0e772f7 · vty · git.iko.soy

CHANGELOG+7−7

compare with master

unifiedsplit

@@ -9,13 +9,13 @@

9 * KASCII is now KChar

10 * KPN5 is now KCenter

11 * tests exist.

12− * Applications add to the input tables by setting inputOverrides of the Config.

12+ * Applications can add to the input tables by setting inputMap of the Config.

13 See Graphics.Vty.Config

14 * Users can define input table extensions that will apply to all vty applications.

15 See Graphics.Vty.Config

16 * terminal timing is now handled by selecting an appropriate VTIME. Previously this was

17 implemented within Vty itself. This reduced complexity in vty but provides a different

18− meta key behavior. There were no know users of the previous behavior.

18+ meta key behavior and implies a requirement on -threaded.

19 * The time vty will wait to verify an ESC byte means a single ESC key is the

20 singleEscPeriod of the Input Config structure.

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

@@ -29,8 +29,8 @@

29 * Each layer is an image.

30 * The layers for a picture are a list of images.

31 * The first image is the top-most layer. The images are ordered from top to bottom.

32− * The transparent areas for a layer are the backgroundFill areas. These will be implicitly

32+ * The transparent areas for a layer are the backgroundFill areas. backgroundFill is

33− added to to pad images when images of different sizes are joined.

33+ added to pad images when images of different sizes are joined.

34 * If the background is clear there is no background layer.

35 * If there is a background character then the bottom layer is the background layer.

36 * emptyPicture is a Picture with no layers and no cursor

@@ -45,8 +45,8 @@

45 events.

46 * Additional information about input and output process can be appended to a debug log

47 * Set environment variable VTY_DEBUG_LOG to path of debug log

48− * Use "debugLog <path>" config directive

48+ * Or use "debugLog <path>" config directive

49− * Set 'debugLog' property of Config

49+ * Or set 'debugLog' property of the Config provided to mkVty.

50 * examples moved to vty-examples package. See test directory for cabal file.

51 * vty-interactive-terminal-test

52 * interactive test. Useful for building a bug report for vty's author.

@@ -55,7 +55,7 @@

55 * view a input event log for vty. Example of interacting with user.

56 * test/EventEcho.hs

57 * vty-rouge

58− * A bad rouge-like game. Example of layers and image build operations.

58+ * The start of a rouge-like game. Example of layers and image build operations.

59 * test/Rouge.hs

60 * vty-benchmark

61 * benchmarks vty. A series of tests that push random pictures to the terminal. The

src/Graphics/Vty/Config.hs+17−15

@@ -109,20 +109,20 @@ singleEscPeriod :: Config -> Int

109singleEscPeriod = maybe 100000 id . specifiedEscPeriod

110

111instance Default Config where

112− def = Config

112+ def = mempty

113− { specifiedEscPeriod = Nothing

114− , debugLog = Nothing

115− , inputOverrides = []

116− }

117

113

118instance Monoid Config where

114instance Monoid Config where

119− mempty = def

115+ mempty = Config

116+ { specifiedEscPeriod = Nothing

117+ , debugLog = mempty

118+ , inputMap = mempty

119+ }

120 mappend c0 c1 = Config

121 -- latter config takes priority in specifiedEscPeriod

122 { specifiedEscPeriod = specifiedEscPeriod c1 <|> specifiedEscPeriod c0

123 -- latter config takes priority in debugInputLog

124− , debugLog = debugLog c1 <|> debugLog c0

124+ , debugLog = debugLog c1 <|> debugLog c0

125− , inputOverrides = inputOverrides c0 <> inputOverrides c1

125+ , inputMap = inputMap c0 <> inputMap c1

126 }

127

128type ConfigParser s a = ParsecT s () (Writer Config) a

@@ -130,12 +130,13 @@ type ConfigParser s a = ParsecT s () (Writer Config) a

130-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@

131userConfig :: IO Config

132userConfig = do

133− userConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

133+ configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

134− overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"

134+ let maybeEnv = tryJust (guard . isDoesNotExistError) . getEnv

135+ overridePath <- maybeEnv "VTY_CONFIG_FILE"

135 overrideConfig <- either (const $ return def) parseConfigFile overridePath

136 overrideConfig <- either (const $ return def) parseConfigFile overridePath

136− debugLogPath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_DEBUG_LOG"

137+ debugLogPath <- maybeEnv "VTY_DEBUG_LOG"

137 let debugLogConfig = either (const def) (\p -> def { debugLog = Just p }) debugLogPath

138 let debugLogConfig = either (const def) (\p -> def { debugLog = Just p }) debugLogPath

138− return $ mconcat [userConfig, overrideConfig, debugLogConfig]

139+ return $ mconcat [configFile, overrideConfig, debugLogConfig]

139

140

140parseConfigFile :: FilePath -> IO Config

141parseConfigFile :: FilePath -> IO Config

141parseConfigFile path = do

142parseConfigFile path = do

@@ -168,14 +169,15 @@ configLexer = P.makeTokenParser configLanguage

168mapDecl = do

169mapDecl = do

169 void $ string "map"

170 void $ string "map"

170 P.whiteSpace configLexer

171 P.whiteSpace configLexer

172+ termIdent <- (char '_' >> P.whiteSpace configLexer >> return Nothing)

171− termIdent <- (char "_" >> return Nothing) <|> (Just <$> P.stringLiteral configLexer)

173+ <|> (Just <$> P.stringLiteral configLexer)

172 bytes <- P.stringLiteral configLexer

174 bytes <- P.stringLiteral configLexer

173 key <- parseKey

175 key <- parseKey

174 modifiers <- parseModifiers

176 modifiers <- parseModifiers

175− lift $ tell $ def { inputOverrides = [(termIdent, bytes, EvKey key modifiers)] }

177+ lift $ tell $ def { inputMap = [(termIdent, bytes, EvKey key modifiers)] }

176

178

177-- TODO: Generated by a vim macro. There is a better way here. Derive parser? Use Read

179-- TODO: Generated by a vim macro. There is a better way here. Derive parser? Use Read

178−-- instance?

180+-- instance? Generics?

179parseKey = do

181parseKey = do

180 key <- P.identifier configLexer

182 key <- P.identifier configLexer

181 case key of

183 case key of

src/Graphics/Vty/Input.hs+5−3

@@ -151,7 +151,8 @@ inputForCurrentTerminal config = do

151-- | Set up the terminal attached to the given Fd for input. Returns a 'Input'.

152--

153-- The table used to determine the 'Events' to produce for the input bytes comes from

154−-- 'classifyTableForTerm'. Which is then overridden by the table from 'classifyTableUserOverrides'.

154+-- 'classifyMapForTerm'. Which is then overridden by the the applicable entries from

155+-- 'inputMap'.

155--

156--

156-- The terminal device is configured with the attributes:

157-- The terminal device is configured with the attributes:

157--

158--

@@ -179,10 +180,11 @@ inputForCurrentTerminal config = do

179inputForNameAndIO :: Config -> String -> Fd -> IO Input

180inputForNameAndIO :: Config -> String -> Fd -> IO Input

180inputForNameAndIO config termName termFd = do

181inputForNameAndIO config termName termFd = do

181 terminal <- Terminfo.setupTerm termName

182 terminal <- Terminfo.setupTerm termName

183+ let inputOverrides = [(s,e) | (t,s,e) <- inputMap config, t == Nothing || t == Just termName]

182− let classifyTable = classifyTableForTerm termName terminal `mappend` inputOverrides config

184+ activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

183 (setAttrs,unsetAttrs) <- attributeControl termFd

185 (setAttrs,unsetAttrs) <- attributeControl termFd

184 setAttrs

186 setAttrs

185− input <- initInputForFd config classifyTable termFd

187+ input <- initInputForFd config termName activeInputMap termFd

186 let pokeIO = Catch $ do

188 let pokeIO = Catch $ do

187 let e = error "vty internal failure: this value should not propagate to users"

189 let e = error "vty internal failure: this value should not propagate to users"

188 setAttrs

190 setAttrs

src/Graphics/Vty/Input/Classify.hs+5−4

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

3-- I did not write this so I might just rewrite it for better understanding. Which is not the best

4-- of reasons.

5-- TODO: measure and rewrite if required.

6−-- TODO: The ClassifyTable interface requires this code to always assure later entries override

6+-- TODO: The ClassifyMap interface requires this code to always assure later entries override

7-- earlier.

8module Graphics.Vty.Input.Classify where

9

@@ -25,7 +25,7 @@ data KClass

25 | Prefix

26 deriving(Show, Eq)

27

28−compile :: ClassifyTable -> [Char] -> KClass

28+compile :: ClassifyMap -> [Char] -> KClass

29compile table = cl' where

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

31 prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

@@ -47,10 +47,11 @@ compile table = cl' where

47 let inputTails = init $ tail $ tails inputBlock

48 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputTails of

49 (s,e) : _ -> Valid e (drop (length s) inputBlock)

50− -- neither a prefix or a full event. Might be interesting to log.

50+ -- neither a prefix or a full event.

51+ -- TODO: debug log

51 [] -> Invalid

52 [] -> Invalid

52

53

53−classify, classifyTab :: ClassifyTable -> [Char] -> KClass

54+classify, classifyTab :: ClassifyMap -> [Char] -> KClass

54

55

55-- As soon as

56-- As soon as

56classify _table s@(c:_) | ord c >= 0xC2

57classify _table s@(c:_) | ord c >= 0xC2

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

@@ -40,3 +40,4 @@ data Event

40 | EvResize Int Int

41 deriving (Eq,Show,Ord)

42

43+type ClassifyMap = [(String,Event)]

src/Graphics/Vty/Input/Loop.hs+10−9

@@ -145,7 +145,7 @@ stopIfRequested = do

145 True <- (liftIO . readIORef) =<< use stopRequestRef

146 return ()

147

148−runInputProcessorLoop :: ClassifyTable -> Input -> IORef Bool -> IO ()

148+runInputProcessorLoop :: ClassifyMap -> Input -> IORef Bool -> IO ()

149runInputProcessorLoop classifyTable input stopFlag = do

150 let bufferSize = 1024

151 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

@@ -165,18 +165,19 @@ attributeControl fd = do

165 unsetAttrs = setTerminalAttributes fd original Immediately

166 return (setAttrs,unsetAttrs)

167

168−logClassifyTable :: Input -> ClassifyTable -> IO()

168+logClassifyMap :: Input -> String -> ClassifyMap -> IO()

169−logClassifyTable input classifyTable = case _inputDebug input of

169+logClassifyMap input termName classifyTable = case _inputDebug input of

170 Nothing -> return ()

171 Just h -> do

172 forM_ classifyTable $ \i -> case i of

173− (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s\n" (show inBytes)

173+ (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show termName)

174+ (show inBytes)

174− (show k)

175+ (show k)

175− (show mods)

176+ (show mods)

176 _ -> return ()

177 _ -> return ()

177

178

178−initInputForFd :: Config -> ClassifyTable -> Fd -> IO Input

179+initInputForFd :: Config -> String -> ClassifyMap -> Fd -> IO Input

179−initInputForFd config classifyTable inFd = do

180+initInputForFd config termName classifyTable inFd = do

180 applyTimingConfig inFd config

181 applyTimingConfig inFd config

181 stopFlag <- newIORef False

182 stopFlag <- newIORef False

182 input <- Input <$> newChan

183 input <- Input <$> newChan

@@ -186,7 +187,7 @@ initInputForFd config classifyTable inFd = do

186 <*> maybe (return Nothing)

187 <*> maybe (return Nothing)

187 (\f -> Just <$> openFile f AppendMode)

188 (\f -> Just <$> openFile f AppendMode)

188 (debugLog config)

189 (debugLog config)

189− logClassifyTable input classifyTable

190+ logClassifyMap input termName classifyTable

190 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

191 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

191 return input

192 return input

192

193

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

@@ -33,26 +33,26 @@ import System.Console.Terminfo

33--

34-- \todo terminfo meta is not supported.

35-- \todo no 8bit

36−classifyTableForTerm :: String -> Terminal -> ClassifyTable

36+classifyMapForTerm :: String -> Terminal -> ClassifyMap

37−classifyTableForTerm termName term =

37+classifyMapForTerm termName term =

38− concat $ capsClassifyTable term keysFromCapsTable

38+ concat $ capsClassifyMap term keysFromCapsTable

39 : universalTable

40 : termSpecificTables termName

41

42-- | key table applicable to all terminals.

43--

44-- TODO: some probably only applicable to ANSI/VT100 terminals.

45−universalTable :: ClassifyTable

45+universalTable :: ClassifyMap

46universalTable = concat [visibleChars, ctrlChars, ctrlMetaChars, specialSupportKeys]

47

48−capsClassifyTable :: Terminal -> [(String,Event)] -> ClassifyTable

48+capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap

49−capsClassifyTable terminal table = [(x,y) | (Just x,y) <- map extractCap table]

49+capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table]

50 where extractCap = first (getCapability terminal . tiGetStr)

51

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

53--

54-- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.

55−termSpecificTables :: String -> [ClassifyTable]

55+termSpecificTables :: String -> [ClassifyMap]

56termSpecificTables _termName = ANSIVT.classifyTable

57

58-- | Visible characters in the ISO-8859-1 and UTF-8 common set.

@@ -62,7 +62,7 @@ termSpecificTables _termName = ANSIVT.classifyTable

62--

63-- TODO: resolve

64-- 1. start at ' '. The earlier characters are all 'ctrlChar'

65−visibleChars :: ClassifyTable

65+visibleChars :: ClassifyMap

66visibleChars = [ ([x], EvKey (KChar x) [])

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

68 ]

@@ -70,7 +70,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])

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

71--

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

73−ctrlChars :: ClassifyTable

73+ctrlChars :: ClassifyMap

74ctrlChars =

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

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

@@ -79,11 +79,11 @@ ctrlChars =

79 ]

80

81-- | Ctrl+Meta+Char

82−ctrlMetaChars :: ClassifyTable

82+ctrlMetaChars :: ClassifyMap

83ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars

84

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

86−specialSupportKeys :: ClassifyTable

86+specialSupportKeys :: ClassifyMap

87specialSupportKeys =

88 [ -- special support for ESC

89 ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

@@ -150,7 +150,7 @@ specialSupportKeys =

150-- * kRIT - shift right

151--

152-- * kcuu1 - up

153−keysFromCapsTable :: ClassifyTable

153+keysFromCapsTable :: ClassifyMap

154keysFromCapsTable =

155 [ ("ka1", EvKey KUpLeft [])

156 , ("ka3", EvKey KUpRight [])

@@ -180,5 +180,5 @@ keysFromCapsTable =

180 ] ++ functionKeyCapsTable

181

182-- | cap names for function keys

183−functionKeyCapsTable :: ClassifyTable

183+functionKeyCapsTable :: ClassifyMap

184functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+7−7

@@ -10,7 +10,7 @@ import Graphics.Vty.Input.Events

10-- | Encoding for navigation keys.

11--

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

13−navKeys0 :: ClassifyTable

13+navKeys0 :: ClassifyMap

14navKeys0 =

15 [ k "G" KCenter

16 , k "P" KPause

@@ -25,7 +25,7 @@ navKeys0 =

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

26

27-- | encoding for shift, meta and ctrl plus arrows/home/end

28−navKeys1 :: ClassifyTable

28+navKeys1 :: ClassifyMap

29navKeys1 =

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

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

@@ -35,14 +35,14 @@ navKeys1 =

35 ]

36

37-- | encoding for ins, del, pageup, pagedown, home, end

38−navKeys2 :: ClassifyTable

38+navKeys2 :: ClassifyMap

39navKeys2 =

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

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

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

43

44-- | encoding for ctrl + ins, del, pageup, pagedown, home, end

45−navKeys3 :: ClassifyTable

45+navKeys3 :: ClassifyMap

46navKeys3 =

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

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

@@ -55,7 +55,7 @@ navKeys3 =

55-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

56--

57-- This encoding depends on the terminal.

58−functionKeys1 :: ClassifyTable

58+functionKeys1 :: ClassifyMap

59functionKeys1 =

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] ]

@@ -69,13 +69,13 @@ functionKeys1 =

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−functionKeys2 :: ClassifyTable

72+functionKeys2 :: ClassifyMap

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

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

75 , x /= '['

76 ]

77

78−classifyTable :: [ClassifyTable]

78+classifyTable :: [ClassifyMap]

79classifyTable =

80 [ navKeys0

81 , navKeys1

test/VerifyConfig.hs+5−1

@@ -33,7 +33,11 @@ exampleConfigConfig :: Config

33exampleConfigConfig = Config

34 { specifiedEscPeriod = def

35 , debugLog = Just "/tmp/vty-debug.txt"

36+ , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])

37+ , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])

36− , inputOverrides = [("\ESC[B", EvKey KUp []), ("\ESC[1;3B", EvKey KDown [MAlt])]

38+ , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])

39+ , (Just "xterm-256-color", "\ESC[1;3B", EvKey KDown [MAlt])

40+ ]

37 }

41 }

38

42

39exampleConfigParses :: IO ()

43exampleConfigParses :: IO ()

test/VerifyUsingMockInput.hs+5−5

@@ -103,14 +103,14 @@ compareEvents inputSpec expectedEvents outEvents = compareEvents' expectedEvents

103 printf "received events %s\n" (show outEvents) :: IO ()

104 return False

105

106−assertEventsFromSynInput :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool

106+assertEventsFromSynInput :: ClassifyMap -> InputSpec -> ExpectedSpec -> IO Bool

107assertEventsFromSynInput table inputSpec expectedEvents = do

108 let maxDuration = sum [t | Delay t <- inputSpec] + minDetectableDelay

109 eventCount = length expectedEvents

110 (writeFd, readFd) <- openPseudoTerminal

111 (setTermAttr,_) <- attributeControl readFd

112 setTermAttr

113− input <- initInputForFd def table readFd

113+ input <- initInputForFd def "dummy" table readFd

114 eventsRef <- newIORef []

115 let writeWaitClose = do

116 synthesizeInput inputSpec writeFd

@@ -159,7 +159,7 @@ verifyCapsSynInputToEvent :: Property IO

159verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

160 forEachOf terminalsOfInterest $ \termName -> monadic $ do

161 term <- setupTerm termName

162− let table = capsClassifyTable term keysFromCapsTable

162+ let table = capsClassifyMap term keysFromCapsTable

163 inputSeq = gen table

164 events = map snd inputSeq

165 keydowns = map (Bytes . fst) inputSeq

@@ -179,7 +179,7 @@ verifyFullSynInputToEvent :: Property IO

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

180 forEachOf terminalsOfInterest $ \termName -> monadic $ do

181 term <- setupTerm termName

182− let table = classifyTableForTerm termName term

182+ let table = classifyMapForTerm termName term

183 inputSeq = gen table

184 events = map snd inputSeq

185 keydowns = map (Bytes . fst) inputSeq

@@ -190,7 +190,7 @@ verifyFullSynInputToEvent_2x :: Property IO

190verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->

191 forEachOf terminalsOfInterest $ \termName -> monadic $ do

192 term <- setupTerm termName

193− let table = classifyTableForTerm termName term

193+ let table = classifyMapForTerm termName term

194 inputSeq = gen table

195 events = concatMap ((\s -> [s,s]) . snd) inputSeq

196 keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq