Changes to HTML writer to incorporate automatic identifiers for
headers and table of contents: + WriterState now includes a list of header identifiers and a table of contents in addition to notes. + The function uniqueIdentifiers creates a list of unique identifiers from a list of inline lists (e.g. headers). + This list is part of WriterState and gets consumed by blockToHtml each time a header is encountered. + Headers are now printed with unique identifiers based on their names, e.g. Shell_scripts for "# Shell scripts". Fancy stuff like links, italics, etc. gets ignored. A numerical index is added to the end if there is already an identifier by the same name, e.g. "Shell_scripts1". + Provision has been made for a table-of-contents block element, but this has not yet been added. git-svn-id: https://pandoc.googlecode.com/svn/trunk@630 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher
parent
0a250edfde
commit
5a0ce1bcac
1 changed files with 66 additions and 16 deletions
|
|
@ -39,6 +39,9 @@ import Control.Monad.State
|
|||
import Text.XHtml.Strict
|
||||
|
||||
type Notes = [Html]
|
||||
type Ids = [String]
|
||||
type Toc = Html
|
||||
type WriterState = (Notes, Ids, Toc)
|
||||
|
||||
-- | Convert Pandoc document to Html string.
|
||||
writeHtmlString :: WriterOptions -> Pandoc -> String
|
||||
|
|
@ -51,7 +54,7 @@ writeHtmlString opts =
|
|||
writeHtml :: WriterOptions -> Pandoc -> Html
|
||||
writeHtml opts (Pandoc (Meta tit authors date) blocks) =
|
||||
let titlePrefix = writerTitlePrefix opts
|
||||
topTitle = evalState (inlineListToHtml opts tit) []
|
||||
topTitle = evalState (inlineListToHtml opts tit) ([],[],noHtml)
|
||||
topTitle' = if null titlePrefix
|
||||
then topTitle
|
||||
else titlePrefix +++ " - " +++ topTitle
|
||||
|
|
@ -69,7 +72,11 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
|
|||
(not (writerS5 opts))
|
||||
then h1 ! [theclass "title"] $ topTitle
|
||||
else noHtml
|
||||
(blocks', revnotes) = runState (blockListToHtml opts blocks) []
|
||||
headerBlocks = filter isHeaderBlock blocks
|
||||
ids = uniqueIdentifiers $ map (\(Header _ lst) -> lst) headerBlocks
|
||||
toc = noHtml -- for debugging: tableOfContents headerBlocks ids
|
||||
(blocks', (revnotes,_,_)) =
|
||||
runState (blockListToHtml opts blocks) ([],ids,toc)
|
||||
notes = reverse revnotes
|
||||
before = primHtml $ writerIncludeBefore opts
|
||||
after = primHtml $ writerIncludeAfter opts
|
||||
|
|
@ -79,6 +86,11 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
|
|||
then head +++ (body thebody)
|
||||
else thebody
|
||||
|
||||
-- | True if block is a Header block.
|
||||
isHeaderBlock :: Block -> Bool
|
||||
isHeaderBlock (Header _ _) = True
|
||||
isHeaderBlock _ = False
|
||||
|
||||
-- | Convert list of Note blocks to a footnote <div>.
|
||||
-- Assumes notes are sorted.
|
||||
footnoteSection :: WriterOptions -> Notes -> Html
|
||||
|
|
@ -129,8 +141,41 @@ obfuscateChar char =
|
|||
obfuscateString :: String -> String
|
||||
obfuscateString = (concatMap obfuscateChar) . decodeEntities
|
||||
|
||||
-- | Convert Pandoc inline list to plain text identifier.
|
||||
inlineListToIdentifier :: [Inline] -> String
|
||||
inlineListToIdentifier [] = ""
|
||||
inlineListToIdentifier (x:xs) =
|
||||
xAsText ++ inlineListToIdentifier xs
|
||||
where xAsText = case x of
|
||||
Str s -> s
|
||||
Emph lst -> inlineListToIdentifier lst
|
||||
Strong lst -> inlineListToIdentifier lst
|
||||
Quoted _ lst -> inlineListToIdentifier lst
|
||||
Code s -> s
|
||||
Space -> "_"
|
||||
EmDash -> "--"
|
||||
EnDash -> "-"
|
||||
Apostrophe -> ""
|
||||
Ellipses -> "..."
|
||||
LineBreak -> "_"
|
||||
TeX _ -> ""
|
||||
HtmlInline _ -> ""
|
||||
Link lst _ -> inlineListToIdentifier lst
|
||||
Image lst _ -> inlineListToIdentifier lst
|
||||
Note _ -> ""
|
||||
|
||||
-- | Return unique identifiers for list of inline lists.
|
||||
uniqueIdentifiers :: [[Inline]] -> [String]
|
||||
uniqueIdentifiers ls =
|
||||
reverse (foldl addIdentifier [] ls) where
|
||||
addIdentifier ids l =
|
||||
let new = inlineListToIdentifier l
|
||||
matches = length $ filter (== new) ids
|
||||
new' = new ++ if matches > 0 then show matches else ""
|
||||
in new':ids
|
||||
|
||||
-- | Convert Pandoc block element to HTML.
|
||||
blockToHtml :: WriterOptions -> Block -> State Notes Html
|
||||
blockToHtml :: WriterOptions -> Block -> State WriterState Html
|
||||
blockToHtml opts block =
|
||||
case block of
|
||||
(Null) -> return $ noHtml
|
||||
|
|
@ -154,14 +199,19 @@ blockToHtml opts block =
|
|||
(return . blockquote)
|
||||
else blockListToHtml opts blocks >>= (return . blockquote)
|
||||
(Header level lst) -> do contents <- inlineListToHtml opts lst
|
||||
(notes, ids, toc) <- get
|
||||
let (id, rest) = if null ids
|
||||
then ("", [])
|
||||
else (head ids, tail ids)
|
||||
put (notes, rest, toc)
|
||||
return $ case level of
|
||||
1 -> h1 contents
|
||||
2 -> h2 contents
|
||||
3 -> h3 contents
|
||||
4 -> h4 contents
|
||||
5 -> h5 contents
|
||||
6 -> h6 contents
|
||||
_ -> paragraph contents
|
||||
1 -> h1 contents ! [identifier id]
|
||||
2 -> h2 contents ! [identifier id]
|
||||
3 -> h3 contents ! [identifier id]
|
||||
4 -> h4 contents ! [identifier id]
|
||||
5 -> h5 contents ! [identifier id]
|
||||
6 -> h6 contents ! [identifier id]
|
||||
_ -> paragraph contents ! [identifier id]
|
||||
(BulletList lst) -> do contents <- mapM (blockListToHtml opts) lst
|
||||
let attribs = if writerIncremental opts
|
||||
then [theclass "incremental"]
|
||||
|
|
@ -216,15 +266,15 @@ tableItemToHtml opts tag align' width item =
|
|||
else []
|
||||
return $ tag ! attrib $ contents
|
||||
|
||||
blockListToHtml :: WriterOptions -> [Block] -> State Notes Html
|
||||
blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
|
||||
blockListToHtml opts lst = mapM (blockToHtml opts) lst >>= (return . toHtmlFromList)
|
||||
|
||||
-- | Convert list of Pandoc inline elements to HTML.
|
||||
inlineListToHtml :: WriterOptions -> [Inline] -> State Notes Html
|
||||
inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
|
||||
inlineListToHtml opts lst = mapM (inlineToHtml opts) lst >>= (return . toHtmlFromList)
|
||||
|
||||
-- | Convert Pandoc inline element to HTML.
|
||||
inlineToHtml :: WriterOptions -> Inline -> State Notes Html
|
||||
inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
|
||||
inlineToHtml opts inline =
|
||||
case inline of
|
||||
(Str str) -> return $ stringToHtml str
|
||||
|
|
@ -263,16 +313,16 @@ inlineToHtml opts inline =
|
|||
if null txt then [] else [alt alternate']
|
||||
return $ image ! attributes
|
||||
-- note: null title included, as in Markdown.pl
|
||||
(Note contents) -> do notes <- get
|
||||
(Note contents) -> do (notes, ids, toc) <- get
|
||||
let number = (length notes) + 1
|
||||
let ref = show number
|
||||
htmlContents <- blockListToNote opts ref contents
|
||||
modify (htmlContents:) -- push contents onto front of notes
|
||||
put (htmlContents:notes, ids, toc) -- push contents onto front of notes
|
||||
return $ anchor ! [href ("#fn" ++ ref),
|
||||
theclass "footnoteRef",
|
||||
identifier ("fnref" ++ ref)] << sup << ref
|
||||
|
||||
blockListToNote :: WriterOptions -> String -> [Block] -> State Notes Html
|
||||
blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
|
||||
blockListToNote opts ref blocks =
|
||||
do contents <- blockListToHtml opts blocks
|
||||
let backlink = anchor ! [href ("#fnref" ++ ref), theclass "footnoteBacklink",
|
||||
|
|
|
|||
Loading…
Reference in a new issue