aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Man.hs54
1 files changed, 36 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
-
- 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
+ let addFont f = map (addFontToRoffStr f)
+ addFontToRoffStr f (RoffStr (s, fs)) = RoffStr (s, S.insert f fs)
+ addFontToRoffStr _ x = x
+
+ 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