b73efb4 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Config: support specifying character width map paths

b73efb4Jonathan Daugherty7 years ago

src/Graphics/Vty/Config.hs+12−1

compare with master

unifiedsplit

@@ -146,6 +146,8 @@ data Config = Config

146 -- | The terminal name used to look up terminfo capabilities.

147 -- The default is the value of the TERM environment variable.

148 , termName :: Maybe String

149+ -- | Terminal width map files.

150+ , termWidthMaps :: [(String, FilePath)]

149 } deriving (Show, Eq)

151 } deriving (Show, Eq)

150

152

151defaultConfig :: Config

153defaultConfig :: Config

@@ -163,6 +165,7 @@ instance Semigroup Config where

163 , inputFd = inputFd c1 <|> inputFd c0

165 , inputFd = inputFd c1 <|> inputFd c0

164 , outputFd = outputFd c1 <|> outputFd c0

166 , outputFd = outputFd c1 <|> outputFd c0

165 , termName = termName c1 <|> termName c0

167 , termName = termName c1 <|> termName c0

168+ , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0

166 }

169 }

167

170

168instance Monoid Config where

171instance Monoid Config where

@@ -176,6 +179,7 @@ instance Monoid Config where

176 , inputFd = Nothing

179 , inputFd = Nothing

177 , outputFd = Nothing

180 , outputFd = Nothing

178 , termName = Nothing

181 , termName = Nothing

182+ , termWidthMaps = []

179 }

183 }

180#if !(MIN_VERSION_base(4,11,0))

184#if !(MIN_VERSION_base(4,11,0))

181 mappend = (<>)

185 mappend = (<>)

@@ -283,13 +287,20 @@ debugLogDecl = do

283 path <- P.stringLiteral configLexer

287 path <- P.stringLiteral configLexer

284 return defaultConfig { debugLog = Just path }

288 return defaultConfig { debugLog = Just path }

285

289

290+widthMapDecl :: Parser Config

291+widthMapDecl = do

292+ "widthMap" <- P.identifier configLexer

293+ tName <- P.stringLiteral configLexer

294+ path <- P.stringLiteral configLexer

295+ return defaultConfig { termWidthMaps = [(tName, path)] }

296+

286ignoreLine :: Parser ()

297ignoreLine :: Parser ()

287ignoreLine = void $ manyTill anyChar newline

298ignoreLine = void $ manyTill anyChar newline

288

299

289parseConfig :: Parser Config

300parseConfig :: Parser Config

290parseConfig = liftM mconcat $ many $ do

301parseConfig = liftM mconcat $ many $ do

291 P.whiteSpace configLexer

302 P.whiteSpace configLexer

292− let directives = [try mapDecl, try debugLogDecl]

303+ let directives = [try mapDecl, try debugLogDecl, try widthMapDecl]

293 choice directives <|> (ignoreLine >> return defaultConfig)

304 choice directives <|> (ignoreLine >> return defaultConfig)

294

305

295class Parse a where parseValue :: Parser a

306class Parse a where parseValue :: Parser a