2581f97 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

EPUB writer: don't strip formatting in TOC.

2581f97John MacFarlane9 years ago

src/Text/Pandoc/Writers/EPUB.hs+23−10

compare with master

unifiedsplit

@@ -41,6 +41,7 @@ import Control.Monad.State.Strict (State, StateT, evalState, evalStateT, get, ge

41import qualified Data.ByteString.Lazy as B

42import qualified Data.ByteString.Lazy.Char8 as B8

43import qualified Data.Text.Lazy as TL

44+import qualified Data.Text as TS

44import Data.Char (isAlphaNum, isDigit, toLower, isAscii)

45import Data.Char (isAlphaNum, isDigit, toLower, isAscii)

45import Data.List (intercalate, isInfixOf, isPrefixOf)

46import Data.List (intercalate, isInfixOf, isPrefixOf)

46import qualified Data.Map as M

47import qualified Data.Map as M

@@ -70,7 +71,7 @@ import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB)

70import Text.Printf (printf)

71import Text.Printf (printf)

71import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..),

72import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..),

72 add_attrs, lookupAttr, node, onlyElems, parseXML,

73 add_attrs, lookupAttr, node, onlyElems, parseXML,

73− ppElement, strContent, unode, unqual)

74+ ppElement, strContent, unode, unqual, showElement)

75-- A Chapter includes a list of blocks and maybe a section

76-- A Chapter includes a list of blocks and maybe a section

76-- number offset. Note, some chapters are unnumbered. The section

77-- number offset. Note, some chapters are unnumbered. The section

@@ -635,17 +636,17 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do

635 let tocLevel = writerTOCDepth opts

636 let tocLevel = writerTOCDepth opts

636

637

637 let navPointNode :: PandocMonad m

638 let navPointNode :: PandocMonad m

638− => (Int -> String -> String -> [Element] -> Element)

639+ => (Int -> [Inline] -> String -> [Element] -> Element)

639 -> S.Element -> StateT Int m Element

640 -> S.Element -> StateT Int m Element

640 navPointNode formatter (S.Sec _ nums (ident,_,_) ils children) = do

641 navPointNode formatter (S.Sec _ nums (ident,_,_) ils children) = do

641 n <- get

642 n <- get

642 modify (+1)

643 modify (+1)

643 let showNums :: [Int] -> String

644 let showNums :: [Int] -> String

644 showNums = intercalate "." . map show

645 showNums = intercalate "." . map show

645− let tit' = stringify ils

646 let tit = if writerNumberSections opts && not (null nums)

647+ then Span ("", ["section-header-number"], [])

647− then showNums nums ++ " " ++ tit'

648+ [Str (showNums nums)] : Space : ils

648− else tit'

649+ else ils

649 src <- case lookup ident reftable of

650 src <- case lookup ident reftable of

650 Just x -> return x

651 Just x -> return x

651 Nothing -> throwError $ PandocSomeError $ ident ++ " not found in reftable"

652 Nothing -> throwError $ PandocSomeError $ ident ++ " not found in reftable"

@@ -656,10 +657,10 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do

656 return $ formatter n tit src subs

657 return $ formatter n tit src subs

657 navPointNode _ (S.Blk _) = throwError $ PandocSomeError "navPointNode encountered Blk"

658 navPointNode _ (S.Blk _) = throwError $ PandocSomeError "navPointNode encountered Blk"

658

659

659− let navMapFormatter :: Int -> String -> String -> [Element] -> Element

660+ let navMapFormatter :: Int -> [Inline] -> String -> [Element] -> Element

660 navMapFormatter n tit src subs = unode "navPoint" !

661 navMapFormatter n tit src subs = unode "navPoint" !

661 [("id", "navPoint-" ++ show n)] $

662 [("id", "navPoint-" ++ show n)] $

662− [ unode "navLabel" $ unode "text" tit

663+ [ unode "navLabel" $ unode "text" $ stringify tit

663 , unode "content" ! [("src", "text/" ++ src)] $ ()

664 , unode "content" ! [("src", "text/" ++ src)] $ ()

664 ] ++ subs

665 ] ++ subs

665

666

@@ -690,19 +691,31 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do

690 ]

691 ]

691 let tocEntry = mkEntry "toc.ncx" tocData

692 let tocEntry = mkEntry "toc.ncx" tocData

692

693

693− let navXhtmlFormatter :: Int -> String -> String -> [Element] -> Element

694+ let navXhtmlFormatter :: Int -> [Inline] -> String -> [Element] -> Element

694 navXhtmlFormatter n tit src subs = unode "li" !

695 navXhtmlFormatter n tit src subs = unode "li" !

695 [("id", "toc-li-" ++ show n)] $

696 [("id", "toc-li-" ++ show n)] $

696 (unode "a" ! [("href", "text/" ++

697 (unode "a" ! [("href", "text/" ++

697 src)]

698 src)]

698− $ tit)

699+ $ titElements)

699 : case subs of

700 : case subs of

700 [] -> []

701 [] -> []

701 (_:_) -> [unode "ol" ! [("class","toc")] $ subs]

702 (_:_) -> [unode "ol" ! [("class","toc")] $ subs]

703+ where titElements = parseXML titRendered

704+ titRendered = case P.runPure

705+ (writeHtmlStringForEPUB version

706+ opts{ writerTemplate = Nothing }

707+ (Pandoc nullMeta

708+ [Plain $ walk delink tit])) of

709+ Left _ -> TS.pack $ stringify tit

710+ Right x -> x

711+ -- can't have a element inside a...

712+ delink (Link _ ils _) = Span ("", [], []) ils

713+ delink x = x

702

714

703 let navtag = if epub3 then "nav" else "div"

715 let navtag = if epub3 then "nav" else "div"

704 tocBlocks <- lift $ evalStateT (mapM (navPointNode navXhtmlFormatter) secs) 1

716 tocBlocks <- lift $ evalStateT (mapM (navPointNode navXhtmlFormatter) secs) 1

705− let navBlocks = [RawBlock (Format "html") $ ppElement $

717+ let navBlocks = [RawBlock (Format "html")

718+ $ showElement $ -- prettyprinting introduces bad spaces

706 unode navtag ! ([("epub:type","toc") | epub3] ++

719 unode navtag ! ([("epub:type","toc") | epub3] ++

707 [("id","toc")]) $

720 [("id","toc")]) $

708 [ unode "h1" ! [("id","toc-title")] $ tocTitle

721 [ unode "h1" ! [("id","toc-title")] $ tocTitle