@@ -40,8 +40,7 @@ import Text.XHtml.Strict
4040
4141type Notes = [Html]
4242type Ids = [String]
43−type Toc = Html
44−type WriterState = (Notes, Ids, Toc)
43+type WriterState = (Notes, Ids)
4544
4645-- | Convert Pandoc document to Html string.
4746writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -54,7 +53,7 @@ writeHtmlString opts =
5453writeHtml :: WriterOptions -> Pandoc -> Html
5554writeHtml opts (Pandoc (Meta tit authors date) blocks) =
5655 let titlePrefix = writerTitlePrefix opts
57− topTitle = evalState (inlineListToHtml opts tit) ([],[],noHtml)
56+ topTitle = evalState (inlineListToHtml opts tit) ([],[])
5857 topTitle' = if null titlePrefix
5958 then topTitle
6059 else titlePrefix +++ " - " +++ topTitle
@@ -74,13 +73,15 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
7473 else noHtml
7574 headerBlocks = filter isHeaderBlock blocks
7675 ids = uniqueIdentifiers $ map (\(Header _ lst) -> lst) headerBlocks
77− toc = noHtml -- for debugging: tableOfContents headerBlocks ids
78− (blocks', (revnotes,_,_)) =
79− runState (blockListToHtml opts blocks) ([],ids,toc)
76+ toc = if writerTableOfContents opts
77+ then tableOfContents opts headerBlocks ids
78+ else noHtml
79+ (blocks', (revnotes,_)) =
80+ runState (blockListToHtml opts blocks) ([],ids)
8081 notes = reverse revnotes
8182 before = primHtml $ writerIncludeBefore opts
8283 after = primHtml $ writerIncludeAfter opts
83− thebody = before +++ titleHeader +++ blocks' +++
84+ thebody = before +++ titleHeader +++ toc +++ blocks' +++
8485 footnoteSection opts notes +++ after
8586 in if writerStandalone opts
8687 then head +++ (body thebody)
@@ -91,6 +92,33 @@ isHeaderBlock :: Block -> Bool
9192isHeaderBlock (Header _ _) = True
9293isHeaderBlock _ = False
9394
95+-- | Construct table of contents from list of header blocks and identifiers.
96+-- Assumes there are as many identifiers as header blocks.
97+tableOfContents :: WriterOptions -> [Block] -> Ids -> Html
98+tableOfContents opts headers ids =
99+ let opts' = opts { writerIgnoreNotes = True }
100+ contentsTree = hierarchicalize headers
101+ contents = evalState (mapM (elementToListItem opts') contentsTree)
102+ ([],ids)
103+ in unordList ! [identifier "toc"] $ contents
104+
105+-- | Converts an Element to a list item for a table of contents,
106+-- retrieving the appropriate identifier from state.
107+elementToListItem :: WriterOptions -> Element -> State WriterState Html
108+elementToListItem opts (Blk _) = return noHtml
109+elementToListItem opts (Sec headerText subsecs) = do
110+ (notes, ids) <- get
111+ let (id, rest) = if null ids
112+ then ("",[])
113+ else (head ids, tail ids)
114+ put (notes, rest)
115+ txt <- inlineListToHtml opts headerText
116+ subHeads <- mapM (elementToListItem opts) subsecs
117+ let subList = if null subHeads
118+ then noHtml
119+ else unordList subHeads
120+ return $ (anchor ! [href ("#" ++ id)] $ txt) +++ subList
121+
94122-- | Convert list of Note blocks to a footnote <div>.
95123-- Assumes notes are sorted.
96124footnoteSection :: WriterOptions -> Notes -> Html
@@ -167,12 +195,12 @@ inlineListToIdentifier (x:xs) =
167195-- | Return unique identifiers for list of inline lists.
168196uniqueIdentifiers :: [[Inline]] -> [String]
169197uniqueIdentifiers ls =
170− reverse (foldl addIdentifier [] ls) where
171− addIdentifier ids l =
198+ let addIdentifier (nonuniqueIds, uniqueIds) l =
172199 let new = inlineListToIdentifier l
173− matches = length $ filter (== new) ids
200+ matches = length $ filter (== new) nonuniqueIds
174201 new' = new ++ if matches > 0 then show matches else ""
175− in new':ids
202+ in (new:nonuniqueIds, new':uniqueIds)
203+ in reverse $ snd (foldl addIdentifier ([],[]) $ ls)
176204
177205-- | Convert Pandoc block element to HTML.
178206blockToHtml :: WriterOptions -> Block -> State WriterState Html
@@ -199,19 +227,25 @@ blockToHtml opts block =
199227 (return . blockquote)
200228 else blockListToHtml opts blocks >>= (return . blockquote)
201229 (Header level lst) -> do contents <- inlineListToHtml opts lst
202− (notes, ids, toc) <- get
230+ (notes, ids) <- get
203231 let (id, rest) = if null ids
204232 then ("", [])
205233 else (head ids, tail ids)
206− put (notes, rest, toc)
207− return $ case level of
208− 1 -> h1 contents ! [identifier id]
209− 2 -> h2 contents ! [identifier id]
210− 3 -> h3 contents ! [identifier id]
211− 4 -> h4 contents ! [identifier id]
212− 5 -> h5 contents ! [identifier id]
213− 6 -> h6 contents ! [identifier id]
214− _ -> paragraph contents ! [identifier id]
234+ put (notes, rest)
235+ let attribs = [identifier id]
236+ let headerHtml = case level of
237+ 1 -> h1 contents ! attribs
238+ 2 -> h2 contents ! attribs
239+ 3 -> h3 contents ! attribs
240+ 4 -> h4 contents ! attribs
241+ 5 -> h5 contents ! attribs
242+ 6 -> h6 contents ! attribs
243+ _ -> paragraph contents ! attribs
244+ let headerHtml' = if writerTableOfContents opts
245+ then anchor ! [href "#toc"] $
246+ headerHtml
247+ else headerHtml
248+ return headerHtml'
215249 (BulletList lst) -> do contents <- mapM (blockListToHtml opts) lst
216250 let attribs = if writerIncremental opts
217251 then [theclass "incremental"]
@@ -313,11 +347,11 @@ inlineToHtml opts inline =
313347 if null txt then [] else [alt alternate']
314348 return $ image ! attributes
315349 -- note: null title included, as in Markdown.pl
316− (Note contents) -> do (notes, ids, toc) <- get
350+ (Note contents) -> do (notes, ids) <- get
317351 let number = (length notes) + 1
318352 let ref = show number
319353 htmlContents <- blockListToNote opts ref contents
320− put (htmlContents:notes, ids, toc) -- push contents onto front of notes
354+ put (htmlContents:notes, ids) -- push contents onto front of notes
321355 return $ anchor ! [href ("#fn" ++ ref),
322356 theclass "footnoteRef",
323357 identifier ("fnref" ++ ref)] << sup << ref