@@ -10,18 +10,37 @@
1010-- Each line of the input config is processed individually. Lines that fail to parse are ignored.
1111-- Later entries take precedence over earlier.
1212--
13−-- = Classify Table Overrides
13+-- For all directives:
14+--
15+-- @
16+-- string := \"\\\"\" chars+ \"\\\"\"
17+-- @
18+--
19+-- = Debug Directives
20+--
21+-- == @debugLog@
22+--
23+-- Format:
24+--
25+-- @
26+-- \"debugLog\" string
27+-- @
28+--
29+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent to a debugLog entry at the
30+-- end of the last config file.
31+--
32+-- = Input Table Directives
1433--
1534-- == @map@
1635--
1736-- Directive format:
1837--
1938-- @
20−-- entry := \"map\" string key modifier_list
21−-- key := KEsc | KChar Char | KBS ... (same as 'Key')
22−-- modifier_list := \"[\" modifier+ \"]\"
23−-- modifier := MShift | MCtrl | MMeta | MAlt
24−-- string := \"\\\"\" chars+ \"\\\"\"
39+-- \"map\" string key modifier_list
40+-- where
41+-- key := KEsc | KChar Char | KBS ... (same as 'Key')
42+-- modifier_list := \"[\" modifier+ \"]\"
43+-- modifier := MShift | MCtrl | MMeta | MAlt
2544-- @
2645--
2746-- EG: If the contents are
@@ -34,6 +53,12 @@
3453-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event. The bytes @\"\\ESC[1;3B\"@ will result
3554-- in the event KDown with the MAlt modifier.
3655--
56+-- If a debug log is requested then vty will output the current input table to the log in the above
57+-- format.
58+--
59+-- EG: Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to
60+-- .vty/config
61+--
3762module Graphics.Vty.Config where
3863
3964-- ignore warning on GHC 7.6+. Required for GHC 7.4
@@ -62,9 +87,10 @@ import qualified Text.Parsec.Token as P
6287
6388data Config = Config
6489 { specifiedEscPeriod :: Maybe Int
65− -- | Debug information is appended to the file.
90+ -- | Debug information is appended to this file if not Nothing.
6691 , debugLog :: Maybe FilePath
67− -- | The (input byte, output event) pairs override VTY\'s built-in tables as well as terminfo.
92+ -- | The (input byte, output event) pairs extend the internal input table of VTY and the table
93+ -- from terminfo.
6894 --
6995 -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.
7096 , inputOverrides :: ClassifyTable
@@ -97,10 +123,12 @@ type ConfigParser s a = ParsecT s () (Writer Config) a
97123-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@
98124userConfig :: IO Config
99125userConfig = do
100− vtyConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile
126+ userConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile
101127 overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"
102128 overrideConfig <- either (const $ return def) parseConfigFile overridePath
103− return $ vtyConfig `mappend` overrideConfig
129+ debugLogPath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_DEBUG_LOG"
130+ let debugLogConfig = either (const $ return def) (def { debugLog = Just debugLogPath })
131+ return $ mconcat [userConfig, overrideConfig, debugLogConfig]
104132
105133parseConfigFile :: FilePath -> IO Config
106134parseConfigFile path = do
@@ -130,7 +158,7 @@ configLanguage = LanguageDef
130158configLexer :: Stream s m Char => P.GenTokenParser s u m
131159configLexer = P.makeTokenParser configLanguage
132160
133−parseOverride = do
161+mapDecl = do
134162 void $ string "map"
135163 P.whiteSpace configLexer
136164 bytes <- P.stringLiteral configLexer
@@ -181,9 +209,15 @@ parseModifier = do
181209 "MAlt" -> return MAlt
182210 _ -> fail $ m ++ " is not a valid modifier identifier"
183211
212+debugLogDecl = do
213+ void $ string "debugLog"
214+ P.whiteSpace configLexer
215+ path <- P.stringLiteral configLexer
216+ lift $ tell $ def { debugLog = Just path }
217+
184218ignoreLine = void $ manyTill anyChar newline
185219
186220parseConfig = void $ many $ do
187221 P.whiteSpace configLexer
188− let directives = [parseOverride]
222+ let directives = [mapDecl, debugLogDecl]
189223 try (choice directives) <|> ignoreLine