diff options
25 files changed, 479 insertions, 635 deletions
| diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 15fa49378..87071ffc4 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -1314,40 +1314,6 @@ Object equality is determined via  :   delimiter of list numbers; one of `DefaultDelim`, `Period`,      `OneParen`, and `TwoParens` (string) -## Hierarchical Element {#type-ref-Element} - -Hierarchical elements can be either *Sec* (sections) or *Blk* -(blocks). *Blk* elements are treated like -[Block](#type-ref-Block)s. - -### Sec {#type-ref-Sec} - -Section elements used to provide hierarchical information on -document contents. - -**Objects of this type are read-only.** - -`level` -:   header level (integer) - -`numbering` -:   section numbering ([list](#module-pandoc.list) of integers) - -`attr` -:   header attributes ([Attr](#type-ref-Attr)) - -`label` -:   header content ([list](#module-pandoc.list) of -    [Inline](#type-ref-Inline)s) - -`contents` -:   list of contents in this section -    ([list](#module-pandoc.list) of [hierarchical -    element](#Element)s) - -`tag`, `t` -:   constant `Sec` (string) -  ## ReaderOptions {#type-ref-ReaderOptions}  Pandoc reader options @@ -2392,23 +2358,23 @@ Returns:  -   Whether the two objects represent the same element (boolean) -### hierarchicalize {#utils-hierarchicalize} - -`hierarchicalize (blocks)` +### make\_sections {#utils-make_sections} -Convert list of [Blocks](#Blocks) into an hierarchical list. An -hierarchical elements is either a normal block (but no Header), -or a `Sec` element. The latter has the following fields: +`make_sections (number_sections, base_level, blocks)` --   level: level in the document hierarchy; --   numbering: list of integers of length `level`, specifying -    the absolute position of the section in the document; --   attr: section attributes (see [Attr](#Attr)); --   contents: nested list of hierarchical elements. +Converst list of [Blocks](#Blocks) into sections. +`Div`s will be created beginning at each `Header` +and containing following content until the next `Header` +of comparable level.  If `number_sections` is true, +a `number` attribute will be added to each `Header` +containing the section number. If `base_level` is +non-null, `Header` levels will be reorganized so +that there are no gaps, and so that the base level +is the level specified.  Returns: --   List of hierarchical elements. +-   List of [Blocks](#Blocks).  Usage: @@ -2416,9 +2382,7 @@ Usage:        pandoc.Header(2, pandoc.Str 'first'),        pandoc.Header(2, pandoc.Str 'second'),      } -    local elements = pandoc.utils.hierarchicalize(blocks) -    print(table.concat(elements[1].numbering, '.')) -- 0.1 -    print(table.concat(elements[2].numbering, '.')) -- 0.2 +    local newblocks = pandoc.utils.make_sections(true, 1, blocks)  ### run\_json\_filter {#utils-run_json_filter} 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 diff --git a/test/command/1710.md b/test/command/1710.md index 4d9c64b30..64d86cffe 100644 --- a/test/command/1710.md +++ b/test/command/1710.md @@ -56,7 +56,6 @@ ok  ^D  \begin{frame}{Slide one}  \protect\hypertarget{slide-one}{} -  \begin{columns}[T]  \begin{column}{0.4\textwidth}  \begin{itemize} @@ -82,6 +81,5 @@ ok  ok  \end{column}  \end{columns} -  \end{frame}  ``` diff --git a/test/command/4016.md b/test/command/4016.md index 5e4e35e0d..577ac1b09 100644 --- a/test/command/4016.md +++ b/test/command/4016.md @@ -15,32 +15,28 @@ pandoc -t beamer  ^D  \begin{frame}{Level 2 blocks}  \protect\hypertarget{level-2-blocks}{} -  \begin{columns}[T]  \begin{column}{0.4\textwidth}  \begin{block}{Block one} - +\protect\hypertarget{block-one}{}  \begin{itemize}  \tightlist  \item    Item  \end{itemize} -  \end{block}  \end{column}  \begin{column}{0.6\textwidth}  \begin{block}{Block two} - +\protect\hypertarget{block-two}{}  \begin{itemize}  \tightlist  \item    Item  \end{itemize} -  \end{block}  \end{column}  \end{columns} -  \end{frame}  ``` diff --git a/test/command/4690.md b/test/command/4690.md index deccfba13..9a46823cc 100644 --- a/test/command/4690.md +++ b/test/command/4690.md @@ -13,7 +13,6 @@ content2  ^D  \begin{frame}{title}  \protect\hypertarget{title}{} -  \begin{columns}[T]  \begin{column}{0.08\textwidth}  content @@ -23,6 +22,5 @@ content  content2  \end{column}  \end{columns} -  \end{frame}  ``` diff --git a/test/command/empty_paragraphs.md b/test/command/empty_paragraphs.md index 001aaf1b0..14bd8d060 100644 --- a/test/command/empty_paragraphs.md +++ b/test/command/empty_paragraphs.md @@ -37,8 +37,6 @@  [Para [Str "hi"], Para [], Para [], Para [Str "lo"]]  ^D  <p>hi</p> - -  <p>lo</p>  ``` diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index dc37ec354..963e70686 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -39,20 +39,17 @@ return {      end)    }, -  group 'hierarchicalize' { +  group 'make_sections' {      test('sanity check', function ()        local blks = {          pandoc.Header(1, {pandoc.Str 'First'}),          pandoc.Header(2, {pandoc.Str 'Second'}),          pandoc.Header(2, {pandoc.Str 'Third'}),        } -      local hblks = utils.hierarchicalize(blks) -      -- cannot create Elements directly; performing only an approximate -      -- sanity checking instead of a full equality comparison. -      assert.are_equal('Sec', hblks[1].t) -      assert.are_equal('Sec', hblks[1].contents[1].t) -      assert.are_equal(1, hblks[1].contents[2].numbering[1]) -      assert.are_equal(2, hblks[1].contents[2].numbering[2]) +      local hblks = utils.make_sections(true, 1, blks) +      assert.are_equal('Div', hblks[1].t) +      assert.are_equal('Header', hblks[1].content[1].t) +      assert.are_equal('1', hblks[1].content[1].attributes['number'])      end)    }, diff --git a/test/writer.html4 b/test/writer.html4 index 6882d6b6c..fdfb56f15 100644 --- a/test/writer.html4 +++ b/test/writer.html4 @@ -442,7 +442,6 @@ Blah  <li>Escaped <code>$</code>: $73 <em>this should be emphasized</em> 23$.</li>  </ul>  <p>Here’s a LaTeX table:</p> -  <hr />  <h1 id="special-characters">Special Characters</h1>  <p>Here is some unicode:</p> diff --git a/test/writer.html5 b/test/writer.html5 index 9b0f19b64..35772350c 100644 --- a/test/writer.html5 +++ b/test/writer.html5 @@ -445,7 +445,6 @@ Blah  <li>Escaped <code>$</code>: $73 <em>this should be emphasized</em> 23$.</li>  </ul>  <p>Here’s a LaTeX table:</p> -  <hr />  <h1 id="special-characters">Special Characters</h1>  <p>Here is some unicode:</p> | 
