diff options
-rw-r--r-- | README | 5 | ||||
-rw-r--r-- | appveyor.yml | 2 | ||||
m--------- | data/templates | 27 | ||||
-rw-r--r-- | src/Text/Pandoc.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Textile.hs | 11 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 29 | ||||
-rw-r--r-- | tests/rst-reader.native | 1 | ||||
-rw-r--r-- | tests/rst-reader.rst | 2 | ||||
-rw-r--r-- | windows/make-windows-installer.bat | 2 | ||||
-rw-r--r-- | windows/stack.yaml | 1 |
11 files changed, 42 insertions, 45 deletions
@@ -949,6 +949,8 @@ Math rendering in HTML : Render TeX formulas using an external script that converts TeX formulas to images. The formula will be concatenated with the URL provided. If *URL* is not specified, the Google Chart API will be used. + Note: the `--webtex` option will affect Markdown output + as well as HTML. `--katex`[`=`*URL*] @@ -1254,6 +1256,9 @@ LaTeX variables are used when [creating a PDF]. `toc-depth` : level of section to include in table of contents +`secnumdepth` +: numbering depth for sections, if sections are numbered + `lof`, `lot` : include list of figures, list of tables diff --git a/appveyor.yml b/appveyor.yml index 588c86a5e..7ce7dc171 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -37,7 +37,7 @@ after_test: # .\ in the stack commandline seems to be .\windows\ (where the stack-appveyor.yaml is) - cd windows - 7z a "pandoc.zip" pandoc.exe - - .\pandoc.exe -s -S ..\README -o README.html + - .\pandoc.exe -s -S --toc ..\README -o README.html - .\pandoc.exe -s -S ..\COPYING -o COPYING.rtf - copy ..\COPYRIGHT COPYRIGHT.txt - | diff --git a/data/templates b/data/templates -Subproject feffd7c64abab863abd3f6458d1c445d6bfe7fc +Subproject 856a5093269cc8e5aaa429fc1775157ff5857c3 diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 0330c46e2..cd93e0b7b 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -191,7 +191,7 @@ parseFormatSpec = parse formatSpec "" where formatSpec = do name <- formatName extMods <- many extMod - return (name, foldl (.) id extMods) + return (name, \x -> foldl (flip ($)) x extMods) formatName = many1 $ noneOf "-+" extMod = do polarity <- oneOf "-+" diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 296c55f32..60d69638b 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -1126,7 +1126,10 @@ explicitLink = try $ do skipSpaces string "`_" optional $ char '_' -- anonymous form - return $ B.link (escapeURI $ trim src) "" label' + let label'' = if label' == mempty + then B.str src + else label' + return $ B.link (escapeURI $ trim src) "" label'' referenceLink :: RSTParser Inlines referenceLink = try $ do diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 17c6583ff..3b8278e27 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -63,7 +63,7 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) import Text.HTML.TagSoup (parseTags, innerText, fromAttrib, Tag(..)) import Text.HTML.TagSoup.Match import Data.List ( intercalate ) -import Data.Char ( digitToInt, isUpper) +import Data.Char ( digitToInt, isUpper ) import Control.Monad ( guard, liftM, when ) import Text.Pandoc.Compat.Monoid ((<>)) import Text.Printf @@ -540,8 +540,8 @@ image = try $ do let attr = case lookup "style" kvs of Just stls -> (ident, cls, pickStylesToKVs ["width", "height"] stls) Nothing -> (ident, cls, kvs) - src <- manyTill anyChar' (lookAhead $ oneOf "!(") - alt <- option "" (try $ (char '(' >> manyTill anyChar' (char ')'))) + src <- many1 (noneOf " \t\n\r!(") + alt <- option "" $ try $ char '(' *> manyTill anyChar (char ')') char '!' return $ B.imageWith attr src alt (B.str alt) @@ -639,10 +639,7 @@ simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser -> (Inlines -> Inlines) -- ^ Inline constructor -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly) simpleInline border construct = try $ do - st <- getState - pos <- getPosition - let afterString = stateLastStrPos st == Just pos - guard $ not afterString + notAfterString border *> notFollowedBy (oneOf " \t\n\r") attr <- attributes body <- trimInlines . mconcat <$> diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 1ff8d2ab9..b04e33085 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -55,6 +55,7 @@ import qualified Data.HashMap.Strict as H import qualified Data.Vector as V import qualified Data.Text as T import qualified Data.Set as Set +import Network.HTTP ( urlEncode ) type Notes = [[Block]] type Ref = ([Inline], Target, Attr) @@ -856,18 +857,22 @@ inlineToMarkdown opts (Str str) = do if stPlain st then return $ text str else return $ text $ escapeString opts str -inlineToMarkdown opts (Math InlineMath str) - | isEnabled Ext_tex_math_dollars opts = - return $ "$" <> text str <> "$" - | isEnabled Ext_tex_math_single_backslash opts = - return $ "\\(" <> text str <> "\\)" - | isEnabled Ext_tex_math_double_backslash opts = - return $ "\\\\(" <> text str <> "\\\\)" - | otherwise = do - plain <- gets stPlain - inlineListToMarkdown opts $ - (if plain then makeMathPlainer else id) $ - texMathToInlines InlineMath str +inlineToMarkdown opts (Math InlineMath str) = + case writerHTMLMathMethod opts of + WebTeX url -> + inlineToMarkdown opts (Image nullAttr [Str str] + (url ++ urlEncode str, str)) + _ | isEnabled Ext_tex_math_dollars opts -> + return $ "$" <> text str <> "$" + | isEnabled Ext_tex_math_single_backslash opts -> + return $ "\\(" <> text str <> "\\)" + | isEnabled Ext_tex_math_double_backslash opts -> + return $ "\\\\(" <> text str <> "\\\\)" + | otherwise -> do + plain <- gets stPlain + inlineListToMarkdown opts $ + (if plain then makeMathPlainer else id) $ + texMathToInlines InlineMath str inlineToMarkdown opts (Math DisplayMath str) | isEnabled Ext_tex_math_dollars opts = return $ "$$" <> text str <> "$$" diff --git a/tests/rst-reader.native b/tests/rst-reader.native index 4752d76ff..d44fa5efb 100644 --- a/tests/rst-reader.native +++ b/tests/rst-reader.native @@ -211,6 +211,7 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa ,Para [Str "Minus:",Space,Str "-"] ,Header 1 ("links",[],[]) [Str "Links"] ,Para [Str "Explicit:",Space,Str "a",Space,Link ("",[],[]) [Str "URL"] ("/url/",""),Str "."] +,Para [Str "Explicit",Space,Str "with",Space,Str "no",Space,Str "label:",Space,Link ("",[],[]) [Str "foo"] ("foo",""),Str "."] ,Para [Str "Two",Space,Str "anonymous",Space,Str "links:",Space,Link ("",[],[]) [Str "the",Space,Str "first"] ("/url1/",""),Space,Str "and",Space,Link ("",[],[]) [Str "the",Space,Str "second"] ("/url2/","")] ,Para [Str "Reference",Space,Str "links:",Space,Link ("",[],[]) [Str "link1"] ("/url1/",""),Space,Str "and",Space,Link ("",[],[]) [Str "link2"] ("/url2/",""),Space,Str "and",Space,Link ("",[],[]) [Str "link1"] ("/url1/",""),Space,Str "again."] ,Para [Str "Here\8217s",Space,Str "a",Space,Link ("",[],[]) [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] ("http://example.com/?foo=1&bar=2",""),Str "."] diff --git a/tests/rst-reader.rst b/tests/rst-reader.rst index ff10abe24..450f2b939 100644 --- a/tests/rst-reader.rst +++ b/tests/rst-reader.rst @@ -378,6 +378,8 @@ Links Explicit: a `URL </url/>`_. +Explicit with no label: `<foo>`_. + Two anonymous links: `the first`__ and `the second`__ __ /url1/ diff --git a/windows/make-windows-installer.bat b/windows/make-windows-installer.bat index 2f0bf4b88..892a61cdc 100644 --- a/windows/make-windows-installer.bat +++ b/windows/make-windows-installer.bat @@ -2,7 +2,7 @@ stack install --test
if %errorlevel% neq 0 exit /b %errorlevel%
for /f "delims=" %%a in ('stack path --local-bin-path') do @set BINPATH=%%a
-%BINPATH%\pandoc.exe -s -S ..\README -o README.html
+%BINPATH%\pandoc.exe -s -S --toc ..\README -o README.html
if %errorlevel% neq 0 exit /b %errorlevel%
%BINPATH%\pandoc.exe -s ..\COPYING -t rtf -S -o COPYING.rtf
if %errorlevel% neq 0 exit /b %errorlevel%
diff --git a/windows/stack.yaml b/windows/stack.yaml index 21a603d90..15f203366 100644 --- a/windows/stack.yaml +++ b/windows/stack.yaml @@ -19,4 +19,5 @@ extra-deps: - 'data-default-instances-base-0.1.0' - 'preprocessor-tools-1.0.1' - 'pandoc-citeproc-0.10' +- 'texmath-0.8.6.4' resolver: lts-6.1 |