@@ -38,7 +38,9 @@ import Control.Monad (liftM, void)
3838import Control.Monad.Except (throwError)
3939import Data.Char (isDigit, isUpper, isLower)
4040import Data.Default (Default)
41+import Data.Functor (($>))
4142import Data.Map (insert)
43+import Data.Set (Set, singleton, fromList, toList)
4244import Data.Maybe (catMaybes, fromMaybe, isNothing)
4345import Data.List (intersperse, intercalate)
4446import qualified Data.Text as T
@@ -57,8 +59,7 @@ import Text.Parsec.Pos (updatePosString)
5759--
5860-- Data Types
5961--
60−
61−data FontKind = Regular | Italic | Bold | ItalicBold deriving Show
62+data FontKind = Bold | Italic | Monospace | Regular deriving (Show, Eq, Ord)
6263
6364data MacroKind = KTitle
6465 | KCodeBlStart
@@ -68,7 +69,9 @@ data MacroKind = KTitle
6869 | KSubTab
6970 deriving (Show, Eq)
7071
71−type RoffStr = (String, FontKind)
72+type Font = Set FontKind
73+
74+type RoffStr = (String, Font)
7275
7376data ManToken = MStr RoffStr
7477 | MLine [RoffStr]
@@ -80,16 +83,16 @@ data ManToken = MStr RoffStr
8083 | MComment String
8184 deriving Show
8285
83−data EscapeThing = EFont FontKind
86+data EscapeThing = EFont Font
8487 | EChar Char
8588 | ENothing
8689 deriving Show
8790
88−data RoffState = RoffState { fontKind :: FontKind
91+data RoffState = RoffState { fontKind :: Font
8992 } deriving Show
9093
9194instance Default RoffState where
92− def = RoffState {fontKind = Regular}
95+ def = RoffState {fontKind = singleton Regular}
9396
9497type ManLexer m = ParserT [Char] RoffState m
9598type ManParser m = ParserT [ManToken] ParserState m
@@ -197,22 +200,29 @@ escapeLexer = do
197200 escFont :: PandocMonad m => ManLexer m EscapeThing
198201 escFont = do
199202 char 'f'
200− font <- choice [ letterFont
201− , char '(' >> anyChar >> anyChar >> return Regular
202− , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
203− , try $ string "[BI]" >> return ItalicBold
204− , char '[' >> many letter >> char ']' >> return Regular
205− , digit >> return Regular
203+ font <- choice [ singleton <$> letterFontKind
204+ , char '(' >> anyChar >> anyChar >> return (singleton Regular)
205+ , try lettersFont
206+ , digit >> return (singleton Regular)
206207 ]
207208 modifyState (\r -> r {fontKind = font})
208209 return $ EFont font
209210
210211 where
211212
212− letterFont :: PandocMonad m => ManLexer m FontKind
213− letterFont = choice [
213+ lettersFont :: PandocMonad m => ManLexer m Font
214+ lettersFont = do
215+ char '['
216+ fs <- many letterFontKind
217+ many letter
218+ char ']'
219+ return $ fromList fs
220+
221+ letterFontKind :: PandocMonad m => ManLexer m FontKind
222+ letterFontKind = choice [
214223 char 'B' >> return Bold
215224 , char 'I' >> return Italic
225+ , char 'C' >> return Monospace
216226 , (char 'P' <|> char 'R') >> return Regular
217227 ]
218228
@@ -223,7 +233,7 @@ escapeLexer = do
223233 logOutput $ SkippedContent ("Unknown escape sequence \\" ++ [c]) pos
224234 return ENothing
225235
226−currentFont :: PandocMonad m => ManLexer m FontKind
236+currentFont :: PandocMonad m => ManLexer m Font
227237currentFont = fontKind <$> getState
228238
229239-- separate function from lexMacro since real man files sometimes do not follow the rules
@@ -253,10 +263,10 @@ lexMacro = do
253263 "RS" -> knownMacro KSubTab
254264 "nf" -> knownMacro KCodeBlStart
255265 "fi" -> knownMacro KCodeBlEnd
256− "B" -> MStr (joinedArgs,Bold)
266+ "B" -> MStr (joinedArgs, singleton Bold)
257267 "BR" -> MMaybeLink joinedArgs
258− x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, ItalicBold)
259− x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, Italic)
268+ x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, fromList [Italic, Bold])
269+ x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, singleton Italic)
260270 "SH" -> MHeader 2 args
261271 "SS" -> MHeader 3 args
262272 x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
@@ -314,7 +324,7 @@ lexLine = do
314324 return $ MLine $ catMaybes lnparts
315325 where
316326
317− esc :: PandocMonad m => ManLexer m (Maybe (String, FontKind))
327+ esc :: PandocMonad m => ManLexer m (Maybe (String, Font))
318328 esc = do
319329 someesc <- escapeLexer
320330 font <- currentFont
@@ -323,7 +333,7 @@ lexLine = do
323333 _ -> Nothing
324334 return rv
325335
326− linePart :: PandocMonad m => ManLexer m (Maybe (String, FontKind))
336+ linePart :: PandocMonad m => ManLexer m (Maybe (String, Font))
327337 linePart = do
328338 lnpart <- many1 $ noneOf "\n\\"
329339 font <- currentFont
@@ -424,10 +434,15 @@ parseSkippedContent = do
424434 onToken _ = return ()
425435
426436strToInline :: RoffStr -> Inline
427−strToInline (s, Regular) = Str s
428−strToInline (s, Italic) = Emph [Str s]
429−strToInline (s, Bold) = Strong [Str s]
430−strToInline (s, ItalicBold) = Strong [Emph [Str s]]
437+strToInline (s, fonts) = inner $ toList fonts where
438+ inner :: [FontKind] -> Inline
439+ inner [] = Str s
440+ inner (Bold:fs) = Strong [inner fs]
441+ inner (Italic:fs) = Emph [inner fs]
442+
443+ -- Monospace goes after Bold and Italic in ordered set
444+ inner (Monospace:_) = Code nullAttr s
445+ inner (Regular:fs) = inner fs
431446
432447parsePara :: PandocMonad m => ManParser m Block
433448parsePara = Para <$> parseInlines