aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2018-10-28 21:03:07 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2018-10-28 21:03:07 -0700
commit7a30eae6935057a9395e5346a1635230389004f5 (patch)
tree9d63e477d86c2916564eef47c320f47671ecae09
parent6b8e595e7285210f018186af93cee3df23da9060 (diff)
downloadpandoc-7a30eae6935057a9395e5346a1635230389004f5.tar.gz
Roff reader: introduce normal/copy mode distinction.
-rw-r--r--src/Text/Pandoc/Readers/Roff.hs37
1 files changed, 33 insertions, 4 deletions
diff --git a/src/Text/Pandoc/Readers/Roff.hs b/src/Text/Pandoc/Readers/Roff.hs
index 7383d95ae..0568f777d 100644
--- a/src/Text/Pandoc/Readers/Roff.hs
+++ b/src/Text/Pandoc/Readers/Roff.hs
@@ -117,10 +117,15 @@ newtype RoffTokens = RoffTokens { unRoffTokens :: Seq.Seq RoffToken }
singleTok :: RoffToken -> RoffTokens
singleTok t = RoffTokens (Seq.singleton t)
+data RoffMode = NormalMode
+ | CopyMode
+ deriving Show
+
data RoffState = RoffState { customMacros :: M.Map String RoffTokens
, prevFont :: FontSpec
, currentFont :: FontSpec
, tableTabChar :: Char
+ , roffMode :: RoffMode
} deriving Show
instance Default RoffState where
@@ -135,6 +140,7 @@ instance Default RoffState where
, prevFont = defaultFontSpec
, currentFont = defaultFontSpec
, tableTabChar = '\t'
+ , roffMode = NormalMode
}
type RoffLexer m = ParserT [Char] RoffState m
@@ -159,7 +165,7 @@ combiningAccentsMap =
escape :: PandocMonad m => RoffLexer m [LinePart]
escape = do
- char '\\'
+ backslash
escapeGlyph <|> escapeNormal
escapeGlyph :: PandocMonad m => RoffLexer m [LinePart]
@@ -226,7 +232,12 @@ escapeNormal = do
'-' -> return [RoffStr "-"]
'_' -> return [RoffStr "_"]
' ' -> return [RoffStr " "]
- '\\' -> return [RoffStr "\\"]
+ '\\' -> do
+ mode <- roffMode <$> getState
+ case mode of
+ CopyMode -> char '\\'
+ NormalMode -> return '\\'
+ return [RoffStr "\\"]
't' -> return [RoffStr "\t"]
'e' -> return [RoffStr "\\"]
'`' -> return [RoffStr "`"]
@@ -514,6 +525,7 @@ lexStringDef args = do -- string definition
lexMacroDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexMacroDef args = do -- macro definition
+ modifyState $ \st -> st{ roffMode = CopyMode }
(macroName, stopMacro) <-
case args of
(x : y : _) -> return (linePartsToString x, linePartsToString y)
@@ -528,7 +540,8 @@ lexMacroDef args = do -- macro definition
return ()
ts <- mconcat <$> manyTill manToken stop
modifyState $ \st ->
- st{ customMacros = M.insert macroName ts (customMacros st) }
+ st{ customMacros = M.insert macroName ts (customMacros st)
+ , roffMode = NormalMode }
return mempty
lexArgs :: PandocMonad m => RoffLexer m [Arg]
@@ -587,6 +600,10 @@ escString = try $ do
lexLine :: PandocMonad m => RoffLexer m RoffTokens
lexLine = do
+ mode <- roffMode <$> getState
+ case mode of
+ CopyMode -> optional $ try $ string "\\&"
+ NormalMode -> return ()
lnparts <- mconcat <$> many1 linePart
eofline
go lnparts
@@ -600,10 +617,22 @@ linePart :: PandocMonad m => RoffLexer m [LinePart]
linePart = macroArg <|> escape <|>
regularText <|> quoteChar <|> spaceTabChar
+backslash :: PandocMonad m => RoffLexer m ()
+backslash = do
+ char '\\'
+ mode <- roffMode <$> getState
+ case mode of
+ -- experimentally, it seems you don't always need to double
+ -- the backslash in macro defs. It's essential with \\$1,
+ -- but not with \\f[I]. So we make the second one optional.
+ CopyMode -> optional $ char '\\'
+ NormalMode -> return ()
+
macroArg :: PandocMonad m => RoffLexer m [LinePart]
macroArg = try $ do
pos <- getPosition
- string "\\\\$"
+ backslash
+ char '$'
x <- escapeArg <|> count 1 digit
case safeRead x of
Just i -> return [MacroArg i]