888b6d2 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

resolve compilation issues and test failures

888b6d2Corey O'Connor13 years ago

CHANGELOG+1−1

compare with master

unifiedsplit

@@ -2,7 +2,7 @@

2 * removed the typeclass based terminal and display context interface in favor of a data

3 structure of properties interface.

4 * input handling changes

5− * KASCII is not KChar

5+ * KASCII is now KChar

6 * KPN5 is now KCenter

7 * tests exist.

8 * the default amount of time between ESC and a subsequent character that causes VTY to

src/Graphics/Vty/Image.hs−70

@@ -50,7 +50,6 @@ import Graphics.Text.Width

51import qualified Data.ByteString as B

52import qualified Data.ByteString.Lazy as BL

53−import Data.Monoid

54import qualified Data.Text as T

53import qualified Data.Text as T

55import qualified Data.Text.Encoding as T

54import qualified Data.Text.Encoding as T

56import qualified Data.Text.Lazy as TL

55import qualified Data.Text.Lazy as TL

@@ -60,75 +59,6 @@ import Data.Word

60infixr 5 <|>

59infixr 5 <|>

61infixr 4 <->

60infixr 4 <->

63−-- | Append in the Monoid instance is equivalent to <->.

64−instance Monoid Image where

65− mempty = EmptyImage

66− mappend = vert_join

67−

68−-- | combines two images side by side

69−--

70−-- Combines text chunks where possible. Assures output_width and output_height properties are not

71−-- violated.

72−--

73−-- The result image will have a width equal to the sum of the two images width. And the height will

74−-- equal the largest height of the two images. The area not defined in one image due to a height

75−-- missmatch will be filled with the background pattern.

76−--

77−-- TODO: the bg fill is biased towards top to bottom languages(?)

78−horiz_join :: Image -> Image -> Image

79−horiz_join EmptyImage i = i

80−horiz_join i EmptyImage = i

81−horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)

82− | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)

83− -- TODO: assumes horiz text height is always 1

84− | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1

85−horiz_join i_0 i_1

86− -- If the images are of the same height then no padding is required

87− | h_0 == h_1 = HorizJoin i_0 i_1 w h_0

88− -- otherwise one of the images needs to be padded to the right size.

89− | h_0 < h_1 -- Pad i_0

90− = let pad_amount = h_1 - h_0

91− in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1

92− | h_0 > h_1 -- Pad i_1

93− = let pad_amount = h_0 - h_1

94− in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0

95− where

96− w_0 = image_width i_0

97− w_1 = image_width i_1

98− w = w_0 + w_1

99− h_0 = image_height i_0

100− h_1 = image_height i_1

101−horiz_join _ _ = error "horiz_join applied to undefined values."

102−

103−-- | combines two images vertically

104−--

105−-- The result image will have a height equal to the sum of the heights of both images.

106−-- The width will equal the largest width of the two images.

107−-- The area not defined in one image due to a width missmatch will be filled with the background

108−-- pattern.

109−--

110−-- TODO: the bg fill is biased towards right to left languages(?)

111−vert_join :: Image -> Image -> Image

112−vert_join EmptyImage i = i

113−vert_join i EmptyImage = i

114−vert_join i_0 i_1

115− -- If the images are of the same width then no background padding is required

116− | w_0 == w_1 = VertJoin i_0 i_1 w_0 h

117− -- Otherwise one of the images needs to be padded to the size of the other image.

118− | w_0 < w_1

119− = let pad_amount = w_1 - w_0

120− in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h

121− | w_0 > w_1

122− = let pad_amount = w_0 - w_1

123− in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h

124− where

125− w_0 = image_width i_0

126− w_1 = image_width i_1

127− h_0 = image_height i_0

128− h_1 = image_height i_1

129− h = h_0 + h_1

130−vert_join _ _ = error "vert_join applied to undefined values."

131−

132-- | An area of the picture's bacground (See Background) of w columns and h rows.

62-- | An area of the picture's bacground (See Background) of w columns and h rows.

133background_fill :: Int -> Int -> Image

63background_fill :: Int -> Int -> Image

134background_fill w h

64background_fill w h

src/Graphics/Vty/Image/Internal.hs+70

@@ -7,6 +7,7 @@ import Graphics.Text.Width

8import Control.DeepSeq

10+import Data.Monoid

10import qualified Data.Text.Lazy as TL

11import qualified Data.Text.Lazy as TL

12-- | A display text is a Data.Text.Lazy

13-- | A display text is a Data.Text.Lazy

@@ -221,3 +222,72 @@ image_height CropBottom { output_height = h } = h

221image_height CropTop { output_height = h } = h

222image_height CropTop { output_height = h } = h

222image_height EmptyImage = 0

223image_height EmptyImage = 0

223

224

225+-- | Append in the Monoid instance is equivalent to <->.

226+instance Monoid Image where

227+ mempty = EmptyImage

228+ mappend = vert_join

229+

230+-- | combines two images side by side

231+--

232+-- Combines text chunks where possible. Assures output_width and output_height properties are not

233+-- violated.

234+--

235+-- The result image will have a width equal to the sum of the two images width. And the height will

236+-- equal the largest height of the two images. The area not defined in one image due to a height

237+-- missmatch will be filled with the background pattern.

238+--

239+-- TODO: the bg fill is biased towards top to bottom languages(?)

240+horiz_join :: Image -> Image -> Image

241+horiz_join EmptyImage i = i

242+horiz_join i EmptyImage = i

243+horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)

244+ | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)

245+ -- TODO: assumes horiz text height is always 1

246+ | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1

247+horiz_join i_0 i_1

248+ -- If the images are of the same height then no padding is required

249+ | h_0 == h_1 = HorizJoin i_0 i_1 w h_0

250+ -- otherwise one of the images needs to be padded to the right size.

251+ | h_0 < h_1 -- Pad i_0

252+ = let pad_amount = h_1 - h_0

253+ in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1

254+ | h_0 > h_1 -- Pad i_1

255+ = let pad_amount = h_0 - h_1

256+ in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0

257+ where

258+ w_0 = image_width i_0

259+ w_1 = image_width i_1

260+ w = w_0 + w_1

261+ h_0 = image_height i_0

262+ h_1 = image_height i_1

263+horiz_join _ _ = error "horiz_join applied to undefined values."

264+

265+-- | combines two images vertically

266+--

267+-- The result image will have a height equal to the sum of the heights of both images.

268+-- The width will equal the largest width of the two images.

269+-- The area not defined in one image due to a width missmatch will be filled with the background

270+-- pattern.

271+--

272+-- TODO: the bg fill is biased towards right to left languages(?)

273+vert_join :: Image -> Image -> Image

274+vert_join EmptyImage i = i

275+vert_join i EmptyImage = i

276+vert_join i_0 i_1

277+ -- If the images are of the same width then no background padding is required

278+ | w_0 == w_1 = VertJoin i_0 i_1 w_0 h

279+ -- Otherwise one of the images needs to be padded to the size of the other image.

280+ | w_0 < w_1

281+ = let pad_amount = w_1 - w_0

282+ in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h

283+ | w_0 > w_1

284+ = let pad_amount = w_0 - w_1

285+ in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h

286+ where

287+ w_0 = image_width i_0

288+ w_1 = image_width i_1

289+ h_0 = image_height i_0

290+ h_1 = image_height i_1

291+ h = h_0 + h_1

292+vert_join _ _ = error "vert_join applied to undefined values."

293+

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

@@ -89,7 +89,7 @@ input_for_name_and_io escDelay term_name term_in = do

89 ]

90 setTerminalAttributes term_in attr' Immediately

91 set_term_timing term_in

92− let classify_table = classify_table_for_term terminal

92+ let classify_table = classify_table_for_term term_name terminal

93 (eventChannel, shutdown_event_processing) <- initInputForFd escDelay classify_table term_in

94 let pokeIO = Catch $ do

95 let e = error "(getsize in input layer)"

src/Graphics/Vty/Input/Events.hs−10

@@ -38,15 +38,5 @@ data Event

38 | EvResize Int Int

39 deriving (Eq,Show,Ord)

41−-- | representation of mapping from input bytes to key and modifier.

42−--

43−-- Deprecated. Only used internally

44−type ClassifyTableV1 = [(String, (Key, [Modifier]))]

45−

46-- | representation of mapping from input bytes to event

41-- | representation of mapping from input bytes to event

47type ClassifyTable = [(String, Event)]

42type ClassifyTable = [(String, Event)]

48−

49−map_to_legacy_table :: ClassifyTable -> ClassifyTableV1

50−map_to_legacy_table = map f

51− where f (s, EvKey k mods) = (s, (k, mods))

52− f _ = error "no mapping for mouse or resize events"

src/Graphics/Vty/Input/Internal.hs+30−9

@@ -1,3 +1,7 @@

1+-- Much of the input layer used to be in a single module with a few large functions. I've refactored

2+-- the input layer into many small bits. Now, I think, the code is a better position to be

3+-- incrementally refined. Still, until there are proper tests in place much of the refinement must

4+-- wait.

1module Graphics.Vty.Input.Internal where

5module Graphics.Vty.Input.Internal where

3import Graphics.Vty.Input.Events

7import Graphics.Vty.Input.Events

@@ -15,6 +19,7 @@ import qualified Data.Set as S( fromList, member )

15import Data.Word

19import Data.Word

17import Foreign ( alloca, poke, peek, Ptr )

21import Foreign ( alloca, poke, peek, Ptr )

22+import Foreign.C.Types (CInt(..))

19import System.Posix.IO ( fdReadBuf

24import System.Posix.IO ( fdReadBuf

20 , setFdOption

25 , setFdOption

@@ -52,6 +57,10 @@ inputToEventThread classifier inputChannel eventChannel = loop []

52 if c == '\xFFFD'

57 if c == '\xFFFD'

53 then return ()

58 then return ()

54 else loop (kb ++ [c])

59 else loop (kb ++ [c])

60+ -- drop the entirety of invalid sequences. Probably better to drop only the first

61+ -- character. However, the read behavior of terminals (a single read corresponds to the

62+ -- bytes of a single event) might mean this results in quicker error recovery from a

63+ -- users perspective.

55 Invalid -> do

64 Invalid -> do

56 c <- readChan inputChannel

65 c <- readChan inputChannel

57 if c == '\xFFFD'

66 if c == '\xFFFD'

@@ -61,7 +70,12 @@ inputToEventThread classifier inputChannel eventChannel = loop []

61 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s

70 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s

62 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""

71 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""

73+-- This makes a kind of tri. Has space efficiency issues with large input blocks.

74+-- Likely building a parser and just applying that would be better.

75+-- I did not write this so I might just rewrite it for better understanding. Not the best of

76+-- reasons...

77+-- TODO: measure and rewrite if required.

64−compile :: ClassifyTableV1 -> [Char] -> KClass

78+compile :: ClassifyTable -> [Char] -> KClass

65compile table = cl' where

79compile table = cl' where

66 -- take all prefixes and create a set of these

80 -- take all prefixes and create a set of these

67 prefix_set = S.fromList $ concatMap (init . inits . fst) $ table

81 prefix_set = S.fromList $ concatMap (init . inits . fst) $ table

@@ -73,19 +87,18 @@ compile table = cl' where

73 -- if the input_block is exactly what is expected for an event then consume the whole

87 -- if the input_block is exactly what is expected for an event then consume the whole

74 -- block and return the event

88 -- block and return the event

75 False -> case event_for_input input_block of

89 False -> case event_for_input input_block of

76− Just (k,m) -> Valid k m

90+ Just (EvKey k m) -> Valid k m

77 -- look up progressively large prefixes of the input block until an event is found

91 -- look up progressively large prefixes of the input block until an event is found

78 -- H: There will always be one match. The prefix_set contains, by definition, all

92 -- H: There will always be one match. The prefix_set contains, by definition, all

79 -- prefixes of an event.

93 -- prefixes of an event.

80 Nothing ->

94 Nothing ->

81 let input_prefixes = init $ inits input_block

95 let input_prefixes = init $ inits input_block

82 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of

96 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of

83− (s,(k,m)) : _ -> MisPfx k m (drop (length s) input_block)

97+ (s,EvKey k m) : _ -> MisPfx k m (drop (length s) input_block)

84− [] -> error $ "vty internal inconsistency - "

98+ -- neither a prefix or a full event. Might be interesting to log.

85− ++ "input not a prefix nor contains any event data "

86− ++ show input_block

99+ [] -> error $ show input_block

100

88−classify, classifyTab :: ClassifyTableV1 -> [Char] -> KClass

101+classify, classifyTab :: ClassifyTable -> [Char] -> KClass

102

90-- As soon as

103-- As soon as

91classify _table "\xFFFD" = EndLoop

104classify _table "\xFFFD" = EndLoop

@@ -97,7 +110,7 @@ classify table other

110

98classifyUtf8 :: [Char] -> KClass

111classifyUtf8 :: [Char] -> KClass

99classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of

112classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of

100− Just (unicodeChar, _) -> Valid (KASCII unicodeChar) []

113+ Just (unicodeChar, _) -> Valid (KChar unicodeChar) []

101 _ -> Invalid -- something bad happened; just ignore and continue.

114 _ -> Invalid -- something bad happened; just ignore and continue.

102

115

103classifyTab table = compile table

116classifyTab table = compile table

@@ -112,7 +125,15 @@ utf8Length c

112 | c < 0xF0 = 3

125 | c < 0xF0 = 3

113 | otherwise = 4

126 | otherwise = 4

114

127

128+-- I gave a quick shot at replacing this code with some that removed the "odd" bits. The "obvious"

129+-- changes all failed testing. This is timing sensitive code.

130+-- I now think I can replace this wil code that makes the time sensitivity explicit. I am waiting

131+-- until I have a good set of characterization tests to verify the input to event timing is still

132+-- correct for a user. I estimate the current tests cover ~70% of the required cases.

133+--

134+-- This is an example of an algorithm where code coverage could be high, even 100%, but the

135+-- algorithm still under tested. I should collect more of these examples...

115−initInputForFd :: Int -> ClassifyTableV1 -> Fd -> IO (Chan Event, IO ())

136+initInputForFd :: Int -> ClassifyTable -> Fd -> IO (Chan Event, IO ())

116initInputForFd escDelay classify_table input_fd = do

137initInputForFd escDelay classify_table input_fd = do

117 inputChannel <- newChan

138 inputChannel <- newChan

118 eventChannel <- newChan

139 eventChannel <- newChan

src/Graphics/Vty/Input/Terminfo.hs+19−15

@@ -1,9 +1,10 @@

1module Graphics.Vty.Input.Terminfo where

3import Graphics.Vty.Input.Events

4−import qualified Graphics.Vty.Input.Terminfo.VT100 as VT100

4+import qualified Graphics.Vty.Input.Terminfo.ANSI as ANSI

5import qualified Graphics.Vty.Input.Terminfo.XTerm7Bit as XTerm7Bit

7+import Control.Arrow

7import System.Console.Terminfo

8import System.Console.Terminfo

9-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

10-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

@@ -33,21 +34,23 @@ import System.Console.Terminfo

33--

34--

34-- \todo terminfo meta is not supported.

35-- \todo terminfo meta is not supported.

35-- \todo no 8bit

36-- \todo no 8bit

36−classify_table_for_term :: String -> Terminal -> ClassifyTableV1

37+classify_table_for_term :: String -> Terminal -> ClassifyTable

37classify_table_for_term term_name term =

38classify_table_for_term term_name term =

38− concatMap map_to_legacy_table

39− $ caps_classify_table term keys_from_caps_table

39+ concat $ caps_classify_table term keys_from_caps_table

40− : visible_chars

40+ : universal_table

41− : ctrl_chars

41+ : term_specific_tables term_name

42− : ctrl_meta_chars

43− : special_support_keys

44− : internal_tables term_name

43+-- | key table assumed to be applicable to all terminals.

44+universal_table :: ClassifyTable

45+universal_table = concat [visible_chars, ctrl_chars, ctrl_meta_chars, special_support_keys]

46+

46−caps_classify_table :: Terminal -> [(String,Event)] -> [(String,Event)]

47+caps_classify_table :: Terminal -> [(String,Event)] -> ClassifyTable

47caps_classify_table terminal table = [(x,y) | (Just x,y) <- map extract_cap table]

48caps_classify_table terminal table = [(x,y) | (Just x,y) <- map extract_cap table]

48 where extract_cap = first (getCapability terminal . tiGetStr)

49 where extract_cap = first (getCapability terminal . tiGetStr)

50−internal_tables term_name

51+-- | tables specific to a given terminal that are not derivable from terminfo.

52+term_specific_tables :: String -> [ClassifyTable]

53+term_specific_tables term_name

51 | ANSI.supports term_name = ANSI.tables

54 | ANSI.supports term_name = ANSI.tables

52 | XTerm7Bit.supports term_name = XTerm7Bit.tables

55 | XTerm7Bit.supports term_name = XTerm7Bit.tables

53 | otherwise = []

56 | otherwise = []

@@ -64,19 +67,20 @@ visible_chars = [ ([x], EvKey (KChar x) [])

64 | x <- [' ' .. toEnum 0xC1]

67 | x <- [' ' .. toEnum 0xC1]

65 ]

68 ]

67−-- | Non visible cahracters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

70+-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

68--

71--

69-- \todo resolve CTRL-i is the same as tab

72-- \todo resolve CTRL-i is the same as tab

70ctrl_chars :: ClassifyTable

73ctrl_chars :: ClassifyTable

71ctrl_chars =

74ctrl_chars =

72 [ ([toEnum x],EvKey (KChar y) [MCtrl])

75 [ ([toEnum x],EvKey (KChar y) [MCtrl])

73 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),

76 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),

74− y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

77+ y /= 'i', -- Resolve issue #3 where CTRL-i hides TAB.

78+ y /= 'h' -- CTRL-h should not hide BS

75 ]

79 ]

77-- | Ctrl+Meta+Char

81-- | Ctrl+Meta+Char

78ctrl_meta_chars :: ClassifyTable

82ctrl_meta_chars :: ClassifyTable

79−ctrl_meta_chars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m)))

83+ctrl_meta_chars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrl_chars

81-- | esc, meta esc, delete, meta delete, enter, meta enter

85-- | esc, meta esc, delete, meta delete, enter, meta enter

82special_support_keys :: ClassifyTable

86special_support_keys :: ClassifyTable

@@ -88,7 +92,7 @@ special_support_keys =

88 -- Special support for Enter

92 -- Special support for Enter

89 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

93 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

90 -- explicit support for tab

94 -- explicit support for tab

91− , ("\t", EvKey KChar '\t' []

95+ , ("\t", EvKey (KChar '\t') [])

92 ]

96 ]

94-- | classify table directly generated from terminfo cap strings

98-- | classify table directly generated from terminfo cap strings

src/Graphics/Vty/Input/Terminfo/ANSI.hs+13−11

@@ -24,7 +24,7 @@ nav_keys_0 =

24-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end

25nav_keys_1 :: ClassifyTable

26nav_keys_1 =

27− [("\ESC[" ++ charCnt ++ show mc++c,(s,m))

27+ [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

28 | charCnt <- ["1;", ""], -- we can have a count or not

29 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

30 ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

@@ -33,16 +33,16 @@ nav_keys_1 =

33 ]

35-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end

36−nav_keys_2 :: ClassifyTableV1

36+nav_keys_2 :: ClassifyTable

37nav_keys_2 =

38− let k n s = ("\ESC["++show n++"~",(s,[]))

38+ let k n s = ("\ESC["++show n++"~",EvKey s [])

39 in zipWith k [2::Int,3,5,6,1,4]

40 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

42-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end

43−nav_keys_3 :: ClassifyTableV1

43+nav_keys_3 :: ClassifyTable

44nav_keys_3 =

45− let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))

45+ let k n s = ("\ESC["++show n++";5~", EvKey s [MCtrl])

46 in zipWith k [2::Int,3,5,6,1,4]

47 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

@@ -55,9 +55,9 @@ nav_keys_3 =

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

56--

57-- That is more complex than below. I cannot fault the original author for just hard coding a table.

58−function_keys_1 :: ClassifyTableV1

58+function_keys_1 :: ClassifyTable

59function_keys_1 =

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

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

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

63-- | VT 100 (?) encoding for meta plus char

@@ -69,11 +69,13 @@ function_keys_1 =

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

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

71-- special_support_keys.

72−function_keys_2 :: ClassifyTableV1

72+function_keys_2 :: ClassifyTable

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

73+function_keys_2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

74+ | x <- '\t':[' ' .. '~']

74− x /= '[']

75+ , x /= '['

76+ ]

76−tables :: [ClassifyTableV1]

78+tables :: [ClassifyTable]

77tables =

79tables =

78 [ nav_keys_0

80 [ nav_keys_0

79 , nav_keys_1

81 , nav_keys_1

src/Graphics/Vty/Input/Terminfo/XTerm7Bit.hs+22−17

@@ -1,17 +1,20 @@

1−module Graphics.Vty.Input.Terminfo.XTerm where

1+module Graphics.Vty.Input.Terminfo.XTerm7Bit where

3import Graphics.Vty.Input.Events

5+import Data.List (isInfixOf, isPrefixOf)

5-- | The built in input augmentation for XTerm supports any TERM starting with xterm except those

7-- | The built in input augmentation for XTerm supports any TERM starting with xterm except those

6-- containing 8bit.

8-- containing 8bit.

9+supports :: String -> Bool

7−supports term_name = "xterm" `isPrefixOf` term_name && !("8bit" `isInfixOf` term_name)

10+supports term_name = "xterm" `isPrefixOf` term_name && not ("8bit" `isInfixOf` term_name)

9-- | Encoding for navigation keys.

12-- | Encoding for navigation keys.

10--

13--

11-- TODO: This is not the same as the input bytes pulled from teh caps table.

14-- TODO: This is not the same as the input bytes pulled from teh caps table.

12−nav_keys_0 :: ClassifyTableV1

15+nav_keys_0 :: ClassifyTable

13nav_keys_0 =

16nav_keys_0 =

14− [ k "G" KNP5

17+ [ k "G" KCenter

15 , k "P" KPause

18 , k "P" KPause

16 , k "A" KUp

19 , k "A" KUp

17 , k "B" KDown

20 , k "B" KDown

@@ -21,12 +24,12 @@ nav_keys_0 =

21 , k "F" KEnd

24 , k "F" KEnd

22 , k "E" KBegin

25 , k "E" KBegin

23 ]

26 ]

24− where k c s = ("\ESC["++c,(s,[]))

27+ where k c s = ("\ESC["++c,EvKey s [])

26-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end

29-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end

27−nav_keys_1 :: ClassifyTableV1

30+nav_keys_1 :: ClassifyTable

28nav_keys_1 =

31nav_keys_1 =

29− [("\ESC[" ++ charCnt ++ show mc++c,(s,m))

32+ [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

30 | charCnt <- ["1;", ""], -- we can have a count or not

33 | charCnt <- ["1;", ""], -- we can have a count or not

31 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

34 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

32 ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

35 ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

@@ -34,16 +37,16 @@ nav_keys_1 =

34 ]

37 ]

36-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end

39-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end

37−nav_keys_2 :: ClassifyTableV1

40+nav_keys_2 :: ClassifyTable

38nav_keys_2 =

41nav_keys_2 =

39− let k n s = ("\ESC["++show n++"~",(s,[]))

42+ let k n s = ("\ESC["++show n++"~",EvKey s [])

40 in zipWith k [2::Int,3,5,6,1,4]

43 in zipWith k [2::Int,3,5,6,1,4]

41 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

44 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

43-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end

46-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end

44−nav_keys_3 :: ClassifyTableV1

47+nav_keys_3 :: ClassifyTable

45nav_keys_3 =

48nav_keys_3 =

46− let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))

49+ let k n s = ("\ESC["++show n++";5~",EvKey s [MCtrl])

47 in zipWith k [2::Int,3,5,6,1,4]

50 in zipWith k [2::Int,3,5,6,1,4]

48 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

51 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

@@ -56,9 +59,9 @@ nav_keys_3 =

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

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

57--

60--

58-- That is more complex than below. I cannot fault the original author for just hard coding a table.

61-- That is more complex than below. I cannot fault the original author for just hard coding a table.

59−function_keys_1 :: ClassifyTableV1

62+function_keys_1 :: ClassifyTable

60function_keys_1 =

63function_keys_1 =

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

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

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

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

64-- | VT 100 (?) encoding for meta plus char

67-- | VT 100 (?) encoding for meta plus char

@@ -70,12 +73,14 @@ function_keys_1 =

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

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

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

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

72-- special_support_keys.

75-- special_support_keys.

73−function_keys_2 :: ClassifyTableV1

76+function_keys_2 :: ClassifyTable

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

77+function_keys_2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

78+ | x <- '\t':[' ' .. '~']

75− x /= '[']

79+ , x /= '['

80+ ]

77-- | classify table for ANSI terminals

82-- | classify table for ANSI terminals

78−tables :: [ClassifyTableV1]

83+tables :: [ClassifyTable]

79tables =

84tables =

80 [ nav_keys_0

85 [ nav_keys_0

81 , nav_keys_1

86 , nav_keys_1

test/Rouge.hs+1−1

@@ -93,7 +93,7 @@ process_event = do

93 then return True

94 else do

95 case k of

96− EvKey (KASCII 'r') [MCtrl] -> ask >>= liftIO . refresh

96+ EvKey (KChar 'r') [MCtrl] -> ask >>= liftIO . refresh

97 EvKey KLeft [] -> move_dude (-1) 0

98 EvKey KRight [] -> move_dude 1 0

99 EvKey KUp [] -> move_dude 0 (-1)

test/VerifyUsingMockInput.hs+29−29

@@ -11,7 +11,7 @@ import Verify.Graphics.Vty.Output

11import Data.List (intersperse)

13import Graphics.Vty hiding (resize)

14−import Graphics.Vty.Input.Data

14+import Graphics.Vty.Input.Events

15import Graphics.Vty.Input.Internal

16import Graphics.Vty.Input.Terminfo

@@ -102,7 +102,7 @@ compare_events input_spec expected_events out_events = compare_events' expected_

102 printf "received events %s\n" (show out_events) :: IO ()

103 return False

104

105−assert_events_from_syn_input :: ClassifyTableV1 -> InputSpec -> ExpectedSpec -> IO Bool

105+assert_events_from_syn_input :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool

106assert_events_from_syn_input table input_spec expected_events = do

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

108 event_count = length expected_events

@@ -127,7 +127,7 @@ assert_events_from_syn_input table input_spec expected_events = do

127 out_events <- reverse <$> readIORef events_ref

128 compare_events input_spec expected_events out_events

129

130−assert_events_from_input_block :: ClassifyTableV1 -> InputSpec -> ExpectedSpec -> IO Bool

130+assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool

131assert_events_from_input_block table input_spec expected_events = do

132 let classifier = classify table

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

@@ -168,12 +168,12 @@ instance Monad m => Serial m (InputBlocksUsingTable event) where

168 selections [] = []

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

170

171−verify_simple_input_block_to_event :: Property IO

171+verify_visible_input_block_to_event :: Property IO

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

172+verify_visible_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do

173− let input_seq = gen simple_chars

173+ let input_seq = gen visible_chars

174 input = Bytes $ concat [s | (s,_) <- input_seq]

175− events = [e | (_,(k,ms)) <- input_seq, let e = EvKey k ms]

175+ events = map snd input_seq

176− monadic $ assert_events_from_input_block simple_chars [input] events

176+ monadic $ assert_events_from_input_block visible_chars [input] events

177

178verify_keys_from_caps_table_block_to_event :: Property IO

179verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->

@@ -181,19 +181,19 @@ verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable ge

181 term <- setupTerm term_name

182 let table = caps_classify_table term keys_from_caps_table

183 input_seq = gen table

184− events = [e | (_,e) <- input_seq]

184+ events = map snd input_seq

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

185+ keydowns = map (Bytes . fst) input_seq

186 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

187− assert_events_from_input_block (map_to_legacy_table table) input events

187+ assert_events_from_input_block table input events

188

189−verify_simple_syn_input_to_event :: Property IO

189+verify_visible_syn_input_to_event :: Property IO

190−verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

190+verify_visible_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

191− let table = simple_chars

191+ let table = visible_chars

192 input_seq = gen table

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

193+ events = map snd input_seq

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

194+ keydowns = map (Bytes . fst) input_seq

195 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

196− assert_events_from_syn_input (concat ansi_classify_table) input events

196+ assert_events_from_syn_input universal_table input events

197

198verify_caps_syn_input_to_event :: Property IO

199verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

@@ -201,39 +201,39 @@ verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

201 term <- setupTerm term_name

202 let table = caps_classify_table term keys_from_caps_table

203 input_seq = gen table

204− events = [e | (_,e) <- input_seq]

204+ events = map snd input_seq

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

205+ keydowns = map (Bytes . fst) input_seq

206 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

207− assert_events_from_syn_input (map_to_legacy_table table) input events

207+ assert_events_from_syn_input table input events

208

209verify_special_syn_input_to_event :: Property IO

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

211− let table = function_keys_1 ++ function_keys_2

211+ let table = special_support_keys

212 input_seq = gen table

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

213+ events = map snd input_seq

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

214+ keydowns = map (Bytes . fst) input_seq

215 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

216− assert_events_from_syn_input (concat ansi_classify_table) input events

216+ assert_events_from_syn_input universal_table input events

217

218verify_full_syn_input_to_event :: Property IO

219verify_full_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

220 forEachOf terminals_of_interest $ \term_name -> monadic $ do

221 term <- setupTerm term_name

222− let table = classify_table_for_term term

222+ let table = classify_table_for_term term_name term

223 input_seq = gen table

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

224+ events = map snd input_seq

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

225+ keydowns = map (Bytes . fst) input_seq

226 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

227 assert_events_from_syn_input table input events

228

229main :: IO ()

230main = defaultMain

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

232− verify_simple_input_block_to_event

232+ verify_visible_input_block_to_event

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

234 verify_keys_from_caps_table_block_to_event

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

236− verify_simple_syn_input_to_event

236+ verify_visible_syn_input_to_event

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

238 verify_caps_syn_input_to_event

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