Revised man writer to use new templates.

Note that now the "--after-body" will come after the "AUTHORS"
section, whereas before it would come before it.  This is a
slight break from backwards compatibility.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1733 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher 2009-12-31 01:17:27 +00:00
parent bf42fa1f54
commit 87537c3ff8
3 changed files with 51 additions and 118 deletions

View file

@ -30,62 +30,56 @@ Conversion of 'Pandoc' documents to groff man page format.
-} -}
module Text.Pandoc.Writers.Man ( writeMan) where module Text.Pandoc.Writers.Man ( writeMan) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Templates
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Printf ( printf ) import Text.Printf ( printf )
import Data.List ( isPrefixOf, drop, nub, intersperse, intercalate ) import Data.List ( isPrefixOf, drop, intersperse, intercalate )
import Text.PrettyPrint.HughesPJ hiding ( Str ) import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State import Control.Monad.State
import Control.Monad ( liftM ) import Control.Monad ( liftM )
type Notes = [[Block]] type Notes = [[Block]]
type Preprocessors = [String] -- e.g. "t" for tbl data WriterState = WriterState { stNotes :: Notes
type WriterState = (Notes, Preprocessors) , stHasTables :: Bool }
-- | Convert Pandoc to Man. -- | Convert Pandoc to Man.
writeMan :: WriterOptions -> Pandoc -> String writeMan :: WriterOptions -> Pandoc -> String
writeMan opts document = render $ evalState (pandocToMan opts document) ([],[]) writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False)
-- | Return groff man representation of document. -- | Return groff man representation of document.
pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
pandocToMan opts (Pandoc meta blocks) = do pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
return empty -- TODO let before = writerIncludeBefore opts
-- let before = writerIncludeBefore opts let after = writerIncludeAfter opts
-- let after = writerIncludeAfter opts let before' = if null before then empty else text before
-- let before' = if null before then empty else text before let after' = if null after then empty else text after
-- let after' = if null after then empty else text after titleText <- inlineListToMan opts title
-- (head', foot) <- metaToMan opts meta authors' <- mapM (inlineListToMan opts) authors
-- body <- blockListToMan opts blocks date' <- inlineListToMan opts date
-- (notes, preprocessors) <- get
-- let preamble = if null preprocessors || not (writerStandalone opts)
-- then empty
-- else text $ ".\\\" " ++ concat (nub preprocessors)
-- notes' <- notesToMan opts (reverse notes)
-- return $ preamble $$ head' $$ before' $$ body $$ notes' $$ foot $$ after'
-- | Insert bibliographic information into Man header and footer.
metaToMan :: WriterOptions -- ^ Options, including Man header
-> Meta -- ^ Meta with bibliographic information
-> State WriterState (Doc, Doc)
metaToMan options (Meta title authors date) = do
titleText <- inlineListToMan options title
authorsText <- mapM (inlineListToMan options) authors
dateText <- inlineListToMan options date
let (cmdName, rest) = break (== ' ') $ render titleText let (cmdName, rest) = break (== ' ') $ render titleText
let (title', section) = case reverse cmdName of let (title', section) = case reverse cmdName of
(')':d:'(':xs) | d `elem` ['0'..'9'] -> (')':d:'(':xs) | d `elem` ['0'..'9'] ->
(text (reverse xs), char d) (text (reverse xs), char d)
xs -> (text (reverse xs), doubleQuotes empty) xs -> (text (reverse xs), doubleQuotes empty)
let extras = map (doubleQuotes . text . removeLeadingTrailingSpace) $ let description = hsep $
map (doubleQuotes . text . removeLeadingTrailingSpace) $
splitBy '|' rest splitBy '|' rest
let head' = (text ".TH") <+> title' <+> section <+> body <- blockListToMan opts blocks
doubleQuotes dateText <+> hsep extras notes <- liftM stNotes get
let foot = case length authorsText of notes' <- notesToMan opts (reverse notes)
0 -> empty let main = render $ before' $$ body $$ notes' $$ after'
1 -> text ".SH AUTHOR" $$ (hcat $ intersperse (text ", ") authorsText) hasTables <- liftM stHasTables get
_ -> text ".SH AUTHORS" $$ (hcat $ intersperse (text ", ") authorsText) let context = writerVariables opts ++
return $ if writerStandalone options [ ("body", main)
then (head', foot) , ("title", render title')
else (empty, empty) , ("section", render section)
, ("date", render date')
, ("description", render description) ] ++
[ ("has-tables", "yes") | hasTables ] ++
[ ("author", render a) | a <- authors' ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main
-- | Return man representation of notes. -- | Return man representation of notes.
notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
@ -173,7 +167,7 @@ blockToMan opts (Table caption alignments widths headers rows) =
aligncode AlignDefault = "l" aligncode AlignDefault = "l"
in do in do
caption' <- inlineListToMan opts caption caption' <- inlineListToMan opts caption
modify (\(notes, preprocessors) -> (notes, "t":preprocessors)) modify $ \st -> st{ stHasTables = True }
let iwidths = if all (== 0) widths let iwidths = if all (== 0) widths
then repeat "" then repeat ""
else map (printf "w(%0.2fn)" . (70 *)) widths else map (printf "w(%0.2fn)" . (70 *)) widths
@ -332,8 +326,9 @@ inlineToMan opts (Image alternate (source, tit)) = do
linkPart <- inlineToMan opts (Link txt (source, tit)) linkPart <- inlineToMan opts (Link txt (source, tit))
return $ char '[' <> text "IMAGE: " <> linkPart <> char ']' return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
inlineToMan _ (Note contents) = do inlineToMan _ (Note contents) = do
modify (\(notes, prep) -> (contents:notes, prep)) -- add to notes in state -- add to notes in state
(notes, _) <- get modify $ \st -> st{ stNotes = contents : stNotes st }
notes <- liftM stNotes get
let ref = show $ (length notes) let ref = show $ (length notes)
return $ char '[' <> text ref <> char ']' return $ char '[' <> text ref <> char ']'

View file

@ -1,75 +1,12 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> $if(has-tables)$
<html xmlns="http://www.w3.org/1999/xhtml" .\"t
><head $endif$
><title .TH $title$ $section$ "$date$" $description$
>title</title $for(header-includes)$
><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" $header-includes$
/><meta name="generator" content="pandoc" $endfor$
/><meta name="author" content="$authors$" $body$
/><meta name="date" content="$date$" $if(author)$
/>$header-includes$ .SH AUTHORS
</head $for(author)$$author$$sep$; $endfor$.
><body $endif$
>
<h1 class="title"
><span class="math"
><em
>title</em
></span
></h1
><div id="TOC"
><ul
><li
><a href="#section-oen"
>section oen</a
></li
></ul
></div
><div id="section-oen"
><h1
><a href="#TOC"
>section oen</a
></h1
><ol style="list-style-type: decimal;"
><li
>one<ol style="list-style-type: lower-alpha;"
><li
>two<ol start="3" style="list-style-type: lower-roman;"
><li
>three</li
></ol
></li
></ol
></li
></ol
><pre class="haskell"
><code
>hi
</code
></pre
><p
>footnote<a href="#fn1" class="footnoteRef" id="fnref1"
><sup
>1</sup
></a
></p
></div
><div class="footnotes"
><hr
/><ol
><li id="fn1"
><p
>with code</p
><pre
><code
>code
</code
></pre
> <a href="#fnref1" class="footnoteBackLink" title="Jump back to footnote 1">&#8617;</a></li
></ol
></div
>
</body
></html
>

View file

@ -776,4 +776,5 @@ In quote.
.PP .PP
In list. In list.
.SH AUTHORS .SH AUTHORS
John MacFarlane, Anonymous John MacFarlane; Anonymous.