EPUB writer: properly handle internal links to IDs in spans, divs.

Closes #1884.
This commit is contained in:
John MacFarlane 2015-01-17 11:27:49 -08:00
parent c63020d5f2
commit 25e12ca7b2

View file

@ -41,7 +41,7 @@ import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.SelfContained ( makeSelfContained ) import Text.Pandoc.SelfContained ( makeSelfContained )
import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive) import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>), (<$))
import Data.Time.Clock.POSIX ( getPOSIXTime ) import Data.Time.Clock.POSIX ( getPOSIXTime )
import Data.Time (getCurrentTime,UTCTime, formatTime) import Data.Time (getCurrentTime,UTCTime, formatTime)
import Text.Pandoc.Compat.Locale ( defaultTimeLocale ) import Text.Pandoc.Compat.Locale ( defaultTimeLocale )
@ -57,7 +57,7 @@ import Text.Pandoc.Options ( WriterOptions(..)
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Walk (walk, walkM) import Text.Pandoc.Walk (walk, walkM)
import Control.Monad.State (modify, get, execState, State, put, evalState) import Control.Monad.State (modify, get, execState, State, put, evalState)
import Control.Monad (foldM, when, mplus, liftM) import Control.Monad (foldM, mplus, liftM)
import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
, strContent, lookupAttr, Node(..), QName(..), parseXML , strContent, lookupAttr, Node(..), QName(..), parseXML
, onlyElems, node, ppElement) , onlyElems, node, ppElement)
@ -894,20 +894,27 @@ addIdentifiers bs = evalState (mapM go bs) []
-- was "header-1" might turn into "ch006.xhtml#header". -- was "header-1" might turn into "ch006.xhtml#header".
correlateRefs :: Int -> [Block] -> [(String,String)] correlateRefs :: Int -> [Block] -> [(String,String)]
correlateRefs chapterHeaderLevel bs = correlateRefs chapterHeaderLevel bs =
identTable $ execState (mapM_ go bs) identTable $ execState (walkM goBlock bs >>= walkM goInline)
IdentState{ chapterNumber = 0 IdentState{ chapterNumber = 0
, identTable = [] } , identTable = [] }
where go :: Block -> State IdentState () where goBlock :: Block -> State IdentState Block
go (Header n (ident,_,_) _) = do goBlock x@(Header n (ident,_,_) _) = x <$ addIdentifier (Just n) ident
when (n <= chapterHeaderLevel) $ goBlock x@(Div (ident,_,_) _) = x <$ addIdentifier Nothing ident
modify $ \s -> s{ chapterNumber = chapterNumber s + 1 } goBlock x = return x
goInline :: Inline -> State IdentState Inline
goInline x@(Span (ident,_,_) _) = x <$ addIdentifier Nothing ident
goInline x = return x
addIdentifier mbHeaderLevel ident = do
case mbHeaderLevel of
Just n | n <= chapterHeaderLevel ->
modify $ \s -> s{ chapterNumber = chapterNumber s + 1 }
_ -> return ()
st <- get st <- get
let chapterid = showChapter (chapterNumber st) ++ let chapterid = showChapter (chapterNumber st) ++
if n <= chapterHeaderLevel case mbHeaderLevel of
then "" Just n | n <= chapterHeaderLevel -> ""
else '#' : ident _ -> '#' : ident
modify $ \s -> s{ identTable = (ident, chapterid) : identTable st } modify $ \s -> s{ identTable = (ident, chapterid) : identTable st }
go _ = return ()
-- Replace internal link references using the table produced -- Replace internal link references using the table produced
-- by correlateRefs. -- by correlateRefs.