aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README5
-rw-r--r--appveyor.yml2
m---------data/templates27
-rw-r--r--src/Text/Pandoc.hs2
-rw-r--r--src/Text/Pandoc/Readers/RST.hs5
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs11
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs29
-rw-r--r--tests/rst-reader.native1
-rw-r--r--tests/rst-reader.rst2
-rw-r--r--windows/make-windows-installer.bat2
-rw-r--r--windows/stack.yaml1
11 files changed, 42 insertions, 45 deletions
diff --git a/README b/README
index ecbc248e0..b0fa386c8 100644
--- a/README
+++ b/README
@@ -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