Roff reader: introduce normal/copy mode distinction.

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]