d5c47c3 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Added table support to man writer (using the tbl preprocessor).

d5c47c3fiddlosopher19 years ago

src/Text/Pandoc/Writers/Man.hs+36−10

compare with master

unifiedsplit

@@ -33,18 +33,20 @@ module Text.Pandoc.Writers.Man (

33 ) where

34import Text.Pandoc.Definition

35import Text.Pandoc.Shared

36+import Text.Printf ( printf )

36import Data.Char ( toUpper )

37import Data.Char ( toUpper )

37−import Data.List ( group, isPrefixOf, drop, find )

38+import Data.List ( group, isPrefixOf, drop, find, nub, intersperse )

38import Text.PrettyPrint.HughesPJ hiding ( Str )

39import Text.PrettyPrint.HughesPJ hiding ( Str )

39import Control.Monad.State

40import Control.Monad.State

41type Notes = [[Block]]

42type Notes = [[Block]]

43+type Preprocessors = [String] -- e.g. "t" for tbl

42−type WriterState = Notes

44+type WriterState = (Notes, Preprocessors)

44-- | Convert Pandoc to Man.

46-- | Convert Pandoc to Man.

45writeMan :: WriterOptions -> Pandoc -> String

47writeMan :: WriterOptions -> Pandoc -> String

46writeMan opts document =

48writeMan opts document =

47− render $ evalState (pandocToMan opts document) []

49+ render $ evalState (pandocToMan opts document) ([],[])

49-- | Return groff man representation of document.

51-- | Return groff man representation of document.

50pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc

52pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc

@@ -55,9 +57,12 @@ pandocToMan opts (Pandoc meta blocks) = do

55 after' = if null after then empty else text after

57 after' = if null after then empty else text after

56 (head, foot) <- metaToMan opts meta

58 (head, foot) <- metaToMan opts meta

57 body <- blockListToMan opts blocks

59 body <- blockListToMan opts blocks

58− notes <- get

60+ (notes, preprocessors) <- get

61+ let preamble = if null preprocessors

62+ then empty

63+ else text $ ".\\\" " ++ concat (nub preprocessors)

59 notes' <- notesToMan opts (reverse notes)

64 notes' <- notesToMan opts (reverse notes)

60− return $ head $$ before' $$ body $$ notes' $$ foot $$ after'

65+ return $ preamble $$ head $$ before' $$ body $$ notes' $$ foot $$ after'

62-- | Insert bibliographic information into Man header and footer.

67-- | Insert bibliographic information into Man header and footer.

63metaToMan :: WriterOptions -- ^ Options, including Man header

68metaToMan :: WriterOptions -- ^ Options, including Man header

@@ -112,7 +117,7 @@ escapeSingleQuote str =

112

117

113-- | Escape special characters for Man.

118-- | Escape special characters for Man.

114escapeString :: String -> String

119escapeString :: String -> String

115−escapeString = escapeSingleQuote . escapeNbsp . backslashEscape "\".\\"

120+escapeString = escapeSingleQuote . escapeNbsp . backslashEscape "\".@\\"

116

121

117-- | Escape a literal (code) section for Man.

122-- | Escape a literal (code) section for Man.

118escapeCode :: String -> String

123escapeCode :: String -> String

@@ -142,8 +147,29 @@ blockToMan opts (CodeBlock str) = return $

142blockToMan opts (BlockQuote blocks) = do

147blockToMan opts (BlockQuote blocks) = do

143 contents <- blockListToMan opts blocks

148 contents <- blockListToMan opts blocks

144 return $ text ".RS" $$ contents $$ text ".RE"

149 return $ text ".RS" $$ contents $$ text ".RE"

145−blockToMan opts (Table caption _ _ headers rows) = blockToMan opts

150+blockToMan opts (Table caption alignments widths headers rows) =

146− (Para [Str "pandoc: TABLE unsupported in Man writer"])

151+ let aligncode AlignLeft = "l"

152+ aligncode AlignRight = "r"

153+ aligncode AlignCenter = "c"

154+ aligncode AlignDefault = "l"

155+ in do

156+ caption' <- inlineListToMan opts caption

157+ modify (\(notes, preprocessors) -> (notes, "t":preprocessors))

158+ let iwidths = map (printf "w(%.2fi)" . (6.5 *)) widths -- 6.5i default width

159+ let coldescriptions = text $ joinWithSep " "

160+ (zipWith (\align width -> aligncode align ++ width)

161+ alignments iwidths) ++ "."

162+ colheadings <- mapM (blockListToMan opts) headers

163+ let makeRow cols = text "T{" $$

164+ (vcat $ intersperse (text "T}@T{") cols) $$

165+ text "T}"

166+ let colheadings' = makeRow colheadings

167+ body <- mapM (\row -> do

168+ cols <- mapM (blockListToMan opts) row

169+ return $ makeRow cols) rows

170+ return $ text ".PP" $$ caption' $$

171+ text ".TS" $$ text "tab(@);" $$ coldescriptions $$

172+ colheadings' $$ text "_" $$ vcat body $$ text ".TE"

147

173

148blockToMan opts (BulletList items) = do

174blockToMan opts (BulletList items) = do

149 contents <- mapM (bulletListItemToMan opts) items

175 contents <- mapM (bulletListItemToMan opts) items

@@ -264,8 +290,8 @@ inlineToMan opts (Image alternate (source, tit)) = do

264 linkPart <- inlineToMan opts (Link txt (source, tit))

290 linkPart <- inlineToMan opts (Link txt (source, tit))

265 return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'

291 return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'

266inlineToMan opts (Note contents) = do

292inlineToMan opts (Note contents) = do

267− modify (\notes -> contents:notes) -- add to notes in state

293+ modify (\(notes, prep) -> (contents:notes, prep)) -- add to notes in state

268− notes <- get

294+ (notes, _) <- get

269 let ref = show $ (length notes)

295 let ref = show $ (length notes)

270 return $ text "[" <> text ref <> char ']'

296 return $ text "[" <> text ref <> char ']'

271

297