Replace Element and makeHierarchical with makeSections.

Text.Pandoc.Shared:

+ Remove `Element` type [API change]
+ Remove `makeHierarchicalize` [API change]
+ Add `makeSections` [API change]
+ Export `deLink` [API change]

Now that we have Divs, we can use them to represent the structure
of sections, and we don't need a special Element type.
`makeSections` reorganizes a block list, adding Divs with
class `section` around sections, and adding numbering
if needed.

This change also fixes some longstanding issues recognizing
section structure when the document contains Divs.
Closes #3057, see also #997.

All writers have been changed to use `makeSections`.
Note that in the process we have reverted the change
c1d058aeb1c6a331a2cc22786ffaab17f7118ccd
made in response to #5168, which I'm not completely
sure was a good idea.

Lua modules have also been adjusted accordingly.
Existing lua filters that use `hierarchicalize` will
need to be rewritten to use `make_sections`.

17 files changed, 459 insertions, 564 deletions

diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 7b428b5f0..c9d61d3e4 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -22,12 +22,9 @@ module Text.Pandoc.Lua.Marshaling.AST
 import Prelude
 import Control.Applicative ((<|>))
 import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
-import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
-                            , metatableName)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
 import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Shared (Element (Blk, Sec))
 
 import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -285,31 +282,3 @@ instance Pushable LuaListAttributes where
 instance Peekable LuaListAttributes where
   peek = defineHowTo "get ListAttributes value" .
          fmap LuaListAttributes . Lua.peek
-
---
--- Hierarchical elements
---
-instance Pushable Element where
-  push (Blk blk) = Lua.push blk
-  push sec = pushAnyWithMetatable pushElementMetatable sec
-   where
-    pushElementMetatable = ensureUserdataMetatable (metatableName sec) $
-                           LuaUtil.addFunction "__index" indexElement
-
-instance Peekable Element where
-  peek idx = Lua.ltype idx >>= \case
-    Lua.TypeUserdata -> Lua.peekAny idx
-    _                -> Blk <$> Lua.peek idx
-
-indexElement :: Element -> String -> Lua Lua.NumResults
-indexElement = \case
-  (Blk _) -> const (1 <$ Lua.pushnil) -- this shouldn't happen
-  (Sec lvl num attr label contents) -> fmap (return 1) . \case
-    "level"     -> Lua.push lvl
-    "numbering" -> Lua.push num
-    "attr"      -> Lua.push (LuaAttr attr)
-    "label"     -> Lua.push label
-    "contents"  -> Lua.push contents
-    "tag"       -> Lua.push "Sec"
-    "t"         -> Lua.push "Sec"
-    _           -> Lua.pushnil
diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs
index fdc63cd99..a6bfa529c 100644
--- a/src/Text/Pandoc/Lua/Module/Types.hs
+++ b/src/Text/Pandoc/Lua/Module/Types.hs
@@ -19,7 +19,6 @@ import Text.Pandoc.Definition
 import Text.Pandoc.Lua.Marshaling.AST (LuaAttr, LuaListAttributes)
 import Text.Pandoc.Lua.Marshaling.Version ()
 import Text.Pandoc.Lua.Util (addFunction)
-import Text.Pandoc.Shared (Element (..))
 
 import qualified Foreign.Lua as Lua
 
@@ -38,7 +37,6 @@ pushCloneTable = do
   addFunction "Attr" cloneAttr
   addFunction "Block" cloneBlock
   addFunction "Citation" cloneCitation
-  addFunction "Element" cloneElement
   addFunction "Inline" cloneInline
   addFunction "Meta" cloneMeta
   addFunction "MetaValue" cloneMetaValue
@@ -55,9 +53,6 @@ cloneBlock = return
 cloneCitation :: Citation -> Lua Citation
 cloneCitation = return
 
-cloneElement :: Element -> Lua Element
-cloneElement = return
-
 cloneInline :: Inline -> Lua Inline
 cloneInline = return
 
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 21e3f5674..057e6580b 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -38,7 +38,7 @@ pushModule mbDatadir = do
   Lua.newtable
   addFunction "blocks_to_inlines" blocksToInlines
   addFunction "equals" equals
-  addFunction "hierarchicalize" hierarchicalize
+  addFunction "make_sections" makeSections
   addFunction "normalize_date" normalizeDate
   addFunction "run_json_filter" (runJSONFilter mbDatadir)
   addFunction "sha1" sha1
@@ -55,9 +55,10 @@ blocksToInlines blks optSep = do
               Nothing -> Shared.defaultBlocksSeparator
   return $ B.toList (Shared.blocksToInlinesWithSep sep blks)
 
--- | Convert list of Pandoc blocks into (hierarchical) list of Elements.
-hierarchicalize :: [Block] -> Lua [Shared.Element]
-hierarchicalize = return . Shared.hierarchicalize
+-- | Convert list of Pandoc blocks into sections using Divs.
+makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block]
+makeSections number baselevel =
+  return . Shared.makeSections number (Lua.fromOptional baselevel)
 
 -- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
 -- limit years to the range 1601-9999 (ISO 8601 accepts greater than
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 7c3546f44..06715145e 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -47,13 +47,13 @@ module Text.Pandoc.Shared (
                      extractSpaces,
                      removeFormatting,
                      deNote,
+                     deLink,
                      stringify,
                      capitalize,
                      compactify,
                      compactifyDL,
                      linesToPara,
-                     Element (..),
-                     hierarchicalize,
+                     makeSections,
                      uniqueIdent,
                      inlineListToIdentifier,
                      isHeaderBlock,
@@ -104,11 +104,10 @@ import qualified Data.Bifunctor as Bifunctor
 import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum,
                   generalCategory, GeneralCategory(NonSpacingMark,
                   SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))
-import Data.Data (Data, Typeable)
 import Data.List (find, intercalate, intersperse, stripPrefix, sortBy)
 import Data.Ord (comparing)
 import qualified Data.Map as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Monoid (Any (..))
 import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr)
 import qualified Data.Set as Set
@@ -366,6 +365,10 @@ deNote :: Inline -> Inline
 deNote (Note _) = Str ""
 deNote x        = x
 
+deLink :: Inline -> Inline
+deLink (Link _ ils _) = Span nullAttr ils
+deLink x              = x
+
 deQuote :: Inline -> Inline
 deQuote (Quoted SingleQuote xs) =
   Span ("",[],[]) (Str "\8216" : xs ++ [Str "\8217"])
@@ -449,34 +452,6 @@ isPara :: Block -> Bool
 isPara (Para _) = True
 isPara _        = False
 
--- | Data structure for defining hierarchical Pandoc documents
-data Element = Blk Block
-             | Sec Int [Int] Attr [Inline] [Element]
-             --    lvl  num attributes label    contents
-             deriving (Eq, Read, Show, Typeable, Data)
-
-instance Walkable Inline Element where
-  walk f (Blk x) = Blk (walk f x)
-  walk f (Sec lev nums attr ils elts) = Sec lev nums attr (walk f ils) (walk f elts)
-  walkM f (Blk x) = Blk `fmap` walkM f x
-  walkM f (Sec lev nums attr ils elts) = do
-    ils' <- walkM f ils
-    elts' <- walkM f elts
-    return $ Sec lev nums attr ils' elts'
-  query f (Blk x)              = query f x
-  query f (Sec _ _ _ ils elts) = query f ils `mappend` query f elts
-
-instance Walkable Block Element where
-  walk f (Blk x) = Blk (walk f x)
-  walk f (Sec lev nums attr ils elts) = Sec lev nums attr (walk f ils) (walk f elts)
-  walkM f (Blk x) = Blk `fmap` walkM f x
-  walkM f (Sec lev nums attr ils elts) = do
-    ils' <- walkM f ils
-    elts' <- walkM f elts
-    return $ Sec lev nums attr ils' elts'
-  query f (Blk x)              = query f x
-  query f (Sec _ _ _ ils elts) = query f ils `mappend` query f elts
-
 -- | Convert Pandoc inline list to plain text identifier.  HTML
 -- identifiers must start with a letter, and may contain only
 -- letters, digits, and the characters _-.
@@ -504,37 +479,67 @@ inlineListToIdentifier exts =
       | otherwise = c == '_' || c == '-' || c == '.'
     spaceToDash = map (\c -> if isSpace c then '-' else c)
 
--- | Convert list of Pandoc blocks into (hierarchical) list of Elements
-hierarchicalize :: [Block] -> [Element]
-hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) []
-
-hierarchicalizeWithIds :: [Block] -> S.State [Int] [Element]
-hierarchicalizeWithIds [] = return []
-hierarchicalizeWithIds (Header level attr@(_,classes,_) title':xs) = do
-  lastnum <- S.get
-  let lastnum' = take level lastnum
-  let newnum = case length lastnum' of
-                    x | "unnumbered" `elem` classes -> []
-                      | x >= level -> init lastnum' ++ [last lastnum' + 1]
-                      | otherwise -> lastnum ++
-                           replicate (level - length lastnum - 1) 0 ++ [1]
-  unless (null newnum) $ S.put newnum
-  let (sectionContents, rest) = break (headerLtEq level) xs
-  sectionContents' <- hierarchicalizeWithIds sectionContents
-  rest' <- hierarchicalizeWithIds rest
-  return $ Sec level newnum attr title' sectionContents' : rest'
-hierarchicalizeWithIds (Div ("refs",classes',kvs')
-                         (Header level (ident,classes,kvs) title' : xs):ys) =
-  hierarchicalizeWithIds (Header level (ident,"references":classes,kvs)
-                           title' : Div ("refs",classes',kvs') xs : ys)
-hierarchicalizeWithIds (x:rest) = do
-  rest' <- hierarchicalizeWithIds rest
-  return $ Blk x : rest'
+
+-- | Put a list of Pandoc blocks into a hierarchical structure:
+-- a list of sections (each a Div with class "section" and first
+-- element a Header).  If the 'numbering' parameter is True, Header
+-- numbers are added via the number attribute on the header.
+-- If the baseLevel parameter is Just n, Header levels are
+-- adjusted to be gapless starting at level n.
+makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
+makeSections numbering mbBaseLevel bs =
+  S.evalState (go bs) (mbBaseLevel, [])
+ where
+  go :: [Block] -> S.State (Maybe Int, [Int]) [Block]
+  go (Header level (ident,classes,kvs) title':xs) = do
+    (mbLevel, lastnum) <- S.get
+    let level' = fromMaybe level mbLevel
+    let lastnum' = take level' lastnum
+    let newnum =
+          if level' > 0
+             then case length lastnum' of
+                      x | "unnumbered" `elem` classes -> []
+                        | x >= level' -> init lastnum' ++ [last lastnum' + 1]
+                        | otherwise -> lastnum ++
+                             replicate (level' - length lastnum - 1) 0 ++ [1]
+             else []
+    unless (null newnum) $ S.modify $ \(mbl, _) -> (mbl, newnum)
+    let (sectionContents, rest) = break (headerLtEq level) xs
+    S.modify $ \(_, ln) -> (fmap (+ 1) mbLevel, ln)
+    sectionContents' <- go sectionContents
+    S.modify $ \(_, ln) -> (mbLevel, ln)
+    rest' <- go rest
+    let divattr = (ident, ["section"], [])
+    let attr = ("",classes,kvs ++
+                   [("number", intercalate "." (map show newnum))
+                     | numbering])
+    return $
+      Div divattr (Header level' attr title' : sectionContents') : rest'
+  go (Div (dident,dclasses,dkvs)
+       (Header level (ident,classes,kvs) title':ys) : xs) = do
+    inner <- go (Header level (ident,classes,kvs) title':ys)
+    let inner' =
+          case inner of
+            (Div (dident',dclasses',dkvs') zs@(Header{}:zs') : ws)
+              | 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
+    rest <- go xs
+    return $ inner' ++ rest
+  go (Div attr xs : rest) = do
+    xs' <- go xs
+    rest' <- go rest
+    return $ Div attr xs' : rest'
+  go (x:xs) = (x :) <$> go xs
+  go [] = return []
 
 headerLtEq :: Int -> Block -> Bool
-headerLtEq level (Header l _ _)                                  = l <= level
-headerLtEq level (Div ("",["references"],[]) (Header l _ _ : _)) = l <= level
-headerLtEq _ _                                                   = False
+headerLtEq level (Header l _ _)  = l <= level
+headerLtEq level (Div _ (b:_))   = headerLtEq level b
+headerLtEq _ _                   = False
 
 -- | Generate a unique identifier from a list of inlines.
 -- Second argument is a list of already used identifiers.
diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs
index 58f3be273..8fb1b63aa 100644
--- a/src/Text/Pandoc/Slides.hs
+++ b/src/Text/Pandoc/Slides.hs
@@ -28,7 +28,7 @@ getSlideLevel = go 6
         nonHOrHR HorizontalRule = False
         nonHOrHR _              = True
 
--- | Prepare a block list to be passed to hierarchicalize.
+-- | Prepare a block list to be passed to makeSections.
 prepSlides :: Int -> [Block] -> [Block]
 prepSlides slideLevel = ensureStartWithH . splitHrule . extractRefsHeader
   where splitHrule (HorizontalRule : Header n attr xs : ys)
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index f360aeee1..c0f215d57 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -84,7 +84,7 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
               (blockListToAsciiDoc opts)
               (fmap chomp . inlineListToAsciiDoc opts)
               meta
-  main <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
+  main <- blockListToAsciiDoc opts $ makeSections False (Just 1) blocks
   st <- get
   let context  = defField "body" main
                $ defField "toc"
@@ -97,14 +97,6 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
        Nothing  -> main
        Just tpl -> renderTemplate tpl context
 
-elementToAsciiDoc :: PandocMonad m
-                  => Int -> WriterOptions -> Element -> ADW m (Doc Text)
-elementToAsciiDoc _ opts (Blk b) = blockToAsciiDoc opts b
-elementToAsciiDoc nestlevel opts (Sec _lvl _num attr label children) = do
-  hdr <- blockToAsciiDoc opts (Header nestlevel attr label)
-  rest <- vcat <$> mapM (elementToAsciiDoc (nestlevel + 1) opts) children
-  return $ hdr $$ rest
-
 -- | Escape special characters for AsciiDoc.
 escapeString :: String -> String
 escapeString = escapeStringUsing escs
@@ -137,6 +129,11 @@ blockToAsciiDoc :: PandocMonad m
                 -> Block         -- ^ Block element
                 -> ADW m (Doc Text)
 blockToAsciiDoc _ Null = return empty
+blockToAsciiDoc opts (Div (id',"section":_,_)
+                       (Header level (_,cls,kvs) ils : xs)) = do
+  hdr <- blockToAsciiDoc opts (Header level (id',cls,kvs) ils)
+  rest <- blockListToAsciiDoc opts xs
+  return $ hdr $$ rest
 blockToAsciiDoc opts (Plain inlines) = do
   contents <- inlineListToAsciiDoc opts inlines
   return $ contents <> blankline
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 3a142fdb8..bef1e6265 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -65,8 +65,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do
               blockListToConTeXt
               (fmap chomp . inlineListToConTeXt)
               meta
-  body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
-  let main = vcat body
+  main <- blockListToConTeXt $ makeSections False Nothing blocks
   let layoutFromMargins = mconcat $ intersperse ("," :: Doc Text) $
                           mapMaybe (\(x,y) ->
                                 ((x <> "=") <>) <$> getField y metadata)
@@ -147,18 +146,15 @@ toLabel z = concatMap go z
          | x `elem` ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x)
          | otherwise = [x]
 
--- | Convert Elements to ConTeXt
-elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m (Doc Text)
-elementToConTeXt _ (Blk block) = blockToConTeXt block
-elementToConTeXt opts (Sec level _ attr title' elements) = do
-  header' <- sectionHeader attr level title'
-  footer' <- sectionFooter attr level
-  innerContents <- mapM (elementToConTeXt opts) elements
-  return $ header' $$ vcat innerContents $$ footer'
-
 -- | Convert Pandoc block element to ConTeXt.
 blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text)
 blockToConTeXt Null = return empty
+blockToConTeXt (Div attr@(_,"section":_,_)
+                 (Header level _ title' : xs)) = do
+  header' <- sectionHeader attr level title'
+  footer' <- sectionFooter attr level
+  innerContents <- blockListToConTeXt xs
+  return $ header' $$ innerContents $$ footer'
 blockToConTeXt (Plain lst) = inlineListToConTeXt lst
 -- title beginning with fig: indicates that the image is a figure
 blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 6f42d05e3..b0472e1d1 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -78,7 +78,6 @@ writeDocbook5 opts d =
 -- | Convert Pandoc document to string in Docbook format.
 writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
 writeDocbook opts (Pandoc meta blocks) = do
-  let elements = hierarchicalize blocks
   let colwidth = if writerWrapText opts == WrapAuto
                     then Just $ writerColumns opts
                     else Nothing
@@ -88,15 +87,15 @@ writeDocbook opts (Pandoc meta blocks) = do
                    TopLevelChapter -> 0
                    TopLevelSection -> 1
                    TopLevelDefault -> 1
+  let fromBlocks = blocksToDocbook opts .
+                   makeSections False (Just startLvl)
   auths' <- mapM (authorToDocbook opts) $ docAuthors meta
   let meta' = B.setMeta "author" auths' meta
   metadata <- metaToContext opts
-                 (fmap vcat .
-                          mapM (elementToDocbook opts startLvl) .
-                            hierarchicalize)
+                 (fromBlocks)
                  (inlinesToDocbook opts)
                  meta'
-  main <- vcat <$> mapM (elementToDocbook opts startLvl) elements
+  main <- fromBlocks blocks
   let context = defField "body" main
               $ defField "mathml" (case writerHTMLMathMethod opts of
                                           MathML -> True
@@ -107,34 +106,6 @@ writeDocbook opts (Pandoc meta blocks) = do
          Nothing  -> main
          Just tpl -> renderTemplate tpl context
 
--- | Convert an Element to Docbook.
-elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m (Doc Text)
-elementToDocbook opts _   (Blk block) = blockToDocbook opts block
-elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
-  version <- ask
-  -- Docbook doesn't allow sections with no content, so insert some if needed
-  let elements' = if null elements
-                    then [Blk (Para [])]
-                    else elements
-      tag = case lvl of
-                 -1                   -> "part"
-                 0                    -> "chapter"
-                 n | n >= 1 && n <= 5 -> if version == DocBook5
-                                              then "section"
-                                              else "sect" ++ show n
-                 _                    -> "simplesect"
-      idName = if version == DocBook5
-                 then "xml:id"
-                 else "id"
-      idAttr = [(idName, writerIdentifierPrefix opts ++ id') | not (null id')]
-      nsAttr = if version == DocBook5 && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
-                                      else []
-      attribs = nsAttr ++ idAttr
-  contents <- mapM (elementToDocbook opts (lvl + 1)) elements'
-  title' <- inlinesToDocbook opts title
-  return $ inTags True tag attribs $
-      inTagsSimple "title" title' $$ vcat contents
-
 -- | Convert a list of Pandoc blocks to Docbook.
 blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
 blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts)
@@ -184,6 +155,29 @@ blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
 blockToDocbook _ Null = return empty
 -- Add ids to paragraphs in divs with ids - this is needed for
 -- pandoc-citeproc to get link anchors in bibliographies:
+blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
+  version <- ask
+  -- Docbook doesn't allow sections with no content, so insert some if needed
+  let bs = if null xs
+              then [Para []]
+              else xs
+      tag = case lvl of
+                 -1                   -> "part"
+                 0                    -> "chapter"
+                 n | n >= 1 && n <= 5 -> if version == DocBook5
+                                              then "section"
+                                              else "sect" ++ show n
+                 _                    -> "simplesect"
+      idName = if version == DocBook5
+                 then "xml:id"
+                 else "id"
+      idAttr = [(idName, writerIdentifierPrefix opts ++ id') | not (null id')]
+      nsAttr = if version == DocBook5 && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
+                                      else []
+      attribs = nsAttr ++ idAttr
+  title' <- inlinesToDocbook opts ils
+  contents <- blocksToDocbook opts bs
+  return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
 blockToDocbook opts (Div (ident,_,_) [Para lst]) =
   let attribs = [("id", ident) | not (null ident)] in
   if hasLineBreaks lst
@@ -197,7 +191,7 @@ blockToDocbook opts (Div (ident,_,_) bs) = do
         then mempty
         else selfClosingTag "anchor" [("id", ident)]) $$ contents
 blockToDocbook _ h@Header{} = do
-  -- should not occur after hierarchicalize, except inside lists/blockquotes
+  -- should be handled by Div section above, except inside lists/blockquotes
   report $ BlockNotRendered h
   return empty
 blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index ad88162b6..b41b17ff9 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -47,7 +47,7 @@ import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
                          getMimeTypeDef)
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.Docx.StyleMap
-import Text.Pandoc.Shared hiding (Element)
+import Text.Pandoc.Shared
 import Text.Pandoc.Walk
 import Text.Pandoc.Writers.Math
 import Text.Pandoc.Writers.Shared
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 0f4e338e6..d0e85ae39 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -26,7 +26,7 @@ import Control.Monad.State.Strict (State, StateT, evalState, evalStateT, get,
 import qualified Data.ByteString.Lazy as B
 import qualified Data.ByteString.Lazy.Char8 as B8
 import Data.Char (isAlphaNum, isAscii, isDigit, toLower)
-import Data.List (intercalate, isInfixOf, isPrefixOf)
+import Data.List (isInfixOf, isPrefixOf)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust)
 import qualified Data.Set as Set
@@ -47,9 +47,8 @@ import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType)
 import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..),
                             ObfuscationMethod (NoObfuscation), WrapOption (..),
                             WriterOptions (..))
-import Text.Pandoc.Shared (hierarchicalize, normalizeDate, renderTags',
+import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags',
                            safeRead, stringify, trim, uniqueIdent)
-import qualified Text.Pandoc.Shared as S (Element (..))
 import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.UUID (getUUID)
 import Text.Pandoc.Walk (query, walk, walkM)
@@ -712,31 +711,34 @@ pandocToEPUB version opts doc = do
   contentsEntry <- mkEntry "content.opf" contentsData
 
   -- toc.ncx
-  let secs = hierarchicalize blocks'
+  let secs = makeSections True (Just 1) blocks'
 
   let tocLevel = writerTOCDepth opts
 
   let navPointNode :: PandocMonad m
                    => (Int -> [Inline] -> String -> [Element] -> Element)
-                   -> S.Element -> StateT Int m Element
-      navPointNode formatter (S.Sec _ nums (ident,_,_) ils children) = do
-        n <- get
-        modify (+1)
-        let showNums :: [Int] -> String
-            showNums = intercalate "." . map show
-        let tit = if writerNumberSections opts && not (null nums)
-                     then Span ("", ["section-header-number"], [])
-                           [Str (showNums nums)] : Space : ils
-                     else ils
-        src <- case lookup ident reftable of
-                 Just x  -> return x
-                 Nothing -> throwError $ PandocSomeError $ ident ++ " not found in reftable"
-        let isSec (S.Sec lev _ _ _ _) = lev <= tocLevel
-            isSec _                   = False
-        let subsecs = filter isSec children
-        subs <- mapM (navPointNode formatter) subsecs
-        return $ formatter n tit src subs
-      navPointNode _ (S.Blk _) = throwError $ PandocSomeError "navPointNode encountered Blk"
+                   -> Block -> StateT Int m [Element]
+      navPointNode formatter (Div (ident,"section":_,_)
+                                (Header lvl (_,_,kvs) ils : children)) = do
+        if lvl > tocLevel
+           then return []
+           else do
+             n <- get
+             modify (+1)
+             let num = fromMaybe "" $ lookup "number" kvs
+             let tit = if writerNumberSections opts && not (null num)
+                          then Span ("", ["section-header-number"], [])
+                                [Str num] : Space : ils
+                          else ils
+             src <- case lookup ident reftable of
+                      Just x  -> return x
+                      Nothing -> throwError $ PandocSomeError $
+                                    ident ++ " not found in reftable"
+             subs <- concat <$> mapM (navPointNode formatter) children
+             return [formatter n tit src subs]
+      navPointNode formatter (Div _ bs) =
+        concat <$> mapM (navPointNode formatter) bs
+      navPointNode _ _ = return []
 
   let navMapFormatter :: Int -> [Inline] -> String -> [Element] -> Element
       navMapFormatter n tit src subs = unode "navPoint" !
@@ -750,7 +752,8 @@ pandocToEPUB version opts doc = do
                   , unode "content" ! [("src", "text/title_page.xhtml")]
                   $ () ]
 
-  navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1
+  navMap <- lift $ evalStateT
+             (concat <$> mapM (navPointNode navMapFormatter) secs) 1
   let tocData = UTF8.fromStringLazy $ ppTopElement $
         unode "ncx" ! [("version","2005-1")
                        ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
@@ -800,7 +803,8 @@ pandocToEPUB version opts doc = do
                 clean x              = x
 
   let navtag = if epub3 then "nav" else "div"
-  tocBlocks <- lift $ evalStateT (mapM (navPointNode navXhtmlFormatter) secs) 1
+  tocBlocks <- lift $ evalStateT
+                 (concat <$> mapM (navPointNode navXhtmlFormatter) secs) 1
   let navBlocks = [RawBlock (Format "html")
                   $ showElement $ -- prettyprinting introduces bad spaces
                    unode navtag ! ([("epub:type","toc") | epub3] ++
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index d2527a0a9..744eb2a06 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -39,9 +39,9 @@ import qualified Text.Pandoc.Class as P
 import Text.Pandoc.Definition
 import Text.Pandoc.Logging
 import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
-import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, hierarchicalize)
+import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,
+                           makeSections)
 import Text.Pandoc.Writers.Shared (lookupMetaString)
-import qualified Text.Pandoc.Shared as Shared (Element(Blk, Sec))
 
 -- | Data to be written at the end of the document:
 -- (foot)notes, URLs, references, images.
@@ -162,28 +162,27 @@ docdate meta' = do
 -- representation.
 renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content]
 renderSections level blocks = do
-    let elements = hierarchicalize blocks
-    let isSection Shared.Sec{} = True
+    let blocks' = makeSections False Nothing blocks
+    let isSection (Div (_,"section":_,_) (Header{}:_)) = True
         isSection _ = False
-    let (initialBlocks, secs) = break isSection elements
-    let elements' = if null initialBlocks
-        then secs
-        else Shared.Sec 1 [] nullAttr mempty initialBlocks : secs
-    cMapM (renderSection level) elements'
-
-
-
-renderSection :: PandocMonad m =>  Int -> Shared.Element -> FBM m [Content]
-renderSection _   (Shared.Blk block) = blockToXml block
-renderSection lvl (Shared.Sec _ _num (id',_,_) title elements) = do
-  content <- cMapM (renderSection (lvl + 1)) elements
+    let (initialBlocks, secs) = break isSection blocks'
+    let blocks'' = if null initialBlocks
+        then blocks'
+        else Div ("",["section"],[])
+               (Header 1 nullAttr mempty : initialBlocks) : secs
+    cMapM (renderSection level) blocks''
+
+renderSection :: PandocMonad m =>  Int -> Block -> FBM m [Content]
+renderSection lvl (Div (id',"section":_,_) (Header _ _ title : xs)) = do
   title' <- if null title
             then return []
             else list . el "title" <$> formatTitle title
+  content <- cMapM (renderSection (lvl + 1)) xs
   let sectionContent = if null id'
       then el "section" (title' ++ content)
       else el "section" ([uattr "id" id'], title' ++ content)
   return [sectionContent]
+renderSection _ b = blockToXml b
 
 -- | Only <p> and <empty-line> are allowed within <title> in FB2.
 formatTitle :: PandocMonad m => [Inline] -> FBM m [Content]
@@ -334,7 +333,7 @@ blockToXml (DefinitionList defs) =
           t <- wrap "strong" term
           return (el "p" t : items)
 blockToXml h@Header{} = do
-  -- should not occur after hierarchicalize, except inside lists/blockquotes
+  -- should not occur after makeSections, except inside lists/blockquotes
   report $ BlockNotRendered h
   return []
 blockToXml HorizontalRule = return [ el "empty-line" () ]
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 38b0e1974..52825fb09 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -32,9 +32,10 @@ import Prelude
 import Control.Monad.State.Strict
 import Data.Char (ord, toLower)
 import Data.List (intercalate, intersperse, isPrefixOf, partition)
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import qualified Data.Set as Set
 import Data.String (fromString)
+import Data.List.Split (splitWhen)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -90,20 +91,20 @@ data WriterState = WriterState
     , stMath         :: Bool    -- ^ Math is used in document
     , stQuotes       :: Bool    -- ^ <q> tag is used
     , stHighlighting :: Bool    -- ^ Syntax highlighting is used
-    , stSecNum       :: [Int]   -- ^ Number of current section
-    , stElement      :: Bool    -- ^ Processing an Element
     , stHtml5        :: Bool    -- ^ Use HTML5
     , stEPUBVersion  :: Maybe EPUBVersion -- ^ EPUB version if for epub
     , stSlideVariant :: HTMLSlideVariant
+    , stSlideLevel   :: Int     -- ^ Slide level
     , stCodeBlockNum :: Int     -- ^ Number of code block
     }
 
 defaultWriterState :: WriterState
 defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
-                                  stHighlighting = False, stSecNum = [],
-                                  stElement = False, stHtml5 = False,
+                                  stHighlighting = False,
+                                  stHtml5 = False,
                                   stEPUBVersion = Nothing,
                                   stSlideVariant = NoSlides,
+                                  stSlideLevel = 1,
                                   stCodeBlockNum = 0}
 
 -- Helpers to render HTML with the appropriate function.
@@ -243,6 +244,8 @@ pandocToHtml :: PandocMonad m
              -> Pandoc
              -> StateT WriterState m (Html, Context Text)
 pandocToHtml opts (Pandoc meta blocks) = do
+  let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts
+  modify $ \st -> st{ stSlideLevel = slideLevel }
   metadata <- metaToContext opts
               (fmap renderHtml' . blockListToHtml opts)
               (fmap renderHtml' . inlineListToHtml opts)
@@ -250,17 +253,15 @@ pandocToHtml opts (Pandoc meta blocks) = do
   let stringifyHTML = escapeStringForXML . stringify
   let authsMeta = map stringifyHTML $ docAuthors meta
   let dateMeta  = stringifyHTML $ docDate meta
-  let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts
   slideVariant <- gets stSlideVariant
-  let sects = hierarchicalize $
+  let sects = makeSections (writerNumberSections opts) Nothing $
               if slideVariant == NoSlides
                  then blocks
                  else prepSlides slideLevel blocks
   toc <- if writerTableOfContents opts && slideVariant /= S5Slides
             then fmap renderHtml' <$> tableOfContents opts sects
             else return Nothing
-  blocks' <- liftM (mconcat . intersperse (nl opts)) $
-                 mapM (elementToHtml Nothing slideLevel opts) sects
+  blocks' <- blockListToHtml opts sects
   st <- get
   notes <- footnoteSection opts (reverse (stNotes st))
   let thebody = blocks' >> notes
@@ -380,130 +381,20 @@ listItemToHtml opts bls
       return $ constr (checkbox >> isContents) >> bsContents
 
 -- | Construct table of contents from list of elements.
-tableOfContents :: PandocMonad m => WriterOptions -> [Element]
+tableOfContents :: PandocMonad m => WriterOptions -> [Block]
                 -> StateT WriterState m (Maybe Html)
 tableOfContents _ [] = return Nothing
 tableOfContents opts sects = do
-  contents  <- mapM (elementToListItem opts) sects
-  let tocList = catMaybes contents
-  if null tocList
-     then return Nothing
-     else Just <$> unordList opts tocList
-
--- | Convert section number to string
-showSecNum :: [Int] -> String
-showSecNum = intercalate "." . map show
-
--- | Converts an Element to a list item for a table of contents,
--- retrieving the appropriate identifier from state.
-elementToListItem :: PandocMonad m => WriterOptions -> Element
-                  -> StateT WriterState m (Maybe Html)
--- Don't include the empty headers created in slide shows
--- shows when an hrule is used to separate slides without a new title:
-elementToListItem _ (Sec _ _ _ [Str "\0"] _) = return Nothing
-elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs)
-  | lev <= writerTOCDepth opts = do
-  let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0)
-  let sectnum = if writerNumberSections opts && not (null num) &&
-                   "unnumbered" `notElem` classes
-                   then (H.span ! A.class_ "toc-section-number"
-                        $ toHtml $ showSecNum num') >> preEscapedString " "
-                   else mempty
-  txt <- liftM (sectnum >>) $
-         inlineListToHtml opts $ walk (deLink . deNote) headerText
-  subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
-  subList <- if null subHeads
-                then return mempty
-                else unordList opts subHeads
   -- in reveal.js, we need #/apples, not #apples:
   slideVariant <- gets stSlideVariant
-  let revealSlash = ['/' | slideVariant== RevealJsSlides]
-  return $ Just
-         $ if null id'
-              then  H.a (toHtml txt) >> subList
-              else (H.a ! A.href (toValue $ "#" ++ revealSlash ++
-                    writerIdentifierPrefix opts ++ id')
-                       $ toHtml txt) >> subList
-elementToListItem _ _ = return Nothing
-
-deLink :: Inline -> Inline
-deLink (Link _ ils _) = Span nullAttr ils
-deLink x              = x
-
--- | Convert an Element to Html.
-elementToHtml :: PandocMonad m => Maybe Int -> Int -> WriterOptions -> Element
-              -> StateT WriterState m Html
-elementToHtml _ _ opts (Blk block) = blockToHtml opts block
-elementToHtml mbparentlevel slideLevel opts
-      (Sec level num (id',classes,keyvals) title' elements)
-  = do
-  slideVariant <- gets stSlideVariant
-  let slide = slideVariant /= NoSlides &&
-               (level <= slideLevel ||
-                -- we're missing a header at slide level (see #5168)
-                maybe False (< slideLevel) mbparentlevel)
-  let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0)
-  modify $ \st -> st{stSecNum = num'}  -- update section number
-  html5 <- gets stHtml5
-  let titleSlide = slide && level < slideLevel
-  header' <- if title' == [Str "\0"]  -- marker for hrule
-                then return mempty
-                else do
-                  modify (\st -> st{ stElement = True})
-                  let level' = if level <= slideLevel &&
-                                  slideVariant == SlidySlides
-                                  then 1 -- see #3566
-                                  else level
-                  res <- blockToHtml opts
-                           (Header level' (id',classes,keyvals) title')
-                  modify (\st -> st{ stElement = False})
-                  return res
-
-  let isSec Sec{} = True
-      isSec (Blk _) = False
-  let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
-      isPause _       = False
-  let fragmentClass = case slideVariant of
-                           RevealJsSlides -> "fragment"
-                           _              -> "incremental"
-  let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\""
-                       ++ fragmentClass ++ "\">")) :
-                   (xs ++ [Blk (RawBlock (Format "html") "</div>")])
-  let (titleBlocks, innerSecs) =
-                     if titleSlide
-                        -- title slides have no content of their own
-                        then ([x | Blk x <- elements],
-                              filter isSec elements)
-                        else case splitBy isPause elements of
-                                  []     -> ([],[])
-                                  (x:xs) -> ([],x ++ concatMap inDiv xs)
-  titleContents <- blockListToHtml opts titleBlocks
-  innerContents <- mapM (elementToHtml (Just level) slideLevel opts) innerSecs
-  let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts]
-  let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++
-                  ["section" | (slide || writerSectionDivs opts) &&
-                               not html5 ] ++
-                  ["level" ++ show level | slide || writerSectionDivs opts ]
-                  ++ classes
-  let secttag  = if html5
-                    then H5.section
-                    else H.div
-  let attr = (id',classes',keyvals)
-  if titleSlide
-     then do
-       t <- addAttrs opts attr $ secttag $ header' <> titleContents
-       return $
-         (if slideVariant == RevealJsSlides && not (null innerContents)
-             -- revealjs doesn't like more than one level of section nesting:
-             && isNothing mbparentlevel
-                then H5.section
-                else id) $ mconcat $ t : innerContents
-     else if writerSectionDivs opts || slide
-          then addAttrs opts attr
-               $ secttag $ inNl $ header' : innerContents
-          else do
-            t <- addAttrs opts attr header'
-            return $ mconcat $ intersperse (nl opts) (t : innerContents)
+  let opts' = case slideVariant of
+                RevealJsSlides ->
+                  opts{ writerIdentifierPrefix =
+                          '/' : writerIdentifierPrefix opts }
+                _ -> opts
+  case toTableOfContents opts sects of
+    bl@(BulletList (_:_)) -> Just <$> blockToHtml opts' bl
+    _ -> return Nothing
 
 -- | Convert list of Note blocks to a footnote <div>.
 -- Assumes notes are sorted.
@@ -686,6 +577,16 @@ figure opts attr txt (s,tit) = do
               else H.div ! A.class_ "figure" $ mconcat
                     [nl opts, img, nl opts, capt, nl opts]
 
+showSecNum :: [Int] -> String
+showSecNum = intercalate "." . map show
+
+getNumber :: WriterOptions -> Attr -> String
+getNumber opts (_,_,kvs) =
+  showSecNum $ zipWith (+) num (writerNumberOffset opts ++ repeat 0)
+  where
+   num = maybe [] (map (fromMaybe 0 . safeRead) . splitWhen (=='.')) $
+          lookup "number" kvs
+
 -- | Convert Pandoc block element to HTML.
 blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html
 blockToHtml _ Null = return mempty
@@ -713,6 +614,73 @@ blockToHtml opts (LineBlock lns) =
   else do
     htmlLines <- inlineListToHtml opts $ intercalate [LineBreak] lns
     return $ H.div ! A.class_ "line-block" $ htmlLines
+blockToHtml opts (Div (ident, "section":dclasses, dkvs)
+                   (Header level hattr ils : xs)) = do
+  slideVariant <- gets stSlideVariant
+  slideLevel <- gets stSlideLevel
+  let slide = slideVariant /= NoSlides &&
+               level <= slideLevel {- DROPPED old fix for #5168 here -}
+  html5 <- gets stHtml5
+  let titleSlide = slide && level < slideLevel
+  let level' = if level <= slideLevel && slideVariant == SlidySlides
+                  then 1 -- see #3566
+                  else level
+  header' <- if ils == [Str "\0"]  -- marker for hrule
+                then return mempty
+                else blockToHtml opts (Header level' hattr ils)
+  let isSec (Div (_,"section":_,_) _) = True
+      isSec (Div _ zs)                = any isSec zs
+      isSec _                         = False
+  let isPause (Para [Str ".",Space,Str ".",Space,Str "."]) = True
+      isPause _ = False
+  let fragmentClass = case slideVariant of
+                           RevealJsSlides -> "fragment"
+                           _              -> "incremental"
+  let inDiv zs = (RawBlock (Format "html") ("<div class=\""
+                       ++ fragmentClass ++ "\">")) :
+                   (zs ++ [RawBlock (Format "html") "</div>"])
+  let (titleBlocks, innerSecs) =
+        if titleSlide
+           -- title slides have no content of their own
+           then break isSec xs
+           else case splitBy isPause xs of
+                     []     -> ([],[])
+                     (z:zs) -> ([],z ++ concatMap inDiv zs)
+  titleContents <- blockListToHtml opts titleBlocks
+  innerContents <- blockListToHtml opts innerSecs
+  let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++
+                  ["section" | (slide || writerSectionDivs opts) &&
+                               not html5 ] ++
+                  ["level" ++ show level | slide || writerSectionDivs opts ]
+                  ++ dclasses
+  let secttag  = if html5
+                    then H5.section
+                    else H.div
+  let attr = (ident, classes', dkvs)
+  if titleSlide
+     then do
+       t <- addAttrs opts attr $ secttag $ header' <> titleContents
+       return $
+         (if slideVariant == RevealJsSlides && not (null innerSecs)
+             -- revealjs doesn't like more than one level of section nesting:
+               {- REMOVED && isNothing mbparentlevel -}
+                then H5.section
+                else id) $ t <> if null innerSecs
+                                   then mempty
+                                   else nl opts <> innerContents
+     else if writerSectionDivs opts || slide || not (null dclasses) ||
+              not (null dkvs)
+          then addAttrs opts attr
+               $ secttag
+               $ nl opts <> header' <> nl opts <>
+                 if null innerSecs
+                    then mempty
+                    else innerContents <> nl opts
+          else do
+            t <- addAttrs opts attr header'
+            return $ t <> if null innerSecs
+                             then mempty
+                             else nl opts <> innerContents
 blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do
   html5 <- gets stHtml5
   slideVariant <- gets stSlideVariant
@@ -826,14 +794,13 @@ blockToHtml opts (BlockQuote blocks) = do
        return $ H.blockquote $ nl opts >> contents >> nl opts
 blockToHtml opts (Header level attr@(_,classes,_) lst) = do
   contents <- inlineListToHtml opts lst
-  secnum <- liftM stSecNum get
+  let secnum = getNumber opts attr
   let contents' = if writerNumberSections opts && not (null secnum)
                      && "unnumbered" `notElem` classes
-                     then (H.span ! A.class_ "header-section-number" $ toHtml
-                          $ showSecNum secnum) >> strToHtml " " >> contents
+                     then (H.span ! A.class_ "header-section-number"
+                             $ toHtml secnum) >> strToHtml " " >> contents
                      else contents
-  inElement <- gets stElement
-  (if inElement then return else addAttrs opts attr)
+  addAttrs opts attr
          $ case level of
               1 -> H.h1 contents'
               2 -> H.h2 contents'
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index ffeceb1c2..c0ed15f52 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -63,30 +63,27 @@ docToJATS opts (Pandoc meta blocks) = do
   let isBackBlock (Div ("refs",_,_) _) = True
       isBackBlock _                    = False
   let (backblocks, bodyblocks) = partition isBackBlock blocks
-  let elements = hierarchicalize bodyblocks
-  let backElements = hierarchicalize $ backblocks
-  let colwidth = if writerWrapText opts == WrapAuto
-                    then Just $ writerColumns opts
-                    else Nothing
   -- The numbering here follows LaTeX's internal numbering
   let startLvl = case writerTopLevelDivision opts of
                    TopLevelPart    -> -1
                    TopLevelChapter -> 0
                    TopLevelSection -> 1
                    TopLevelDefault -> 1
+  let fromBlocks = blocksToJATS opts . makeSections False (Just startLvl)
+  let colwidth = if writerWrapText opts == WrapAuto
+                    then Just $ writerColumns opts
+                    else Nothing
   metadata <- metaToContext opts
-                 (fmap vcat .
-                          mapM (elementToJATS opts startLvl) .
-                            hierarchicalize)
+                 fromBlocks
                  (fmap chomp . inlinesToJATS opts)
                  meta
-  main <- vcat <$> mapM (elementToJATS opts startLvl) elements
+  main <- fromBlocks bodyblocks
   notes <- reverse . map snd <$> gets jatsNotes
-  backs <- mapM (elementToJATS opts startLvl) backElements
+  backs <- fromBlocks backblocks
   let fns = if null notes
             then mempty
             else inTagsIndented "fn-group" $ vcat notes
-  let back = vcat backs $$ fns
+  let back = backs $$ fns
   let date =
         case getField "date" metadata of
           Nothing -> NullVal
@@ -116,18 +113,6 @@ docToJATS opts (Pandoc meta blocks) = do
        Nothing  -> main
        Just tpl -> renderTemplate tpl context
 
--- | Convert an Element to JATS.
-elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m (Doc Text)
-elementToJATS opts _   (Blk block) = blockToJATS opts block
-elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do
-  let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')]
-  let otherAttrs = ["sec-type", "specific-use"]
-  let attribs = idAttr ++ [(k,v) | (k,v) <- kvs, k `elem` otherAttrs]
-  contents <- mapM (elementToJATS opts (lvl + 1)) elements
-  title' <- inlinesToJATS opts title
-  return $ inTags True "sec" attribs $
-      inTagsSimple "title" title' $$ vcat contents
-
 -- | Convert a list of Pandoc blocks to JATS.
 blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text)
 blocksToJATS = wrappedBlocksToJATS (const False)
@@ -225,6 +210,14 @@ codeAttr (ident,classes,kvs) = (lang, attr)
 -- | Convert a Pandoc block element to JATS.
 blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
 blockToJATS _ Null = return empty
+blockToJATS opts (Div (id',"section":_,kvs) (Header _lvl _ ils : xs)) = do
+  let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')]
+  let otherAttrs = ["sec-type", "specific-use"]
+  let attribs = idAttr ++ [(k,v) | (k,v) <- kvs, k `elem` otherAttrs]
+  title' <- inlinesToJATS opts ils
+  contents <- blocksToJATS opts xs
+  return $ inTags True "sec" attribs $
+      inTagsSimple "title" title' $$ contents
 -- Bibliography reference:
 blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) =
   inlinesToJATS opts lst
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 3c952c2d1..2e340b411 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -168,9 +168,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do
   blocks''' <- if beamer
                   then toSlides blocks''
                   else return blocks''
-  body <- mapM (elementToLaTeX options) $ hierarchicalize blocks'''
+  main <- blockListToLaTeX $ makeSections False Nothing blocks'''
   biblioTitle <- inlineListToLaTeX lastHeader
-  let main = vsep body
   st <- get
   titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta
   authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta
@@ -298,16 +297,6 @@ pandocToLaTeX options (Pandoc meta blocks) = do
        Nothing  -> main
        Just tpl -> renderTemplate tpl context'
 
--- | Convert Elements to LaTeX
-elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m (Doc Text)
-elementToLaTeX _ (Blk block) = blockToLaTeX block
-elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do
-  modify $ \s -> s{stInHeading = True}
-  header' <- sectionHeader ("unnumbered" `elem` classes) id' level title'
-  modify $ \s -> s{stInHeading = False}
-  innerContents <- mapM (elementToLaTeX opts) elements
-  return $ vsep (header' : innerContents)
-
 data StringContext = TextString
                    | URLString
                    | CodeString
@@ -459,68 +448,16 @@ toSlides bs = do
   opts <- gets stOptions
   let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts
   let bs' = prepSlides slideLevel bs
-  concat `fmap` mapM (elementToBeamer slideLevel) (hierarchicalize bs')
+  walkM (elementToBeamer slideLevel) (makeSections False Nothing bs')
 
-elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block]
-elementToBeamer _slideLevel (Blk (Div attrs bs)) = do
-  -- make sure we support "blocks" inside divs
-  bs' <- concat `fmap` mapM (elementToBeamer 0) (hierarchicalize bs)
-  return [Div attrs bs']
-
-elementToBeamer _slideLevel (Blk b) = return [b]
-elementToBeamer slideLevel  (Sec lvl _num (ident,classes,kvs) tit elts)
-  | lvl >  slideLevel = do
-      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
-      return $ Para ( RawInline "latex" "\\begin{block}{"
-                    : tit ++ [RawInline "latex" "}"] )
-             : bs ++ [RawBlock "latex" "\\end{block}"]
-  | lvl <  slideLevel = do
-      let isSec Sec{} = True
-          isSec _     = False
-      let (contentElts, secElts) = break isSec elts
-      let elts' = if null contentElts
-                     then secElts
-                     else Sec slideLevel [] nullAttr tit contentElts :
-                          secElts
-      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts'
-      return $ Header lvl (ident,classes,kvs) tit : bs
-  | otherwise = do -- lvl == slideLevel
-      -- note: [fragile] is required or verbatim breaks
-      let hasCodeBlock (CodeBlock _ _) = [True]
-          hasCodeBlock _               = []
-      let hasCode (Code _ _) = [True]
-          hasCode _          = []
-      let fragile = "fragile" `elem` classes ||
-                    not (null $ query hasCodeBlock elts ++ query hasCode elts)
-      let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile",
-                          "b", "c", "t", "environment",
-                          "label", "plain", "shrink", "standout",
-                          "noframenumbering"]
-      let optionslist = ["fragile" | fragile
-                                   , isNothing (lookup "fragile" kvs)
-                                   , "fragile" `notElem` classes] ++
-                        [k | k <- classes, k `elem` frameoptions] ++
-                        [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions]
-      let options = if null optionslist
-                       then ""
-                       else "[" ++ intercalate "," optionslist ++ "]"
-      let latex = RawInline (Format "latex")
-      slideTitle <-
-            if tit == [Str "\0"] -- marker for hrule
-               then return []
-               else return $ latex "{" : tit ++ [latex "}"]
-      ref <- toLabel ident
-      let slideAnchor = if null ident
-                           then []
-                           else [latex ("\n\\protect\\hypertarget{" ++
-                                  ref ++ "}{}")]
-      let slideStart = Para $
-              RawInline "latex" ("\\begin{frame}" ++ options) :
-                 slideTitle ++ slideAnchor
-      let slideEnd = RawBlock "latex" "\\end{frame}"
-      -- now carve up slide into blocks if there are sections inside
-      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
-      return $ slideStart : bs ++ [slideEnd]
+-- this creates section slides and marks slides with class "slide","block"
+elementToBeamer :: PandocMonad m => Int -> Block -> LW m Block
+elementToBeamer slideLevel d@(Div (ident,dclasses,dkvs)
+                              xs@(Header lvl _ _ : _))
+  | lvl >  slideLevel = return $ Div (ident,"block":dclasses,dkvs) xs
+  | lvl <  slideLevel = return d
+  | otherwise = return $ Div (ident,"slide":dclasses,dkvs) xs
+elementToBeamer _ x = return x
 
 isListBlock :: Block -> Bool
 isListBlock (BulletList _)     = True
@@ -533,85 +470,87 @@ blockToLaTeX :: PandocMonad m
              => Block     -- ^ Block to convert
              -> LW m (Doc Text)
 blockToLaTeX Null = return empty
-blockToLaTeX (Div (identifier,classes,kvs) bs)
-  | "incremental" `elem` classes = do
-      let classes' = filter ("incremental"/=) classes
-      beamer <- gets stBeamer
-      if beamer
-        then do oldIncremental <- gets stIncremental
-                modify $ \s -> s{ stIncremental = True }
-                result <- blockToLaTeX $ Div (identifier,classes',kvs) bs
-                modify $ \s -> s{ stIncremental = oldIncremental }
-                return result
-        else blockToLaTeX $ Div (identifier,classes',kvs) bs
-  | "nonincremental" `elem` classes = do
-      let classes' = filter ("nonincremental"/=) classes
-      beamer <- gets stBeamer
-      if beamer
-        then do oldIncremental <- gets stIncremental
-                modify $ \s -> s{ stIncremental = False }
-                result <- blockToLaTeX $ Div (identifier,classes',kvs) bs
-                modify $ \s -> s{ stIncremental = oldIncremental }
-                return result
-        else blockToLaTeX $ Div (identifier,classes',kvs) bs
-  | identifier == "refs" = do
-       modify $ \st -> st{ stHasCslRefs = True
-                         , stCslHangingIndent =
-                            "hanging-indent" `elem` classes }
-       contents <- blockListToLaTeX bs
-       return $ "\\begin{cslreferences}" $$
-                contents $$
-                "\\end{cslreferences}"
-  | otherwise = do
-      beamer <- gets stBeamer
-      linkAnchor' <- hypertarget True identifier empty
-    -- see #2704 for the motivation for adding \leavevmode:
-      let linkAnchor =
-            case bs of
-              Para _ : _
-                | not (isEmpty linkAnchor')
-                  -> "\\leavevmode" <> linkAnchor' <> "%"
-              _ -> linkAnchor'
-      let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir
-      lang <- toLang $ lookup "lang" kvs
-      let wrapColumns = if beamer && "columns" `elem` classes
-                        then \contents ->
-                               inCmd "begin" "columns" <> brackets "T"
-                               $$ contents
-                               $$ inCmd "end" "columns"
-                        else id
-          wrapColumn  = if beamer && "column" `elem` classes
-                        then \contents ->
-                               let w = maybe "0.48" fromPct (lookup "width" kvs)
-                               in  inCmd "begin" "column" <>
-                                   braces (text w <> "\\textwidth")
-                                   $$ contents
-                                   $$ inCmd "end" "column"
-                        else id
-          fromPct xs =
-            case reverse xs of
-              '%':ds -> case safeRead (reverse ds) of
-                          Just digits -> showFl (digits / 100 :: Double)
-                          Nothing -> xs
-              _      -> xs
-          wrapDir = case lookup "dir" kvs of
-                      Just "rtl" -> align "RTL"
-                      Just "ltr" -> align "LTR"
-                      _          -> id
-          wrapLang txt = case lang of
-                           Just lng -> let (l, o) = toPolyglossiaEnv lng
-                                           ops = if null o
-                                                 then ""
-                                                 else brackets $ text o
-                                       in  inCmd "begin" (text l) <> ops
-                                           $$ blankline <> txt <> blankline
-                                           $$ inCmd "end" (text l)
-                           Nothing  -> txt
-          wrapNotes txt = if beamer && "notes" `elem` classes
-                          then "\\note" <> braces txt -- speaker notes
-                          else linkAnchor $$ txt
-      (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes)
-        <$> blockListToLaTeX bs
+blockToLaTeX (Div attr@(identifier,"block":_,_) (Header _ _ ils : bs)) = do
+  ref <- toLabel identifier
+  let anchor = if null identifier
+                  then empty
+                  else cr <> "\\protect\\hypertarget" <>
+                       braces (text ref) <> braces empty
+  title' <- inlineListToLaTeX ils
+  contents <- blockListToLaTeX bs
+  wrapDiv attr $ ("\\begin{block}" <> braces title' <> anchor) $$
+                 contents $$ "\\end{block}"
+blockToLaTeX (Div (identifier,"slide":dclasses,dkvs)
+               (Header _ (_,hclasses,hkvs) ils : bs)) = do
+  -- note: [fragile] is required or verbatim breaks
+  let hasCodeBlock (CodeBlock _ _) = [True]
+      hasCodeBlock _               = []
+  let hasCode (Code _ _) = [True]
+      hasCode _          = []
+  let classes = dclasses ++ hclasses
+  let kvs = dkvs ++ hkvs
+  let fragile = "fragile" `elem` classes ||
+                not (null $ query hasCodeBlock bs ++ query hasCode bs)
+  let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile",
+                      "b", "c", "t", "environment",
+                      "label", "plain", "shrink", "standout",
+                      "noframenumbering"]
+  let optionslist = ["fragile" | fragile
+                               , isNothing (lookup "fragile" kvs)
+                               , "fragile" `notElem` classes] ++
+                    [k | k <- classes, k `elem` frameoptions] ++
+                    [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions]
+  let options = if null optionslist
+                   then empty
+                   else brackets (text (intercalate "," optionslist))
+  slideTitle <- if ils == [Str "\0"] -- marker for hrule
+                   then return empty
+                   else braces <$> inlineListToLaTeX ils
+  ref <- toLabel identifier
+  let slideAnchor = if null identifier
+                       then empty
+                       else cr <> "\\protect\\hypertarget" <>
+                            braces (text ref) <> braces empty
+  contents <- blockListToLaTeX bs >>= wrapDiv (identifier,classes,kvs)
+  return $ ("\\begin{frame}" <> options <> slideTitle <> slideAnchor) $$
+           contents $$
+           "\\end{frame}"
+blockToLaTeX (Div (identifier@(_:_),dclasses,dkvs)
+               (Header lvl ("",hclasses,hkvs) ils : bs)) = do
+  -- move identifier from div to header
+  blockToLaTeX (Div ("",dclasses,dkvs)
+               (Header lvl (identifier,hclasses,hkvs) ils : bs))
+blockToLaTeX (Div (identifier,classes,kvs) bs) = do
+  beamer <- gets stBeamer
+  oldIncremental <- gets stIncremental
+  if beamer && "incremental" `elem` classes
+     then modify $ \st -> st{ stIncremental = True }
+     else if beamer && "nonincremental" `elem` classes
+             then modify $ \st -> st { stIncremental = False }
+             else return ()
+  result <- if identifier == "refs"
+               then do
+                 inner <- blockListToLaTeX bs
+                 modify $ \st -> st{ stHasCslRefs = True
+                                   , stCslHangingIndent =
+                                      "hanging-indent" `elem` classes }
+                 return $ "\\begin{cslreferences}" $$
+                          inner $$
+                          "\\end{cslreferences}"
+               else blockListToLaTeX bs
+  modify $ \st -> st{ stIncremental = oldIncremental }
+  linkAnchor' <- hypertarget True identifier empty
+  -- see #2704 for the motivation for adding \leavevmode:
+  let linkAnchor =
+        case bs of
+          Para _ : _
+            | not (isEmpty linkAnchor')
+              -> "\\leavevmode" <> linkAnchor' <> "%"
+          _ -> linkAnchor'
+      wrapNotes txt = if beamer && "notes" `elem` classes
+                         then "\\note" <> braces txt -- speaker notes
+                         else linkAnchor $$ txt
+  wrapNotes <$> wrapDiv (identifier,classes,kvs) result
 blockToLaTeX (Plain lst) =
   inlineListToLaTeX lst
 -- title beginning with fig: indicates that the image is a figure
@@ -1077,6 +1016,46 @@ sectionHeader unnumbered ident level lst = do
                                 braces txtNoNotes
                          else empty
 
+wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)
+wrapDiv (_,classes,kvs) t = do
+  beamer <- gets stBeamer
+  let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir
+  lang <- toLang $ lookup "lang" kvs
+  let wrapColumns = if beamer && "columns" `elem` classes
+                    then \contents ->
+                           inCmd "begin" "columns" <> brackets "T"
+                           $$ contents
+                           $$ inCmd "end" "columns"
+                    else id
+      wrapColumn  = if beamer && "column" `elem` classes
+                    then \contents ->
+                           let w = maybe "0.48" fromPct (lookup "width" kvs)
+                           in  inCmd "begin" "column" <>
+                               braces (text w <> "\\textwidth")
+                               $$ contents
+                               $$ inCmd "end" "column"
+                    else id
+      fromPct xs =
+        case reverse xs of
+          '%':ds -> case safeRead (reverse ds) of
+                      Just digits -> showFl (digits / 100 :: Double)
+                      Nothing -> xs
+          _      -> xs
+      wrapDir = case lookup "dir" kvs of
+                  Just "rtl" -> align "RTL"
+                  Just "ltr" -> align "LTR"
+                  _          -> id
+      wrapLang txt = case lang of
+                       Just lng -> let (l, o) = toPolyglossiaEnv lng
+                                       ops = if null o
+                                             then ""
+                                             else brackets $ text o
+                                   in  inCmd "begin" (text l) <> ops
+                                       $$ blankline <> txt <> blankline
+                                       $$ inCmd "end" (text l)
+                       Nothing  -> txt
+  return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t
+
 hypertarget :: PandocMonad m => Bool -> String -> Doc Text -> LW m (Doc Text)
 hypertarget _ "" x    = return x
 hypertarget addnewline ident x = do
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index 7bbb026bb..83f64ec5e 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -13,14 +13,12 @@ Conversion of 'Pandoc' documents to OPML XML.
 -}
 module Text.Pandoc.Writers.OPML ( writeOPML) where
 import Prelude
-import Control.Monad.Except (throwError)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad)
 import Data.Time
 import Text.Pandoc.Definition
-import Text.Pandoc.Error
 import Text.Pandoc.Options
 import Text.DocLayout
 import Text.Pandoc.Shared
@@ -33,8 +31,7 @@ import Text.Pandoc.XML
 -- | Convert Pandoc document to string in OPML format.
 writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
 writeOPML opts (Pandoc meta blocks) = do
-  let elements = hierarchicalize blocks
-      colwidth = if writerWrapText opts == WrapAuto
+  let colwidth = if writerWrapText opts == WrapAuto
                     then Just $ writerColumns opts
                     else Nothing
       meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
@@ -42,7 +39,8 @@ writeOPML opts (Pandoc meta blocks) = do
               (writeMarkdown def . Pandoc nullMeta)
               (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils]))
               meta'
-  main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements
+  let blocks' = makeSections False (Just 1) blocks
+  main <- (render colwidth . vcat) <$> mapM (blockToOPML opts) blocks'
   let context = defField "body" main metadata
   return $
     (if writerPreferAscii opts then toEntities else id) $
@@ -63,25 +61,18 @@ convertDate :: [Inline] -> String
 convertDate ils = maybe "" showDateTimeRFC822 $
   parseTimeM True defaultTimeLocale "%F" =<< normalizeDate (stringify ils)
 
--- | Convert an Element to OPML.
-elementToOPML :: PandocMonad m => WriterOptions -> Element -> m (Doc Text)
-elementToOPML _ (Blk _) = return empty
-elementToOPML opts (Sec _ _num _ title elements) = do
-  let isBlk :: Element -> Bool
-      isBlk (Blk _) = True
-      isBlk _       = False
-
-      fromBlk :: PandocMonad m => Element -> m Block
-      fromBlk (Blk x) = return x
-      fromBlk _ = throwError $ PandocSomeError "fromBlk called on non-block"
-
-      (blocks, rest) = span isBlk elements
+-- | Convert a Block to OPML.
+blockToOPML :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
+blockToOPML opts (Div (_,"section":_,_) (Header _ _ title : xs)) = do
+  let isSect (Div (_,"section":_,_) (Header{}:_)) = True
+      isSect _ = False
+  let (blocks, rest) = break isSect xs
   htmlIls <- writeHtmlInlines title
   md <- if null blocks
         then return mempty
-        else do blks <- mapM fromBlk blocks
-                writeMarkdown def $ Pandoc nullMeta blks
+        else writeMarkdown def $ Pandoc nullMeta blocks
   let attrs = ("text", T.unpack htmlIls) :
               [("_note", T.unpack $ T.stripEnd md) | not (null blocks)]
-  o <- mapM (elementToOPML opts) rest
-  return $ inTags True "outline" attrs $ vcat o
+  rest' <- vcat <$> mapM (blockToOPML opts) rest
+  return $ inTags True "outline" attrs rest'
+blockToOPML _ _ = return empty
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index a0e274377..7d4a496f2 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -39,6 +39,7 @@ module Text.Pandoc.Writers.Shared (
 where
 import Prelude
 import Safe (lastMay)
+import Data.Maybe (fromMaybe)
 import Control.Monad (zipWithM)
 import Data.Aeson (ToJSON (..), encode)
 import Data.Char (chr, ord, isSpace)
@@ -49,7 +50,7 @@ import qualified Text.Pandoc.Builder as Builder
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.DocLayout
-import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote)
+import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink)
 import Text.Pandoc.Walk (walk)
 import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.XML (escapeStringForXML)
@@ -382,20 +383,28 @@ toTableOfContents :: WriterOptions
                   -> [Block]
                   -> Block
 toTableOfContents opts bs =
-  BulletList $ map (elementToListItem opts) (hierarchicalize bs)
+  BulletList $ filter (not . null)
+             $ map (sectionToListItem opts)
+             $ makeSections (writerNumberSections opts) Nothing bs
 
 -- | Converts an Element to a list item for a table of contents,
-elementToListItem :: WriterOptions -> Element -> [Block]
-elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs)
-  = Plain headerLink : [BulletList listContents | not (null subsecs)
-                                                , lev < writerTOCDepth opts]
+sectionToListItem :: WriterOptions -> Block -> [Block]
+sectionToListItem opts (Div (ident,_,_)
+                         (Header lev (_,_,kvs) ils : subsecs)) =
+  Plain headerLink : [BulletList listContents | not (null listContents)
+                                              , lev < writerTOCDepth opts]
  where
-   headerText' = walk deNote headerText
+   num = fromMaybe "" $ lookup "number" kvs
+   addNumber  = if null num
+                   then id
+                   else (Span ("",["toc-section-number"],[])
+                           [Str num] :) . (Space :)
+   headerText' = addNumber $ walk (deLink . deNote) ils
    headerLink = if null ident
                    then headerText'
                    else [Link nullAttr headerText' ('#':ident, "")]
-   listContents = map (elementToListItem opts) subsecs
-elementToListItem _ (Blk _) = []
+   listContents = filter (not . null) $ map (sectionToListItem opts) subsecs
+sectionToListItem _ _ = []
 
 endsWithPlain :: [Block] -> Bool
 endsWithPlain xs =
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index 25062d6fc..b9b5aaa85 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -32,21 +32,20 @@ import Text.Pandoc.XML
 -- | Convert Pandoc document to string in Docbook format.
 writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
 writeTEI opts (Pandoc meta blocks) = do
-  let elements = hierarchicalize blocks
-      colwidth = if writerWrapText opts == WrapAuto
+  let colwidth = if writerWrapText opts == WrapAuto
                     then Just $ writerColumns opts
                     else Nothing
-      startLvl = case writerTopLevelDivision opts of
+  let startLvl = case writerTopLevelDivision opts of
                    TopLevelPart    -> -1
                    TopLevelChapter -> 0
                    TopLevelSection -> 1
                    TopLevelDefault -> 1
+  let fromBlocks = blocksToTEI opts . makeSections False (Just startLvl)
   metadata <- metaToContext opts
-                 (fmap vcat .
-                   mapM (elementToTEI opts startLvl) . hierarchicalize)
+                 fromBlocks
                  (fmap chomp . inlinesToTEI opts)
                  meta
-  main    <- vcat <$> mapM (elementToTEI opts startLvl) elements
+  main    <- fromBlocks blocks
   let context = defField "body" main
               $ defField "mathml" (case writerHTMLMathMethod opts of
                                           MathML -> True
@@ -56,25 +55,6 @@ writeTEI opts (Pandoc meta blocks) = do
        Nothing  -> main
        Just tpl -> renderTemplate tpl context
 
--- | Convert an Element to TEI.
-elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m (Doc Text)
-elementToTEI opts _   (Blk block) = blockToTEI opts block
-elementToTEI opts lvl (Sec _ _num attr title elements) = do
-  -- TEI doesn't allow sections with no content, so insert some if needed
-  let elements' = if null elements
-                    then [Blk (Para [])]
-                    else elements
-      -- level numbering correspond to LaTeX internals
-      divType = case lvl of
-                 n | n == -1          -> "part"
-                   | n == 0           -> "chapter"
-                   | n >= 1 && n <= 5 -> "level" ++ show n
-                   | otherwise        -> "section"
-  contents <- vcat <$> mapM (elementToTEI opts (lvl + 1)) elements'
-  titleContents <- inlinesToTEI opts title
-  return $ inTags True "div" (("type", divType) : idFromAttr opts attr) $
-      inTagsSimple "head" titleContents $$ contents
-
 -- | Convert a list of Pandoc blocks to TEI.
 blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
 blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs
@@ -121,6 +101,22 @@ imageToTEI opts attr src = return $ selfClosingTag "graphic" $
 -- | Convert a Pandoc block element to TEI.
 blockToTEI :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
 blockToTEI _ Null = return empty
+blockToTEI opts (Div attr@(_,"section":_,_) (Header lvl _ ils : xs)) =
+  do
+  -- TEI doesn't allow sections with no content, so insert some if needed
+  let xs' = if null xs
+               then [Para []]
+               else xs
+      -- level numbering correspond to LaTeX internals
+      divType = case lvl of
+                 n | n == -1          -> "part"
+                   | n == 0           -> "chapter"
+                   | n >= 1 && n <= 5 -> "level" ++ show n
+                   | otherwise        -> "section"
+  titleContents <- inlinesToTEI opts ils
+  contents <- blocksToTEI opts xs'
+  return $ inTags True "div" (("type", divType) : idFromAttr opts attr) $
+      inTagsSimple "head" titleContents $$ contents
 -- Add ids to paragraphs in divs with ids - this is needed for
 -- pandoc-citeproc to get link anchors in bibliographies:
 blockToTEI opts (Div attr [Para lst]) = do
@@ -128,7 +124,7 @@ blockToTEI opts (Div attr [Para lst]) = do
   inTags False "p" attribs <$> inlinesToTEI opts lst
 blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs
 blockToTEI _ h@Header{} = do
-  -- should not occur after hierarchicalize, except inside lists/blockquotes
+  -- should not occur after makeSections, except inside lists/blockquotes
   report $ BlockNotRendered h
   return empty
 -- For TEI simple, text must be within containing block element, so