From 5a0ce1bcac4feebfd62696386313b589d0cd122c Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Sat, 7 Jul 2007 03:52:10 +0000 Subject: 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 --- src/Text/Pandoc/Writers/HTML.hs | 82 +++++++++++++++++++++++++++++++++-------- 1 file changed, 66 insertions(+), 16 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index f6fc0741e..15286b0ea 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -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
. -- 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", -- cgit v1.2.3