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
c1d058aeb1
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`.
This commit is contained in:
John MacFarlane
parent
1ccff3339d
commit
9f984ff26a
25 changed files with 477 additions and 633 deletions
|
|
@ -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}
|
||||
### make\_sections {#utils-make_sections}
|
||||
|
||||
`hierarchicalize (blocks)`
|
||||
`make_sections (number_sections, base_level, blocks)`
|
||||
|
||||
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:
|
||||
|
||||
- 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}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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] ++
|
||||
|
|
|
|||
|
|
@ -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'
|
||||
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 -> 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
|
||||
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" () ]
|
||||
|
|
|
|||
|
|
@ -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'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
```
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
```
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
```
|
||||
|
|
|
|||
|
|
@ -37,8 +37,6 @@
|
|||
[Para [Str "hi"], Para [], Para [], Para [Str "lo"]]
|
||||
^D
|
||||
<p>hi</p>
|
||||
|
||||
|
||||
<p>lo</p>
|
||||
```
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
},
|
||||
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue