c231f47 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

move some function keys to be read from caps. disambiguate some keys. expand input test

c231f47Corey O'Connor13 years ago

src/Graphics/Vty/Input/Data.hs+37−10

compare with master

unifiedsplit

@@ -2,6 +2,8 @@

2module Graphics.Vty.Input.Data where

4-- | Representations of non-modifier keys.

5+--

6+-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.

7 | KLeft | KDown | KRight | KEnter

9 | KLeft | KDown | KRight | KEnter

@@ -41,7 +43,10 @@ keys_from_caps_table =

41 , ("kcub1", EvKey KLeft [])

43 , ("kcub1", EvKey KLeft [])

42 , ("kLFT", EvKey KLeft [MShift])

44 , ("kLFT", EvKey KLeft [MShift])

43 , ("kRIT", EvKey KRight [MShift])

45 , ("kRIT", EvKey KRight [MShift])

44− ]

46+ ] ++ function_key_caps_table

47+

48+function_key_caps_table :: [(String, Event)]

49+function_key_caps_table = flip map [0..63] $ \n -> ("key_f" ++ show n, EvKey (KFun n) [])

46nav_keys_0 :: ClassifyTable

51nav_keys_0 :: ClassifyTable

47nav_keys_0 =

52nav_keys_0 =

@@ -82,22 +87,41 @@ nav_keys_3 =

82-- Support for simple characters.

87-- Support for simple characters.

83-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this

88-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this

84-- classify table is reached.

89-- classify table is reached.

90+--

91+-- TODO: resolve

92+-- 1. start at ' '. The earlier characters are all ctrl_char_keys

85simple_chars :: ClassifyTable

93simple_chars :: ClassifyTable

86−simple_chars = [ (x:[],(KASCII x,[])) | x <- map toEnum [0..0xC1] ]

94+simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]

88-- TODO: Support for function keys (should use terminfo)

96-- TODO: Support for function keys (should use terminfo)

89--

97--

90-- (corey): yes. This definitely should. On my terminal these keys do not operate as expected.

98-- (corey): yes. This definitely should. On my terminal these keys do not operate as expected.

91−function_keys_0 :: ClassifyTable

99+-- function_keys_0 :: ClassifyTable

92−function_keys_0 = [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ]

100+-- function_keys_0 = [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ]

93−

101+

102+-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:

103+-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any

104+-- character transmitted, this fact can be indicated with km. Other- wise, software will

105+-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this

106+-- ``meta mode'' on and off, they can be given as smm and rmm."

107+--

108+-- That is more complex that below. I cannot fault the original author for just hard coding a table

109+-- ;-)

94function_keys_1 :: ClassifyTable

110function_keys_1 :: ClassifyTable

95function_keys_1 =

111function_keys_1 =

96 let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in

112 let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in

97− concat [ f 6 [17..21] [], f 11 [23,24] [], f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

113+ concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

98−

114+

115+-- TODO: resolve -

116+--

117+-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".

118+-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is

119+-- the same as ESC should examine km and current encoding.

120+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by

121+-- special_support_keys.

99function_keys_2 :: ClassifyTable

122function_keys_2 :: ClassifyTable

100−function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\ESC':'\t':[' ' .. '\DEL'] ]

123+function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],

124+ x /= '[']

101

125

102-- Ctrl+Char

126-- Ctrl+Char

103ctrl_char_keys :: ClassifyTable

127ctrl_char_keys :: ClassifyTable

@@ -108,9 +132,13 @@ ctrl_char_keys =

108 ]

132 ]

109

133

110-- Ctrl+Meta+Char

134-- Ctrl+Meta+Char

135+--

136+-- TODO: CTRL-i is the same as tab thing

111ctrl_meta_keys :: ClassifyTable

137ctrl_meta_keys :: ClassifyTable

112ctrl_meta_keys =

138ctrl_meta_keys =

113− [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']) ]

139+ [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),

140+ y /= 'i'

141+ ]

114

142

115-- Special support

143-- Special support

116special_support_keys :: ClassifyTable

144special_support_keys :: ClassifyTable

@@ -131,7 +159,6 @@ ansi_classify_table =

131 , nav_keys_2

159 , nav_keys_2

132 , nav_keys_3

160 , nav_keys_3

133 , simple_chars

161 , simple_chars

134− , function_keys_0

135 , function_keys_1

162 , function_keys_1

136 , function_keys_2

163 , function_keys_2

137 , ctrl_char_keys

164 , ctrl_char_keys

src/Graphics/Vty/Input/Internal.hs+1−1

@@ -4,7 +4,7 @@ import Graphics.Vty.Input.Data

5import Codec.Binary.UTF8.Generic (decode)

6import Control.Concurrent

7−import Control.Exception (try, IOException(..))

7+import Control.Exception (try, IOException)

8import Control.Monad (when, void)

10import Data.Char

test/VerifyUsingMockInput.hs+30−14

@@ -8,7 +8,7 @@ module Main where

9import Verify.Graphics.Vty.Terminal

11−import Data.List (intersperse, permutations)

11+import Data.List (intersperse)

13import Graphics.Vty hiding (resize)

14import Graphics.Vty.Input.Data

@@ -36,6 +36,9 @@ import Test.SmallCheck.Series

36max_block_size :: Int

37max_block_size = 16

39+max_table_size :: Int

40+max_table_size = 28

41+

39forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m

42forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m

40forEachOf l = over (generate (\n -> take n l))

43forEachOf l = over (generate (\n -> take n l))

@@ -81,7 +84,6 @@ assert_events_from_syn_input :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO

81assert_events_from_syn_input table input_spec expected_events = do

84assert_events_from_syn_input table input_spec expected_events = do

82 let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay

85 let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay

83 event_count = length expected_events

86 event_count = length expected_events

84− -- create pipe

85 (output_fd, input_fd) <- createPipe

87 (output_fd, input_fd) <- createPipe

86 (output, shutdown_input) <- initInputForFd test_esc_sample_delay table output_fd

88 (output, shutdown_input) <- initInputForFd test_esc_sample_delay table output_fd

87 events_ref <- newIORef []

89 events_ref <- newIORef []

@@ -93,13 +95,13 @@ assert_events_from_syn_input table input_spec expected_events = do

93 closeFd input_fd

95 closeFd input_fd

94 closeFd output_fd

96 closeFd output_fd

95 -- drain output pipe

97 -- drain output pipe

96− let read_all_events = read_loop event_count

98+ let read_events = read_loop event_count

97 read_loop 0 = return ()

99 read_loop 0 = return ()

98 read_loop n = do

100 read_loop n = do

99 e <- readChan output

101 e <- readChan output

100 modifyIORef events_ref ((:) e)

102 modifyIORef events_ref ((:) e)

101 read_loop (n - 1)

103 read_loop (n - 1)

102− gen_events_using_io_actions max_duration write_wait_close read_all_events

104+ gen_events_using_io_actions max_duration write_wait_close read_events

103 out_events <- reverse <$> readIORef events_ref

105 out_events <- reverse <$> readIORef events_ref

104 print (input_spec, expected_events, out_events)

106 print (input_spec, expected_events, out_events)

105 return $ out_events == expected_events

107 return $ out_events == expected_events

@@ -139,8 +141,11 @@ instance Show (InputBlocksUsingTable event) where

139

141

140instance Monad m => Serial m (InputBlocksUsingTable event) where

142instance Monad m => Serial m (InputBlocksUsingTable event) where

141 series = do

143 series = do

142− n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table

144+ n :: Int <- localDepth (const max_table_size) series

143− return $ InputBlocksUsingTable $ \table -> concat (take n (permutations table))

145+ return $ InputBlocksUsingTable $ \table -> concat (take n (selections table))

146+ where

147+ selections [] = []

148+ selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)

144

149

145verify_simple_input_block_to_event :: Property IO

150verify_simple_input_block_to_event :: Property IO

146verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do

151verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do

@@ -161,7 +166,16 @@ verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable ge

161 assert_events_from_input_block (map_to_legacy_table table) input events

166 assert_events_from_input_block (map_to_legacy_table table) input events

162

167

163verify_simple_syn_input_to_event :: Property IO

168verify_simple_syn_input_to_event :: Property IO

164−verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

169+verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

170+ let table = simple_chars

171+ input_seq = gen table

172+ events = [EvKey k ms | (_,(k,ms)) <- input_seq]

173+ keydowns = [Bytes s | (s,_) <- input_seq]

174+ input = intersperse (Delay test_key_delay) keydowns

175+ assert_events_from_syn_input (concat ansi_classify_table) input events

176+

177+verify_caps_syn_input_to_event :: Property IO

178+verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

165 forEachOf terminals_of_interest $ \term_name -> monadic $ do

179 forEachOf terminals_of_interest $ \term_name -> monadic $ do

166 term <- setupTerm term_name

180 term <- setupTerm term_name

167 let table = caps_classify_table term keys_from_caps_table

181 let table = caps_classify_table term keys_from_caps_table

@@ -171,9 +185,9 @@ verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

171 input = intersperse (Delay test_key_delay) keydowns

185 input = intersperse (Delay test_key_delay) keydowns

172 assert_events_from_syn_input (map_to_legacy_table table) input events

186 assert_events_from_syn_input (map_to_legacy_table table) input events

173

187

174−verify_fkeys_syn_input_to_event :: Property IO

188+verify_special_syn_input_to_event :: Property IO

175−verify_fkeys_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

189+verify_special_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

176− let table = function_keys_0

190+ let table = function_keys_1 ++ function_keys_2

177 input_seq = gen table

191 input_seq = gen table

178 events = [EvKey k ms | (_,(k,ms)) <- input_seq]

192 events = [EvKey k ms | (_,(k,ms)) <- input_seq]

179 keydowns = [Bytes s | (s,_) <- input_seq]

193 keydowns = [Bytes s | (s,_) <- input_seq]

@@ -182,13 +196,15 @@ verify_fkeys_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monad

182

196

183main :: IO ()

197main :: IO ()

184main = defaultMain

198main = defaultMain

185− [ testProperty "basic block generated from a single ansi chars to event translation"

199+ [ testProperty "basic block generated from a single visible chars to event translation"

186 verify_simple_input_block_to_event

200 verify_simple_input_block_to_event

187 , testProperty "key sequences read from caps table map to expected events"

201 , testProperty "key sequences read from caps table map to expected events"

188 verify_keys_from_caps_table_block_to_event

202 verify_keys_from_caps_table_block_to_event

189− , testProperty "synthesized typing from basic blocks translates to expected events"

203+ , testProperty "synthesized typing from single visible chars translates to expected events"

190 verify_simple_syn_input_to_event

204 verify_simple_syn_input_to_event

191− , testProperty "synthesized typing from function keys translates to expected events"

205+ , testProperty "synthesized typing from keys from capabilities tables translates to expected events"

192− verify_fkeys_syn_input_to_event

206+ verify_caps_syn_input_to_event

207+ , testProperty "synthesized typing from hard coded special keys translates to expected events"

208+ verify_special_syn_input_to_event

193 ]

209 ]

194

210