diff --git a/AUTHORS.md b/AUTHORS.md
--- a/AUTHORS.md
+++ b/AUTHORS.md
@@ -25,6 +25,7 @@
- Amy de Buitléir
- Anabra
- Anders Waldenborg
+- Andonome
- Andreas Deininger
- Andreas Lööw
- Andreas Scherer
@@ -87,6 +88,7 @@
- Christoffer Sawicki
- Christophe Dervieux
- Christopher Kenny
+- Clar Fon
- Clare Macrae
- Clint Adams
- Conal Elliott
@@ -151,6 +153,7 @@
- Fyodor Sheremetyev
- Gabor Pali
- Gabriel Lewertowski
+- Gaurav Vijay Jadhav
- Gavin Beatty
- George Stagg
- Georgi Lyubenov
@@ -366,6 +369,7 @@
- Recai Oktaş
- Repetitive
- Reuben Thomas
+- Robert Szarka
- Robertas
- Rowan Rodrik van der Molen
- Roland Hieber
@@ -378,6 +382,7 @@
- Salim B
- Sam S. Almahri
- Sam May
+- Samuel Huang
- Samuel Tardieu
- Saumel Lemmenmeier
- Santiago Zarate
@@ -467,6 +472,7 @@
- Yoan Blanc
- You Jiangbin
- Yuchen Pei
+- Yusuf Efe
- Zihang Chen
- 3w36zj6
- arcnmx
@@ -549,4 +555,5 @@
- willj-dev
- wuffi
- wzy
+- zenor0
- λx.x
diff --git a/MANUAL.txt b/MANUAL.txt
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -1,7 +1,7 @@
---
title: Pandoc User's Guide
author: John MacFarlane
-date: 2026-08-28
+date: 2026-09-26
---
# Synopsis
@@ -2937,17 +2937,24 @@
to e.g. `20px`, but it also accepts `pt`
(12pt = 16px in most browsers).
-`fontcolor`
+`fontcolor`, `fontcolordark`
: sets the CSS `color` property on the `html` element.
-`linkcolor`
+`linkcolor`, `linkcolordark`
: sets the CSS `color` property on all links.
+`quotebordercolor`, `quotebordercolordark`
+: sets the CSS `border-color` property for the left-border of
+: `blockquote` elements.
+
+`quotecolor`, `quotecolordark`
+: sets the CSS `color` property for `blockquote` elements.
+
`monofont`
-: sets the CSS `font-family` property on `code` elements.
+: sets the CSS `font-family` property on `code` and `pre` elements.
-`monobackgroundcolor`
-: sets the CSS `background-color` property on `code` elements
+`monobackgroundcolor`, `monobackgroundcolordark`
+: sets the CSS `background-color` property on `code` and `pre` elements
and adds extra padding.
`linestretch`
@@ -2957,7 +2964,7 @@
`maxwidth`
: sets the CSS `max-width` property (default is 36em).
-`backgroundcolor`
+`backgroundcolor`, `backgroundcolordark`
: sets the CSS `background-color` property on the `html` element.
`margin-left`, `margin-right`, `margin-top`, `margin-bottom`
@@ -2984,6 +2991,41 @@
---
[CSS]: https://developer.mozilla.org/en-US/docs/Learn/CSS
+
+#### Note on `color-scheme`
+
+By default, the browser's chosen `color-scheme` (either `light` or `dark`)
+will affect the color of various unstyled elements like input fields, which are
+generally only applicable if your document is specifically targeting HTML.
+
+By default, Pandoc emits `color-scheme: light dark` to allow the system to
+choose between a default light-mode or dark-mode scheme, but it alters this
+if variables specifically override colors, under the assumption that the user
+wishes for that scheme to always be used.
+
+Currently, this is only per a basic heuristic that checks whether the following
+variables are provided:
+
+* `fontcolor`
+* `fontcolordark`
+* `backgroundcolor`
+* `backgroundcolordark`
+
+And if only one "mode" is provided (light or dark), `color-scheme` is set so
+that this chosen mode is used always, regardless of the system's preference for
+light or dark mode.
+
+Note that there are a few caveats to this, namely that:
+
+* If the browser does not support `light-dark` (older than ~2024), then it will
+ always choose light mode, regardless of this override.
+* When printing, light mode is always chosen, and color variables are ignored.
+* Syntax highlighting is currently unaffected by color scheme.
+
+In general, if you wish to override the theming for a single scheme, you should
+choose to override either the normal `*color` variables (light mode) or the
+`*colordark` variables (dark mode) to ensure that the styles do not conflict
+with other styles added by new versions of Pandoc or the browser itself.
### Variables for HTML math
diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs
--- a/benchmark/benchmark-pandoc.hs
+++ b/benchmark/benchmark-pandoc.hs
@@ -18,6 +18,7 @@
-}
import Text.Pandoc
import Text.Pandoc.MIME
+import Text.Pandoc.Shared (stringify, stringifyInlines)
import Control.DeepSeq (force)
import Control.Monad.Except (throwError)
import qualified Text.Pandoc.UTF8 as UTF8
@@ -89,6 +90,19 @@
writerFun def{ writerExtensions = wexts} d)
doc
+-- | A large inline sequence exercising both the common constructors
+-- and the ones 'stringify' special-cases ('Quoted', 'Note', 'Cite').
+bigInlines :: [Inline]
+bigInlines = concat $ replicate 1000
+ [ Str "Lorem", Space
+ , Emph [Str "ipsum", Space, Strong [Str "dolor"]], Space
+ , Quoted DoubleQuote [Str "sit", Space, Str "amet"], SoftBreak
+ , Link nullAttr [Str "consectetur"] ("https://example.com", "title")
+ , Space, Code nullAttr "adipiscing", Space
+ , Note [Para [Str "footnote", Space, Emph [Str "text"]]]
+ , Cite [] [Str "elit"], LineBreak
+ ]
+
main :: IO ()
main = do
inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
@@ -102,4 +116,9 @@
, bgroup "readers" $ mapMaybe (readerBench doc . fst)
(sortOn fst
readers :: [(T.Text, Reader PandocPure)])
+ , env (pure $ force bigInlines) $ \ils ->
+ bgroup "stringify"
+ [ bench "stringify" $ nf stringify ils
+ , bench "stringifyInlines" $ nf stringifyInlines ils
+ ]
]
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,738 @@
# Revision history for pandoc
+## pandoc 3.12 (2026-09-27)
+
+ * Markdown reader:
+
+ + Make alert keywords case-insensitive (#11836, Hendrik Erz).
+ In addition, the class `alert` is now added to the produced
+ Divs.
+ + Fix stream position handling in `base64DataURI`.
+ + Cheaply reject `bareURL` before trying uri/emailAddress.
+ + Reset sourcepos in `parseWithString'` when parsing a block
+ quote or list item. Otherwise it can happen that by the
+ time `parseWithString'` is called, the position has already
+ been set to the next file on the command line. Fixes an
+ odd bug with `rebase_relative_paths` (#11888).
+ + `rebase_relative_paths`: recognize URLs with unknown schemes
+ (#11858).
+ + Use `takeWhile1P` in the hot inline parsers `str`, `code`,
+ `enclosure`, and `mmdShortSubscript`.
+ + Reset sourcepos in `parseWithString'` when parsing a block quote
+ or list item (#11888). This ensures that `rebase_relative_paths`
+ will see the right source file.
+
+ * Typst reader:
+
+ + Map `form: "prose"` citations to AuthorInText (#11846,
+ Samuel Huang).
+ + Make the handler maps monomorphic by wrapping the handlers
+ in newtypes with polymorphic fields (BlockHandler, InlineHandler).
+ + Store document labels in a Set instead of a list.
+ + In `pInline`, only perform the label-target check for
+ `ref` elements, not for every inline element.
+ + Handle `highlight` as a mark span (#11879, Samuel Huang).
+ + Collapse citations around soft break (#11897).
+ + Handle block content in inline element bodies (#11881,
+ Samuel Huang).
+ + Handle `#par` (explicit paragraph element).
+
+ * LaTeX reader:
+
+ + Support LaTeX3 (xparse) document commands (#7540).
+ Support the features described in the LaTeX usrguide.
+ + Fix `\qed` to produce U+00A0 (nbsp) instead of BEL.
+ + Fix `unescapeURL` handling of escaped backslash.
+ + Require that `\newif` names begin with "if".
+ + Fix position off-by-one after `##` in tokenizer.
+ + Fix doubled source positions in `retokenizeComment`.
+ + Make raw token capture O(1) per token.
+ + Make `untokenize` linear instead of quadratic.
+ + Fail `macroDef` fast on non-macro-defining commands.
+ + Peek at next token directly in `peekTok` instead of going
+ through `satisfyTok`.
+ + Skip `doMacros` state update for non-macro tokens.
+ + Build command dispatch maps (`inlineCommands`, etc.) once per parse.
+ + Keep ASCII quotes when ligatures are disabled.
+ + Don't discard state changes made in optional arguments.
+ + Keep nested conditionals balanced in `\iftrue` etc.
+
+ * Docx reader:
+
+ + Read ScreenTips as link titles (#11869, Robert Szarka).
+ + Use `comment-id` instead of `id` in AST for comments.
+
+ * ODT reader:
+
+ + Rewrite in monadic style. Net -994 lines. No changes to test output.
+ + Handle `textProperties` on paragraph styles (#2623).
+ Previously these just got ignored, not applied to the
+ paragraph's text.
+
+ * HTML reader:
+
+ + Don't require a closing tag for checkbox inputs.
+ `` is a void element.
+ + Allow omitted `` in tables. The `` closing
+ tag is optional in HTML.
+ + Don't drop cells when there are too few `
` elements.
+ + Let the first of duplicate attributes win. HTML specifies that
+ the first occurrence wins.
+ + Respect `raw_html` for inline `B
^D
[ Para
@@ -8,4 +8,14 @@
, Str "B"
]
]
+```
+
+The style element's contents should not be parsed as text
+even when raw_html is disabled:
+
+```
+% pandoc -f html -t native
+
AB
+^D
+[ Para [ Str "AB" ] ]
```
diff --git a/test/command/10965.md b/test/command/10965.md
--- a/test/command/10965.md
+++ b/test/command/10965.md
@@ -7,7 +7,6 @@
#block[
#set text(lang: "en");
This text should be in English.
-
]
```
@@ -20,7 +19,6 @@
#block[
#set text(lang: "fr");
Ce texte devrait être en français.
-
]
```
@@ -33,7 +31,6 @@
#block[
#set text(lang: "de");
Dieser Text sollte auf Deutsch sein.
-
]
```
@@ -45,6 +42,5 @@
^D
#block[
This should not have lang set.
-
]
```
diff --git a/test/command/11583.md b/test/command/11583.md
--- a/test/command/11583.md
+++ b/test/command/11583.md
@@ -11,6 +11,5 @@
+ item
+ item
+ item
-
]
```
diff --git a/test/command/1166.md b/test/command/1166.md
--- a/test/command/1166.md
+++ b/test/command/1166.md
@@ -24,15 +24,15 @@
```
diff --git a/test/command/9635.md b/test/command/9635.md
--- a/test/command/9635.md
+++ b/test/command/9635.md
@@ -6,7 +6,7 @@
okay
^D
-2> [WARNING] Div at _chunk line 1 column 1 unclosed at _chunk line 5 column 1, closing implicitly.
+2> [WARNING] Div at line 1 column 1 unclosed at line 5 column 1, closing implicitly.
Footnotes
diff --git a/test/writer.typst b/test/writer.typst
--- a/test/writer.typst
+++ b/test/writer.typst
@@ -542,7 +542,6 @@
#block[
#block[
foo
-
]
]
#block[
@@ -557,7 +556,6 @@
#block[
foo
-
]
This should be a code block, though:
diff --git a/xml-light/Text/Pandoc/XML/Light.hs b/xml-light/Text/Pandoc/XML/Light.hs
--- a/xml-light/Text/Pandoc/XML/Light.hs
+++ b/xml-light/Text/Pandoc/XML/Light.hs
@@ -43,7 +43,10 @@
import qualified Control.Exception as E
import qualified Text.XML as Conduit
-import Text.XML.Unresolved (InvalidEventStream(..))
+import qualified Text.XML.Stream.Parse as P
+import Data.Conduit (runConduit, (.|))
+import qualified Data.Conduit.List as CL
+import Data.Char (isSpace)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Map as M
@@ -64,46 +67,137 @@
elementToElement . Conduit.documentRoot <$>
either (Left . T.pack . E.displayException) Right
(Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True
- , Conduit.psDecodeEntities = decodeEnts } t)
- where
- decodeEnts ref = case M.lookup ref entityMap of
- Nothing -> XML.ContentEntity ref
- Just t' -> XML.ContentText t'
+ , Conduit.psDecodeEntities =
+ entityResolver entityMap } t)
parseXMLContents :: TL.Text -> Either T.Text [Content]
parseXMLContents = parseXMLContentsWithEntities mempty
+-- | Parse a list of XML contents. Unlike 'parseXMLElementWithEntities',
+-- this does not require a single root element: multiple sibling
+-- elements and top-level text are accepted. An XML declaration,
+-- DOCTYPE, comments, and processing instructions are skipped.
parseXMLContentsWithEntities :: M.Map T.Text T.Text
-> TL.Text -> Either T.Text [Content]
parseXMLContentsWithEntities entityMap t =
- case Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True
- , Conduit.psDecodeEntities = decodeEnts
- } t of
- Left e ->
- case E.fromException e of
- Just (ContentAfterRoot _) ->
- elContent <$> parseXMLElementWithEntities entityMap
- ("" <> t <> "")
- _ -> Left . T.pack . E.displayException $ e
- Right x -> Right [Elem . elementToElement . Conduit.documentRoot $ x]
+ case runConduit (CL.sourceList (TL.toChunks t) .| parser
+ .| CL.fold step (Right ([], []))) of
+ Left err -> Left . T.pack . E.displayException $ (err :: E.SomeException)
+ Right st -> normalizeTop <$> finishContents st
where
- decodeEnts ref = case M.lookup ref entityMap of
- Nothing -> XML.ContentEntity ref
- Just t' -> XML.ContentText t'
+ parser = P.parseTextPos P.def{ P.psRetainNamespaces = True
+ , P.psDecodeEntities =
+ entityResolver entityMap }
+entityResolver :: M.Map T.Text T.Text -> T.Text -> XML.Content
+entityResolver entityMap ref =
+ case M.lookup ref entityMap of
+ Nothing -> XML.ContentEntity ref
+ Just t' -> XML.ContentText t'
+
+-- An element that is being built, with its children so far in reverse order.
+data Frame = Frame QName [Attr] [Content]
+
+-- The top-level contents built so far (reversed) and the stack of
+-- open elements (innermost first); or an error.
+type BuildState = Either T.Text ([Content], [Frame])
+
+-- Fold one parse event into the content forest being built, checking
+-- that start and end tags are balanced.
+step :: BuildState -> P.EventPos -> BuildState
+step st@(Left _) _ = st
+step (Right (cs, stack)) (pos, event) =
+ case event of
+ XML.EventBeginElement name attribs ->
+ case mapM toAttr attribs of
+ Left e -> Left e
+ Right attrs -> Right (cs, Frame (nameToQName name) attrs [] : stack)
+ XML.EventEndElement name ->
+ case stack of
+ Frame fname attrs children : stack'
+ | nameToQName name == fname ->
+ emit (Elem (Element fname attrs (mergeText (reverse children))
+ Nothing)) stack'
+ _ -> Left $ atPos $ "Unexpected close tag " <>
+ showQ (nameToQName name)
+ XML.EventContent c ->
+ case contentToText c of
+ Left e -> Left e
+ Right txt -> emit (textContent txt) stack
+ XML.EventCDATA txt -> emit (textContent txt) stack
+ _ -> Right (cs, stack)
+ -- skip begin/end document, doctype, comments, and PIs
+ where
+ -- add finished content to the enclosing element (or the top level)
+ emit c [] = Right (c : cs, [])
+ emit c (Frame name attrs children : stack') =
+ Right (cs, Frame name attrs (c : children) : stack')
+
+ textContent txt = Text (CData CDataText txt Nothing)
+
+ toAttr (name, vals) =
+ Attr (nameToQName name) . T.concat <$> mapM contentToText vals
+
+ contentToText (XML.ContentText txt) = Right txt
+ contentToText (XML.ContentEntity ref) =
+ Left $ atPos $ "Unresolved entity &" <> ref <> ";"
+
+ atPos msg = case pos of
+ Just pr -> T.pack (show pr) <> ": " <> msg
+ Nothing -> msg
+
+finishContents :: BuildState -> Either T.Text [Content]
+finishContents (Left e) = Left e
+finishContents (Right (cs, [])) = Right (mergeText (reverse cs))
+finishContents (Right (_, Frame name _ _ : _)) =
+ Left $ "Missing close tag for " <> showQ name
+
+showQ :: QName -> T.Text
+showQ (QName name _ Nothing) = name
+showQ (QName name _ (Just pre)) = pre <> ":" <> name
+
+-- Merge adjacent text nodes (the stream parser splits text at
+-- entity and CDATA boundaries).
+mergeText :: [Content] -> [Content]
+mergeText (Text cd : cs) =
+ case span isText cs of
+ ([], _) -> Text cd : mergeText cs
+ (ts, rest) -> Text cd{ cdData = T.concat (cdData cd :
+ [d | Text (CData _ d _) <- ts]) }
+ : mergeText rest
+ where
+ isText Text{} = True
+ isText _ = False
+mergeText (c : cs) = c : mergeText cs
+mergeText [] = []
+
+-- If the content is a single element surrounded only by whitespace
+-- (as in a complete XML document, where there may be newlines after
+-- an XML declaration or DOCTYPE), drop the whitespace.
+normalizeTop :: [Content] -> [Content]
+normalizeTop cs =
+ case filter (not . isWhitespaceText) cs of
+ cs'@[Elem _] -> cs'
+ _ -> cs
+ where
+ isWhitespaceText (Text cd) = T.all isSpace (cdData cd)
+ isWhitespaceText _ = False
+
+nameToQName :: Conduit.Name -> QName
+nameToQName (Conduit.Name localName mbns mbpref) =
+ case mbpref of
+ Nothing ->
+ case T.stripPrefix "xmlns:" localName of
+ Just rest -> QName rest mbns (Just "xmlns")
+ Nothing -> QName localName mbns mbpref
+ _ -> QName localName mbns mbpref
+
elementToElement :: Conduit.Element -> Element
elementToElement (Conduit.Element name attribMap nodes) =
- Element (nameToQname name) attrs (mapMaybe nodeToContent nodes) Nothing
+ Element (nameToQName name) attrs (mapMaybe nodeToContent nodes) Nothing
where
- attrs = map (\(n,v) -> Attr (nameToQname n) v) $
+ attrs = map (\(n,v) -> Attr (nameToQName n) v) $
M.toList attribMap
- nameToQname (Conduit.Name localName mbns mbpref) =
- case mbpref of
- Nothing ->
- case T.stripPrefix "xmlns:" localName of
- Just rest -> QName rest mbns (Just "xmlns")
- Nothing -> QName localName mbns mbpref
- _ -> QName localName mbns mbpref
nodeToContent :: Conduit.Node -> Maybe Content
nodeToContent (Conduit.NodeElement el) =
diff --git a/xml-light/Text/Pandoc/XML/Light/Output.hs b/xml-light/Text/Pandoc/XML/Light/Output.hs
--- a/xml-light/Text/Pandoc/XML/Light/Output.hs
+++ b/xml-light/Text/Pandoc/XML/Light/Output.hs
@@ -11,27 +11,30 @@
Portability : portable
This code is based on code from xml-light, released under the BSD3 license.
- We use a text Builder instead of ShowS.
+ We use a TextBuilder (from the text-builder package) instead of ShowS.
-}
module Text.Pandoc.XML.Light.Output
( -- * Replacement for xml-light's Text.XML.Output
ppTopElement
, ppElement
, ppContent
+ , ppcTopElement
, ppcElement
, ppcContent
, showTopElement
, showElement
, showContent
, useShortEmptyTags
+ , useInlineTags
, defaultConfigPP
+ , prettyConfigPP
, ConfigPP(..)
) where
+import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import Data.Text.Lazy.Builder (Builder, singleton, fromText, toLazyText)
+import TextBuilder (TextBuilder, char, text, toText)
import Text.Pandoc.XML.Light.Types
--
@@ -46,6 +49,7 @@
--------------------------------------------------------------------------------
data ConfigPP = ConfigPP
{ shortEmptyTag :: QName -> Bool
+ , inlineTag :: QName -> Bool
, prettify :: Bool
}
@@ -53,6 +57,7 @@
-- * Always use abbreviate empty tags.
defaultConfigPP :: ConfigPP
defaultConfigPP = ConfigPP { shortEmptyTag = const True
+ , inlineTag = const False
, prettify = False
}
@@ -63,7 +68,13 @@
useShortEmptyTags :: (QName -> Bool) -> ConfigPP -> ConfigPP
useShortEmptyTags p c = c { shortEmptyTag = p }
+-- | The predicate specifies which tags should be treated as inline:
+-- when pretty-printing, the whole content of an inline element is
+-- kept on a single line, so that no whitespace is added inside it.
+useInlineTags :: (QName -> Bool) -> ConfigPP -> ConfigPP
+useInlineTags p c = c { inlineTag = p }
+
-- | Specify if we should use extra white-space to make document more readable.
-- WARNING: This adds additional white-space to text elements,
-- and so it may change the meaning of the document.
@@ -102,47 +113,70 @@
-- | Pretty printing elements
ppcElement :: ConfigPP -> Element -> Text
-ppcElement c = TL.toStrict . toLazyText . ppElementS c mempty
+ppcElement c = toText . ppElementS c mempty
-- | Pretty printing content
ppcContent :: ConfigPP -> Content -> Text
-ppcContent c = TL.toStrict . toLazyText . ppContentS c mempty
-
-ppcCData :: ConfigPP -> CData -> Text
-ppcCData c = TL.toStrict . toLazyText . ppCDataS c mempty
+ppcContent c = toText . ppContentS c mempty
-type Indent = Builder
+type Indent = TextBuilder
-- | Pretty printing content using ShowT
-ppContentS :: ConfigPP -> Indent -> Content -> Builder
+ppContentS :: ConfigPP -> Indent -> Content -> TextBuilder
ppContentS c i x = case x of
Elem e -> ppElementS c i e
Text t -> ppCDataS c i t
CRef r -> showCRefS r
-ppElementS :: ConfigPP -> Indent -> Element -> Builder
-ppElementS c i e = i <> tagStart (elName e) (elAttribs e) <>
+ppElementS :: ConfigPP -> Indent -> Element -> TextBuilder
+ppElementS c i e = i <> ppElementS' c i e
+
+-- | Like ppElementS, but without indentation before the element
+-- itself. The indentation is still passed down, so that block-level
+-- elements nested inside an inline element are indented properly.
+ppElementS' :: ConfigPP -> Indent -> Element -> TextBuilder
+ppElementS' c i e = tagStart (elName e) (elAttribs e) <>
(case elContent e of
- [] | "?" `T.isPrefixOf` qName name -> fromText " ?>"
- | shortEmptyTag c name -> fromText " />"
- [Text t] -> singleton '>' <> ppCDataS c mempty t <> tagEnd name
- cs -> singleton '>' <> nl <>
+ [] | "?" `T.isPrefixOf` qName name -> text " ?>"
+ | shortEmptyTag c name -> text " />"
+ [Text t] -> char '>' <>
+ ppCDataS' c (if inlineTag c name then i else mempty) t <>
+ tagEnd name
+ cs | inlineTag c name ->
+ char '>' <> mconcat (map inlineContent cs) <> tagEnd name
+ | otherwise ->
+ char '>' <> nl <>
mconcat (map ((<> nl) . ppContentS c (sp <> i)) cs) <>
i <> tagEnd name
- where (nl,sp) = if prettify c then ("\n"," ") else ("","")
+ where (nl,sp) = if prettify c
+ then (text "\n", text " ")
+ else (mempty, mempty)
+ -- content of an inline element: no indentation is
+ -- emitted, so that no whitespace is added to the content
+ inlineContent (Elem el) = ppElementS' c i el
+ inlineContent (Text t) = ppCDataS' c i t
+ inlineContent (CRef r) = showCRefS r
)
where name = elName e
-ppCDataS :: ConfigPP -> Indent -> CData -> Builder
-ppCDataS c i t = i <> if cdVerbatim t /= CDataText || not (prettify c)
- then showCDataS t
- else foldr cons mempty (T.unpack (showCData t))
- where cons :: Char -> Builder -> Builder
- cons '\n' ys = singleton '\n' <> i <> ys
- cons y ys = singleton y <> ys
+ppCDataS :: ConfigPP -> Indent -> CData -> TextBuilder
+ppCDataS c i t = i <> ppCDataS' c i t
+-- | Like ppCDataS, but without indentation before the text itself.
+-- The indentation is still used after newlines in the text.
+ppCDataS' :: ConfigPP -> Indent -> CData -> TextBuilder
+ppCDataS' c i t = if cdVerbatim t /= CDataText || not (prettify c)
+ then showCDataS t
+ -- add indentation after newlines; escaping
+ -- neither adds nor removes newlines, so we
+ -- can split the unescaped text
+ else mconcat
+ (intersperse (char '\n' <> i)
+ (map escStr
+ (T.split (=='\n') (cdData t))))
+
--------------------------------------------------------------------------------
-- | Adds the header.
@@ -155,43 +189,39 @@
showElement :: Element -> Text
showElement = ppcElement defaultConfigPP
-showCData :: CData -> Text
-showCData = ppcCData defaultConfigPP
-
-- Note: crefs should not contain '&', ';', etc.
-showCRefS :: Text -> Builder
-showCRefS r = singleton '&' <> fromText r <> singleton ';'
+showCRefS :: Text -> TextBuilder
+showCRefS r = char '&' <> text r <> char ';'
-- | Convert a text element to characters.
-showCDataS :: CData -> Builder
+showCDataS :: CData -> TextBuilder
showCDataS cd =
case cdVerbatim cd of
CDataText -> escStr (cdData cd)
- CDataVerbatim -> fromText " escCData (cdData cd) <>
- fromText "]]>"
- CDataRaw -> fromText (cdData cd)
+ CDataVerbatim -> text " escCData (cdData cd) <>
+ text "]]>"
+ CDataRaw -> text (cdData cd)
--------------------------------------------------------------------------------
-escCData :: Text -> Builder
-escCData t
- | "]]>" `T.isPrefixOf` t =
- fromText "]]]]>" <> fromText (T.drop 3 t)
-escCData t
- = case T.uncons t of
- Nothing -> mempty
- Just (c,t') -> singleton c <> escCData t'
+escCData :: Text -> TextBuilder
+escCData t =
+ case T.breakOn "]]>" t of
+ (chunk, rest)
+ | T.null rest -> text chunk
+ | otherwise -> text chunk <> text "]]]]>" <>
+ escCData (T.drop 3 rest)
-escChar :: Char -> Builder
+escChar :: Char -> TextBuilder
escChar c = case c of
- '<' -> fromText "<"
- '>' -> fromText ">"
- '&' -> fromText "&"
- '"' -> fromText """
+ '<' -> text "<"
+ '>' -> text ">"
+ '&' -> text "&"
+ '"' -> text """
-- we use ' instead of ' because IE apparently has difficulties
-- rendering ' in xhtml.
-- Reported by Rohan Drape .
- '\'' -> fromText "'"
- _ -> singleton c
+ '\'' -> text "'"
+ _ -> char c
{- original xml-light version:
-- NOTE: We escape '\r' explicitly because otherwise they get lost
@@ -201,10 +231,13 @@
where oc = ord c
-}
-escStr :: Text -> Builder
-escStr cs = if T.any needsEscape cs
- then mconcat (map escChar (T.unpack cs))
- else fromText cs
+escStr :: Text -> TextBuilder
+escStr cs = case T.break needsEscape cs of
+ (chunk, rest) ->
+ case T.uncons rest of
+ Nothing -> text chunk
+ Just (c, rest') ->
+ text chunk <> escChar c <> escStr rest'
where
needsEscape '<' = True
needsEscape '>' = True
@@ -213,22 +246,22 @@
needsEscape '\'' = True
needsEscape _ = False
-tagEnd :: QName -> Builder
-tagEnd qn = fromText " showQName qn <> singleton '>'
+tagEnd :: QName -> TextBuilder
+tagEnd qn = text " showQName qn <> char '>'
-tagStart :: QName -> [Attr] -> Builder
-tagStart qn as = singleton '<' <> showQName qn <> as_str
+tagStart :: QName -> [Attr] -> TextBuilder
+tagStart qn as = char '<' <> showQName qn <> as_str
where as_str = if null as
then mempty
else mconcat (map showAttr as)
-showAttr :: Attr -> Builder
-showAttr (Attr qn v) = singleton ' ' <> showQName qn <>
- singleton '=' <>
- singleton '"' <> escStr v <> singleton '"'
+showAttr :: Attr -> TextBuilder
+showAttr (Attr qn v) = char ' ' <> showQName qn <>
+ char '=' <>
+ char '"' <> escStr v <> char '"'
-showQName :: QName -> Builder
+showQName :: QName -> TextBuilder
showQName q =
case qPrefix q of
- Nothing -> fromText (qName q)
- Just p -> fromText p <> singleton ':' <> fromText (qName q)
+ Nothing -> text (qName q)
+ Just p -> text p <> char ':' <> text (qName q)
+
++ +
+ +
+
+
+
+
+
+
+
+
+
+
+