Improved makeSections so we don't get doubled attributes.

Closes #5986.
This commit is contained in:
John MacFarlane 2019-12-17 11:09:00 -08:00
parent 11bab77120
commit 20cf4e47b0
4 changed files with 23 additions and 18 deletions

View file

@ -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)

View file

@ -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 ]

View file

@ -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>
```

View file

@ -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>
```