Improved makeSections so we don't get doubled attributes.
Closes #5986.
This commit is contained in:
parent
11bab77120
commit
20cf4e47b0
4 changed files with 23 additions and 18 deletions
|
@ -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)
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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>
|
||||
```
|
||||
|
|
|
@ -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>
|
||||
```
|
||||
|
|
Loading…
Add table
Reference in a new issue