From 7a9832166e36f77402d5e0259647e9f5c7ba4e58 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 20 Dec 2021 13:44:03 -0800 Subject: Add text wrapping to HTML output. Previously the HTML writer was exceptional in not being sensitive to the `--wrap` option. With this change `--wrap` now works for HTML. The default (as with other formats) is automatic wrapping to 72 columns. A new internal module, T.P.Writers.Blaze, exports `layoutMarkup`. This converts a blaze Html structure into a doclayout Doc Text. In addition, we now add a line break between an `img` tag and the associated `figcaption`. Note: Output is never wrapped in `writeHtmlStringForEPUB`. This accords with previous behavior since previously the HTML writer was insensitive to `--wrap` settings. There's no real need to wrap HTML inside a zipped container. Note that the contents of script, textarea, and pre tags are always laid out with the `flush` combinator, so that unwanted spaces won't be introduced if these occur in an indented context in a template. Closes #7764. --- MANUAL.txt | 1 - pandoc.cabal | 1 + src/Text/Pandoc/Writers/Blaze.hs | 139 +++++++++++++++++++++++++++++++++++++++ src/Text/Pandoc/Writers/HTML.hs | 107 ++++++++++++++++-------------- test/command/262.md | 3 +- test/command/2649.md | 9 ++- test/command/3523.md | 8 ++- test/command/3534.md | 15 +++-- test/command/3577.md | 9 ++- test/command/3701.md | 3 +- test/command/3752.md | 18 +++-- test/command/3840.md | 3 +- test/command/4012.md | 3 +- test/command/4186.md | 3 +- test/command/4235.md | 10 ++- test/command/4639.md | 2 +- test/command/4677.md | 3 +- test/command/4743.md | 4 +- test/command/512.md | 3 +- test/command/5121.md | 3 +- test/command/5627.md | 12 ++-- test/command/5642.md | 3 +- test/command/5650.md | 6 +- test/command/5655.md | 10 ++- test/command/5813.md | 3 +- test/command/5986.md | 3 +- test/command/6739.md | 3 +- test/command/7006.md | 9 ++- test/command/7416.md | 6 +- test/command/7568.md | 7 +- test/command/7713.md | 3 +- test/command/853.md | 6 +- test/command/video-audio.md | 10 ++- test/ipynb/rank.out.html | 12 ++-- test/s5-basic.html | 3 +- test/s5-fancy.html | 7 +- test/s5-fragment.html | 3 +- test/s5-inserts.html | 3 +- test/tables.html5 | 6 +- test/writer.html4 | 85 ++++++++++++++++-------- test/writer.html5 | 100 +++++++++++++++++++--------- 41 files changed, 475 insertions(+), 172 deletions(-) create mode 100644 src/Text/Pandoc/Writers/Blaze.hs diff --git a/MANUAL.txt b/MANUAL.txt index 2e6d53ca6..008a0e657 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -790,7 +790,6 @@ header when requesting a document from a URL: preserve the wrapping from the source document (that is, where there are nonsemantic newlines in the source, there will be nonsemantic newlines in the output as well). - Automatic wrapping does not currently work in HTML output. In `ipynb` output, this option affects wrapping of the contents of markdown cells. diff --git a/pandoc.cabal b/pandoc.cabal index 3cad5bce7..dc6a92a5f 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -688,6 +688,7 @@ library Text.Pandoc.Writers.Markdown.Types, Text.Pandoc.Writers.Markdown.Inline, Text.Pandoc.Writers.Roff, + Text.Pandoc.Writers.Blaze, Text.Pandoc.Writers.Powerpoint.Presentation, Text.Pandoc.Writers.Powerpoint.Output, Text.Pandoc.Lua.ErrorConversion, diff --git a/src/Text/Pandoc/Writers/Blaze.hs b/src/Text/Pandoc/Writers/Blaze.hs new file mode 100644 index 000000000..0e3bd0f98 --- /dev/null +++ b/src/Text/Pandoc/Writers/Blaze.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Writers.Shared + Copyright : Copyright (C) 2021 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +Render blaze-html Html to DocLayout document (so it can be wrapped). +-} +module Text.Pandoc.Writers.Blaze ( layoutMarkup ) +where +import Text.Blaze +import qualified Data.ByteString as S +import Data.List (isInfixOf) +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text as T +import Data.Text (Text) +import Text.DocLayout hiding (Text, Empty) +import Text.Blaze.Internal (ChoiceString(..), getText, MarkupM(..)) + +layoutMarkup :: Markup -> Doc T.Text +layoutMarkup = go True mempty + where + go :: Bool -> Doc T.Text -> MarkupM b -> Doc T.Text + go wrap attrs (Parent _ open close content) = + let open' = getText open + in literal open' + <> attrs + <> char '>' + <> (if allowsWrap open' + then go wrap mempty content + else flush $ go False mempty content) + <> literal (getText close) + go wrap attrs (CustomParent tag content) = + char '<' + <> fromChoiceString wrap tag + <> attrs + <> char '>' + <> go wrap mempty content + <> literal " fromChoiceString wrap tag + <> char '>' + go _wrap attrs (Leaf _ begin end _) = + literal (getText begin) + <> attrs + <> literal (getText end) + go wrap attrs (CustomLeaf tag close _) = + char '<' + <> fromChoiceString wrap tag + <> attrs + <> (if close then literal " />" else char '>') + go wrap attrs (AddAttribute rawkey _ value h) = + go wrap + (space' wrap + <> literal (getText rawkey) + <> char '=' + <> doubleQuotes (fromChoiceString wrap value) + <> attrs) h + go wrap attrs (AddCustomAttribute key value h) = + go wrap + (space' wrap + <> fromChoiceString wrap key + <> char '=' + <> doubleQuotes (fromChoiceString wrap value) + <> attrs) h + go wrap _ (Content content _) = fromChoiceString wrap content + go wrap _ (Comment comment _) = + literal "" + go wrap attrs (Append h1 h2) = go wrap attrs h1 <> go wrap attrs h2 + go _ _ (Empty _) = mempty + space' wrap = if wrap then space else char ' ' + +allowsWrap :: T.Text -> Bool +allowsWrap t = + not (t == " ChoiceString -- ^ String to render + -> Doc Text -- ^ Resulting builder +fromChoiceString wrap (Static s) = withWrap wrap $ getText s +fromChoiceString wrap (String s) = withWrap wrap $ + escapeMarkupEntities $ T.pack s +fromChoiceString wrap (Text s) = withWrap wrap $ escapeMarkupEntities s +fromChoiceString wrap (ByteString s) = withWrap wrap $ decodeUtf8 s +fromChoiceString _wrap (PreEscaped x) = -- don't wrap! + case x of + String s -> literal $ T.pack s + Text s -> literal s + s -> fromChoiceString False s +fromChoiceString wrap (External x) = case x of + -- Check that the sequence " if " if " if " fromChoiceString wrap s +fromChoiceString wrap (AppendChoiceString x y) = + fromChoiceString wrap x <> fromChoiceString wrap y +fromChoiceString _ EmptyChoiceString = mempty + +withWrap :: Bool -> Text -> Doc Text +withWrap wrap + | wrap = mconcat . toChunks + | otherwise = literal + +toChunks :: Text -> [Doc Text] +toChunks = map toDoc . T.groupBy sameStatus + where + toDoc t = + if T.any (== ' ') t + then space + else if T.any (== '\n') t + then cr + else literal t + sameStatus c d = + (c == ' ' && d == ' ') || + (c == '\n' && d == '\n') || + (c /= ' ' && d /= ' ' && c /= '\n' && d /= '\n') + + +-- | Escape predefined XML entities in a text value +-- +escapeMarkupEntities :: Text -- ^ Text to escape + -> Text -- ^ Resulting Doc +escapeMarkupEntities = T.concatMap escape + where + escape :: Char -> Text + escape '<' = "<" + escape '>' = ">" + escape '&' = "&" + escape '"' = """ + escape '\'' = "'" + escape x = T.singleton x diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 247cddfc9..664aeffb6 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -39,7 +39,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Network.URI (URI (..), parseURIReference) import Numeric (showHex) -import Text.DocLayout (render, literal) +import Text.DocLayout (render, literal, Doc) import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent) import Text.DocTemplates (FromContext (lookupContext), Context (..)) import Text.Blaze.Html hiding (contents) @@ -70,6 +70,7 @@ import Text.Pandoc.Class.PandocPure (runPure) import Text.Pandoc.Error import Text.Pandoc.Logging import Text.Pandoc.MIME (mediaCategory) +import Text.Pandoc.Writers.Blaze (layoutMarkup) import Text.TeXMath import Text.XML.Light (elChildren, unode, unqual) import qualified Text.XML.Light as XML @@ -160,7 +161,8 @@ writeHtmlStringForEPUB :: PandocMonad m -> m Text writeHtmlStringForEPUB version o = writeHtmlString' defaultWriterState{ stHtml5 = version == EPUB3, - stEPUBVersion = Just version } o + stEPUBVersion = Just version } + o{ writerWrapText = WrapNone } -- | Convert Pandoc document to Reveal JS HTML slide show. writeRevealJs :: PandocMonad m @@ -207,17 +209,23 @@ writeHtmlString' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Text writeHtmlString' st opts d = do (body, context) <- evalStateT (pandocToHtml opts d) st + let colwidth = case writerWrapText opts of + WrapAuto -> Just (writerColumns opts) + _ -> Nothing (if writerPreferAscii opts then toEntities else id) <$> case writerTemplate opts of - Nothing -> return $ renderHtml' body + Nothing -> return $ + case colwidth of + Nothing -> renderHtml' body -- optimization, skip layout + Just cols -> render (Just cols) $ layoutMarkup body Just tpl -> do -- warn if empty lang when (isNothing (getField "lang" context :: Maybe Text)) $ report NoLangSpecified -- check for empty pagetitle - context' <- + (context' :: Context Text) <- case getField "pagetitle" context of Just (s :: Text) | not (T.null s) -> return context _ -> do @@ -228,9 +236,9 @@ writeHtmlString' st opts d = do Just [] -> "Untitled" Just (x:_) -> takeBaseName $ T.unpack x report $ NoTitleElement fallback - return $ resetField "pagetitle" fallback context - return $ render Nothing $ renderTemplate tpl - (defField "body" (renderHtml' body) context') + return $ resetField "pagetitle" (literal fallback) context + return $ render colwidth $ renderTemplate tpl + (defField "body" (layoutMarkup body) context') writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html writeHtml' st opts d = @@ -252,13 +260,13 @@ pandocToHtml opts (Pandoc meta blocks) = do let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts modify $ \st -> st{ stSlideLevel = slideLevel } metadata <- metaToContext opts - (fmap (literal . renderHtml') . blockListToHtml opts) - (fmap (literal . renderHtml') . inlineListToHtml opts) + (fmap layoutMarkup . blockListToHtml opts) + (fmap layoutMarkup . inlineListToHtml opts) meta let stringifyHTML = escapeStringForXML . stringify - let authsMeta = map stringifyHTML $ docAuthors meta + let authsMeta = map (literal . stringifyHTML) $ docAuthors meta let dateMeta = stringifyHTML $ docDate meta - let descriptionMeta = escapeStringForXML $ + let descriptionMeta = literal $ escapeStringForXML $ lookupMetaString "description" meta slideVariant <- gets stSlideVariant let sects = adjustNumbers opts $ @@ -267,7 +275,7 @@ pandocToHtml opts (Pandoc meta blocks) = do then blocks else prepSlides slideLevel blocks toc <- if writerTableOfContents opts && slideVariant /= S5Slides - then fmap renderHtml' <$> tableOfContents opts sects + then fmap layoutMarkup <$> tableOfContents opts sects else return Nothing blocks' <- blockListToHtml opts sects notes <- do @@ -281,7 +289,7 @@ pandocToHtml opts (Pandoc meta blocks) = do return notes st <- get let thebody = blocks' >> notes - let math = case writerHTMLMathMethod opts of + let math = layoutMarkup $ case writerHTMLMathMethod opts of MathJax url | slideVariant /= RevealJsSlides -> -- mathjax is handled via a special plugin in revealjs @@ -298,7 +306,7 @@ pandocToHtml opts (Pandoc meta blocks) = do nl opts let katexFlushLeft = case lookupContext "classoption" metadata of - Just clsops | "fleqn" `elem` (clsops :: [Text]) -> "true" + Just clsops | "fleqn" `elem` (clsops :: [Doc Text]) -> "true" _ -> "false" H.script $ text $ T.unlines [ "document.addEventListener(\"DOMContentLoaded\", function () {" @@ -324,15 +332,16 @@ pandocToHtml opts (Pandoc meta blocks) = do Just s | not (stHtml5 st) -> H.script ! A.type_ "text/javascript" $ preEscapedString - ("/* T.unpack s <> "/*]]>*/\n") | otherwise -> mempty Nothing -> mempty let mCss :: Maybe [Text] = lookupContext "css" metadata - let context = (if stHighlighting st + let context :: Context Text + context = (if stHighlighting st then case writerHighlightStyle opts of Just sty -> defField "highlighting-css" - (T.pack $ styleToCss sty) + (literal $ T.pack $ styleToCss sty) Nothing -> id else id) . (if stCsl st @@ -342,15 +351,15 @@ pandocToHtml opts (Pandoc meta blocks) = do Just 0 -> id Just n -> defField "csl-entry-spacing" - (tshow n <> "em")) + (literal $ tshow n <> "em")) else id) . (if stMath st - then defField "math" (renderHtml' math) + then defField "math" math else id) . (case writerHTMLMathMethod opts of MathJax u -> defField "mathjax" True . defField "mathjaxurl" - (T.takeWhile (/='?') u) + (literal $ T.takeWhile (/='?') u) _ -> defField "mathjax" False) . (case writerHTMLMathMethod opts of PlainMath -> defField "displaymath-css" True @@ -361,11 +370,12 @@ pandocToHtml opts (Pandoc meta blocks) = do -- template can't distinguish False/undefined defField "controls" True . defField "controlsTutorial" True . - defField "controlsLayout" ("bottom-right" :: Text) . - defField "controlsBackArrows" ("faded" :: Text) . + defField "controlsLayout" + ("bottom-right" :: Doc Text) . + defField "controlsBackArrows" ("faded" :: Doc Text) . defField "progress" True . defField "slideNumber" False . - defField "showSlideNumber" ("all" :: Text) . + defField "showSlideNumber" ("all" :: Doc Text) . defField "hashOneBasedIndex" False . defField "hash" True . defField "respondToHashChanges" True . @@ -377,7 +387,7 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "touch" True . defField "loop" False . defField "rtl" False . - defField "navigationMode" ("default" :: Text) . + defField "navigationMode" ("default" :: Doc Text) . defField "shuffle" False . defField "fragments" True . defField "fragmentInURL" True . @@ -385,22 +395,22 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "help" True . defField "pause" True . defField "showNotes" False . - defField "autoPlayMedia" ("null" :: Text) . - defField "preloadIframes" ("null" :: Text) . - defField "autoSlide" ("0" :: Text) . + defField "autoPlayMedia" ("null" :: Doc Text) . + defField "preloadIframes" ("null" :: Doc Text) . + defField "autoSlide" ("0" :: Doc Text) . defField "autoSlideStoppable" True . - defField "autoSlideMethod" ("null" :: Text) . - defField "defaultTiming" ("null" :: Text) . + defField "autoSlideMethod" ("null" :: Doc Text) . + defField "defaultTiming" ("null" :: Doc Text) . defField "mouseWheel" False . - defField "display" ("block" :: Text) . + defField "display" ("block" :: Doc Text) . defField "hideInactiveCursor" True . - defField "hideCursorTime" ("5000" :: Text) . + defField "hideCursorTime" ("5000" :: Doc Text) . defField "previewLinks" False . - defField "transition" ("slide" :: Text) . - defField "transitionSpeed" ("default" :: Text) . - defField "backgroundTransition" ("fade" :: Text) . - defField "viewDistance" ("3" :: Text) . - defField "mobileViewDistance" ("2" :: Text) + defField "transition" ("slide" :: Doc Text) . + defField "transitionSpeed" ("default" :: Doc Text) . + defField "backgroundTransition" ("fade" :: Doc Text) . + defField "viewDistance" ("3" :: Doc Text) . + defField "mobileViewDistance" ("2" :: Doc Text) else id) . defField "document-css" (isNothing mCss && slideVariant == NoSlides) . defField "quotes" (stQuotes st) . @@ -410,18 +420,18 @@ pandocToHtml opts (Pandoc meta blocks) = do maybe id (defField "toc") toc . maybe id (defField "table-of-contents") toc . defField "author-meta" authsMeta . - maybe id (defField "date-meta") + maybe id (defField "date-meta" . literal) (normalizeDate dateMeta) . defField "description-meta" descriptionMeta . defField "pagetitle" - (stringifyHTML . docTitle $ meta) . - defField "idprefix" (writerIdentifierPrefix opts) . + (literal . stringifyHTML . docTitle $ meta) . + defField "idprefix" (literal $ writerIdentifierPrefix opts) . -- these should maybe be set in pandoc.hs defField "slidy-url" - ("https://www.w3.org/Talks/Tools/Slidy2" :: Text) . - defField "slideous-url" ("slideous" :: Text) . - defField "revealjs-url" ("https://unpkg.com/reveal.js@^4/" :: Text) $ - defField "s5-url" ("s5/default" :: Text) . + ("https://www.w3.org/Talks/Tools/Slidy2" :: Doc Text) . + defField "slideous-url" ("slideous" :: Doc Text) . + defField "revealjs-url" ("https://unpkg.com/reveal.js@^4/" :: Doc Text) $ + defField "s5-url" ("s5/default" :: Doc Text) . defField "html5" (stHtml5 st) $ metadata return (thebody, context) @@ -705,12 +715,11 @@ figure opts attr@(_, _, attrList) txt (s,tit) = do img <- inlineToHtml opts (Image attr alt (s,tit)) capt <- if null txt then return mempty - else tocapt `fmap` inlineListToHtml opts txt + else (nl opts <>) . tocapt <$> inlineListToHtml opts txt + let inner = mconcat [nl opts, img, capt, nl opts] return $ if html5 - then H5.figure $ mconcat - [nl opts, img, capt, nl opts] - else H.div ! A.class_ "figure" $ mconcat - [nl opts, img, nl opts, capt, nl opts] + then H5.figure inner + else H.div ! A.class_ "figure" $ inner adjustNumbers :: WriterOptions -> [Block] -> [Block] @@ -1332,7 +1341,7 @@ inlineToHtml opts inline = do Space -> return $ strToHtml " " SoftBreak -> return $ case writerWrapText opts of WrapNone -> preEscapedText " " - WrapAuto -> preEscapedText " " + WrapAuto -> " " WrapPreserve -> preEscapedText "\n" LineBreak -> return $ do if html5 then H5.br else H.br diff --git a/test/command/262.md b/test/command/262.md index bda2acb35..61af20ede 100644 --- a/test/command/262.md +++ b/test/command/262.md @@ -5,7 +5,8 @@ .. _hello: .. _goodbye: example.com ^D -

hello and goodbye

+

hello and goodbye

``` ``` diff --git a/test/command/2649.md b/test/command/2649.md index 52ae16ce4..4ab059ea0 100644 --- a/test/command/2649.md +++ b/test/command/2649.md @@ -90,17 +90,20 @@

1

-

Sébastien Loeb

+

Sébastien +Loeb

78

2

-

Sébastien Ogier

+

Sébastien +Ogier

38

10

-

Hannu Mikkola

+

Hannu +Mikkola

18

diff --git a/test/command/3523.md b/test/command/3523.md index cb0089489..c3574943c 100644 --- a/test/command/3523.md +++ b/test/command/3523.md @@ -19,8 +19,12 @@ \end{document} ^D
-

Das Recht hat kein Dasein für sich, sein Wesen vielmehr ist das Leben des Menschen selbst, von einer besonderen Seite angesehen.

-

Das Recht hat kein Dasein für sich, sein Wesen vielmehr ist das Leben des Menschen selbst, von einer besonderen Seite angesehen.

+

Das Recht hat kein Dasein für sich, sein Wesen vielmehr +ist das Leben des Menschen selbst, von einer besonderen Seite +angesehen.

+

Das Recht hat kein Dasein für sich, sein Wesen vielmehr +ist das Leben des Menschen selbst, von einer besonderen Seite +angesehen.

  • hey

  • hey

  • diff --git a/test/command/3534.md b/test/command/3534.md index 8692007d2..42dca9207 100644 --- a/test/command/3534.md +++ b/test/command/3534.md @@ -2,7 +2,9 @@ % pandoc -f latex -t html I want to explain the interface of \lstinline[language=Java]{public class MyClass}. ^D -

    I want to explain the interface of public class MyClass.

    +

    I want to explain the interface of public class +MyClass.

    ``` @@ -10,7 +12,8 @@ I want to explain the interface of \lstinline[language=Java]{public class MyClas % pandoc -f latex -t html I want to explain the interface of \lstinline{public class MyClass}. ^D -

    I want to explain the interface of public class MyClass.

    +

    I want to explain the interface of public class +MyClass.

    ``` @@ -43,7 +46,9 @@ I want to explain the interface of \lstinline[language=Java]{public class MyClas % pandoc -f latex -t html I want to explain the interface of \mintinline{java}{public class MyClass}. ^D -

    I want to explain the interface of public class MyClass.

    +

    I want to explain the interface of public class +MyClass.

    ``` @@ -51,7 +56,9 @@ I want to explain the interface of \mintinline{java}{public class MyClass}. % pandoc -f latex -t html I want to explain the interface of \mintinline{java}|public class MyClass|. ^D -

    I want to explain the interface of public class MyClass.

    +

    I want to explain the interface of public class +MyClass.

    ``` diff --git a/test/command/3577.md b/test/command/3577.md index 2f415146d..2caeb7c11 100644 --- a/test/command/3577.md +++ b/test/command/3577.md @@ -16,10 +16,12 @@ \end{figure} ^D
    -Caption 1 +Caption 1 +
    -Caption 2 +Caption 2 +
    ``` ``` @@ -30,6 +32,7 @@ \end{figure} ^D
    -Caption 3 +Caption 3 +
    ``` diff --git a/test/command/3701.md b/test/command/3701.md index 01e438639..bd70fae59 100644 --- a/test/command/3701.md +++ b/test/command/3701.md @@ -55,6 +55,7 @@ ^D

    a

    a

    -

    a A a

    +

    a A a

    a

    ``` diff --git a/test/command/3752.md b/test/command/3752.md index 863e3f2d4..7db581cfe 100644 --- a/test/command/3752.md +++ b/test/command/3752.md @@ -32,11 +32,14 @@ A spider: [spider] ^D

    Chapter one

    A spider: spider

    -

    Another spider: another spider

    +

    Another spider: another
+spider

    The moon: moon

    Link to spider picture.

    -

    URL left alone: manual.

    -

    Absolute path left alone: absolute.

    +

    URL left alone: manual.

    +

    Absolute path left alone: absolute.

    Link to fragment: chapter two.

    Empty path: empty.

    Chapter two

    @@ -48,11 +51,14 @@ A spider: [spider] ^D

    Chapter one

    A spider: spider

    -

    Another spider: another spider

    +

    Another spider: another
+spider

    The moon: moon

    Link to spider picture.

    -

    URL left alone: manual.

    -

    Absolute path left alone: absolute.

    +

    URL left alone: manual.

    +

    Absolute path left alone: absolute.

    Link to fragment: chapter two.

    Empty path: empty.

    Chapter two

    diff --git a/test/command/3840.md b/test/command/3840.md index ceb1d1e51..a0dd314d3 100644 --- a/test/command/3840.md +++ b/test/command/3840.md @@ -2,7 +2,8 @@ % pandoc [@Alhazen1572-qk, V.9]: "competentius est" ^D -

    [@Alhazen1572-qk, V.9]: “competentius est”

    +

    [@Alhazen1572-qk, +V.9]: “competentius est”

    ``` ``` diff --git a/test/command/4012.md b/test/command/4012.md index 9e32692d6..26e971d4e 100644 --- a/test/command/4012.md +++ b/test/command/4012.md @@ -4,5 +4,6 @@ [image]: http://example.com/image.jpg {height=35mm} ^D -

    image

    +

    ``` diff --git a/test/command/4186.md b/test/command/4186.md index 90ac1271b..b2a2bd6e9 100644 --- a/test/command/4186.md +++ b/test/command/4186.md @@ -57,7 +57,8 @@ Outside all lists.
This belongs to the outer list element, and is aligned accordingly, since the NAME attribute is not indented deeply enough. It is not enough for the BEGIN alone to be aligned deeply if the block is meant to have a NAME.
 
-

Still in the shallower list element since the preceding example block forced the deeper list element to terminate.

+

Still in the shallower list element since the preceding example block +forced the deeper list element to terminate.

Outside all lists.

``` diff --git a/test/command/4235.md b/test/command/4235.md index 4f2644dd6..5b534b6d7 100644 --- a/test/command/4235.md +++ b/test/command/4235.md @@ -2,11 +2,15 @@ % pandoc --id-prefix=foo This.^[Has a footnote.] ^D -

This.1

-
+

This.1

+

    -
  1. Has a footnote.↩︎

  2. +
  3. Has a footnote.↩︎

``` diff --git a/test/command/4639.md b/test/command/4639.md index c35df1749..31ac3a5d9 100644 --- a/test/command/4639.md +++ b/test/command/4639.md @@ -5,6 +5,6 @@ \end{equation} ^D

\[\begin{equation} - E=mc^2 +E=mc^2 \end{equation}\]

``` diff --git a/test/command/4677.md b/test/command/4677.md index 2694624b9..64c436005 100644 --- a/test/command/4677.md +++ b/test/command/4677.md @@ -3,6 +3,7 @@ ![Caption](img.png){#img:1} ^D
-Caption +Caption +
``` diff --git a/test/command/4743.md b/test/command/4743.md index 582540736..a75ec1078 100644 --- a/test/command/4743.md +++ b/test/command/4743.md @@ -41,5 +41,7 @@ My:thumbsup:emoji:heart: My:thumbsup:emoji:heart:x :hearts: xyz ^D

0️⃣ header

-

My👍emoji❤️x ♥️ xyz

+

My👍emoji❤️x ♥️ xyz

``` diff --git a/test/command/512.md b/test/command/512.md index b95921309..21b3ea9a7 100644 --- a/test/command/512.md +++ b/test/command/512.md @@ -8,7 +8,8 @@ __ link1_ __ link2_ ^D -

click here or click here

+

click here or click here

``` Multiple indirection: diff --git a/test/command/5121.md b/test/command/5121.md index 1ee6bda77..f1b972fb4 100644 --- a/test/command/5121.md +++ b/test/command/5121.md @@ -5,7 +5,8 @@ ## Header 2 ^D
-My caption +My caption +
## Header 2 diff --git a/test/command/5627.md b/test/command/5627.md index 9910e76c5..dde4c99d6 100644 --- a/test/command/5627.md +++ b/test/command/5627.md @@ -20,8 +20,10 @@ Something
  • Two -->something<!--
  • Three
  • -
    --><!--<script>alert('Escaped!')</script>
    -
    Something
    +
    --><!--<script>alert('Escaped!')</script>
    +
    Something
    ``` ``` @@ -46,8 +48,10 @@ Something
  • -->something<!--
  • bye -->something else<!--
  • -
    --><!--<script>alert('Escaped!')</script>
    -
    Something
    +
    --><!--<script>alert('Escaped!')</script>
    +
    Something
    ``` ``` diff --git a/test/command/5642.md b/test/command/5642.md index cd60df812..120a88ada 100644 --- a/test/command/5642.md +++ b/test/command/5642.md @@ -3,6 +3,7 @@ ![test](foo){aria-describedby="barbaz"} ^D
    -test +test +
    ``` diff --git a/test/command/5650.md b/test/command/5650.md index a2dd215bc..1e96aeaa4 100644 --- a/test/command/5650.md +++ b/test/command/5650.md @@ -5,7 +5,8 @@ a b ``` ^D -
    a
    +
    a
     b
    ```` @@ -16,7 +17,8 @@ a b ``` ^D -
    a
    +
    a
     b
    ```` diff --git a/test/command/5655.md b/test/command/5655.md index 692009562..72ad46e5e 100644 --- a/test/command/5655.md +++ b/test/command/5655.md @@ -2,13 +2,19 @@ % pandoc --webtex $T_n={n+1 \choose 2}$ ^D -

    T_n={n+1 \choose 2}

    +

    ```` ```` % pandoc --webtex $$T_n={n+1 \choose 2}$$ ^D -

    T_n={n+1 \choose 2}

    +

    ```` diff --git a/test/command/5813.md b/test/command/5813.md index 927a161ed..51f774524 100644 --- a/test/command/5813.md +++ b/test/command/5813.md @@ -2,5 +2,6 @@ % pandoc -f gfm ### Jekyll Plugins & Gems :gem: ^D -

    Jekyll Plugins & Gems 💎

    +

    Jekyll Plugins & Gems 💎

    ``` diff --git a/test/command/5986.md b/test/command/5986.md index c181e33ad..aaa1e6568 100644 --- a/test/command/5986.md +++ b/test/command/5986.md @@ -6,7 +6,8 @@

    diff --git a/test/command/6739.md b/test/command/6739.md index 7c9ed24a2..ff2d4bc75 100644 --- a/test/command/6739.md +++ b/test/command/6739.md @@ -4,7 +4,8 @@ * `--argA | --argB` This item has a pipe character ^D
      -
    • --argument This item does not have a pipe character
    • +
    • --argument This item does not have a pipe +character
    • --argA | --argB This item has a pipe character
    ``` diff --git a/test/command/7006.md b/test/command/7006.md index 7e2215cdf..22aaf84ad 100644 --- a/test/command/7006.md +++ b/test/command/7006.md @@ -6,13 +6,16 @@ Test.[^fn] ![Caption.](/image.jpg) ^D -

    Test.1

    -
    +

    Test.1

    +

    1. Foo:

      -Caption. +Caption. +
      ↩︎
    diff --git a/test/command/7416.md b/test/command/7416.md index 2f9577f10..d440725ab 100644 --- a/test/command/7416.md +++ b/test/command/7416.md @@ -4,7 +4,8 @@ ^D
    -alt
    caption
    +alt +
    caption
    ``` @@ -14,6 +15,7 @@ ^D
    -caption +caption +
    ``` diff --git a/test/command/7568.md b/test/command/7568.md index 42f1e37b1..487da0861 100644 --- a/test/command/7568.md +++ b/test/command/7568.md @@ -7,5 +7,10 @@ holds a useful spot. .. _Labyrinth Lord\: Revised Edition: https://www.drivethrurpg.com/product/64332/Labyrinth-Lord-Revised-Edition ^D -

    While Labyrinth Lord: Revised Edition (LLRE; PDF and POD) has been criticized for not being a completely faithful retro-clone of the Moldvay/Cook/Marsh Basic/Expert D&D rules (B/X), I think it still holds a useful spot.

    +

    While Labyrinth +Lord: Revised Edition (LLRE; PDF and POD) has been criticized for +not being a completely faithful retro-clone of the Moldvay/Cook/Marsh +Basic/Expert D&D rules (B/X), I think it still holds a useful +spot.

    ``` diff --git a/test/command/7713.md b/test/command/7713.md index d42dcd9b8..851cb4729 100644 --- a/test/command/7713.md +++ b/test/command/7713.md @@ -21,7 +21,8 @@ -cccccccccc cccccccccc cccccccccc cccccccccc cccccccccc cccccccccc +cccccccccc cccccccccc cccccccccc cccccccccc cccccccccc +cccccccccc diff --git a/test/command/853.md b/test/command/853.md index 54eb416a9..bcc3b4654 100644 --- a/test/command/853.md +++ b/test/command/853.md @@ -7,11 +7,13 @@ Here is a citation reference: [CIT2002]_. .. [CIT2002] This is the citation. It's just like a footnote, except the label is textual. ^D -

    Here is a citation reference: [CIT2002].

    +

    Here is a citation reference: [CIT2002].

    CIT2002
    -

    This is the citation. It's just like a footnote, except the label is textual.

    +

    This is the citation. It's just like a footnote, except the label +is textual.

    diff --git a/test/command/video-audio.md b/test/command/video-audio.md index 451b614d8..4fbd58db3 100644 --- a/test/command/video-audio.md +++ b/test/command/video-audio.md @@ -10,9 +10,13 @@ ![](./test.jpg) ^D -

    -

    -

    +

    +

    +

    ``` diff --git a/test/ipynb/rank.out.html b/test/ipynb/rank.out.html index eb5176509..a82fe8bbc 100644 --- a/test/ipynb/rank.out.html +++ b/test/ipynb/rank.out.html @@ -1,8 +1,12 @@ -
    -
    import matplotlib.pyplot as plt
    +
    +
    import matplotlib.pyplot as plt
    -
    -
    fig, ax = plt.subplots(figsize=(1, 1), dpi=4)
    +
    +
    fig, ax = plt.subplots(figsize=(1, 1), dpi=4)
     ax.imshow([[0, 1], [2, 3]]);

    you should see this when converting from ipynb to html instead of the image below.

    diff --git a/test/s5-basic.html b/test/s5-basic.html index 7440b575b..3a225da83 100644 --- a/test/s5-basic.html +++ b/test/s5-basic.html @@ -56,7 +56,8 @@

    Math

      -
    • $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$
    • +
    • $\frac{d}{dx}f(x)=\lim_{h\to +0}\frac{f(x+h)-f(x)}{h}$
    diff --git a/test/s5-fancy.html b/test/s5-fancy.html index f5c41e561..00b25e80c 100644 --- a/test/s5-fancy.html +++ b/test/s5-fancy.html @@ -28,7 +28,9 @@ - +
    @@ -56,7 +58,8 @@

    Math

      -
    • \(\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}\)
    • +
    • \(\frac{d}{dx}f(x)=\lim_{h\to +0}\frac{f(x+h)-f(x)}{h}\)
    diff --git a/test/s5-fragment.html b/test/s5-fragment.html index 81c578d25..1a8d4839d 100644 --- a/test/s5-fragment.html +++ b/test/s5-fragment.html @@ -5,5 +5,6 @@

    Math

      -
    • $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$
    • +
    • $\frac{d}{dx}f(x)=\lim_{h\to +0}\frac{f(x+h)-f(x)}{h}$
    diff --git a/test/s5-inserts.html b/test/s5-inserts.html index 1df9dd018..04dfc134a 100644 --- a/test/s5-inserts.html +++ b/test/s5-inserts.html @@ -35,7 +35,8 @@ STUFF INSERTED

    Math

      -
    • $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$
    • +
    • $\frac{d}{dx}f(x)=\lim_{h\to +0}\frac{f(x+h)-f(x)}{h}$
    STUFF INSERTED diff --git a/test/tables.html5 b/test/tables.html5 index 533d2fd25..b3ee0ec79 100644 --- a/test/tables.html5 +++ b/test/tables.html5 @@ -121,7 +121,8 @@ Second row 5.0 -Here’s another one. Note the blank line between rows. +Here’s another one. Note the blank line between +rows. @@ -152,7 +153,8 @@ Second row 5.0 -Here’s another one. Note the blank line between rows. +Here’s another one. Note the blank line between +rows. diff --git a/test/writer.html4 b/test/writer.html4 index 257d86ddb..e2adcf5bc 100644 --- a/test/writer.html4 +++ b/test/writer.html4 @@ -156,10 +156,12 @@

    Anonymous

    July 17, 2006

    -

    This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite.

    +

    This is a set of tests for pandoc. Most of them are adapted from John +Gruber’s markdown test suite.


    Headers

    - +

    Level 3 with emphasis

    Level 4

    Level 5
    @@ -172,7 +174,9 @@

    Paragraphs

    Here’s a regular paragraph.

    -

    In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item.

    +

    In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. +Because a hard-wrapped line in the middle of a paragraph looked like a list +item.

    Here’s one with a bullet. * criminey.

    There should be a hard line break
    here.

    @@ -283,7 +287,8 @@ These should not be escaped: \$ \\ \> \[ \{

    Multiple paragraphs:

    1. Item 1, graf one.

      -

      Item 1. graf two. The quick brown fox jumped over the lazy dog’s back.

    2. +

      Item 1. graf two. The quick brown fox jumped over the lazy dog’s +back.

    3. Item 2.

    4. Item 3.

    @@ -540,18 +545,22 @@ Blah

    So is this word.

    This is strong and em.

    So is this word.

    -

    This is code: >, $, \, \$, <html>.

    +

    This is code: >, $, \, +\$, <html>.

    This is strikeout.

    -

    Superscripts: abcd ahello ahello there.

    +

    Superscripts: abcd ahello +ahello there.

    Subscripts: H2O, H23O, Hmany of themO.

    -

    These should not be superscripts or subscripts, because of the unescaped spaces: a^b c^d, a~b c~d.

    +

    These should not be superscripts or subscripts, because of the unescaped +spaces: a^b c^d, a~b c~d.


    Smart quotes, ellipses, dashes

    “Hello,” said the spider. “‘Shelob’ is my name.”

    ‘A’, ‘B’, and ‘C’ are letters.

    ‘Oak,’ ‘elm,’ and ‘beech’ are names of trees. So is ‘pine.’

    ‘He said, “I want to go.”’ Were you alive in the 70’s?

    -

    Here is some quoted ‘code’ and a “quoted link”.

    +

    Here is some quoted ‘code’ and a “quoted link”.

    Some dashes: one—two — three—four — five.

    Dashes between numbers: 5–7, 255–66, 1987–1999.

    Ellipses…and…and….

    @@ -564,13 +573,16 @@ Blah
  • α ∧ ω
  • 223
  • p-Tree
  • -
  • Here’s some display math: $$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$$
  • -
  • Here’s one that has a line break in it: α + ω × x2.
  • +
  • Here’s some display math: $$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$$
  • +
  • Here’s one that has a line break in it: α + ω × x2.
  • These shouldn’t be math:

    • To get the famous equation, write $e = mc^2$.
    • -
    • $22,000 is a lot of money. So is $34,000. (It worked if “lot” is emphasized.)
    • +
    • $22,000 is a lot of money. So is $34,000. (It worked if “lot” is +emphasized.)
    • Shoes ($20) and socks ($5).
    • Escaped $: $73 this should be emphasized 23$.
    @@ -613,7 +625,8 @@ Blah

    URL and title.

    URL and title.

    URL and title.

    -

    URL and title

    +

    URL and +title

    URL and title

    with_underscore

    Email link

    @@ -630,22 +643,29 @@ Blah

    Foo bar.

    Foo biz.

    With ampersands

    -

    Here’s a link with an ampersand in the URL.

    -

    Here’s a link with an amersand in the link text: AT&T.

    +

    Here’s a link with an ampersand +in the URL.

    +

    Here’s a link with an amersand in the link text: AT&T.

    Here’s an inline link.

    -

    Here’s an inline link in pointy braces.

    +

    Here’s an inline link in pointy +braces.

    -

    With an ampersand: http://example.com/?foo=1&bar=2

    +

    With an ampersand: http://example.com/?foo=1&bar=2

    -

    An e-mail address:

    +

    An e-mail address: nobody@nowhere.net

    -

    Blockquoted: http://example.com/

    +

    Blockquoted: http://example.com/

    -

    Auto-links should not occur here: <http://example.com/>

    +

    Auto-links should not occur here: +<http://example.com/>

    or here: <http://example.com/>

    Images

    @@ -657,23 +677,36 @@ Blah

    Here is a movie movie icon.


    Footnotes

    -

    Here is a footnote reference,1 and another.2 This should not be a footnote reference, because it contains a space.[^my note] Here is an inline note.3

    +

    Here is a footnote reference,1 and another.2 This should not be a footnote reference, +because it contains a space.[^my note] Here is an inline note.3

    -

    Notes can go in quotes.4

    +

    Notes can go in quotes.4

      -
    1. And in list items.5
    2. +
    3. And in list items.5

    This paragraph should not be part of the note, as it is not indented.


      -
    1. Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document.↩︎

    2. +
    3. Here is the footnote. It can go anywhere after the footnote +reference. It need not be placed at the end of the document.↩︎

    4. Here’s the long note. This one contains multiple blocks.

      -

      Subsequent blocks are indented to show that they belong to the footnote (as with list items).

      +

      Subsequent blocks are indented to show that they belong to the footnote (as +with list items).

        { <code> }
      -

      If you want, you can indent every line, but you can also be lazy and just indent the first line of each block.↩︎

    5. -
    6. This is easier to type. Inline notes may contain links and ] verbatim characters, as well as [bracketed text].↩︎

    7. +

      If you want, you can indent every line, but you can also be lazy and just +indent the first line of each block.↩︎

      +
    8. This is easier to type. Inline notes may contain links and ] verbatim characters, as +well as [bracketed text].↩︎

    9. In quote.↩︎

    10. In list.↩︎

    diff --git a/test/writer.html5 b/test/writer.html5 index 0141bf9fe..cdfcf042f 100644 --- a/test/writer.html5 +++ b/test/writer.html5 @@ -159,10 +159,12 @@

    Anonymous

    July 17, 2006

    -

    This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite.

    +

    This is a set of tests for pandoc. Most of them are adapted from John +Gruber’s markdown test suite.


    Headers

    - +

    Level 3 with emphasis

    Level 4

    Level 5
    @@ -175,7 +177,9 @@

    Paragraphs

    Here’s a regular paragraph.

    -

    In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item.

    +

    In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. +Because a hard-wrapped line in the middle of a paragraph looked like a list +item.

    Here’s one with a bullet. * criminey.

    There should be a hard line break
    here.

    @@ -286,7 +290,8 @@ These should not be escaped: \$ \\ \> \[ \{

    Multiple paragraphs:

    1. Item 1, graf one.

      -

      Item 1. graf two. The quick brown fox jumped over the lazy dog’s back.

    2. +

      Item 1. graf two. The quick brown fox jumped over the lazy dog’s +back.

    3. Item 2.

    4. Item 3.

    @@ -543,18 +548,22 @@ Blah

    So is this word.

    This is strong and em.

    So is this word.

    -

    This is code: >, $, \, \$, <html>.

    +

    This is code: >, $, \, +\$, <html>.

    This is strikeout.

    -

    Superscripts: abcd ahello ahello there.

    +

    Superscripts: abcd ahello +ahello there.

    Subscripts: H2O, H23O, Hmany of themO.

    -

    These should not be superscripts or subscripts, because of the unescaped spaces: a^b c^d, a~b c~d.

    +

    These should not be superscripts or subscripts, because of the unescaped +spaces: a^b c^d, a~b c~d.


    Smart quotes, ellipses, dashes

    “Hello,” said the spider. “‘Shelob’ is my name.”

    ‘A’, ‘B’, and ‘C’ are letters.

    ‘Oak,’ ‘elm,’ and ‘beech’ are names of trees. So is ‘pine.’

    ‘He said, “I want to go.”’ Were you alive in the 70’s?

    -

    Here is some quoted ‘code’ and a “quoted link”.

    +

    Here is some quoted ‘code’ and a “quoted link”.

    Some dashes: one—two — three—four — five.

    Dashes between numbers: 5–7, 255–66, 1987–1999.

    Ellipses…and…and….

    @@ -567,13 +576,16 @@ Blah
  • α ∧ ω
  • 223
  • p-Tree
  • -
  • Here’s some display math: $$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$$
  • -
  • Here’s one that has a line break in it: α + ω × x2.
  • +
  • Here’s some display math: $$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$$
  • +
  • Here’s one that has a line break in it: α + ω × x2.
  • These shouldn’t be math:

    • To get the famous equation, write $e = mc^2$.
    • -
    • $22,000 is a lot of money. So is $34,000. (It worked if “lot” is emphasized.)
    • +
    • $22,000 is a lot of money. So is $34,000. (It worked if “lot” is +emphasized.)
    • Shoes ($20) and socks ($5).
    • Escaped $: $73 this should be emphasized 23$.
    @@ -616,7 +628,8 @@ Blah

    URL and title.

    URL and title.

    URL and title.

    -

    URL and title

    +

    URL and +title

    URL and title

    with_underscore

    Email link

    @@ -633,51 +646,78 @@ Blah

    Foo bar.

    Foo biz.

    With ampersands

    -

    Here’s a link with an ampersand in the URL.

    -

    Here’s a link with an amersand in the link text: AT&T.

    +

    Here’s a link with an ampersand +in the URL.

    +

    Here’s a link with an amersand in the link text: AT&T.

    Here’s an inline link.

    -

    Here’s an inline link in pointy braces.

    +

    Here’s an inline link in pointy +braces.

    -

    With an ampersand: http://example.com/?foo=1&bar=2

    +

    With an ampersand: http://example.com/?foo=1&bar=2

    -

    An e-mail address:

    +

    An e-mail address: nobody@nowhere.net

    -

    Blockquoted: http://example.com/

    +

    Blockquoted: http://example.com/

    -

    Auto-links should not occur here: <http://example.com/>

    +

    Auto-links should not occur here: +<http://example.com/>

    or here: <http://example.com/>

    Images

    From “Voyage dans la Lune” by Georges Melies (1902):

    -lalune +lalune +

    Here is a movie movie icon.


    Footnotes

    -

    Here is a footnote reference,1 and another.2 This should not be a footnote reference, because it contains a space.[^my note] Here is an inline note.3

    +

    Here is a footnote reference,1 and another.2 This should +not be a footnote reference, because it contains a space.[^my note] +Here is an inline note.3

    -

    Notes can go in quotes.4

    +

    Notes can go in quotes.4

      -
    1. And in list items.5
    2. +
    3. And in list items.5

    This paragraph should not be part of the note, as it is not indented.


      -
    1. Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document.↩︎

    2. -
    3. Here’s the long note. This one contains multiple blocks.

      -

      Subsequent blocks are indented to show that they belong to the footnote (as with list items).

      +
    4. Here is the footnote. It can go anywhere +after the footnote reference. It need not be placed at the end of the +document.↩︎

    5. +
    6. Here’s the long note. This one contains +multiple blocks.

      +

      Subsequent blocks are indented to show that they belong to the footnote (as +with list items).

        { <code> }
      -

      If you want, you can indent every line, but you can also be lazy and just indent the first line of each block.↩︎

    7. -
    8. This is easier to type. Inline notes may contain links and ] verbatim characters, as well as [bracketed text].↩︎

    9. -
    10. In quote.↩︎

    11. -
    12. In list.↩︎

    13. +

      If you want, you can indent every line, but you can also be lazy and just +indent the first line of each block.↩︎

      +
    14. This is easier to type. Inline notes +may contain links and ] verbatim +characters, as well as [bracketed text].↩︎

    15. +
    16. In quote.↩︎

    17. +
    18. In list.↩︎

    -- cgit v1.2.3