From 2b89aaf04dd2d1bdafa0ee507abefd4f0d6df271 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 14 May 2018 10:37:46 -0700 Subject: Make internal links work in ODT/OpenDocument. This adds proper bookmarks to the headers with non-null IDs. Closes #4358. --- test/writer.opendocument | 97 ++++++++++++++++++++++++++---------------------- 1 file changed, 53 insertions(+), 44 deletions(-) (limited to 'test') diff --git a/test/writer.opendocument b/test/writer.opendocument index 081b33971..535130c0a 100644 --- a/test/writer.opendocument +++ b/test/writer.opendocument @@ -803,23 +803,31 @@ This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite. -Headers -Level 2 with an +Headers +Level +2 with an embedded -link -Level 3 with -emphasis -Level 4 -Level 5 -Level 1 -Level 2 with -emphasis -Level 3 +link +Level +3 with +emphasis +Level +4 +Level +5 +Level +1 +Level +2 with +emphasis +Level +3 with no blank line -Level 2 +Level +2 with no blank line -Paragraphs +Paragraphs Here’s a regular paragraph. In Markdown 1.0.0 and earlier. Version @@ -830,8 +838,8 @@ criminey. There should be a hard line breakhere. -Block -Quotes +Block +Quotes E-mail style: This is a block quote. It is pretty short. @@ -855,8 +863,8 @@ short. 2 > 1. And a following paragraph. -Code -Blocks +Code +Blocks Code: ---- (should be four hyphens) @@ -870,8 +878,8 @@ Blocks These should not be escaped: \$ \\ \> \[ \{ -Lists -Unordered +Lists +Unordered Asterisks tight: @@ -944,7 +952,7 @@ Blocks Minus 3 -Ordered +Ordered Tight: @@ -1007,7 +1015,7 @@ Blocks Item 3. -Nested +Nested Tab @@ -1068,8 +1076,8 @@ paragraphs: Third -Tabs and -spaces +Tabs +and spaces this is a list item indented with @@ -1089,8 +1097,8 @@ spaces -Fancy list -markers +Fancy +list markers begins with 2 @@ -1157,8 +1165,8 @@ item: M.A. 2007 B. Williams -Definition -Lists +Definition +Lists Tight using spaces: apple red fruit @@ -1225,8 +1233,8 @@ fruit sublist -HTML -Blocks +HTML +Blocks Simple block on one line: foo @@ -1262,8 +1270,8 @@ spaces on the line: <hr /> Hr’s: -Inline -Markup +Inline +Markup This is emphasized, and so is this. @@ -1300,8 +1308,9 @@ Hmany of themO. These should not be superscripts or subscripts, because of the unescaped spaces: a^b c^d, a~b c~d. -Smart quotes, -ellipses, dashes +Smart +quotes, ellipses, +dashes “Hello,” said the spider. “‘Shelob’ is my name.” ‘A’, ‘B’, and ‘C’ are letters. @@ -1319,7 +1328,7 @@ five. 1987–1999. Ellipses…and…and…. -LaTeX +LaTeX @@ -1371,8 +1380,8 @@ five. Here’s a LaTeX table: -Special -Characters +Special +Characters Here is some unicode: @@ -1415,8 +1424,8 @@ it. Plus: + Minus: - -Links -Explicit +Links +Explicit Just a URL. URL @@ -1433,7 +1442,7 @@ and title Email link Empty. -Reference +Reference Foo bar. With @@ -1453,8 +1462,8 @@ by itself should be a link. bar. Foo biz. -With -ampersands +With +ampersands Here’s a link with an ampersand in the URL. @@ -1467,7 +1476,7 @@ link. Here’s an inline link in pointy braces. -Autolinks +Autolinks With an ampersand: http://example.com/?foo=1&bar=2 @@ -1489,7 +1498,7 @@ link in pointy braces. <http://example.com/> or here: <http://example.com/> -Images +Images From “Voyage dans la Lune” by Georges Melies (1902): @@ -1498,7 +1507,7 @@ Georges Melies (1902): icon. -Footnotes +Footnotes Here is a footnote reference,1Here is the footnote. It can go anywhere after the footnote reference. It need not -- cgit v1.2.3 From 58447bba98cb162b21c30755e0e237f890160a1e Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 15 May 2018 09:15:45 -0700 Subject: rawLaTeXBlock: don't expand macros in macro definitions! Closes #4653. Note that this only affected LaTeX in markdown. Added regression test. --- src/Text/Pandoc/Readers/LaTeX.hs | 22 +++++++++++----------- test/command/4653.md | 8 ++++++++ 2 files changed, 19 insertions(+), 11 deletions(-) create mode 100644 test/command/4653.md (limited to 'test') diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 39dffde76..f2c0d1fbb 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -242,8 +242,8 @@ withVerbatimMode parser = do return result rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s) - => LP m a -> LP m a -> ParserT String s m (a, String) -rawLaTeXParser parser valParser = do + => Bool -> LP m a -> LP m a -> ParserT String s m (a, String) +rawLaTeXParser retokenize parser valParser = do inp <- getInput let toks = tokenize "source" $ T.pack inp pstate <- getState @@ -254,10 +254,11 @@ rawLaTeXParser parser valParser = do case res' of Left _ -> mzero Right toks' -> do - res <- lift $ runParserT (do doMacros 0 - -- retokenize, applying macros - ts <- many (satisfyTok (const True)) - setInput ts + res <- lift $ runParserT (do when retokenize $ do + -- retokenize, applying macros + doMacros 0 + ts <- many (satisfyTok (const True)) + setInput ts rawparser) lstate' "chunk" toks' case res of @@ -284,20 +285,19 @@ rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s) => ParserT String s m String rawLaTeXBlock = do lookAhead (try (char '\\' >> letter)) - -- we don't want to apply newly defined latex macros to their own - -- definitions: - snd <$> rawLaTeXParser (environment <|> macroDef <|> blockCommand) blocks + snd <$> (rawLaTeXParser False macroDef blocks + <|> rawLaTeXParser True(environment <|> macroDef <|> blockCommand) blocks) rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s) => ParserT String s m String rawLaTeXInline = do lookAhead (try (char '\\' >> letter)) - snd <$> rawLaTeXParser (inlineEnvironment <|> inlineCommand') inlines + snd <$> rawLaTeXParser True (inlineEnvironment <|> inlineCommand') inlines inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines inlineCommand = do lookAhead (try (char '\\' >> letter)) - fst <$> rawLaTeXParser (inlineEnvironment <|> inlineCommand') inlines + fst <$> rawLaTeXParser True (inlineEnvironment <|> inlineCommand') inlines tokenize :: SourceName -> Text -> [Tok] tokenize sourcename = totoks (initialPos sourcename) diff --git a/test/command/4653.md b/test/command/4653.md new file mode 100644 index 000000000..24a706e89 --- /dev/null +++ b/test/command/4653.md @@ -0,0 +1,8 @@ +``` +% pandoc -t latex +\let\tex\TeX +\renewcommand{\TeX}{\tex\xspace} +^D +\let\tex\TeX +\renewcommand{\TeX}{\tex\xspace} +``` -- cgit v1.2.3 From 6907985e82b5ac2ae98bf787738fc9ad3a402026 Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Sun, 27 May 2018 22:22:04 +0300 Subject: Muse reader: test image with space in filename --- test/Tests/Readers/Muse.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'test') diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index ecdd5fdb0..ddfedbff4 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -197,6 +197,9 @@ tests = , "Image with description" =: "[[image.jpg][Image]]" =?> para (image "image.jpg" "" (text "Image")) + , "Image with space in filename" =: + "[[image name.jpg]]" =?> + para (image "image name.jpg" "" mempty) , "Image link" =: "[[URL:image.jpg]]" =?> para (link "image.jpg" "" (str "image.jpg")) -- cgit v1.2.3 From 1100bfc0e67954760c0c1767018404bf0129dd01 Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Wed, 30 May 2018 02:25:30 +0300 Subject: Muse reader: parse image URLs without "guard" and "takeExtension" --- src/Text/Pandoc/Readers/Muse.hs | 8 +++----- test/Tests/Readers/Muse.hs | 3 +++ 2 files changed, 6 insertions(+), 5 deletions(-) (limited to 'test') diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index e8b7d24f7..9eda0d4f3 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -52,7 +52,6 @@ import qualified Data.Map as M import qualified Data.Set as Set import Data.Maybe (fromMaybe, isNothing) import Data.Text (Text, unpack) -import System.FilePath (takeExtension) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B @@ -966,14 +965,13 @@ explicitLink = try $ do image :: PandocMonad m => MuseParser m (F Inlines) image = try $ do string "[[" - url <- manyTill anyChar $ char ']' + (url, ext) <- manyUntil (noneOf "]") $ (imageExtension <* char ']') content <- optionMaybe linkContent char ']' - guard $ isImageUrl url - return $ B.image url "" <$> fromMaybe (return mempty) content + return $ B.image (url ++ ext) "" <$> fromMaybe (return mempty) content where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"] - isImageUrl = (`elem` imageExtensions) . takeExtension + imageExtension = choice (try . string <$> imageExtensions) link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index ddfedbff4..6b4e0fdbd 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -194,6 +194,9 @@ tests = , "Image" =: "[[image.jpg]]" =?> para (image "image.jpg" "" mempty) + , "Closing bracket is not allowed in image filename" =: + "[[foo]bar.jpg]]" =?> + para (text "[[foo]bar.jpg]]") , "Image with description" =: "[[image.jpg][Image]]" =?> para (image "image.jpg" "" (text "Image")) -- cgit v1.2.3 From 252ab9b77323230fa58e3b877101b061d77f673c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 30 May 2018 09:24:52 -0700 Subject: Markdown writer: preserve `implicit_figures` with attributes... ...even if `implicit_attributes` is not set, by rendering in raw HTML. Fixes #4677. --- src/Text/Pandoc/Writers/Markdown.hs | 16 +++++++++++----- test/command/4677.md | 7 +++++++ 2 files changed, 18 insertions(+), 5 deletions(-) create mode 100644 test/command/4677.md (limited to 'test') diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 075858e5e..fe8f452d3 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -452,8 +452,14 @@ blockToMarkdown' opts (Plain inlines) = do | otherwise -> contents return $ contents' <> cr -- title beginning with fig: indicates figure -blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = - blockToMarkdown opts (Para [Image attr alt (src,tit)]) +blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + (text . T.unpack . T.strip) <$> + writeHtml5String opts{ writerTemplate = Nothing } + (Pandoc nullMeta [Para [Image attr alt (src,"fig:" ++ tit)]]) + | otherwise = blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown' opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown' opts (LineBlock lns) = @@ -619,7 +625,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do (all null headers) aligns' widths' headers rows | isEnabled Ext_raw_html opts -> fmap (id,) $ (text . T.unpack) <$> - (writeHtml5String def $ Pandoc nullMeta [t]) + (writeHtml5String opts{ writerTemplate = Nothing } $ Pandoc nullMeta [t]) | hasSimpleCells && isEnabled Ext_pipe_tables opts -> do rawHeaders <- padRow <$> mapM (blockListToMarkdown opts) headers @@ -1172,7 +1178,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit)) not (isEnabled Ext_link_attributes opts) && attr /= nullAttr = -- use raw HTML (text . T.unpack . T.strip) <$> - writeHtml5String def (Pandoc nullMeta [Plain [lnk]]) + writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [lnk]]) | otherwise = do plain <- asks envPlain linktext <- inlineListToMarkdown opts txt @@ -1212,7 +1218,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit)) not (isEnabled Ext_link_attributes opts) && attr /= nullAttr = -- use raw HTML (text . T.unpack . T.strip) <$> - writeHtml5String def (Pandoc nullMeta [Plain [img]]) + writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]]) | otherwise = do plain <- asks envPlain let txt = if null alternate || alternate == [Str source] diff --git a/test/command/4677.md b/test/command/4677.md new file mode 100644 index 000000000..3ca8add9d --- /dev/null +++ b/test/command/4677.md @@ -0,0 +1,7 @@ +``` +% echo '![Caption](img.png){#img:1}' | pandoc --to "markdown-bracketed_spans-fenced_divs-link_attributes-simple_tables-multiline_tables-grid_tables-pipe_tables-fenced_code_attributes-markdown_in_html_blocks-table_captions-smart" +^D +
+Caption
Caption
+
+``` -- cgit v1.2.3 From 7119715a6af7d04d17e40bb76e901c11bf27d3f3 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 30 May 2018 12:48:07 -0700 Subject: LaTeX reader `rawLaTeXBlock`: handle macros that resolve to a... ...`\begin` or `\end`. Fixes #4667. --- src/Text/Pandoc/Readers/LaTeX.hs | 18 +++++++++++++++++- test/command/4667.md | 20 ++++++++++++++++++++ 2 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 test/command/4667.md (limited to 'test') diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 2fdb3d43c..fff628c46 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -286,7 +286,23 @@ rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s) rawLaTeXBlock = do lookAhead (try (char '\\' >> letter)) snd <$> (rawLaTeXParser False macroDef blocks - <|> rawLaTeXParser True(environment <|> macroDef <|> blockCommand) blocks) + <|> rawLaTeXParser True + (environment <|> macroDef <|> blockCommand) + (mconcat <$> (many (block <|> beginOrEndCommand)))) + +-- See #4667 for motivation; sometimes people write macros +-- that just evaluate to a begin or end command, which blockCommand +-- won't accept. +beginOrEndCommand :: PandocMonad m => LP m Blocks +beginOrEndCommand = try $ do + Tok _ (CtrlSeq name) txt <- anyControlSeq + guard $ name == "begin" || name == "end" + (envname, rawargs) <- withRaw braced + if M.member (untokenize envname) + (inlineEnvironments :: M.Map Text (LP PandocPure Inlines)) + then mzero + else return $ rawBlock "latex" + (T.unpack (txt <> untokenize rawargs)) rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s) => ParserT String s m String diff --git a/test/command/4667.md b/test/command/4667.md new file mode 100644 index 000000000..1fff3708d --- /dev/null +++ b/test/command/4667.md @@ -0,0 +1,20 @@ +``` +pandoc -t latex +--- +header-includes: +- \newcommand{\blandscape}{\begin{landscape}} +- \newcommand{\elandscape}{\end{landscape}} +... + +\blandscape + +testing + +\elandscape +^D +\begin{landscape} + +testing + +\end{landscape} +``` -- cgit v1.2.3 From 1f78efff3b903158da557dbe83c2350954d40a2e Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Thu, 31 May 2018 00:57:58 +0300 Subject: Muse reader: add support for images with specified width --- src/Text/Pandoc/Readers/Muse.hs | 13 +++++++++---- test/Tests/Readers/Muse.hs | 6 ++++++ 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'test') diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 9eda0d4f3..72909dc4d 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -35,7 +35,7 @@ TODO: - Page breaks (five "*") - Org tables - table.el tables -- Images with attributes (floating and width) +- Floating images - tag -} module Text.Pandoc.Readers.Muse (readMuse) where @@ -50,7 +50,7 @@ import Data.List (intercalate) import Data.List.Split (splitOn) import qualified Data.Map as M import qualified Data.Set as Set -import Data.Maybe (fromMaybe, isNothing) +import Data.Maybe (fromMaybe, isNothing, maybeToList) import Data.Text (Text, unpack) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks, Inlines) @@ -965,13 +965,18 @@ explicitLink = try $ do image :: PandocMonad m => MuseParser m (F Inlines) image = try $ do string "[[" - (url, ext) <- manyUntil (noneOf "]") $ (imageExtension <* char ']') + (url, (ext, width)) <- manyUntil (noneOf "]") $ (imageExtensionAndOptions <* char ']') content <- optionMaybe linkContent char ']' - return $ B.image (url ++ ext) "" <$> fromMaybe (return mempty) content + let widthAttr = maybeToList (("width",) . (++ "%") <$> width) + return $ B.imageWith ("", [], widthAttr) (url ++ ext) mempty <$> fromMaybe (return mempty) content where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"] imageExtension = choice (try . string <$> imageExtensions) + imageExtensionAndOptions = do + ext <- imageExtension + width <- optionMaybe (many1 spaceChar *> many1 digit) + return (ext, width) link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 6b4e0fdbd..1146aa6d2 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -203,6 +203,12 @@ tests = , "Image with space in filename" =: "[[image name.jpg]]" =?> para (image "image name.jpg" "" mempty) + , "Image with width" =: + "[[image.jpg 60]]" =?> + para (imageWith ("", [], [("width", "60%")]) "image.jpg" mempty mempty) + , "At least one space is required between image filename and width" =: + "[[image.jpg60]]" =?> + para (link "image.jpg60" mempty (str "image.jpg60")) , "Image link" =: "[[URL:image.jpg]]" =?> para (link "image.jpg" "" (str "image.jpg")) -- cgit v1.2.3 From 5fbc981fc24d24652de3061353f09d1912928fba Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Thu, 31 May 2018 23:31:27 +0300 Subject: Muse reader: add support for floating images --- src/Text/Pandoc/Readers/Muse.hs | 24 ++++++++++++++++++------ test/Tests/Readers/Muse.hs | 6 ++++++ 2 files changed, 24 insertions(+), 6 deletions(-) (limited to 'test') diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 72909dc4d..6ff84bff1 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -35,7 +35,6 @@ TODO: - Page breaks (five "*") - Org tables - table.el tables -- Floating images - tag -} module Text.Pandoc.Readers.Muse (readMuse) where @@ -965,18 +964,31 @@ explicitLink = try $ do image :: PandocMonad m => MuseParser m (F Inlines) image = try $ do string "[[" - (url, (ext, width)) <- manyUntil (noneOf "]") $ (imageExtensionAndOptions <* char ']') + (url, (ext, width, align)) <- manyUntil (noneOf "]") $ (imageExtensionAndOptions <* char ']') content <- optionMaybe linkContent char ']' - let widthAttr = maybeToList (("width",) . (++ "%") <$> width) - return $ B.imageWith ("", [], widthAttr) (url ++ ext) mempty <$> fromMaybe (return mempty) content + let widthAttr = case align of + Just 'f' -> [("width", (fromMaybe "100" width) ++ "%"), ("height", "75%")] + _ -> maybeToList (("width",) . (++ "%") <$> width) + let alignClass = case align of + Just 'r' -> ["align-right"] + Just 'l' -> ["align-left"] + Just 'f' -> [] + Nothing -> [] + return $ B.imageWith ("", alignClass, widthAttr) (url ++ ext) mempty <$> fromMaybe (return mempty) content where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"] imageExtension = choice (try . string <$> imageExtensions) imageExtensionAndOptions = do ext <- imageExtension - width <- optionMaybe (many1 spaceChar *> many1 digit) - return (ext, width) + (width, align) <- option (Nothing, Nothing) imageAttrs + return (ext, width, align) + imageAttrs = do + many1 spaceChar + width <- optionMaybe (many1 digit) + many spaceChar + align <- optionMaybe (oneOf "rlf") + return (width, align) link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 1146aa6d2..fe25e9c5d 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -209,6 +209,12 @@ tests = , "At least one space is required between image filename and width" =: "[[image.jpg60]]" =?> para (link "image.jpg60" mempty (str "image.jpg60")) + , "Left-aligned image with width" =: + "[[image.png 60 l][Image]]" =?> + para (imageWith ("", ["align-left"], [("width", "60%")]) "image.png" "" (str "Image")) + , "Right-aligned image with width" =: + "[[image.png 60 r][Image]]" =?> + para (imageWith ("", ["align-right"], [("width", "60%")]) "image.png" "" (str "Image")) , "Image link" =: "[[URL:image.jpg]]" =?> para (link "image.jpg" "" (str "image.jpg")) -- cgit v1.2.3 From d32e8664498d799932927d9865ce71e014472ef3 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 1 Jun 2018 09:24:26 -0700 Subject: LaTeX reader: handle includes without surrounding blanklines. In addition, `\input` can now be used in an inline context, e.g. to provide part of a paragraph, as it can in LaTeX. Closes #4553. --- pandoc.cabal | 1 + src/Text/Pandoc/Readers/LaTeX.hs | 16 +++++++++------- test/command/4553.md | 15 +++++++++++++++ test/command/bar.tex | 1 + 4 files changed, 26 insertions(+), 7 deletions(-) create mode 100644 test/command/4553.md create mode 100644 test/command/bar.tex (limited to 'test') diff --git a/pandoc.cabal b/pandoc.cabal index 75eb60d95..3931db123 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -192,6 +192,7 @@ extra-source-files: test/command/inkscape-cube.svg test/command/sub-file-chapter-1.tex test/command/sub-file-chapter-2.tex + test/command/bar.tex test/command/3510-subdoc.org test/command/3510-export.latex test/command/3510-src.hs diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index fff628c46..042295fd9 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1642,6 +1642,8 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList , ("Rn", romanNumeralLower) -- babel , ("foreignlanguage", foreignlanguage) + -- include + , ("input", include "input") ] makeUppercase :: Inlines -> Inlines @@ -1917,7 +1919,6 @@ end_ t = try (do preamble :: PandocMonad m => LP m Blocks preamble = mempty <$ many preambleBlock where preambleBlock = spaces1 - <|> void include <|> void macroDef <|> void blockCommand <|> void braced @@ -1930,11 +1931,8 @@ paragraph = do then return mempty else return $ para x -include :: PandocMonad m => LP m Blocks -include = do - (Tok _ (CtrlSeq name) _) <- - controlSeq "include" <|> controlSeq "input" <|> - controlSeq "subfile" <|> controlSeq "usepackage" +include :: (PandocMonad m, Monoid a) => Text -> LP m a +include name = do skipMany opt fs <- (map (T.unpack . removeDoubleQuotes . T.strip) . T.splitOn "," . untokenize) <$> braced @@ -2251,6 +2249,11 @@ blockCommands = M.fromList -- LaTeX colors , ("textcolor", coloredBlock "color") , ("colorbox", coloredBlock "background-color") + -- include + , ("include", include "include") + , ("input", include "input") + , ("subfile", include "subfile") + , ("usepackage", include "usepackage") ] @@ -2689,7 +2692,6 @@ block :: PandocMonad m => LP m Blocks block = do res <- (mempty <$ spaces1) <|> environment - <|> include <|> macroDef <|> blockCommand <|> paragraph diff --git a/test/command/4553.md b/test/command/4553.md new file mode 100644 index 000000000..e5122d4d9 --- /dev/null +++ b/test/command/4553.md @@ -0,0 +1,15 @@ +``` +pandoc -f latex -t native +foo \include{command/bar} +^D +[Para [Str "foo"] +,Para [Emph [Str "hi",Space,Str "there"]]] +``` + +``` +pandoc -f latex -t native +foo \input{command/bar} +^D +[Para [Str "foo",Space,Emph [Str "hi",Space,Str "there"]]] +``` + diff --git a/test/command/bar.tex b/test/command/bar.tex new file mode 100644 index 000000000..e2113ab93 --- /dev/null +++ b/test/command/bar.tex @@ -0,0 +1 @@ +\emph{hi there} -- cgit v1.2.3 From 905dee6ee3c96560d67e82f6786b8f248b5c83c8 Mon Sep 17 00:00:00 2001 From: Mauro Bieg Date: Thu, 7 Jun 2018 19:50:14 +0200 Subject: beamer output: fix single digit column percentage (#4691) fixes #4690 --- src/Text/Pandoc/Writers/LaTeX.hs | 2 +- test/command/1710.md | 7 +++---- test/command/4016.md | 4 ++-- test/command/4690.md | 28 ++++++++++++++++++++++++++++ 4 files changed, 34 insertions(+), 7 deletions(-) create mode 100644 test/command/4690.md (limited to 'test') diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 2904bec06..4c791aa44 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -487,7 +487,7 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) then \contents -> let fromPct xs = case reverse xs of - '%':ds -> '0':'.': reverse ds + '%':ds -> showFl (read (reverse ds) / 100 :: Double) _ -> xs w = maybe "0.48" fromPct (lookup "width" kvs) in inCmd "begin" "column" <> diff --git a/test/command/1710.md b/test/command/1710.md index d20dfe191..4d9c64b30 100644 --- a/test/command/1710.md +++ b/test/command/1710.md @@ -58,7 +58,7 @@ ok \protect\hypertarget{slide-one}{} \begin{columns}[T] -\begin{column}{0.40\textwidth} +\begin{column}{0.4\textwidth} \begin{itemize} \tightlist \item @@ -68,7 +68,7 @@ ok \end{itemize} \end{column} -\begin{column}{0.40\textwidth} +\begin{column}{0.4\textwidth} \begin{itemize} \tightlist \item @@ -78,11 +78,10 @@ ok \end{itemize} \end{column} -\begin{column}{0.10\textwidth} +\begin{column}{0.1\textwidth} ok \end{column} \end{columns} \end{frame} ``` - diff --git a/test/command/4016.md b/test/command/4016.md index 3918251c6..5e4e35e0d 100644 --- a/test/command/4016.md +++ b/test/command/4016.md @@ -17,7 +17,7 @@ pandoc -t beamer \protect\hypertarget{level-2-blocks}{} \begin{columns}[T] -\begin{column}{0.40\textwidth} +\begin{column}{0.4\textwidth} \begin{block}{Block one} \begin{itemize} @@ -29,7 +29,7 @@ pandoc -t beamer \end{block} \end{column} -\begin{column}{0.60\textwidth} +\begin{column}{0.6\textwidth} \begin{block}{Block two} \begin{itemize} diff --git a/test/command/4690.md b/test/command/4690.md new file mode 100644 index 000000000..deccfba13 --- /dev/null +++ b/test/command/4690.md @@ -0,0 +1,28 @@ +``` +% pandoc -t beamer +# title + +:::: {.columns} +::: {.column width="8%"} +content +::: +::: {.column width="84%"} +content2 +::: +:::: +^D +\begin{frame}{title} +\protect\hypertarget{title}{} + +\begin{columns}[T] +\begin{column}{0.08\textwidth} +content +\end{column} + +\begin{column}{0.84\textwidth} +content2 +\end{column} +\end{columns} + +\end{frame} +``` -- cgit v1.2.3 From edcfbccf5dbef7d64b498376b457cc0e44fd275c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 9 Jun 2018 13:34:21 -0700 Subject: Use skylighting 0.7.2. Adjust tests. This should fix commercialhaskell/stackage#3719, once a new release is made. --- pandoc.cabal | 2 +- stack.yaml | 4 ++-- test/lhs-test.html | 10 ++++------ test/lhs-test.html+lhs | 10 ++++------ 4 files changed, 11 insertions(+), 15 deletions(-) (limited to 'test') diff --git a/pandoc.cabal b/pandoc.cabal index 564fd600a..db2ccb8ed 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -369,7 +369,7 @@ library tagsoup >= 0.14.6 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, - skylighting >= 0.5.1 && < 0.8, + skylighting >= 0.7.2 && < 0.8, data-default >= 0.4 && < 0.8, temporary >= 1.1 && < 1.4, blaze-html >= 0.9 && < 0.10, diff --git a/stack.yaml b/stack.yaml index e2af054ee..2dbf82137 100644 --- a/stack.yaml +++ b/stack.yaml @@ -13,8 +13,8 @@ packages: - '.' extra-deps: - pandoc-citeproc-0.14.3.1 -- skylighting-0.7.0.2 -- skylighting-core-0.7.0.2 +- skylighting-0.7.2 +- skylighting-core-0.7.2 - ansi-terminal-0.8.0.2 - tasty-1.0.1.1 - test-framework-0.8.2.0 diff --git a/test/lhs-test.html b/test/lhs-test.html index c9777ea7b..5fce225df 100644 --- a/test/lhs-test.html +++ b/test/lhs-test.html @@ -14,7 +14,7 @@