@@ -31,7 +31,8 @@ Conversion of 'Pandoc' documents to groff man page format.
3131module Text.Pandoc.Writers.Man ( writeMan) where
3232import Control.Monad.Except (throwError)
3333import Control.Monad.State
34−import Data.List (intercalate, intersperse, stripPrefix)
34+import Data.List (intercalate, intersperse, stripPrefix, sort)
35+import qualified Data.Map as Map
3536import Data.Maybe (fromMaybe)
3637import Text.Pandoc.Builder (deleteMeta)
3738import Text.Pandoc.Class (PandocMonad, report)
@@ -47,12 +48,23 @@ import Text.Pandoc.Writers.Shared
4748import Text.Printf (printf)
4849
4950type Notes = [[Block]]
50−data WriterState = WriterState { stNotes :: Notes
51− , stHasTables :: Bool }
51+data WriterState = WriterState { stNotes :: Notes
52+ , stFontFeatures :: Map.Map Char Bool
53+ , stHasTables :: Bool }
54+
55+defaultWriterState :: WriterState
56+defaultWriterState = WriterState { stNotes = []
57+ , stFontFeatures = Map.fromList [
58+ ('I',False)
59+ , ('B',False)
60+ , ('C',False)
61+ ]
62+ , stHasTables = False }
5263
5364-- | Convert Pandoc to Man.
5465writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m String
55−writeMan opts document = evalStateT (pandocToMan opts document) (WriterState [] False)
66+writeMan opts document =
67+ evalStateT (pandocToMan opts document) defaultWriterState
5668
5769-- | Return groff man representation of document.
5870pandocToMan :: PandocMonad m => WriterOptions -> Pandoc -> StateT WriterState m String
@@ -316,11 +328,9 @@ inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat)
316328inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc
317329inlineToMan opts (Span _ ils) = inlineListToMan opts ils
318330inlineToMan opts (Emph lst) = do
319− contents <- inlineListToMan opts lst
320− return $ text "\\f[I]" <> contents <> text "\\f[]"
331+ withFontFeature 'I' (inlineListToMan opts lst)
321332inlineToMan opts (Strong lst) = do
322− contents <- inlineListToMan opts lst
323− return $ text "\\f[B]" <> contents <> text "\\f[]"
333+ withFontFeature 'B' (inlineListToMan opts lst)
324334inlineToMan opts (Strikeout lst) = do
325335 contents <- inlineListToMan opts lst
326336 return $ text "[STRIKEOUT:" <> contents <> char ']'
@@ -340,7 +350,7 @@ inlineToMan opts (Quoted DoubleQuote lst) = do
340350inlineToMan opts (Cite _ lst) =
341351 inlineListToMan opts lst
342352inlineToMan _ (Code _ str) =
343− return $ text $ "\\f[C]" ++ escapeCode str ++ "\\f[]"
353+ withFontFeature 'C' (return (text $ escapeCode str))
344354inlineToMan _ (Str str@('.':_)) =
345355 return $ afterBreak "\\&" <> text (escapeString str)
346356inlineToMan _ (Str str) = return $ text $ escapeString str
@@ -379,3 +389,21 @@ inlineToMan _ (Note contents) = do
379389 notes <- gets stNotes
380390 let ref = show $ (length notes)
381391 return $ char '[' <> text ref <> char ']'
392+
393+fontChange :: PandocMonad m => StateT WriterState m Doc
394+fontChange = do
395+ features <- gets stFontFeatures
396+ let filling = sort [c | (c,True) <- Map.toList features]
397+ return $ text $ "\\f[" ++ filling ++ "]"
398+
399+withFontFeature :: PandocMonad m
400+ => Char
401+ -> StateT WriterState m Doc
402+ -> StateT WriterState m Doc
403+withFontFeature c action = do
404+ modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
405+ begin <- fontChange
406+ d <- action
407+ modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
408+ end <- fontChange
409+ return $ begin <> d <> end