diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r-- | src/Text/Pandoc/Readers/Groff.hs | 46 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Man.hs | 15 |
2 files changed, 36 insertions, 25 deletions
diff --git a/src/Text/Pandoc/Readers/Groff.hs b/src/Text/Pandoc/Readers/Groff.hs index 94cc96b24..e63272682 100644 --- a/src/Text/Pandoc/Readers/Groff.hs +++ b/src/Text/Pandoc/Readers/Groff.hs @@ -32,8 +32,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Tokenizer for groff formats (man, ms). -} module Text.Pandoc.Readers.Groff - ( FontKind(..) - , MacroKind + ( MacroKind + , FontSpec(..) + , defaultFontSpec , LinePart(..) , Arg , ManToken(..) @@ -72,12 +73,18 @@ import qualified Data.Text.Normalize as Normalize -- -- Data Types -- -data FontKind = Bold | Italic | Monospace | Regular deriving (Show, Eq, Ord) +data FontSpec = FontSpec{ fontBold :: Bool + , fontItalic :: Bool + , fontMonospace :: Bool + } deriving (Show, Eq, Ord) + +defaultFontSpec :: FontSpec +defaultFontSpec = FontSpec False False False type MacroKind = String data LinePart = RoffStr String - | Font [FontKind] + | Font FontSpec | FontSize Int | MacroArg Int deriving Show @@ -97,7 +104,8 @@ newtype ManTokens = ManTokens { unManTokens :: Seq.Seq ManToken } singleTok :: ManToken -> ManTokens singleTok t = ManTokens (Seq.singleton t) -data RoffState = RoffState { customMacros :: M.Map String ManTokens +data RoffState = RoffState { customMacros :: M.Map String ManTokens + , lastFont :: FontSpec } deriving Show instance Default RoffState where @@ -109,6 +117,7 @@ instance Default RoffState where , ("lq", "\x201C") , ("rq", "\x201D") , ("R", "\x00AE") ] + , lastFont = defaultFontSpec } type ManLexer m = ParserT [Char] RoffState m @@ -245,29 +254,32 @@ escFontSize = do escFont :: PandocMonad m => ManLexer m [LinePart] escFont = do font <- choice - [ char 'S' >> return [Regular] - , digit >> return [Regular] - , (:[]) <$> letterFontKind - , char '(' >> anyChar >> anyChar >> return [Regular] + [ char 'S' >> return defaultFontSpec + , digit >> return defaultFontSpec + , char '(' >> anyChar >> anyChar >> return defaultFontSpec + , digit >> return defaultFontSpec + , ($ defaultFontSpec) <$> letterFontKind , lettersFont - , digit >> return [Regular] ] + modifyState $ \st -> st{ lastFont = font } return [Font font] -lettersFont :: PandocMonad m => ManLexer m [FontKind] +lettersFont :: PandocMonad m => ManLexer m FontSpec lettersFont = try $ do char '[' fs <- many letterFontKind skipMany letter char ']' - return fs + if null fs + then lastFont <$> getState + else return $ foldr ($) defaultFontSpec fs -letterFontKind :: PandocMonad m => ManLexer m FontKind +letterFontKind :: PandocMonad m => ManLexer m (FontSpec -> FontSpec) letterFontKind = choice [ - oneOf ['B','b'] >> return Bold - , oneOf ['I','i'] >> return Italic - , oneOf ['C','c'] >> return Monospace - , oneOf ['P','p','R','r'] >> return Regular + oneOf ['B','b'] >> return (\fs -> fs{ fontBold = True }) + , oneOf ['I','i'] >> return (\fs -> fs { fontItalic = True }) + , oneOf ['C','c'] >> return (\fs -> fs { fontMonospace = True }) + , oneOf ['P','p','R','r'] >> return id ] diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs index 4fefb0e66..d7e65abec 100644 --- a/src/Text/Pandoc/Readers/Man.hs +++ b/src/Text/Pandoc/Readers/Man.hs @@ -174,16 +174,15 @@ parseTitle = do return mempty linePartsToInlines :: [LinePart] -> Inlines -linePartsToInlines = go [] +linePartsToInlines = go where - go :: [[FontKind]] -> [LinePart] -> Inlines - go _ [] = mempty - go fs (MacroArg _:xs) = go fs xs -- shouldn't happen - go fs (RoffStr s : xs) = text s <> go fs xs - go (_:fs) (Font [] : xs) = go fs xs -- return to previous font - go fs (Font _newfonts : xs) = go fs xs - go fonts (FontSize _fs : xs) = go fonts xs + go :: [LinePart] -> Inlines + go [] = mempty + go (MacroArg _:xs) = go xs -- shouldn't happen + go (RoffStr s : xs) = text s <> go xs + go (Font _newfonts : xs) = go xs + go (FontSize _fs : xs) = go xs parsePara :: PandocMonad m => ManParser m Blocks parsePara = para . trimInlines <$> parseInlines |