@@ -153,21 +153,45 @@ characterCodeMap =
153153 M.fromList $ map (\(x,y) -> (y,x)) $ characterCodes ++ combiningAccents
154154
155155escapeLexer :: PandocMonad m => ManLexer m String
156−escapeLexer = do
156+escapeLexer = try $ do
157157 char '\\'
158− twoCharGlyph <|> bracketedGlyph <|> escFont <|> escSingle <|> escStar
158+ c <- noneOf ['*','$'] -- see escStar, macroArg
159+ case c of
160+ '(' -> twoCharGlyph
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"
159185
160186 where
161187
162188 twoCharGlyph = do
163− char '('
164189 cs <- count 2 anyChar
165190 case M.lookup cs characterCodeMap of
166191 Just c -> return [c]
167192 Nothing -> escUnknown ('\\':'(':cs) "\xFFFD"
168193
169194 bracketedGlyph =
170− char '[' *>
171195 ( ucharCode `sepBy1` (char '_')
172196 <|> charCode `sepBy1` (many1 Parsec.space)
173197 ) <* char ']'
@@ -185,65 +209,9 @@ escapeLexer = do
185209 Nothing -> escUnknown ("\\[" ++ cs ++ "]") '\xFFFD'
186210 Just c -> return c
187211
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"
243212
244213 escFont :: PandocMonad m => ManLexer m String
245214 escFont = do
246− char 'f'
247215 font <- choice [ S.singleton <$> letterFontKind
248216 , char '(' >> anyChar >> anyChar >> return (S.singleton Regular)
249217 , try lettersFont
@@ -371,68 +339,107 @@ lexArgs = do
371339
372340 plainArg :: PandocMonad m => ManLexer m [LinePart]
373341 plainArg = do
374− -- TODO skip initial spaces, then parse many linePart til a spaec
375342 skipMany spacetab
376− many (macroArg <|> esc <|> regularText <|> unescapedQuote)
343+ mconcat <$>
344+ many (macroArg <|> esc <|> regularText <|> unescapedQuote <|> escStar)
377345 where unescapedQuote = do
378346 char '"'
379347 fonts <- currentFont
380− return $ RoffStr ("\"", fonts)
348+ return [RoffStr ("\"", fonts)]
381349
382350
383351 quotedArg :: PandocMonad m => ManLexer m [LinePart]
384352 quotedArg = do
385353 char '"'
386− xs <- many (macroArg <|> esc <|> regularText <|> spaceTabChar
387− <|> escapedQuote)
354+ xs <- mconcat <$>
355+ many (macroArg <|> esc <|> escStar <|> regularText
356+ <|> spaceTabChar <|> escapedQuote)
388357 char '"'
389358 return xs
390359 where escapedQuote = try $ do
391360 char '"'
392361 char '"'
393362 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
395401
396402lexLine :: PandocMonad m => ManLexer m ManTokens
397403lexLine = do
398− lnparts <- many1 linePart
404+ lnparts <- mconcat <$> many1 linePart
399405 eofline
400406 return $ singleTok $ MLine lnparts
401407 where
402408
403−linePart :: PandocMonad m => ManLexer m LinePart
404−linePart = macroArg <|> esc <|> regularText <|> quoteChar <|> spaceTabChar
409+linePart :: PandocMonad m => ManLexer m [LinePart]
410+linePart = macroArg <|> esc <|> escStar <|>
411+ regularText <|> quoteChar <|> spaceTabChar
405412
406−macroArg :: PandocMonad m => ManLexer m LinePart
413+macroArg :: PandocMonad m => ManLexer m [LinePart]
407414macroArg = try $ do
408415 char '\\'
409416 char '$'
410417 x <- digit
411− return $ MacroArg $ ord x - ord '0'
418+ return [MacroArg $ ord x - ord '0']
412419
413−esc :: PandocMonad m => ManLexer m LinePart
420+esc :: PandocMonad m => ManLexer m [LinePart]
414421esc = do
415422 s <- escapeLexer
416423 font <- currentFont
417− return $ RoffStr (s, font)
424+ return [RoffStr (s, font)]
418425
419−regularText :: PandocMonad m => ManLexer m LinePart
426+regularText :: PandocMonad m => ManLexer m [LinePart]
420427regularText = do
421428 s <- many1 $ noneOf "\n\r\t \\\""
422429 font <- currentFont
423− return $ RoffStr (s, font)
430+ return [RoffStr (s, font)]
424431
425−quoteChar :: PandocMonad m => ManLexer m LinePart
432+quoteChar :: PandocMonad m => ManLexer m [LinePart]
426433quoteChar = do
427434 char '"'
428435 font <- currentFont
429− return $ RoffStr ("\"", font)
436+ return [RoffStr ("\"", font)]
430437
431−spaceTabChar :: PandocMonad m => ManLexer m LinePart
438+spaceTabChar :: PandocMonad m => ManLexer m [LinePart]
432439spaceTabChar = do
433440 c <- spacetab
434441 font <- currentFont
435− return $ RoffStr ([c], font)
442+ return [RoffStr ([c], font)]
436443
437444lexEmptyLine :: PandocMonad m => ManLexer m ManTokens
438445lexEmptyLine = char '\n' >> return (singleTok MEmptyLine)