diff options
| -rw-r--r-- | src/Text/Pandoc/Shared.hs | 30 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 3 | ||||
| -rw-r--r-- | test/command/5986.md | 2 | ||||
| -rw-r--r-- | test/command/section-divs.md | 6 |
4 files changed, 23 insertions, 18 deletions
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 809a16652..69ade7e95 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -582,25 +582,20 @@ makeSections numbering mbBaseLevel bs = let attr = ("",classes,kvs') return $ Div divattr (Header level' attr title' : sectionContents') : rest' - go (Div (dident,dclasses,dkvs) - (Header level (ident,classes,kvs) title':ys) : xs) + go (Div divattr@(dident,dclasses,_) (Header level hattr title':ys) : xs) | all (\case Header level' _ _ -> level' > level _ -> True) ys , "column" `notElem` dclasses , "columns" `notElem` dclasses = do - inner <- go (Header level (ident,classes,kvs) title':ys) - let inner' = - case inner of - (Div (dident',dclasses',dkvs') zs@(Header{}:zs') : ws) - | T.null dident -> - Div (dident',dclasses' ++ dclasses,dkvs' ++ dkvs) zs : ws - | otherwise -> -- keep id on header so we don't lose anchor - Div (dident,dclasses ++ dclasses',dkvs ++ dkvs') - (Header level (dident',classes,kvs) title':zs') : ws - _ -> inner -- shouldn't happen + inner <- go (Header level hattr title':ys) rest <- go xs - return $ inner' ++ rest + return $ + case inner of + [Div divattr'@(dident',_,_) zs] + | T.null dident || T.null dident' || dident == dident' + -> Div (combineAttr divattr' divattr) zs : rest + _ -> Div divattr inner : rest go (Div attr xs : rest) = do xs' <- go xs rest' <- go rest @@ -608,6 +603,14 @@ makeSections numbering mbBaseLevel bs = go (x:xs) = (x :) <$> go xs go [] = return [] + combineAttr :: Attr -> Attr -> Attr + combineAttr (id1, classes1, kvs1) (id2, classes2, kvs2) = + (if T.null id1 then id2 else id1, + ordNub (classes1 ++ classes2), + foldr (\(k,v) kvs -> case lookup k kvs of + Nothing -> (k,v):kvs + Just _ -> kvs) mempty (kvs1 ++ kvs2)) + headerLtEq :: Int -> Block -> Bool headerLtEq level (Header l _ _) = l <= level headerLtEq level (Div _ (b:_)) = headerLtEq level b @@ -642,6 +645,7 @@ headerShift n (Pandoc meta (Header m _ ils : bs)) , m + n == 0 = headerShift n $ B.setTitle (B.fromList ils) $ Pandoc meta bs headerShift n (Pandoc meta bs) = Pandoc meta (walk shift bs) + where shift :: Block -> Block shift (Header level attr inner) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 4d8a6b961..784606dd5 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -663,7 +663,8 @@ blockToHtml opts (Div (ident, "section":dclasses, dkvs) (z:zs) -> ([],z ++ concatMap inDiv zs) titleContents <- blockListToHtml opts titleBlocks innerContents <- blockListToHtml opts innerSecs - let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++ + let classes' = ordNub $ + ["title-slide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && not html5 ] ++ ["level" <> tshow level | slide || writerSectionDivs opts ] diff --git a/test/command/5986.md b/test/command/5986.md index b1545c050..dd426a416 100644 --- a/test/command/5986.md +++ b/test/command/5986.md @@ -10,7 +10,7 @@ </ol> </nav> <p><span id="ch001.xhtml"></span></p> -<section id="ch001.xhtml#hi" class="level1 section" data-number="1"> +<section id="ch001.xhtml#hi" class="level1" data-number="1"> <h1 data-number="1"><span class="header-section-number">1</span> Hi</h1> </section> ``` diff --git a/test/command/section-divs.md b/test/command/section-divs.md index 6e2412e04..5ee28bba8 100644 --- a/test/command/section-divs.md +++ b/test/command/section-divs.md @@ -13,13 +13,13 @@ Ok == ::: ^D -<section id="hi" class="level1 section"> +<section id="hi" class="level1"> <h1>Hi</h1> -<section id="there" class="level2 section"> +<section id="there" class="level2"> <h2>there</h2> </section> </section> -<section id="ok" class="level1 section"> +<section id="ok" class="level1"> <h1>Ok</h1> </section> ``` |