aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/EPUB.hs68
-rw-r--r--tests/features.native38
2 files changed, 64 insertions, 42 deletions
diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs
index ca65a8f0f..968b815c0 100644
--- a/src/Text/Pandoc/Readers/EPUB.hs
+++ b/src/Text/Pandoc/Readers/EPUB.hs
@@ -22,7 +22,9 @@ import qualified Text.Pandoc.Builder as B
import Codec.Archive.Zip ( Archive (..), toArchive, fromEntry
, findEntryByPath, Entry)
import qualified Data.ByteString.Lazy as BL (ByteString)
-import System.FilePath (takeFileName, (</>), dropFileName, normalise)
+import System.FilePath ( takeFileName, (</>), dropFileName, normalise
+ , joinPath, dropFileName, splitDirectories
+ , splitFileName )
import qualified Text.Pandoc.UTF8 as UTF8 (toStringLazy)
import Control.Applicative ((<$>))
import Control.Monad (guard, liftM, when)
@@ -48,13 +50,12 @@ runEPUB = either error id . runExcept
-- Note that internal reference are aggresively normalised so that all ids
-- are of the form "filename#id"
--
--- For now all paths are stripped from images
archiveToEPUB :: (MonadError String m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)
archiveToEPUB os archive = do
(root, content) <- getManifest archive
meta <- parseMeta content
(cover, items) <- parseManifest content
- let coverDoc = fromMaybe mempty (imageToPandoc . takeFileName <$> cover)
+ let coverDoc = fromMaybe mempty (imageToPandoc <$> cover)
spine <- parseSpine items content
let escapedSpine = map (escapeURI . takeFileName . fst) spine
Pandoc _ bs <-
@@ -68,16 +69,19 @@ archiveToEPUB os archive = do
os' = os {readerExtensions = foldr S.insert rs [Ext_epub_html_exts, Ext_raw_html]}
os'' = os' {readerParseRaw = True}
parseSpineElem :: MonadError String m => FilePath -> (FilePath, MIME) -> m Pandoc
- parseSpineElem r (path, mime) = do
+ parseSpineElem (normalise -> r) (normalise -> path, mime) = do
when (readerTrace os) (traceM path)
- doc <- mimeToReader mime (normalise (r </> path))
+ doc <- mimeToReader mime r path
let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty
- return $ docSpan <> fixInternalReferences (takeFileName path) doc
- mimeToReader :: MonadError String m => MIME -> FilePath -> m Pandoc
- mimeToReader "application/xhtml+xml" path = do
- fname <- findEntryByPathE path archive
- return $ readHtml os'' . UTF8.toStringLazy $ fromEntry fname
- mimeToReader s path
+ return $ docSpan <> doc
+ mimeToReader :: MonadError String m => MIME -> FilePath -> FilePath -> m Pandoc
+ mimeToReader "application/xhtml+xml" r path = do
+ fname <- findEntryByPathE (r </> path) archive
+ return $ fixInternalReferences (r </> path) .
+ readHtml os'' .
+ UTF8.toStringLazy $
+ fromEntry fname
+ mimeToReader s _ path
| s `elem` imageMimes = return $ imageToPandoc path
| otherwise = return $ mempty
@@ -86,18 +90,34 @@ fetchImages :: [(FilePath, MIME)]
-> Archive
-> Pandoc
-> MediaBag
-fetchImages mimes root a (query iq -> links) =
+fetchImages mimes root arc (query iq -> links) =
foldr (uncurry3 insertMedia) mempty
(mapMaybe getEntry links)
where
- getEntry l = let mediaPos = normalise (root </> l) in
- (l , lookup mediaPos mimes, ) . fromEntry
- <$> findEntryByPath mediaPos a
+ getEntry (normalise -> l) =
+ let mediaPos = normalise (root </> l) in
+ (l , lookup mediaPos mimes, ) . fromEntry
+ <$> findEntryByPath mediaPos arc
iq :: Inline -> [FilePath]
iq (Image _ (url, _)) = [url]
iq _ = []
+-- Remove relative paths
+renameImages :: FilePath -> Inline -> Inline
+renameImages root (Image a (url, b)) = Image a (collapse (root </> url), b)
+renameImages _ x = x
+
+collapse :: FilePath -> FilePath
+collapse = joinPath . reverse . foldl go [] . splitDirectories
+ where
+ go rs "." = rs
+ go r@(p:rs) ".." = case p of
+ ".." -> ("..":r)
+ "/" -> ("..":r)
+ _ -> rs
+ go _ "/" = ["/"]
+ go rs x = x:rs
imageToPandoc :: FilePath -> Pandoc
imageToPandoc s = B.doc . B.para $ B.image s "" mempty
@@ -168,11 +188,14 @@ getManifest archive = do
-- Fixup
-fixInternalReferences :: String -> Pandoc -> Pandoc
-fixInternalReferences s =
- (walk normalisePath) . (walk $ fixBlockIRs s') . (walk $ fixInlineIRs s')
+fixInternalReferences :: FilePath -> Pandoc -> Pandoc
+fixInternalReferences pathToFile =
+ (walk $ renameImages root)
+ . (walk normalisePath)
+ . (walk $ fixBlockIRs filename)
+ . (walk $ fixInlineIRs filename)
where
- s' = escapeURI s
+ (root, escapeURI -> filename) = splitFileName pathToFile
fixInlineIRs :: String -> Inline -> Inline
fixInlineIRs s (Span as v) =
@@ -227,12 +250,12 @@ foldM' f z (x:xs) = do
z' <- f z x
z' `deepseq` foldM' f z' xs
-traceM :: Monad m => String -> m ()
-traceM = flip trace (return ())
-
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (a, b, c) = f a b c
+traceM :: Monad m => String -> m ()
+traceM = flip trace (return ())
+
-- Utility
stripNamespace :: QName -> String
@@ -270,4 +293,3 @@ findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x
mkE :: MonadError String m => String -> Maybe a -> m a
mkE s = maybe (throwError s) return
-
diff --git a/tests/features.native b/tests/features.native
index 12d0986d2..b84d6781f 100644
--- a/tests/features.native
+++ b/tests/features.native
@@ -49,19 +49,19 @@
,RawBlock (Format "html") "<section id=\"img-010\" class=\"ctest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "img-010"],Space,Str "GIF"]
,Para [Str "Tests",Space,Str "whether",Space,Str "the",Space,Str "GIF",Space,Str "image",Space,Str "format",Space,Str "is",Space,Str "supported."]
-,Para [Image [Str "gif",Space,Str "test"] ("check.gif","")]
+,Para [Image [Str "gif",Space,Str "test"] ("EPUB/img/check.gif","")]
,Para [Str "If",Space,Str "a",Space,Str "checkmark",Space,Str "precedes",Space,Str "this",Space,Str "paragaph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"img-020\" class=\"ctest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "img-020"],Space,Str "PNG"]
,Para [Str "Tests",Space,Str "whether",Space,Str "the",Space,Str "PNG",Space,Str "image",Space,Str "format",Space,Str "is",Space,Str "supported."]
-,Para [Image [Str "png",Space,Str "test"] ("check.png","")]
+,Para [Image [Str "png",Space,Str "test"] ("EPUB/img/check.png","")]
,Para [Str "If",Space,Str "a",Space,Str "checkmark",Space,Str "precedes",Space,Str "this",Space,Str "paragaph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"img-030\" class=\"ctest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "img-030"],Space,Str "JPEG"]
,Para [Str "Tests",Space,Str "whether",Space,Str "the",Space,Str "JPEG",Space,Str "image",Space,Str "format",Space,Str "is",Space,Str "supported."]
-,Para [Image [Str "jpeg",Space,Str "test"] ("check.jpg","")]
+,Para [Image [Str "jpeg",Space,Str "test"] ("EPUB/img/check.jpg","")]
,Para [Str "If",Space,Str "a",Space,Str "checkmark",Space,Str "precedes",Space,Str "this",Space,Str "paragaph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "</section>"
@@ -197,65 +197,65 @@
,RawBlock (Format "html") "<section id=\"mathml-010\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-010"],Space,Str "Rendering"]
,Para [Str "Tests",Space,Str "whether",Space,Str "MathML",Space,Str "equation",Space,Str "rendering",Space,Str "is",Space,Str "supported."]
-,Para [Math DisplayMath "\\int_{-\\mathrm{\8734}}^{\\mathrm{\8734}}e^{-x^{2}} dx=\\sqrt{\\pi}",Space,Math DisplayMath "\\underset{n=1}{\\overset{\\mathrm{\8734}}{\\sum}}\\frac{1}{n^{2}}=\\frac{\\pi^{2}}{6}",Space,Math DisplayMath "x=\\frac{-b\\pm\\sqrt{b^{2}-4ac}}{2a}"]
+,Para [Math DisplayMath "\\int_{- \\infty}^{\\infty}e^{- x^{2}}\\, dx = \\sqrt{\\pi}",Space,Math DisplayMath "\\sum\\limits_{n = 1}^{\\infty}\\frac{1}{n^{2}} = \\frac{\\pi^{2}}{6}",Space,Math DisplayMath "x = \\frac{- b \\pm \\sqrt{b^{2} - 4ac}}{2a}"]
,Para [Str "If",Space,Str "the",Space,Str "preceding",Space,Str "equations",Space,Str "are",Space,Str "not",Space,Str "presented",Space,Str "as",Space,Str "linear",Space,Str "text",Space,Str "(e.g.,",Space,Str "x=-b\177b2-4ac2a),",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-020\" class=\"otest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[OPTIONAL]"],Space,Span ("",["test-id"],[]) [Str "mathml-020"],Space,Str "CSS",Space,Str "Styling",Space,Str "of",Space,Str "the",Space,Code ("",[],[]) "math",Space,Str "element"]
,Para [Str "Tests",Space,Str "whether",Space,Str "basic",Space,Str "CSS",Space,Str "styling",Space,Str "of",Space,Str "MathML",Space,Str "is",Space,Str "supported",Space,Str "on",Space,Str "the",Space,Code ("",[],[]) "math",Space,Str "element."]
-,Para [Math InlineMath "{2x}{+y-z}"]
+,Para [Math InlineMath "{2x}{+ y - z}"]
,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "equation",Space,Str "has",Space,Str "a",Space,Str "yellow",Space,Str "background",Space,Str "and",Space,Str "a",Space,Str "dashed",Space,Str "border."]
,Para [Str "If",Space,Str "the",Space,Str "reading",Space,Str "system",Space,Str "does",Space,Str "not",Space,Str "have",Space,Str "a",Space,Str "viewport,",Space,Str "or",Space,Str "does",Space,Str "not",Space,Str "support",Space,Str "CSS",Space,Str "styles,",Space,Str "this",Space,Str "test",Space,Str "should",Space,Str "be",Space,Str "marked",Space,Code ("",[],[]) "Not Supported",Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-021\" class=\"otest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[OPTIONAL]"],Space,Span ("",["test-id"],[]) [Str "mathml-021"],Space,Str "CSS",Space,Str "Styling",Space,Str "of",Space,Str "the",Space,Code ("",[],[]) "mo",Space,Str "element"]
,Para [Str "Tests",Space,Str "whether",Space,Str "basic",Space,Str "CSS",Space,Str "styling",Space,Str "of",Space,Str "MathML",Space,Str "is",Space,Str "supported",Space,Str "on",Space,Str "the",Space,Code ("",[],[]) "mo",Space,Str "element."]
-,Para [Math InlineMath "{2x}{+y-z}"]
+,Para [Math InlineMath "{2x}{+ y - z}"]
,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "operators",Space,Str "are",Space,Str "enlarged",Space,Str "relative",Space,Str "to",Space,Str "the",Space,Str "other",Space,Str "symbols",Space,Str "and",Space,Str "numbers."]
,Para [Str "If",Space,Str "the",Space,Str "reading",Space,Str "system",Space,Str "does",Space,Str "not",Space,Str "have",Space,Str "a",Space,Str "viewport,",Space,Str "or",Space,Str "does",Space,Str "not",Space,Str "support",Space,Str "CSS",Space,Str "styles,",Space,Str "this",Space,Str "test",Space,Str "should",Space,Str "be",Space,Str "marked",Space,Code ("",[],[]) "Not Supported",Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-022\" class=\"otest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[OPTIONAL]"],Space,Span ("",["test-id"],[]) [Str "mathml-022"],Space,Str "CSS",Space,Str "Styling",Space,Str "of",Space,Str "the",Space,Code ("",[],[]) "mi",Space,Str "element"]
,Para [Str "Tests",Space,Str "whether",Space,Str "basic",Space,Str "CSS",Space,Str "styling",Space,Str "of",Space,Str "MathML",Space,Str "is",Space,Str "supported",Space,Str "on",Space,Str "the",Space,Code ("",[],[]) "mi",Space,Str "element."]
-,Para [Math InlineMath "{2x}{+y-z}"]
+,Para [Math InlineMath "{2x}{+ y - z}"]
,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "identifiers",Space,Str "are",Space,Str "bolded",Space,Str "and",Space,Str "blue."]
,Para [Str "If",Space,Str "the",Space,Str "reading",Space,Str "system",Space,Str "does",Space,Str "not",Space,Str "have",Space,Str "a",Space,Str "viewport,",Space,Str "or",Space,Str "does",Space,Str "not",Space,Str "support",Space,Str "CSS",Space,Str "styles,",Space,Str "this",Space,Str "test",Space,Str "should",Space,Str "be",Space,Str "marked",Space,Code ("",[],[]) "Not Supported",Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-023\" class=\"otest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[OPTIONAL]"],Space,Span ("",["test-id"],[]) [Str "mathml-023"],Space,Str "CSS",Space,Str "Styling",Space,Str "of",Space,Str "the",Space,Code ("",[],[]) "mn",Space,Str "element"]
,Para [Str "Tests",Space,Str "whether",Space,Str "basic",Space,Str "CSS",Space,Str "styling",Space,Str "of",Space,Str "MathML",Space,Str "is",Space,Str "supported",Space,Str "on",Space,Str "the",Space,Code ("",[],[]) "mn",Space,Str "element."]
-,Para [Math InlineMath "{2x}{+y-z}"]
+,Para [Math InlineMath "{2x}{+ y - z}"]
,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "number",Space,Str "2",Space,Str "is",Space,Str "italicized",Space,Str "and",Space,Str "blue."]
,Para [Str "If",Space,Str "the",Space,Str "reading",Space,Str "system",Space,Str "does",Space,Str "not",Space,Str "have",Space,Str "a",Space,Str "viewport,",Space,Str "or",Space,Str "does",Space,Str "not",Space,Str "support",Space,Str "CSS",Space,Str "styles,",Space,Str "this",Space,Str "test",Space,Str "should",Space,Str "be",Space,Str "marked",Space,Code ("",[],[]) "Not Supported",Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-024\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-024"],Str "Horizontal",Space,Str "stretch,",Space,Code ("",[],[]) "mover",Str ",",Space,Code ("",[],[]) "munder",Str ",",Space,Str "and",Space,Code ("",[],[]) "mspace",Space,Str "elements"]
,Para [Str "Tests",Space,Str "whether",Space,Str "horizontal",Space,Str "stretch,",Space,Code ("",[],[]) "mover",Str ",",Space,Code ("",[],[]) "munder",Str ",",Space,Code ("",[],[]) "mspace",Space,Str "elements",Space,Str "are",Space,Str "supported."]
-,Para [Math DisplayMath "c=\\overset{\\mathrm{complex\\ number}}{\\overbrace{\\underset{\\mathrm{real}}{\\underbrace{\\qquad a\\qquad}}+\\underset{\\mathrm{imaginary}}{\\underbrace{\\quad bi\\quad}}}}"]
-,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Image [Str "description",Space,Str "of",Space,Str "imaginary",Space,Str "number:",Space,Str "c",Space,Str "=",Space,Str "a",Space,Str "+bi",Space,Str "with",Space,Str "an",Space,Str "overbrace",Space,Str "reading",Space,Str "'complex",Space,Str "number'",Space,Str "and",Space,Str "underbraces",Space,Str "below",Space,Str "'a'",Space,Str "and",Space,Str "'b",Space,Str "i'",Space,Str "reading",Space,Str "'real'",Space,Str "and",Space,Str "'imaginary'",Space,Str "respectively."] ("complex_number.png",""),Str "."]
+,Para [Math DisplayMath "c = \\overset{\\text{complex\\ number}}{\\overbrace{\\underset{\\text{real}}{\\underbrace{\\qquad a\\qquad}} + \\underset{\\text{imaginary}}{\\underbrace{\\quad b{\\mathbb{i}}\\quad}}}}"]
+,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Image [Str "description",Space,Str "of",Space,Str "imaginary",Space,Str "number:",Space,Str "c",Space,Str "=",Space,Str "a",Space,Str "+bi",Space,Str "with",Space,Str "an",Space,Str "overbrace",Space,Str "reading",Space,Str "'complex",Space,Str "number'",Space,Str "and",Space,Str "underbraces",Space,Str "below",Space,Str "'a'",Space,Str "and",Space,Str "'b",Space,Str "i'",Space,Str "reading",Space,Str "'real'",Space,Str "and",Space,Str "'imaginary'",Space,Str "respectively."] ("EPUB/img/complex_number.png",""),Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-025\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-025"],Str "Testing",Space,Code ("",[],[]) "mtable",Space,Str "with",Space,Code ("",[],[]) "colspan",Space,Str "and",Space,Code ("",[],[]) "rowspan",Space,Str "attributes,",Space,Str "Hebrew",Space,Str "and",Space,Str "Script",Space,Str "fonts"]
,Para [Str "Tests",Space,Str "whether",Space,Code ("",[],[]) "mtable",Space,Str "with",Space,Code ("",[],[]) "colspan",Space,Str "and",Space,Code ("",[],[]) "mspace",Space,Str "attributes",Space,Str "(colum",Space,Str "and",Space,Str "row",Space,Str "spanning)",Space,Str "are",Space,Str "supported;",Space,Str "uses",Space,Str "Hebrew",Space,Str "and",Space,Str "Script",Space,Str "alphabets."]
-,Para [Math DisplayMath "\\begin{array}{llllllllll}\n & \\operatorname{cov}\\left(\\operatorname{\\mathcal{L}}\\right) & \\longrightarrow & \\operatorname{non}\\left(\\operatorname{\\mathcal{K}}\\right) & \\longrightarrow & \\operatorname{cof}\\left(\\operatorname{\\mathcal{K}}\\right) & \\longrightarrow & \\operatorname{cof}\\left(\\operatorname{\\mathcal{L}}\\right) & \\longrightarrow & 2^{\\aleph_{0}} \\\\\n & \\uparrow & & \\uparrow & & \\uparrow & & \\uparrow & & \\\\\n & \\operatorname{\\mathfrak{b}} & \\longrightarrow & \\operatorname{\\mathfrak{d}} & & & & & & \\\\\n & \\uparrow & & \\uparrow & & & & & & \\\\\n\\aleph_{1} & \\longrightarrow & \\operatorname{add}\\left(\\operatorname{\\mathcal{L}}\\right) & \\longrightarrow & \\operatorname{add}\\left(\\operatorname{\\mathcal{K}}\\right) & \\longrightarrow & \\operatorname{cov}\\left(\\operatorname{\\mathcal{K}}\\right) & \\longrightarrow & \\operatorname{non}\\left(\\operatorname{\\mathcal{L}}\\right) & \\\\\n\\end{array}"]
-,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Link [Str "Cicho\324's",Space,Str "Diagram"] ("Cicho%C5%84's_diagram",""),Str ":",Space,Image [Str "rendering",Space,Str "of",Space,Str "Cicho\324's",Space,Str "diagram."] ("cichons_diagram.png",""),Str "."]
+,Para [Math DisplayMath "\\begin{array}{llllllllll}\n & {\\operatorname{cov}\\left( \\mathcal{L} \\right)} & \\longrightarrow & {\\operatorname{non}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cof}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cof}\\left( \\mathcal{L} \\right)} & \\longrightarrow & 2^{\\aleph_{0}} \\\\\n & \\uparrow & & \\uparrow & & \\uparrow & & \\uparrow & & \\\\\n & {\\mathfrak{b}} & \\longrightarrow & {\\mathfrak{d}} & & & & & & \\\\\n & \\uparrow & & \\uparrow & & & & & & \\\\\n\\aleph_{1} & \\longrightarrow & {\\operatorname{add}\\left( \\mathcal{L} \\right)} & \\longrightarrow & {\\operatorname{add}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cov}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{non}\\left( \\mathcal{L} \\right)} & \\\\\n\\end{array}"]
+,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Link [Str "Cicho\324's",Space,Str "Diagram"] ("Cicho%C5%84's_diagram",""),Str ":",Space,Image [Str "rendering",Space,Str "of",Space,Str "Cicho\324's",Space,Str "diagram."] ("EPUB/img/cichons_diagram.png",""),Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-026\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-026"],Str "BiDi,",Space,Str "RTL",Space,Str "and",Space,Str "Arabic",Space,Str "alphabets"]
,Para [Str "Tests",Space,Str "whether",Space,Str "right-to-left",Space,Str "and",Space,Str "Arabic",Space,Str "alphabets",Space,Str "are",Space,Str "supported."]
-,Para [Math DisplayMath "{d{\\left(s\\right)}}={\\left\\{\\begin{array}{ll}\n{\\underset{\\operatorname{\\lbrack?\\rbrack}=1}{\\overset{S}{\\sum}}s^{\\operatorname{\\lbrack?\\rbrack}}} & {\\mathrm{\1573\1584\1575\1603\1575\1606}s>0} \\\\\n{\\int_{1}^{S}{s^{\\operatorname{\\lbrack?\\rbrack}}\\operatorname{}s}} & {\\mathrm{\1573\1584\1575\1603\1575\1606}s\\in m} \\\\\n{T\\pi} & {\\mathrm{\1594\1610\1585\1584\1604\1603}{\\left(\\mathrm{\1605\1593}\\pi\\simeq 3,141\\right)}} \\\\\n\\end{array}\\right.}"]
-,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "a",Space,Str "piecewise",Space,Str "defined",Space,Str "function",Space,Str "in",Space,Str "Maghreb-style",Space,Str "notation"] ("Maghreb1.png",""),Str "."]
+,Para [Math DisplayMath "{d\\left( s \\right)} = \\begin{cases}\n{\\sum\\limits_{{\\lbrack?\\rbrack} = 1}^{S}s^{\\lbrack?\\rbrack}} & {\\text{\1573\1584\1575\1603\1575\1606}s > 0} \\\\\n{\\int_{1}^{S}{s^{\\lbrack?\\rbrack}s}} & {\\text{\1573\1584\1575\1603\1575\1606}s \\in m} \\\\\n{T\\pi} & {\\text{\1594\1610\1585\1584\1604\1603}\\left( \\text{\1605\1593}\\pi \\simeq 3,141 \\right)} \\\\\n\\end{cases}"]
+,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "a",Space,Str "piecewise",Space,Str "defined",Space,Str "function",Space,Str "in",Space,Str "Maghreb-style",Space,Str "notation"] ("EPUB/img/Maghreb1.png",""),Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-027\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-027"],Str "Elementary",Space,Str "math:",Space,Str "long",Space,Str "division",Space,Str "notation"]
,Para [Str "Tests",Space,Str "whether",Space,Code ("",[],[]) "mlongdiv",Space,Str "elements",Space,Str "(from",Space,Str "elementary",Space,Str "math)",Space,Str "are",Space,Str "supported."]
-,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "A",Space,Str "long",Space,Str "division",Space,Str "dividing",Space,Str "1306",Space,Str "by",Space,Str "3,",Space,Str "presented",Space,Str "in",Space,Str "'lefttop'",Space,Str "(US)",Space,Str "notation"] ("ElementaryMathExample.png",""),Str "."]
+,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "A",Space,Str "long",Space,Str "division",Space,Str "dividing",Space,Str "1306",Space,Str "by",Space,Str "3,",Space,Str "presented",Space,Str "in",Space,Str "'lefttop'",Space,Str "(US)",Space,Str "notation"] ("EPUB/img/ElementaryMathExample.png",""),Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"mathml-028\" class=\"ctest\">"
,Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "mathml-028"],Str "Multiscripts,",Space,Str "Greek",Space,Str "and",Space,Str "Gothic",Space,Str "alphabets"]
,Para [Str "Tests",Space,Str "whether",Space,Code ("",[],[]) "mmultiscript",Space,Str "elements",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "Greek",Space,Str "and",Space,Str "Gothic",Space,Str "alphabets",Space,Str "are",Space,Str "supported."]
,Para [Math DisplayMath "\\underset{}{\\overset{}{}}"]
-,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "a",Space,Str "large",Space,Str "capital",Space,Str "Pi",Space,Str "with",Space,Str "Gothic",Space,Str "characters",Space,Str "as",Space,Str "multiscripts",Space,Str "which",Space,Str "in",Space,Str "turn",Space,Str "have",Space,Str "Greek",Space,Str "multiscripts"] ("multiscripts_and_greek_alphabet.png",""),Str "."]
+,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:",Space,Image [Str "a",Space,Str "large",Space,Str "capital",Space,Str "Pi",Space,Str "with",Space,Str "Gothic",Space,Str "characters",Space,Str "as",Space,Str "multiscripts",Space,Str "which",Space,Str "in",Space,Str "turn",Space,Str "have",Space,Str "Greek",Space,Str "multiscripts"] ("EPUB/img/multiscripts_and_greek_alphabet.png",""),Str "."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "</section>"
,Para [Span ("content-svg-001.xhtml",[],[]) []]
@@ -371,7 +371,7 @@
,RawBlock (Format "html") "<section id=\"svg-410\" class=\"ctest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "svg-410"],Space,Code ("",[],[]) "img"]
,Para [Str "Tests",Space,Str "whether",Space,Str "SVG",Space,Str "is",Space,Str "supported",Space,Str "in",Space,Code ("",[],[]) "img",Space,Str "elements."]
-,Para [Image [Str "a",Space,Str "grey",Space,Str "circle"] ("circle.svg","")]
+,Para [Image [Str "a",Space,Str "grey",Space,Str "circle"] ("EPUB/svg/circle.svg","")]
,Para [Str "If",Space,Str "a",Space,Str "grey",Space,Str "circle",Space,Str "is",Space,Str "rendered",Space,Str "before",Space,Str "this",Space,Str "paragraph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"svg-420\" class=\"ctest\">"
@@ -427,7 +427,7 @@
,RawBlock (Format "html") "<section id=\"fallback-010\" class=\"ctest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],Space,Span ("",["test-id"],[]) [Str "fallback-010"],Space,Str "Image",Space,Str "fallbacks"]
,Para [Str "Tests",Space,Str "whether",Space,Str "manifest",Space,Str "fallbacks",Space,Str "for",Space,Str "non-core",Space,Str "image",Space,Str "media",Space,Str "types",Space,Str "are",Space,Str "supported."]
-,Para [Image [Str "test"] ("nonimage.xyz","")]
+,Para [Image [Str "test"] ("EPUB/img/nonimage.xyz","")]
,Para [Str "If",Space,Str "an",Space,Str "image",Space,Str "of",Space,Str "a",Space,Str "checkmark",Space,Str "is",Space,Str "rendered",Space,Str "before",Space,Str "this",Space,Str "paragraph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,RawBlock (Format "html") "</section>"
,RawBlock (Format "html") "<section id=\"fallback-020\" class=\"ctest\">"
@@ -469,7 +469,7 @@
,RawBlock (Format "html") "<section id=\"switch-020\" class=\"otest\">"
,Header 4 ("",[],[]) [Span ("",["nature"],[]) [Str "[OPTIONAL]"],Space,Span ("",["test-id"],[]) [Str "switch-020"],Space,Str "MathML",Space,Str "Embedding"]
,Para [Str "Tests",Space,Str "whether",Space,Str "the",Space,Str "MathML",Space,Str "namespace",Space,Str "is",Space,Str "recognized",Space,Str "when",Space,Str "used",Space,Str "in",Space,Str "an",Space,Code ("",[],[]) "epub:case",Space,Str "element."]
-,Para [Math InlineMath "{2x}{+y-z}"]
+,Para [Math InlineMath "{2x}{+ y - z}"]
,Para [Str "If",Space,Str "a",Space,Str "MathML",Space,Str "equation",Space,Str "is",Space,Str "rendered",Space,Str "before",Space,Str "this",Space,Str "paragraph,",Space,Str "the",Space,Str "test",Space,Str "passes."]
,Para [Str "If",Space,Str "test",Space,Code ("",[],[]) "switch-010",Space,Str "did",Space,Str "not",Space,Str "pass,",Space,Str "this",Space,Str "test",Space,Str "should",Space,Str "be",Space,Str "marked",Space,Code ("",[],[]) "Not Supported",Str "."]
,RawBlock (Format "html") "</section>"