diff options
Diffstat (limited to 'src')
24 files changed, 108 insertions, 86 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 629814e4d..6277020a5 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -723,6 +723,7 @@ data ParserState = ParserState stateDate :: [Inline], -- ^ Date of document stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used stateHeaders :: [[Inline]], -- ^ List of headers (used for implicit ref links) + stateIdentifiers :: [String], -- ^ List of header identifiers used stateNextExample :: Int, -- ^ Number of next example stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers stateHasChapters :: Bool, -- ^ True if \chapter encountered @@ -751,6 +752,7 @@ defaultParserState = stateDate = [], stateHeaderTable = [], stateHeaders = [], + stateIdentifiers = [], stateNextExample = 1, stateExamples = M.empty, stateHasChapters = False, diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 424d9bdec..f4f421cfc 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -160,7 +160,7 @@ fixPlains inList bs = if any isParaish bs else bs where isParaish (Para _) = True isParaish (CodeBlock _ _) = True - isParaish (Header _ _) = True + isParaish (Header _ _ _) = True isParaish (BlockQuote _) = True isParaish (BulletList _) = not inList isParaish (OrderedList _ _) = not inList @@ -201,7 +201,9 @@ pHeader = try $ do contents <- liftM concat $ manyTill inline (pCloses tagtype <|> eof) return $ if bodyTitle then [] -- skip a representation of the title in the body - else [Header level $ normalizeSpaces contents] + else [Header level (fromAttrib "id" $ + TagOpen tagtype attr, [], []) $ + normalizeSpaces contents] pHrule :: TagParser [Block] pHrule = do diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index a3a2334a4..c27ccf6fd 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -372,10 +372,16 @@ block = choice [ codeBlockFenced header :: MarkdownParser (F Blocks) header = setextHeader <|> atxHeader <?> "header" -addToHeaderList :: F Inlines -> MarkdownParser () -addToHeaderList text = - updateState $ \st -> st{ stateHeaders = B.toList (runF text defaultParserState) - : stateHeaders st } +-- returns unique identifier +addToHeaderList :: F Inlines -> MarkdownParser String +addToHeaderList text = do + let headerList = B.toList $ runF text defaultParserState + updateState $ \st -> st{ stateHeaders = headerList : stateHeaders st } + (do guardEnabled Ext_header_identifiers + ids <- stateIdentifiers `fmap` getState + let id' = uniqueIdent headerList ids + updateState $ \st -> st{ stateIdentifiers = id' : ids } + return id') <|> return "" atxHeader :: MarkdownParser (F Blocks) atxHeader = try $ do @@ -383,8 +389,8 @@ atxHeader = try $ do notFollowedBy (char '.' <|> char ')') -- this would be a list skipSpaces text <- trimInlinesF . mconcat <$> manyTill inline atxClosing - addToHeaderList text - return $ B.header level <$> text + id' <- addToHeaderList text + return $ B.headerWith (id',[],[]) level <$> text atxClosing :: Parser [Char] st String atxClosing = try $ skipMany (char '#') >> blanklines @@ -399,8 +405,8 @@ setextHeader = try $ do many (char underlineChar) blanklines let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 - addToHeaderList text - return $ B.header level <$> text + id' <- addToHeaderList text + return $ B.headerWith (id',[],[]) level <$> text -- -- hrule block diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 60301ad85..cc8293132 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -74,14 +74,14 @@ specialChars = "\\`|*_<>$:/[]{}()-.\"'\8216\8217\8220\8221" -- isHeader :: Int -> Block -> Bool -isHeader n (Header x _) = x == n -isHeader _ _ = False +isHeader n (Header x _ _) = x == n +isHeader _ _ = False -- | Promote all headers in a list of blocks. (Part of -- title transformation for RST.) promoteHeaders :: Int -> [Block] -> [Block] -promoteHeaders num ((Header level text):rest) = - (Header (level - num) text):(promoteHeaders num rest) +promoteHeaders num ((Header level attr text):rest) = + (Header (level - num) attr text):(promoteHeaders num rest) promoteHeaders num (other:rest) = other:(promoteHeaders num rest) promoteHeaders _ [] = [] @@ -90,10 +90,10 @@ promoteHeaders _ [] = [] -- promote all the other headers. titleTransform :: [Block] -- ^ list of blocks -> ([Block], [Inline]) -- ^ modified list of blocks, title -titleTransform ((Header 1 head1):(Header 2 head2):rest) | +titleTransform ((Header 1 _ head1):(Header 2 _ head2):rest) | not (any (isHeader 1) rest || any (isHeader 2) rest) = -- both title & subtitle (promoteHeaders 2 rest, head1 ++ [Str ":", Space] ++ head2) -titleTransform ((Header 1 head1):rest) | +titleTransform ((Header 1 _ head1):rest) | not (any (isHeader 1) rest) = -- title, no subtitle (promoteHeaders 1 rest, head1) titleTransform blocks = (blocks, []) diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index f2a70612d..3ac7f4efb 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -171,9 +171,14 @@ header :: Parser [Char] ParserState Block header = try $ do char 'h' level <- digitToInt <$> oneOf "123456" - optional attributes >> char '.' >> whitespace + attr <- option "" attributes + let ident = case attr of + '#':xs -> xs + _ -> "" + char '.' + whitespace name <- normalizeSpaces <$> manyTill inline blockBreak - return $ Header level name + return $ Header level (ident,[],[]) name -- | Blockquote of the form "bq. content" blockQuote :: Parser [Char] ParserState Block diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 648086fd4..f23c043e1 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -426,18 +426,17 @@ inlineListToIdentifier = -- | Convert list of Pandoc blocks into (hierarchical) list of Elements hierarchicalize :: [Block] -> [Element] -hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) ([],[]) +hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) [] -hierarchicalizeWithIds :: [Block] -> S.State ([Int],[String]) [Element] +hierarchicalizeWithIds :: [Block] -> S.State [Int] [Element] hierarchicalizeWithIds [] = return [] -hierarchicalizeWithIds ((Header level title'):xs) = do - (lastnum, usedIdents) <- S.get - let ident = uniqueIdent title' usedIdents +hierarchicalizeWithIds ((Header level (ident,_,_) title'):xs) = do + lastnum <- S.get let lastnum' = take level lastnum let newnum = if length lastnum' >= level then init lastnum' ++ [last lastnum' + 1] else lastnum ++ replicate (level - length lastnum - 1) 0 ++ [1] - S.put (newnum, (ident : usedIdents)) + S.put newnum let (sectionContents, rest) = break (headerLtEq level) xs sectionContents' <- hierarchicalizeWithIds sectionContents rest' <- hierarchicalizeWithIds rest @@ -447,7 +446,7 @@ hierarchicalizeWithIds (x:rest) = do return $ (Blk x) : rest' headerLtEq :: Int -> Block -> Bool -headerLtEq level (Header l _) = l <= level +headerLtEq level (Header l _ _) = l <= level headerLtEq _ _ = False -- | Generate a unique identifier from a list of inlines. @@ -466,15 +465,15 @@ uniqueIdent title' usedIdents = -- | True if block is a Header block. isHeaderBlock :: Block -> Bool -isHeaderBlock (Header _ _) = True +isHeaderBlock (Header _ _ _) = True isHeaderBlock _ = False -- | Shift header levels up or down. headerShift :: Int -> Pandoc -> Pandoc headerShift n = bottomUp shift where shift :: Block -> Block - shift (Header level inner) = Header (level + n) inner - shift x = x + shift (Header level attr inner) = Header (level + n) attr inner + shift x = x -- | Detect if a list is tight. isTightList :: [[Block]] -> Bool diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index fe9b60720..b69057b7a 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -35,24 +35,24 @@ import Text.Pandoc.Definition -- level that occurs before a non-header/non-hrule in the blocks). getSlideLevel :: [Block] -> Int getSlideLevel = go 6 - where go least (Header n _ : x : xs) + where go least (Header n _ _ : x : xs) | n < least && nonHOrHR x = go n xs | otherwise = go least (x:xs) go least (_ : xs) = go least xs go least [] = least - nonHOrHR (Header _ _) = False + nonHOrHR (Header _ _ _) = False nonHOrHR (HorizontalRule) = False nonHOrHR _ = True -- | Prepare a block list to be passed to hierarchicalize. prepSlides :: Int -> [Block] -> [Block] prepSlides slideLevel = ensureStartWithH . splitHrule - where splitHrule (HorizontalRule : Header n xs : ys) - | n == slideLevel = Header slideLevel xs : splitHrule ys - splitHrule (HorizontalRule : xs) = Header slideLevel [Str "\0"] : + where splitHrule (HorizontalRule : Header n attr xs : ys) + | n == slideLevel = Header slideLevel attr xs : splitHrule ys + splitHrule (HorizontalRule : xs) = Header slideLevel nullAttr [Str "\0"] : splitHrule xs splitHrule (x : xs) = x : splitHrule xs splitHrule [] = [] - ensureStartWithH bs@(Header n _:_) + ensureStartWithH bs@(Header n _ _:_) | n <= slideLevel = bs - ensureStartWithH bs = Header slideLevel [Str "\0"] : bs + ensureStartWithH bs = Header slideLevel nullAttr [Str "\0"] : bs diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b03bc77a8..30da6ac1a 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -126,10 +126,10 @@ blockToAsciiDoc opts (Para inlines) = do blockToAsciiDoc _ (RawBlock _ _) = return empty blockToAsciiDoc _ HorizontalRule = return $ blankline <> text "'''''" <> blankline -blockToAsciiDoc opts (Header level inlines) = do +blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do contents <- inlineListToAsciiDoc opts inlines let len = offset contents - return $ contents <> cr <> + return $ ("[[" <> text ident <> "]]") $$ contents $$ (case level of 1 -> text $ replicate len '-' 2 -> text $ replicate len '~' diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 0663d537c..b9dcf0c71 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -190,7 +190,7 @@ blockToConTeXt (DefinitionList lst) = liftM vcat $ mapM defListItemToConTeXt lst blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline -- If this is ever executed, provide a default for the reference identifier. -blockToConTeXt (Header level lst) = sectionHeader "" level lst +blockToConTeXt (Header level (ident,_,_) lst) = sectionHeader ident level lst blockToConTeXt (Table caption aligns widths heads rows) = do let colDescriptor colWidth alignment = (case alignment of AlignLeft -> 'l' diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index fe768efc5..890feacbf 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -142,7 +142,7 @@ listItemToDocbook opts item = -- | Convert a Pandoc block element to Docbook. blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook _ Null = empty -blockToDocbook _ (Header _ _) = empty -- should not occur after hierarchicalize +blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst blockToDocbook opts (Para [Image txt (src,_)]) = let alt = inlinesToDocbook opts txt diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 069a5f6eb..839bb16d4 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -337,11 +337,13 @@ getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique -- | Convert a Pandoc block element to OpenXML. blockToOpenXML :: WriterOptions -> Block -> WS [Element] blockToOpenXML _ Null = return [] -blockToOpenXML opts (Header lev lst) = do +blockToOpenXML opts (Header lev (ident,_,_) lst) = do contents <- withParaProp (pStyle $ "Heading" ++ show lev) $ blockToOpenXML opts (Para lst) usedIdents <- gets stSectionIds - let bookmarkName = uniqueIdent lst usedIdents + let bookmarkName = if null ident + then uniqueIdent lst usedIdents + else ident modify $ \s -> s{ stSectionIds = bookmarkName : stSectionIds s } id' <- getUniqueId let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id') diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index b8a4bf1c6..493b762ac 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -119,18 +119,17 @@ writeEPUB opts doc@(Pandoc meta _) = do -- add level 1 header to beginning if none there let blocks' = case blocks of - (Header 1 _ : _) -> blocks - _ -> Header 1 (docTitle meta) : blocks + (Header 1 _ _ : _) -> blocks + _ -> Header 1 ("",[],[]) (docTitle meta) : blocks let chapterHeaderLevel = writerEpubChapterLevel opts - -- internal reference IDs change when we chunk the file, -- so that '#my-header-1' might turn into 'chap004.xhtml#my-header'. -- the next two lines fix that: let reftable = correlateRefs chapterHeaderLevel blocks' let blocks'' = replaceRefs reftable blocks' - let isChapterHeader (Header n _) = n <= chapterHeaderLevel + let isChapterHeader (Header n _ _) = n <= chapterHeaderLevel isChapterHeader _ = False let toChunks :: [Block] -> [[Block]] @@ -145,8 +144,8 @@ writeEPUB opts doc@(Pandoc meta _) = do $ renderHtml $ writeHtml opts' $ case bs of - (Header _ xs : _) -> Pandoc (Meta xs [] []) bs - _ -> Pandoc (Meta [] [] []) bs + (Header _ _ xs : _) -> Pandoc (Meta xs [] []) bs + _ -> Pandoc (Meta [] [] []) bs let chapterEntries = zipWith chapToEntry [1..] chunks @@ -444,7 +443,7 @@ correlateRefs chapterHeaderLevel bs = , chapterIdents = [] , identTable = [] } where go :: Block -> State IdentState () - go (Header n ils) = do + go (Header n _ ils) = do when (n <= chapterHeaderLevel) $ modify $ \s -> s{ chapterNumber = chapterNumber s + 1 , chapterIdents = [] } diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 301d80c54..eeb4616b4 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -158,7 +158,7 @@ renderSection level (ttl, body) = do return $ el "section" (title ++ content) where hasSubsections = any isHeader - isHeader (Header _ _) = True + isHeader (Header _ _ _) = True isHeader _ = False -- | Only <p> and <empty-line> are allowed within <title> in FB2. @@ -186,13 +186,13 @@ splitSections level blocks = reverse $ revSplit (reverse blocks) let (lastsec, before) = break sameLevel rblocks (header, prevblocks) = case before of - ((Header n title):prevblocks') -> + ((Header n _ title):prevblocks') -> if n == level then (title, prevblocks') else ([], before) _ -> ([], before) in (header, reverse lastsec) : revSplit prevblocks - sameLevel (Header n _) = n == level + sameLevel (Header n _ _) = n == level sameLevel _ = False -- | Make another FictionBook body with footnotes. @@ -361,7 +361,7 @@ blockToXml (DefinitionList defs) = needsBreak (Para _) = False needsBreak (Plain ins) = LineBreak `notElem` ins needsBreak _ = True -blockToXml (Header _ _) = -- should never happen, see renderSections +blockToXml (Header _ _ _) = -- should never happen, see renderSections error "unexpected header in section text" blockToXml HorizontalRule = return [ el "empty-line" () @@ -413,7 +413,7 @@ indent = indentBlock let s' = unlines . map (spacer++) . lines $ s in CodeBlock a s' indentBlock (BlockQuote bs) = BlockQuote (map indent bs) - indentBlock (Header l ins) = Header l (indentLines ins) + indentBlock (Header l attr' ins) = Header l attr' (indentLines ins) indentBlock everythingElse = everythingElse -- indent every (explicit) line indentLines :: [Inline] -> [Inline] @@ -613,4 +613,4 @@ cMap = concatMap -- | Monadic equivalent of 'concatMap'. cMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] -cMapM f xs = concat `liftM` mapM f xs
\ No newline at end of file +cMapM f xs = concat `liftM` mapM f xs diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 68a8a1e09..2d42dd24e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -219,7 +219,10 @@ inTemplate opts tit auths authsMeta date toc body' newvars = -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix prefixedId :: WriterOptions -> String -> Attribute -prefixedId opts s = A.id $ toValue $ writerIdentifierPrefix opts ++ s +prefixedId opts s = + case s of + "" -> mempty + _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s -- | Replacement for Text.XHtml's unordList. unordList :: WriterOptions -> ([Html] -> Html) @@ -258,7 +261,10 @@ elementToListItem opts (Sec lev num id' headerText subsecs) let subList = if null subHeads then mempty else unordList opts subHeads - return $ Just $ (H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ id') + return $ Just + $ if null id' + then (H.a $ toHtml txt) >> subList + else (H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ id') $ toHtml txt) >> subList elementToListItem _ _ = return Nothing @@ -273,7 +279,7 @@ elementToHtml slideLevel opts (Sec level num id' title' elements) = do let titleSlide = slide && level < slideLevel header' <- if title' == [Str "\0"] -- marker for hrule then return mempty - else blockToHtml opts (Header level' title') + else blockToHtml opts (Header level' (id',[],[]) title') let isSec (Sec _ _ _ _ _) = True isSec (Blk _) = False innerContents <- mapM (elementToHtml slideLevel opts) @@ -283,8 +289,7 @@ elementToHtml slideLevel opts (Sec level num id' title' elements) = do else elements let header'' = if (writerSectionDivs opts || writerSlideVariant opts == S5Slides || - slide || - not (isEnabled Ext_header_identifiers opts)) + slide) then header' else header' ! prefixedId opts id' let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] @@ -442,15 +447,16 @@ blockToHtml opts (BlockQuote blocks) = else do contents <- blockListToHtml opts blocks return $ H.blockquote $ nl opts >> contents >> nl opts -blockToHtml opts (Header level lst) = do +blockToHtml opts (Header level (ident,_,_) lst) = do contents <- inlineListToHtml opts lst secnum <- liftM stSecNum get let contents' = if writerNumberSections opts then (H.span ! A.class_ "header-section-number" $ toHtml $ showSecNum secnum) >> strToHtml " " >> contents else contents - let contents'' = if writerTableOfContents opts - then H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "TOC") $ contents' + let contents'' = if writerTableOfContents opts && not (null ident) + then H.a ! A.href (toValue $ + '#' : writerIdentifierPrefix opts ++ ident) $ contents' else contents' return $ (case level of 1 -> H.h1 contents'' diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index f86eb079a..f01ddac78 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -109,8 +109,8 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then (blocks, []) else case last blocks of - Header 1 il -> (init blocks, il) - _ -> (blocks, []) + Header 1 _ il -> (init blocks, il) + _ -> (blocks, []) blocks'' <- if writerBeamer options then toSlides blocks' else return blocks' @@ -227,7 +227,7 @@ toSlides bs = do elementToBeamer :: Int -> Element -> State WriterState [Block] elementToBeamer _slideLevel (Blk b) = return [b] -elementToBeamer slideLevel (Sec lvl _num _ident tit elts) +elementToBeamer slideLevel (Sec lvl _num ident tit elts) | lvl > slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts return $ Para ( RawInline "latex" "\\begin{block}{" @@ -235,7 +235,7 @@ elementToBeamer slideLevel (Sec lvl _num _ident tit elts) : bs ++ [RawBlock "latex" "\\end{block}"] | lvl < slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ (Header lvl tit) : bs + return $ (Header lvl (ident,[],[]) tit) : bs | otherwise = do -- lvl == slideLevel -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] @@ -404,7 +404,7 @@ blockToLaTeX (DefinitionList lst) = do "\\end{description}" blockToLaTeX HorizontalRule = return $ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}" -blockToLaTeX (Header level lst) = sectionHeader "" level lst +blockToLaTeX (Header level (id',_,_) lst) = sectionHeader id' level lst blockToLaTeX (Table caption aligns widths heads rows) = do modify $ \s -> s{ stInTable = True, stTableNotes = [] } headers <- if all null heads diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 10ca961f8..d5e44e71a 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -161,7 +161,7 @@ blockToMan opts (Para inlines) = do blockToMan _ (RawBlock "man" str) = return $ text str blockToMan _ (RawBlock _ _) = return empty blockToMan _ HorizontalRule = return $ text ".PP" $$ text " * * * * *" -blockToMan opts (Header level inlines) = do +blockToMan opts (Header level _ inlines) = do contents <- inlineListToMan opts inlines let heading = case level of 1 -> ".SH " diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 384851c91..adefbb2b5 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -274,7 +274,7 @@ blockToMarkdown opts (RawBlock f str) blockToMarkdown _ (RawBlock _ _) = return empty blockToMarkdown _ HorizontalRule = return $ blankline <> text "* * * * *" <> blankline -blockToMarkdown opts (Header level inlines) = do +blockToMarkdown opts (Header level attr inlines) = do contents <- inlineListToMarkdown opts inlines st <- get let setext = writerSetextHeaders opts diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 01fc49a10..a71d7ee7e 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -104,7 +104,7 @@ blockToMediaWiki _ (RawBlock _ _) = return "" blockToMediaWiki _ HorizontalRule = return "\n-----\n" -blockToMediaWiki opts (Header level inlines) = do +blockToMediaWiki opts (Header level _ inlines) = do contents <- inlineListToMediaWiki opts inlines let eqs = replicate level '=' return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 027ddfda1..b59e096c9 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -287,7 +287,7 @@ blockToOpenDocument :: WriterOptions -> Block -> State WriterState Doc blockToOpenDocument o bs | Plain b <- bs = inParagraphTags =<< inlinesToOpenDocument o b | Para b <- bs = inParagraphTags =<< inlinesToOpenDocument o b - | Header i b <- bs = setFirstPara >> + | Header i _ b <- bs = setFirstPara >> (inHeaderTags i =<< inlinesToOpenDocument o b) | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b | DefinitionList b <- bs = setFirstPara >> defList b diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 86b570c30..894d4afa0 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -131,7 +131,7 @@ blockToOrg (RawBlock f str) | f == "org" || f == "latex" || f == "tex" = return $ text str blockToOrg (RawBlock _ _) = return empty blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline -blockToOrg (Header level inlines) = do +blockToOrg (Header level _ inlines) = do contents <- inlineListToOrg inlines let headerStr = text $ if level > 999 then " " else replicate level '*' return $ headerStr <> " " <> contents <> blankline diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 40939c6b7..85ca98f5a 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -161,7 +161,7 @@ blockToRST (RawBlock f str) = (nest 3 $ text str) $$ blankline blockToRST HorizontalRule = return $ blankline $$ "--------------" $$ blankline -blockToRST (Header level inlines) = do +blockToRST (Header level _ inlines) = do contents <- inlineListToRST inlines let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1) let border = text $ replicate (offset contents) headerChar diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 619e7086f..f2a271c1d 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -72,7 +72,7 @@ writeRTF options (Pandoc (Meta title authors date) blocks) = datetext = inlineListToRTF date spacer = not $ all null $ titletext : datetext : authorstext body = concatMap (blockToRTF 0 AlignDefault) blocks - isTOCHeader (Header lev _) = lev <= writerTOCDepth options + isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options isTOCHeader _ = False context = writerVariables options ++ [ ("body", body) @@ -91,7 +91,7 @@ tableOfContents :: [Block] -> String tableOfContents headers = let contentsTree = hierarchicalize headers in concatMap (blockToRTF 0 AlignDefault) $ - [Header 1 [Str "Contents"], + [Header 1 nullAttr [Str "Contents"], BulletList (map elementToListItem contentsTree)] elementToListItem :: Element -> [Block] @@ -208,7 +208,7 @@ blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $ concatMap (definitionListItemToRTF alignment indent) lst blockToRTF indent _ HorizontalRule = rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash" -blockToRTF indent alignment (Header level lst) = rtfPar indent 0 alignment $ +blockToRTF indent alignment (Header level _ lst) = rtfPar indent 0 alignment $ "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst blockToRTF indent alignment (Table caption aligns sizes headers rows) = (if all null headers diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 4c29b410d..03e08c463 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -64,7 +64,7 @@ writeTexinfo options document = -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc wrapTop (Pandoc (Meta title authors date) blocks) = - Pandoc (Meta title authors date) (Header 0 title : blocks) + Pandoc (Meta title authors date) (Header 0 nullAttr title : blocks) pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String pandocToTexinfo options (Pandoc (Meta title authors date) blocks) = do @@ -195,14 +195,14 @@ blockToTexinfo HorizontalRule = text (take 72 $ repeat '-') $$ text "@end ifnottex" -blockToTexinfo (Header 0 lst) = do +blockToTexinfo (Header 0 _ lst) = do txt <- if null lst then return $ text "Top" else inlineListToTexinfo lst return $ text "@node Top" $$ text "@top " <> txt <> blankline -blockToTexinfo (Header level lst) = do +blockToTexinfo (Header level _ lst) = do node <- inlineListForNode lst txt <- inlineListToTexinfo lst idsUsed <- gets stIdentifiers @@ -286,7 +286,7 @@ blockListToTexinfo [] = return empty blockListToTexinfo (x:xs) = do x' <- blockToTexinfo x case x of - Header level _ -> do + Header level _ _ -> do -- We need need to insert a menu for this node. let (before, after) = break isHeader xs before' <- blockListToTexinfo before @@ -311,14 +311,14 @@ blockListToTexinfo (x:xs) = do return $ x' $$ xs' isHeader :: Block -> Bool -isHeader (Header _ _) = True -isHeader _ = False +isHeader (Header _ _ _) = True +isHeader _ = False collectNodes :: Int -> [Block] -> [Block] collectNodes _ [] = [] collectNodes level (x:xs) = case x of - (Header hl _) -> + (Header hl _ _) -> if hl < level then [] else if hl == level @@ -329,7 +329,7 @@ collectNodes level (x:xs) = makeMenuLine :: Block -> State WriterState Doc -makeMenuLine (Header _ lst) = do +makeMenuLine (Header _ _ lst) = do txt <- inlineListForNode lst return $ text "* " <> txt <> text "::" makeMenuLine _ = error "makeMenuLine called with non-Header block" diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 44fdc7efb..1f5d3e79d 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -121,9 +121,10 @@ blockToTextile _ (RawBlock f str) = blockToTextile _ HorizontalRule = return "<hr />\n" -blockToTextile opts (Header level inlines) = do +blockToTextile opts (Header level (ident,_,_) inlines) = do contents <- inlineListToTextile opts inlines - let prefix = 'h' : (show level ++ ". ") + let attribs = if null ident then "" else "(#" ++ ident ++ ")" + let prefix = 'h' : show level ++ attribs ++ ". " return $ prefix ++ contents ++ "\n" blockToTextile _ (CodeBlock (_,classes,_) str) | any (all isSpace) (lines str) = |