From f202279902da34dfa4f22e4e53cb0bf93d519d1e Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 20 Oct 2018 16:40:44 -0700
Subject: [PATCH] Man reader: Fix .B, .I, .BR, etc.
---
src/Text/Pandoc/Readers/Man.hs | 52 +++++++++++++++++++++++-----------
test/Tests/Readers/Man.hs | 5 +++-
2 files changed, 39 insertions(+), 18 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index 7fa30e93a..3eaa92a18 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -41,7 +41,7 @@ import Data.Default (Default)
import Data.Maybe (catMaybes)
import qualified Data.Map as M
import Data.Set (Set, singleton)
-import qualified Data.Set as S (fromList, toList, union)
+import qualified Data.Set as S (fromList, toList, insert)
import Data.List (intersperse, intercalate)
import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad(..), report)
@@ -56,6 +56,8 @@ import qualified Text.Parsec as Parsec
import Text.Parsec.Pos (updatePosString)
import Text.Pandoc.GroffChar (characterCodes, combiningAccents)
+import Debug.Trace (traceShowId)
+
--
-- Data Types
--
@@ -280,25 +282,41 @@ lexMacro = do
many spacetab
macroName <- many (letter <|> oneOf ['\\', '"', '&', '.'])
args <- lexArgs
- let addFonts fs = map (addFontsToRoffStr fs)
- addFontsToRoffStr fs (RoffStr (s, fs')) = RoffStr (s, fs `S.union` fs')
- addFontsToRoffStr _ x = x
+ let addFont f = map (addFontToRoffStr f)
+ addFontToRoffStr f (RoffStr (s, fs)) = RoffStr (s, S.insert f fs)
+ addFontToRoffStr _ x = x
- tok = case macroName of
- "" -> MComment
- x | x `elem` ["\\\"", "\\#"] -> MComment
- "B" -> MLine $ concatMap (addFonts (singleton Bold)) args
- "BR" -> MLine $ concat args -- TODO
- x | x `elem` ["BI", "IB"] -> MLine $ -- TODO FIXME!
- concatMap (addFonts (S.fromList [Italic, Bold])) args
- x | x `elem` ["I", "IR", "RI"] -> MLine $
- concatMap (addFonts (singleton Italic)) args
- x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
- _ -> MMacro macroName args
- return tok
+ case macroName of
+ "" -> return MComment
+ "\\\"" -> return MComment
+ "\\#" -> return MComment
+ "B" -> do
+ args' <- argsOrFromNextLine args
+ return $ MLine $ concatMap (addFont Bold) args'
+ "I" -> do
+ args' <- argsOrFromNextLine args
+ return $ MLine $ concatMap (addFont Italic) args'
+ x | x `elem` ["BI", "IB", "RI", "IR", "BR", "RB"] -> do
+ let toFont 'I' = Italic
+ toFont 'R' = Regular
+ toFont 'B' = Bold
+ toFont 'M' = Monospace
+ toFont _ = Regular
+ let fontlist = map toFont x
+ return $ MLine $ concat $ zipWith addFont (cycle fontlist) args
+ x | x `elem` [ "P", "PP", "LP", "sp"] -> return MEmptyLine
+ _ -> return $ MMacro macroName args
where
+ argsOrFromNextLine :: PandocMonad m => [[LinePart]] -> ManLexer m [[LinePart]]
+ argsOrFromNextLine args =
+ if null args
+ then do
+ MLine lps <- lexLine
+ return [lps]
+ else return args
+
lexArgs :: PandocMonad m => ManLexer m [[LinePart]]
lexArgs = do
args <- many $ try oneArg
@@ -439,7 +457,7 @@ parseSkippedContent :: PandocMonad m => ManParser m Blocks
parseSkippedContent = mempty <$ (mcomment <|> memptyLine)
linePartsToInlines :: [LinePart] -> Inlines
-linePartsToInlines = mconcat . map go
+linePartsToInlines = mconcat . traceShowId . map go . traceShowId
where
go (RoffStr (s, fonts)) = inner (S.toList fonts) s
go _ = mempty
diff --git a/test/Tests/Readers/Man.hs b/test/Tests/Readers/Man.hs
index d45c69705..7541d1c67 100644
--- a/test/Tests/Readers/Man.hs
+++ b/test/Tests/Readers/Man.hs
@@ -40,12 +40,15 @@ tests = [
, "Macro args" =:
".B \"single arg with \"\"Q\"\"\""
=?> (para $ strong $ text "single arg with \"Q\"")
+ , "Argument from next line" =:
+ ".B\nsingle arg with \"Q\""
+ =?> (para $ strong $ text "single arg with \"Q\"")
, "comment" =:
".\\\"bla\naaa"
=?> (para $ str "aaa")
, "link" =:
".BR aa (1)"
- =?> para (text "aa(1)")
+ =?> para (strong (str "aa") <> str "(1)")
],
testGroup "Escapes" [
"fonts" =: