aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Groff.hs46
-rw-r--r--src/Text/Pandoc/Readers/Man.hs15
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