git.iko.soy/typeable/pandoc
on master help sign in
Man reader: improved escaping code.
95b9d94John MacFarlane
src/Text/Pandoc/Readers/Man.hs+86−79
compare with master
unifiedsplit
@@ -153,21 +153,45 @@ characterCodeMap =
153 M.fromList $ map (\(x,y) -> (y,x)) $ characterCodes ++ combiningAccents
153 M.fromList $ map (\(x,y) -> (y,x)) $ characterCodes ++ combiningAccents
154
154
155escapeLexer :: PandocMonad m => ManLexer m String
155escapeLexer :: PandocMonad m => ManLexer m String
156−escapeLexer = do
156+escapeLexer = try $ do
157 char '\\'
157 char '\\'
158+ c <- noneOf ['*','$'] -- see escStar, macroArg
159+ case c of
160+ '(' -> twoCharGlyph
158− twoCharGlyph <|> bracketedGlyph <|> escFont <|> escSingle <|> escStar
161+ '[' -> bracketedGlyph
162+ 'f' -> escFont
163+ '"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment
164+ '#' -> mempty <$ manyTill anyChar newline
165+ '%' -> return mempty
166+ '{' -> return mempty
167+ '}' -> return mempty
168+ '&' -> return mempty
169+ '\n' -> return mempty
170+ ':' -> return mempty
171+ '0' -> return mempty
172+ 'c' -> return mempty
173+ '-' -> return "-"
174+ '_' -> return "_"
175+ ' ' -> return " "
176+ '\\' -> return "\\"
177+ 't' -> return "\t"
178+ 'e' -> return "\\"
179+ '`' -> return "`"
180+ '^' -> return " "
181+ '|' -> return " "
182+ '\'' -> return "`"
183+ '.' -> return "`"
184+ _ -> escUnknown [c] "\xFFFD"
159
185
160 where
186 where
161
187
162 twoCharGlyph = do
188 twoCharGlyph = do
163− char '('
164 cs <- count 2 anyChar
189 cs <- count 2 anyChar
165 case M.lookup cs characterCodeMap of
190 case M.lookup cs characterCodeMap of
166 Just c -> return [c]
191 Just c -> return [c]
167 Nothing -> escUnknown ('\\':'(':cs) "\xFFFD"
192 Nothing -> escUnknown ('\\':'(':cs) "\xFFFD"
168
193
169 bracketedGlyph =
194 bracketedGlyph =
170− char '[' *>
171 ( ucharCode `sepBy1` (char '_')
195 ( ucharCode `sepBy1` (char '_')
172 <|> charCode `sepBy1` (many1 Parsec.space)
196 <|> charCode `sepBy1` (many1 Parsec.space)
173 ) <* char ']'
197 ) <* char ']'
@@ -185,65 +209,9 @@ escapeLexer = do
185 Nothing -> escUnknown ("\\[" ++ cs ++ "]") '\xFFFD'
209 Nothing -> escUnknown ("\\[" ++ cs ++ "]") '\xFFFD'
186 Just c -> return c
210 Just c -> return c
187
211
188− escStar = do
189− char '*'
190− (do char '('
191− cs <- count 2 anyChar
192− case cs of
193− "HF" -> mempty <$ modifyState (\st ->
194− st{fontKind = S.insert Bold (fontKind st) })
195− "Tm" -> return "\x2122"
196− "lq" -> return "\x201c"
197− "rq" -> return "\x201d"
198− _ -> resolveString cs <|> escUnknown ("\\(" ++ cs) "\xFFFD")
199− <|>
200− (do char '['
201− cs <- many (noneOf "\t\n\r ]")
202− char ']'
203− resolveString cs <|> escUnknown ("\\[" ++ cs ++ "]") "\xFFFD" )
204− <|>
205− (do c <- anyChar
206− case c of
207− 'R' -> return "\xae"
208− 'S' -> return mempty -- switch back to default font size
209− _ -> resolveString [c] <|> escUnknown ['\\',c] "\xFFFD" )
210−
211− -- strings and macros share namespace
212− resolveString stringname = do
213− ManTokens ts <- resolveMacro stringname []
214− case Foldable.toList ts of
215− [MLine [RoffStr (s,_)]] -> return s
216− _ -> mzero
217−
218− escSingle = do
219− c <- noneOf ['*','[','(']
220− case c of
221− '"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment
222− '#' -> mempty <$ manyTill anyChar newline
223− '%' -> return mempty
224− '{' -> return mempty
225− '}' -> return mempty
226− '&' -> return mempty
227− '\n' -> return mempty
228− ':' -> return mempty
229− '0' -> return mempty
230− 'c' -> return mempty
231− '-' -> return "-"
232− '_' -> return "_"
233− ' ' -> return " "
234− '\\' -> return "\\"
235− 't' -> return "\t"
236− 'e' -> return "\\"
237− '`' -> return "`"
238− '^' -> return " "
239− '|' -> return " "
240− '\'' -> return "`"
241− '.' -> return "`"
242− _ -> escUnknown [c] "\xFFFD"
243
212
244 escFont :: PandocMonad m => ManLexer m String
213 escFont :: PandocMonad m => ManLexer m String
245 escFont = do
214 escFont = do
246− char 'f'
247 font <- choice [ S.singleton <$> letterFontKind
215 font <- choice [ S.singleton <$> letterFontKind
248 , char '(' >> anyChar >> anyChar >> return (S.singleton Regular)
216 , char '(' >> anyChar >> anyChar >> return (S.singleton Regular)
249 , try lettersFont
217 , try lettersFont
@@ -371,68 +339,107 @@ lexArgs = do
371
339
372 plainArg :: PandocMonad m => ManLexer m [LinePart]
340 plainArg :: PandocMonad m => ManLexer m [LinePart]
373 plainArg = do
341 plainArg = do
374− -- TODO skip initial spaces, then parse many linePart til a spaec
375 skipMany spacetab
342 skipMany spacetab
343+ mconcat <$>
376− many (macroArg <|> esc <|> regularText <|> unescapedQuote)
344+ many (macroArg <|> esc <|> regularText <|> unescapedQuote <|> escStar)
377 where unescapedQuote = do
345 where unescapedQuote = do
378 char '"'
346 char '"'
379 fonts <- currentFont
347 fonts <- currentFont
380− return $ RoffStr ("\"", fonts)
348+ return [RoffStr ("\"", fonts)]
381
349
382
350
383 quotedArg :: PandocMonad m => ManLexer m [LinePart]
351 quotedArg :: PandocMonad m => ManLexer m [LinePart]
384 quotedArg = do
352 quotedArg = do
385 char '"'
353 char '"'
354+ xs <- mconcat <$>
386− xs <- many (macroArg <|> esc <|> regularText <|> spaceTabChar
355+ many (macroArg <|> esc <|> escStar <|> regularText
387− <|> escapedQuote)
356+ <|> spaceTabChar <|> escapedQuote)
388 char '"'
357 char '"'
389 return xs
358 return xs
390 where escapedQuote = try $ do
359 where escapedQuote = try $ do
391 char '"'
360 char '"'
392 char '"'
361 char '"'
393 fonts <- currentFont
362 fonts <- currentFont
394− return $ RoffStr ("\"", fonts)
363+ return [RoffStr ("\"", fonts)]
364+
365+escStar :: PandocMonad m => ManLexer m [LinePart]
366+escStar = try $ do
367+ char '\\'
368+ char '*'
369+ font <- currentFont
370+ let retstr s = return [RoffStr (s, font)]
371+ c <- anyChar
372+ case c of
373+ '(' -> do
374+ cs <- count 2 anyChar
375+ case cs of
376+ "HF" -> mempty <$ modifyState (\st ->
377+ st{fontKind = S.insert Bold (fontKind st) })
378+ "Tm" -> retstr "\x2122"
379+ "lq" -> retstr "\x201c"
380+ "rq" -> retstr "\x201d"
381+ _ -> resolveString cs
382+ '[' -> do
383+ cs <- many (noneOf "\t\n\r ]")
384+ char ']'
385+ resolveString cs
386+ 'R' -> retstr "\xae"
387+ 'S' -> return mempty -- switch back to default font size
388+ _ -> resolveString [c]
389+
390+ where
391+
392+ -- strings and macros share namespace
393+ resolveString stringname = do
394+ ManTokens ts <- resolveMacro stringname []
395+ case Foldable.toList ts of
396+ [MLine xs] -> return xs
397+ _ -> do
398+ pos <- getPosition
399+ report $ SkippedContent ("unknown string " ++ stringname) pos
400+ return mempty
395
401
396lexLine :: PandocMonad m => ManLexer m ManTokens
402lexLine :: PandocMonad m => ManLexer m ManTokens
397lexLine = do
403lexLine = do
398− lnparts <- many1 linePart
404+ lnparts <- mconcat <$> many1 linePart
399 eofline
405 eofline
400 return $ singleTok $ MLine lnparts
406 return $ singleTok $ MLine lnparts
401 where
407 where
402
408
403−linePart :: PandocMonad m => ManLexer m LinePart
409+linePart :: PandocMonad m => ManLexer m [LinePart]
410+linePart = macroArg <|> esc <|> escStar <|>
404−linePart = macroArg <|> esc <|> regularText <|> quoteChar <|> spaceTabChar
411+ regularText <|> quoteChar <|> spaceTabChar
405
412
406−macroArg :: PandocMonad m => ManLexer m LinePart
413+macroArg :: PandocMonad m => ManLexer m [LinePart]
407macroArg = try $ do
414macroArg = try $ do
408 char '\\'
415 char '\\'
409 char '$'
416 char '$'
410 x <- digit
417 x <- digit
411− return $ MacroArg $ ord x - ord '0'
418+ return [MacroArg $ ord x - ord '0']
412
419
413−esc :: PandocMonad m => ManLexer m LinePart
420+esc :: PandocMonad m => ManLexer m [LinePart]
414esc = do
421esc = do
415 s <- escapeLexer
422 s <- escapeLexer
416 font <- currentFont
423 font <- currentFont
417− return $ RoffStr (s, font)
424+ return [RoffStr (s, font)]
418
425
419−regularText :: PandocMonad m => ManLexer m LinePart
426+regularText :: PandocMonad m => ManLexer m [LinePart]
420regularText = do
427regularText = do
421 s <- many1 $ noneOf "\n\r\t \\\""
428 s <- many1 $ noneOf "\n\r\t \\\""
422 font <- currentFont
429 font <- currentFont
423− return $ RoffStr (s, font)
430+ return [RoffStr (s, font)]
424
431
425−quoteChar :: PandocMonad m => ManLexer m LinePart
432+quoteChar :: PandocMonad m => ManLexer m [LinePart]
426quoteChar = do
433quoteChar = do
427 char '"'
434 char '"'
428 font <- currentFont
435 font <- currentFont
429− return $ RoffStr ("\"", font)
436+ return [RoffStr ("\"", font)]
430
437
431−spaceTabChar :: PandocMonad m => ManLexer m LinePart
438+spaceTabChar :: PandocMonad m => ManLexer m [LinePart]
432spaceTabChar = do
439spaceTabChar = do
433 c <- spacetab
440 c <- spacetab
434 font <- currentFont
441 font <- currentFont
435− return $ RoffStr ([c], font)
442+ return [RoffStr ([c], font)]
436
443
437lexEmptyLine :: PandocMonad m => ManLexer m ManTokens
444lexEmptyLine :: PandocMonad m => ManLexer m ManTokens
438lexEmptyLine = char '\n' >> return (singleTok MEmptyLine)
445lexEmptyLine = char '\n' >> return (singleTok MEmptyLine)