diff --git a/README b/README --- a/README +++ b/README @@ -1,6 +1,6 @@ % Pandoc User's Guide % John MacFarlane -% June 4, 2016 +% July 17, 2016 Synopsis ======== @@ -13,18 +13,19 @@ Pandoc is a [Haskell] library for converting from one markup format to another, and a command-line tool that uses this library. It can read [Markdown], [CommonMark], [PHP Markdown Extra], [GitHub-Flavored Markdown], -and (subsets of) [Textile], [reStructuredText], [HTML], [LaTeX], [MediaWiki markup], [TWiki -markup], [Haddock markup], [OPML], [Emacs Org mode], [DocBook], -[txt2tags], [EPUB], [ODT] and [Word docx]; and it can write plain text, -[Markdown], [CommonMark], [PHP Markdown Extra], [GitHub-Flavored Markdown], -[reStructuredText], [XHTML], [HTML5], [LaTeX] (including -[`beamer`] slide shows), [ConTeXt], [RTF], [OPML], [DocBook], -[OpenDocument], [ODT], [Word docx], [GNU Texinfo], [MediaWiki markup], -[DokuWiki markup], [Haddock markup], [EPUB] (v2 or v3), -[FictionBook2], [Textile], [groff man] pages, [Emacs Org mode], -[AsciiDoc], [InDesign ICML], [TEI Simple], and [Slidy], [Slideous], [DZSlides], -[reveal.js] or [S5] HTML slide shows. It can also produce [PDF] output -on systems where LaTeX, ConTeXt, or `wkhtmltopdf` is installed. +[MultiMarkdown], and (subsets of) [Textile], [reStructuredText], [HTML], +[LaTeX], [MediaWiki markup], [TWiki markup], [Haddock markup], [OPML], [Emacs +Org mode], [DocBook], [txt2tags], [EPUB], [ODT] and [Word docx]; and it can +write plain text, [Markdown], [CommonMark], [PHP Markdown Extra], +[GitHub-Flavored Markdown], [MultiMarkdown], [reStructuredText], [XHTML], +[HTML5], [LaTeX] (including [`beamer`] slide shows), [ConTeXt], [RTF], [OPML], +[DocBook], [OpenDocument], [ODT], [Word docx], [GNU Texinfo], [MediaWiki +markup], [DokuWiki markup], [ZimWiki markup], [Haddock markup], +[EPUB] (v2 or v3), [FictionBook2], [Textile], [groff man] pages, +[Emacs Org mode], [AsciiDoc], [InDesign ICML], [TEI Simple], and [Slidy], +[Slideous], [DZSlides], [reveal.js] or [S5] HTML slide shows. It can also +produce [PDF] output on systems where LaTeX, ConTeXt, or `wkhtmltopdf` is +installed. Pandoc's enhanced version of Markdown includes syntax for [footnotes], [tables], flexible [ordered lists], [definition lists], [fenced code blocks], @@ -55,6 +56,7 @@ [CommonMark]: http://commonmark.org [PHP Markdown Extra]: https://michelf.ca/projects/php-markdown/extra/ [GitHub-Flavored Markdown]: https://help.github.com/articles/github-flavored-markdown/ +[MultiMarkdown]: http://fletcherpenney.net/multimarkdown/ [reStructuredText]: http://docutils.sourceforge.net/docs/ref/rst/introduction.html [S5]: http://meyerweb.com/eric/tools/s5/ [Slidy]: http://www.w3.org/Talks/Tools/Slidy/ @@ -76,6 +78,7 @@ [Textile]: http://redcloth.org/textile [MediaWiki markup]: https://www.mediawiki.org/wiki/Help:Formatting [DokuWiki markup]: https://www.dokuwiki.org/dokuwiki +[ZimWiki markup]: http://zim-wiki.org/manual/Help/Wiki_Syntax.html [TWiki markup]: http://twiki.org/cgi-bin/view/TWiki/TextFormattingRules [Haddock markup]: https://www.haskell.org/haddock/doc/html/ch03s08.html [groff man]: http://developer.apple.com/DOCUMENTATION/Darwin/Reference/ManPages/man7/groff_man.7.html @@ -242,8 +245,8 @@ : Specify input format. *FORMAT* can be `native` (native Haskell), `json` (JSON version of native AST), `markdown` (pandoc's extended Markdown), `markdown_strict` (original unextended - Markdown), `markdown_phpextra` (PHP Markdown Extra), - `markdown_github` (GitHub-Flavored Markdown), + Markdown), `markdown_phpextra` (PHP Markdown Extra), `markdown_github` + (GitHub-Flavored Markdown), `markdown_mmd` (MultiMarkdown), `commonmark` (CommonMark Markdown), `textile` (Textile), `rst` (reStructuredText), `html` (HTML), `docbook` (DocBook), `t2t` (txt2tags), `docx` (docx), `odt` (ODT), `epub` (EPUB), `opml` (OPML), @@ -267,12 +270,13 @@ `json` (JSON version of native AST), `plain` (plain text), `markdown` (pandoc's extended Markdown), `markdown_strict` (original unextended Markdown), `markdown_phpextra` (PHP Markdown - Extra), `markdown_github` (GitHub-Flavored - Markdown), `commonmark` (CommonMark Markdown), `rst` + Extra), `markdown_github` (GitHub-Flavored Markdown), `markdown_mmd` + (MultiMarkdown), `commonmark` (CommonMark Markdown), `rst` (reStructuredText), `html` (XHTML), `html5` (HTML5), `latex` (LaTeX), `beamer` (LaTeX beamer slide show), `context` (ConTeXt), - `man` (groff man), `mediawiki` (MediaWiki markup), `dokuwiki` - (DokuWiki markup), `textile` (Textile), `org` (Emacs Org mode), + `man` (groff man), `mediawiki` (MediaWiki markup), + `dokuwiki` (DokuWiki markup), `zimwiki` (ZimWiki markup), + `textile` (Textile), `org` (Emacs Org mode), `texinfo` (GNU Texinfo), `opml` (OPML), `docbook` (DocBook 4), `docbook5` (DocBook 5), `opendocument` (OpenDocument), `odt` (OpenOffice text document), `docx` (Word docx), `haddock` @@ -349,12 +353,12 @@ : Parse untranslatable HTML codes and LaTeX environments as raw HTML or LaTeX, instead of ignoring them. Affects only HTML and LaTeX - input. Raw HTML can be printed in Markdown, reStructuredText, HTML, - Slidy, Slideous, DZSlides, reveal.js, and S5 output; raw LaTeX - can be printed in Markdown, reStructuredText, LaTeX, and ConTeXt output. - The default is for the readers to omit untranslatable HTML codes and - LaTeX environments. (The LaTeX reader does pass through untranslatable - LaTeX *commands*, even if `-R` is not specified.) + input. Raw HTML can be printed in Markdown, reStructuredText, Emacs Org + mode, HTML, Slidy, Slideous, DZSlides, reveal.js, and S5 output; raw LaTeX + can be printed in Markdown, reStructuredText, Emacs Org mode, LaTeX, and + ConTeXt output. The default is for the readers to omit untranslatable + HTML codes and LaTeX environments. (The LaTeX reader does pass through + untranslatable LaTeX *commands*, even if `-R` is not specified.) `-S`, `--smart` @@ -452,11 +456,13 @@ `--track-changes=accept`|`reject`|`all` -: Specifies what to do with insertions and deletions produced by the MS - Word "Track Changes" feature. `accept` (the default), inserts all - insertions, and ignores all deletions. `reject` inserts all - deletions and ignores insertions. `all` puts in both insertions - and deletions, wrapped in spans with `insertion` and `deletion` +: Specifies what to do with insertions, deletions, and comments + produced by the MS Word "Track Changes" feature. `accept` (the + default), inserts all insertions, and ignores all + deletions. `reject` inserts all deletions and ignores + insertions. Both `accept` and `reject` ignore comments. `all` puts + in insertions, deletions, and comments, wrapped in spans with + `insertion`, `deletion`, `comment-start`, and `comment-end` classes, respectively. The author and time of change is included. `all` is useful for scripting: only accepting changes from a certain reviewer, say, or before a certain date. This @@ -707,7 +713,7 @@ `none` leaves `mailto:` links as they are. `javascript` obfuscates them using javascript. `references` obfuscates them by printing their letters as decimal or hexadecimal character references. The default - is `javascript`. + is `none`. `--id-prefix=`*STRING* @@ -946,6 +952,8 @@ : 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*] @@ -1251,6 +1259,9 @@ `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 @@ -2638,7 +2649,7 @@ TeX math will be printed in all output formats. How it is rendered depends on the output format: -Markdown, LaTeX, Emacs Org mode, ConTeXt +Markdown, LaTeX, Emacs Org mode, ConTeXt, ZimWiki ~ It will appear verbatim between `$` characters. reStructuredText @@ -2738,8 +2749,8 @@ be disabled if desired.) The raw HTML is passed through unchanged in HTML, S5, Slidy, Slideous, -DZSlides, EPUB, Markdown, and Textile output, and suppressed in other -formats. +DZSlides, EPUB, Markdown, Emacs Org mode, and Textile output, and suppressed +in other formats. #### Extension: `markdown_in_html_blocks` #### @@ -2818,7 +2829,7 @@ LaTeX, not as Markdown. Inline LaTeX is ignored in output formats other than Markdown, LaTeX, -and ConTeXt. +Emacs Org mode, and ConTeXt. LaTeX macros ------------ @@ -3322,8 +3333,6 @@ See the MultiMarkdown documentation for details. If `pandoc_title_block` or `yaml_metadata_block` is enabled, it will take precedence over `mmd_title_block`. - -[MultiMarkdown]: http://fletcherpenney.net/multimarkdown/ #### Extension: `abbreviations` #### diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,261 @@ +pandoc (1.17.2) + + * Added Zim Wiki writer, template and tests. `zimwiki` is now + a valid output format. (Alex Ivkin) + + * Changed email-obfuscation default to no obfuscation (#2988). + + `writerEmailObfuscation` in `defaultWriterOptions` is now + `NoObfuscation`. + + the default for the command-line `--email-obfuscation` option is + now `none`. + + * Docbook writer: Declare xlink namespace in Docbook5 output (Ivo Clarysse). + + * Org writer: + + + Support arbitrary raw inlines (Albert Krewinkel). + Org mode allows arbitrary raw inlines ("export snippets" in Emacs + parlance) to be included as `@@format:raw foreign format text@@`. + + Improve Div handling (Albert Krewinkel). Div blocks handling is + changed to make the output look more like idiomatic org mode: + - Div-wrapped content is output as-is if the div's attribute is the + null attribute. + - Div containers with an id but neither classes nor key-value pairs + are unwrapped and the id is added as an anchor. + - Divs with classes associated with greater block elements are + wrapped in a `#+BEGIN`...`#+END` block. + - The old behavior for Divs with more complex attributes is kept. + + * HTML writer: Better support for raw LaTeX environments (#2758). + Previously we just passed all raw TeX through when MathJax + was used for HTML math. This passed through too much. + With this patch, only raw LaTeX environments that MathJax + can handle get passed through. + This patch also causes raw LaTeX environments to be treated + as math, when possible, with MathML and WebTeX output. + + * Markdown writer: use raw HTML for simple, pipe tables with linebreaks + (#2993). Markdown line breaks involve a newline, and simple and pipe + tables can't contain one. + + * Make --webtex work with the Markdown writer (#1177). + This is a convenient option for people using + websites whose Markdown flavors don't provide for math. + + * Docx writer: + + + Set paragraph to FirstPara after display math (Jesse Rosenthal). + We treat display math like block quotes, and apply FirstParagraph style + to paragraphs that follow them. These can be styled as the user + wishes. (But, when the user is using indentation, this allows for + paragraphs to continue after display math without indentation.) + + Use actual creation time as doc prop (Jesse Rosenthal). + Previously, we had used the user-supplied date, if available, for Word's + document creation metadata. This could lead to weird results, as in + cases where the user post-dates a document (so the modification might be + prior to the creation). Here we use the actual computer time to set the + document creation. + + * LaTeX writer: + + + Don't URI-escape image source (#2825). Usually this is a local file, + and replacing spaces with `%20` ruins things. + + Allow 'standout' as a beamer frame option (#3007). + `## Slide title {.standout}`. + + * RST reader: Fixed links with no explicit link text. The link + `` ``_ `` should have `foo` as both its link text and its URL. + See RST spec at + Closes Debian #828167 -- reported by Christian Heller. + + * Textile reader: + + + Fixed attributes (#2984). Attributes can't be followed by + a space. So, `_(class)emph_` but `_(noclass) emph_`. + + Fixed exponential parsing bug (#3020). + + Fix overly aggressive interpretation as images (#2998). + Spaces are not allowed in the image URL in textile. + + * LaTeX reader: + + + Fix `\cite` so it is a NormalCitation not AuthorInText. + + Strip off double quotes around image source if present (#2825). + Avoids interpreting these as part of the literal filename. + + * Org reader: + + + Add semicolon to list of special chars (Albert Krewinkel) + Semicolons are used as special characters in citations syntax. This + ensures the correct parsing of Pandoc-style citations: `[prefix; @key; + suffix]`. Previously, parsing would have failed unless there was a space + or other special character as the last character. + + Add support for "Berkeley-style" cites (Albert Krewinkel, #1978). + A specification for an official Org-mode citation syntax was drafted by + Richard Lawrence and enhanced with the help of others on the orgmode + mailing list. Basic support for this citation style is added to the + reader. + + Support arbitrary raw inlines (Albert Krewinkel). + Org mode allows arbitrary raw inlines ("export snippets" in Emacs + parlance) to be included as `@@format:raw foreign format text@@`. + + Remove partial functions (Albert Krewinkel, #2991). + Partial functions like `head` lead to avoidable errors and should be + avoided. They are replaced with total functions. + + Support figure labels (Albert Krewinkel, #2496, #2999). + Figure labels given as `#+LABEL: thelabel` are used as the ID of the + respective image. This allows e.g. the LaTeX to add proper `\label` + markup. + + Improve tag and properties type safety (Albert Krewinkel). + Specific newtype definitions are used to replace stringly typing of tags + and properties. Type safety is increased while readability is improved. + + Parse as headlines, convert to blocks (Albert Krewinkel). + Emacs org-mode is based on outline-mode, which treats documents as trees + with headlines are nodes. The reader is refactored to parse into a + similar tree structure. This simplifies transformations acting on + document (sub-)trees. + * Refactor comment tree handling (Albert Krewinkel). + Comment trees were handled after parsing, as pattern matching on lists + is easier than matching on sequences. The new method of reading + documents as trees allows for more elegant subtree removal. + * Support archived trees export options (Albert Krewinkel). + Handling of archived trees can be modified using the `arch` option. + Archived trees are either dropped, exported completely, or collapsed to + include just the header when the `arch` option is nil, non-nil, or + `headline`, respectively. + * Put export setting parser into module (Albert Krewinkel). + Export option parsing is distinct enough from general block parsing to + justify putting it into a separate module. + * Support headline levels export setting (Albert Krewinkel). + The depths of headlines can be modified using the `H` option. Deeper + headlines will be converted to lists. + * Replace ugly code with view pattern (Albert Krewinkel). + Some less-than-smart code required a pragma switching of overlapping + pattern warnings in order to compile seamlessly. Using view patterns + makes the code easier to read and also doesn't require overlapping + pattern checks to be disabled. + * Fix parsing of verbatim inlines (Albert Krewinkel, #3016). + Org rules for allowed characters before or after markup chars were not + checked for verbatim text. This resultet in wrong parsing outcomes of + if the verbatim text contained e.g. space enclosed markup characters as + part of the text (`=is_substr = True=`). Forcing the parser to update + the positions of allowed/forbidden markup border characters fixes this. + + * LaTeX template: fix for obscure hyperref/xelatex issue. + Here's a minimal case: + + \documentclass[]{article} + \usepackage{hyperref} + \begin{document} + \section{\%á} + \end{document} + + Without this change, this fails on the second invocation of xelatex. + This affects inputs this like `# %á` with pdf output via xelatex. + + * trypandoc: call results 'html' instead of 'result'. + This is for better compatibility with babelmark2. + + * Document MultiMarkdown as input/output format (Albert Krewinkel, #2973). + MultiMarkdown was only mentioned as a supported Markdown dialect but not + as a possible input or output format. A brief mention is added + everywhere the other supported markdown dialects are mentioned. + + * Document Org mode as a format containing raw HTML (Albert Krewinkel) + Raw HTML is kept when the output format is Emacs Org mode. + + * Implement `RawInline` and `RawBlock` in sample lua custom writer (#2985). + + * Text.Pandoc.Shared: + + + Introduce blocksToInlines function (Jesse Rosenthal). + This is a lossy function for converting `[Block] -> [Inline]`. Its main + use, at the moment, is for docx comments, which can contain arbitrary + blocks (except for footnotes), but which will be converted to spans. + This is, at the moment, pretty useless for everything but the basic + `Para` and `Plain` comments. It can be improved, but the docx reader + should probably emit a warning if the comment contains more than this. + + Add BlockQuote to blocksToInlines (Jesse Rosenthal). + + Add further formats for `normalizeDate` (Jesse Rosenthal). + We want to avoid illegal dates -- in particular years with greater than + four digits. We attempt to parse series of digits first as `%Y%m%d`, then + `%Y%m`, and finally `%Y`. + + `normalizeDate` should reject illegal years (Jesse Rosenthal). + We only allow years between 1601 and 9999, inclusive. The ISO 8601 + actually says that years are supposed to start with 1583, but MS Word + only allows 1601-9999. This should stop corrupted word files if the date + is out of that range, or is parsed incorrectly. + + Improve year sanity check in normalizeDate (Jesse Rosenthal). + Previously we parsed a list of dates, took the first one, and then + tested its year range. That meant that if the first one failed, we + returned nothing, regardless of what the others did. Now we test for + sanity before running `msum` over the list of Maybe values. Anything + failing the test will be Nothing, so will not be a candidate. + + * Docx reader: + + + Add simple comment functionality. (Jesse Rosenthal). + This adds simple track-changes comment parsing to the docx reader. It is + turned on with `--track-changes=all`. All comments are converted to + inlines, which can list some information. In the future a warning will be + added for comments with formatting that seems like it will be excessively + denatured. Note that comments can extend across blocks. For that reason + there are two spans: `comment-start` and `comment-end`. `comment-start` + will contain the comment. `comment-end` will always be empty. The two + will be associated by a numeric id. + + Enable warnings in top-level reader (Jesse Rosenthal). + Previously we had only allowed for warnings in the parser. Now we allow + for them in the `Docx.hs` as well. The warnings are simply concatenated. + + Add warning for advanced comment formatting. (Jesse Rosenthal). + We can't guarantee we'll convert every comment correctly, though we'll + do the best we can. This warns if the comment includes something other + than Para or Plain. + + Add tests for warnings. (Jesse Rosenthal). + + Add tests for comments (Jesse Rosenthal). + We test for comments, using all track-changes options. Note that we + should only output comments if `--track-changes=all`. We also test for + emitting warnings if there is complicated formatting. + + * README: update to include track-changes comments. (Jesse Rosenthal) + + * Improved Windows installer - don't ignore properties set on command-line. + See #2708. Needs testing to see if this resolves the issue. + Thanks to @nkalvi. + + * Process markdown extensions on command line in L->R order (#2995). + Previously they were processed, very unintuitively, in R->L + order, so that `markdown-tex_math_dollars+tex_math_dollars` + had `tex_math_dollars` disabled. + + * Added `secnumdepth` variable to LaTeX template (#2920). + + * Include table of contents in README.html in Windows package. + + * Writers: treat SoftBreak as space for stripping (Jesse Rosenthal) + In Writers.Shared, we strip leading and trailing spaces for display + math. Since SoftBreak's are treated as spaces, we should strip those + too. + + * beamer, latex templates: pass biblatexoptions directly in package load. + This allows runtime optinos to be used. Fixes jgm/pandoc-citeproc#201 + + * CPP workaround for deprecation of `parseUrl` in http-client. + + * Removed some redundant class constraints. + + * make_oxs_package.sh - use OSX env variable. + + * Added `winpkg` target to Makefile. This downloads the windows package + from appveyor and signs it using the key. + + * Document Org mode as a format containing raw TeX (Albert Krewinkel). + Raw TeX is kept verbatim when the output format is Emacs Org mode. + + * Support math with haddock-library >= 1.4. + + * Removed `-rtsopts` from library stanza. It has no effect, and Hackage + wouldn't accept the package. + + * Update library dependency versions. + pandoc (1.17.1) * New output format: `docbook5` (Ivo Clarysse). diff --git a/data/sample.lua b/data/sample.lua --- a/data/sample.lua +++ b/data/sample.lua @@ -170,6 +170,12 @@ return "" .. s .. "" end +function RawInline(format, str) + if format == "html" then + return str + end +end + function Cite(s, cs) local ids = {} for _,cit in ipairs(cs) do @@ -305,6 +311,12 @@ end add('= 1.10 Build-Type: Custom License: GPL @@ -21,11 +21,11 @@ Emacs Org-Mode, txt2tags, Word Docx, ODT, and Textile, and it can write Markdown, reStructuredText, XHTML, HTML 5, LaTeX, ConTeXt, DocBook, OPML, TEI, OpenDocument, ODT, - Word docx, RTF, MediaWiki, DokuWiki, Textile, groff man - pages, plain text, Emacs Org-Mode, AsciiDoc, Haddock markup, - EPUB (v2 and v3), FictionBook2, InDesign ICML, and several - kinds of HTML/javascript slide shows (S5, Slidy, Slideous, - DZSlides, reveal.js). + Word docx, RTF, MediaWiki, DokuWiki, ZimWiki, Textile, + groff man pages, plain text, Emacs Org-Mode, AsciiDoc, + Haddock markup, EPUB (v2 and v3), FictionBook2, InDesign ICML, + and several kinds of HTML/javascript slide shows (S5, Slidy, + Slideous, DZSlides, reveal.js). . In contrast to most existing tools for converting Markdown to HTML, pandoc has a modular design: it consists of a set of @@ -55,6 +55,7 @@ data/templates/default.plain data/templates/default.mediawiki data/templates/default.dokuwiki + data/templates/default.zimwiki data/templates/default.rtf data/templates/default.s5 data/templates/default.slidy @@ -148,6 +149,7 @@ tests/tables.docbook tests/tables.docbook5 tests/tables.dokuwiki + tests/tables.zimwiki tests/tables.icml tests/tables.html tests/tables.latex @@ -189,6 +191,7 @@ tests/writer.fb2 tests/writer.opml tests/writer.dokuwiki + tests/writer.zimwiki tests/writers-lang-and-dir.latex tests/writers-lang-and-dir.context tests/dokuwiki_inline_formatting.dokuwiki @@ -260,13 +263,13 @@ text >= 0.11 && < 1.3, zip-archive >= 0.2.3.4 && < 0.4, HTTP >= 4000.0.5 && < 4000.4, - texmath >= 0.8.6.2 && < 0.9, + texmath >= 0.8.6.4 && < 0.9, xml >= 1.3.12 && < 1.4, random >= 1 && < 1.2, extensible-exceptions >= 0.1 && < 0.2, pandoc-types >= 1.16 && < 1.17, aeson >= 0.7 && < 0.12, - tagsoup >= 0.13.7 && < 0.14, + tagsoup >= 0.13.7 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, highlighting-kate >= 0.6.2 && < 0.7, @@ -297,8 +300,8 @@ else Build-Depends: network >= 2 && < 2.6 if flag(https) - Build-Depends: http-client >= 0.3.2 && < 0.5, - http-client-tls >= 0.2 && < 0.3, + Build-Depends: http-client >= 0.5 && < 0.6, + http-client-tls >= 0.3 && < 0.4, http-types >= 0.8 && < 0.10 cpp-options: -DHTTP_CLIENT if flag(embed_data_files) @@ -363,6 +366,7 @@ Text.Pandoc.Writers.Textile, Text.Pandoc.Writers.MediaWiki, Text.Pandoc.Writers.DokuWiki, + Text.Pandoc.Writers.ZimWiki, Text.Pandoc.Writers.RTF, Text.Pandoc.Writers.ODT, Text.Pandoc.Writers.Docx, @@ -395,6 +399,7 @@ Text.Pandoc.Readers.Odt.Arrows.Utils, Text.Pandoc.Readers.Org.BlockStarts, Text.Pandoc.Readers.Org.Blocks, + Text.Pandoc.Readers.Org.ExportSettings, Text.Pandoc.Readers.Org.Inlines, Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, @@ -487,7 +492,7 @@ test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4, - QuickCheck >= 2.4 && < 2.9, + QuickCheck >= 2.4 && < 2.10, HUnit >= 1.2 && < 1.4, containers >= 0.1 && < 0.6, ansi-terminal >= 0.5 && < 0.7, diff --git a/pandoc.hs b/pandoc.hs --- a/pandoc.hs +++ b/pandoc.hs @@ -263,7 +263,7 @@ , optWrapText = WrapAuto , optColumns = 72 , optFilters = [] - , optEmailObfuscation = JavascriptObfuscation + , optEmailObfuscation = NoObfuscation , optIdentifierPrefix = "" , optIndentedCodeClasses = [] , optDataDir = Nothing diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -104,6 +104,7 @@ , writeMan , writeMediaWiki , writeDokuWiki + , writeZimWiki , writeTextile , writeRTF , writeODT @@ -164,6 +165,7 @@ import Text.Pandoc.Writers.RTF import Text.Pandoc.Writers.MediaWiki import Text.Pandoc.Writers.DokuWiki +import Text.Pandoc.Writers.ZimWiki import Text.Pandoc.Writers.Textile import Text.Pandoc.Writers.Org import Text.Pandoc.Writers.AsciiDoc @@ -191,7 +193,7 @@ 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 "-+" @@ -310,6 +312,7 @@ ,("rst" , PureStringWriter writeRST) ,("mediawiki" , PureStringWriter writeMediaWiki) ,("dokuwiki" , PureStringWriter writeDokuWiki) + ,("zimwiki" , PureStringWriter writeZimWiki) ,("textile" , PureStringWriter writeTextile) ,("rtf" , IOStringWriter writeRTFWithEmbeddedImages) ,("org" , PureStringWriter writeOrg) diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -399,7 +399,7 @@ , writerDpi = 96 , writerWrapText = WrapAuto , writerColumns = 72 - , writerEmailObfuscation = JavascriptObfuscation + , writerEmailObfuscation = NoObfuscation , writerIdentifierPrefix = "" , writerSourceURL = Nothing , writerUserDataDir = Nothing diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -865,13 +865,13 @@ --- -- | Removes the ParsecT layer from the monad transformer stack -readWithM :: (Monad m, Functor m) +readWithM :: (Monad m) => ParserT [Char] st m a -- ^ parser -> st -- ^ initial state -> String -- ^ input -> m (Either PandocError a) readWithM parser state input = - mapLeft (ParsecError input) <$> runParserT parser state "source" input + mapLeft (ParsecError input) `liftM` runParserT parser state "source" input -- | Parse a string with a given parser and state @@ -891,7 +891,7 @@ return (doc, warnings) -- | Parse a string with @parser@ (for testing). -testStringWith :: (Show a, Stream [Char] Identity Char) +testStringWith :: (Show a) => ParserT [Char] ParserState Identity a -> [Char] -> IO () @@ -1267,7 +1267,7 @@ stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) : stateWarnings st } infixr 5 <+?> -(<+?>) :: (Monoid a, Monad m) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a +(<+?>) :: (Monoid a) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>) extractIdClass :: Attr -> Attr diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -208,8 +208,7 @@ go (Prefixed s d' : xs) = Prefixed s (chomp d') : xs go xs = xs -outp :: (IsString a, Monoid a) - => Int -> String -> DocState a +outp :: (IsString a) => Int -> String -> DocState a outp off s | off < 0 = do -- offset < 0 means newline characters st' <- get let rawpref = prefix st' @@ -234,8 +233,7 @@ -- | Renders a 'Doc'. @render (Just n)@ will use -- a line length of @n@ to reflow text on breakable spaces. -- @render Nothing@ will not reflow text. -render :: (Monoid a, IsString a) - => Maybe Int -> Doc -> a +render :: (IsString a) => Maybe Int -> Doc -> a render linelen doc = fromString . mconcat . reverse . output $ execState (renderDoc doc) startingState where startingState = RenderState{ diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -102,9 +102,9 @@ -> Either PandocError (Pandoc, MediaBag, [String]) readDocxWithWarnings opts bytes | Right archive <- toArchiveOrFail bytes - , Right (docx, warnings) <- archiveToDocxWithWarnings archive = do - (meta, blks, mediaBag) <- docxToOutput opts docx - return (Pandoc meta blks, mediaBag, warnings) + , Right (docx, parserWarnings) <- archiveToDocxWithWarnings archive = do + (meta, blks, mediaBag, warnings) <- docxToOutput opts docx + return (Pandoc meta blks, mediaBag, parserWarnings ++ warnings) readDocxWithWarnings _ _ = Left (ParseFailure "couldn't parse docx file") @@ -118,12 +118,14 @@ data DState = DState { docxAnchorMap :: M.Map String String , docxMediaBag :: MediaBag , docxDropCap :: Inlines + , docxWarnings :: [String] } instance Default DState where def = DState { docxAnchorMap = M.empty , docxMediaBag = mempty , docxDropCap = mempty + , docxWarnings = [] } data DEnv = DEnv { docxOptions :: ReaderOptions @@ -137,6 +139,11 @@ evalDocxContext :: DocxContext a -> DEnv -> DState -> Either PandocError a evalDocxContext ctx env st = flip evalState st . flip runReaderT env . runExceptT $ ctx +addDocxWarning :: String -> DocxContext () +addDocxWarning msg = do + warnings <- gets docxWarnings + modify $ \s -> s {docxWarnings = msg : warnings} + -- This is empty, but we put it in for future-proofing. spansToKeep :: [String] spansToKeep = [] @@ -319,6 +326,17 @@ showDim d = show (d / 914400) ++ "in" extentToAttr _ = nullAttr +blocksToInlinesWarn :: String -> Blocks -> DocxContext Inlines +blocksToInlinesWarn cmtId blks = do + let blkList = toList blks + notParaOrPlain :: Block -> Bool + notParaOrPlain (Para _) = False + notParaOrPlain (Plain _) = False + notParaOrPlain _ = True + when (not $ null $ filter notParaOrPlain blkList) + (addDocxWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting") + return $ fromList $ blocksToInlines blkList + parPartToInlines :: ParPart -> DocxContext Inlines parPartToInlines (PlainRun r) = runToInlines r parPartToInlines (Insertion _ author date runs) = do @@ -339,6 +357,22 @@ ils <- smushInlines <$> mapM runToInlines runs let attr = ("", ["deletion"], [("author", author), ("date", date)]) return $ spanWith attr ils +parPartToInlines (CommentStart cmtId author date bodyParts) = do + opts <- asks docxOptions + case readerTrackChanges opts of + AllChanges -> do + blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts + ils <- blocksToInlinesWarn cmtId blks + let attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)]) + return $ spanWith attr ils + _ -> return mempty +parPartToInlines (CommentEnd cmtId) = do + opts <- asks docxOptions + case readerTrackChanges opts of + AllChanges -> do + let attr = ("", ["comment-end"], [("id", cmtId)]) + return $ spanWith attr mempty + _ -> return mempty parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors = return mempty parPartToInlines (BookMark _ anchor) = @@ -565,18 +599,20 @@ rewriteLinks :: [Block] -> DocxContext [Block] rewriteLinks = mapM (walkM rewriteLink') -bodyToOutput :: Body -> DocxContext (Meta, [Block], MediaBag) +bodyToOutput :: Body -> DocxContext (Meta, [Block], MediaBag, [String]) bodyToOutput (Body bps) = do let (metabps, blkbps) = sepBodyParts bps meta <- bodyPartsToMeta metabps blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks mediaBag <- gets docxMediaBag + warnings <- gets docxWarnings return $ (meta, blks', - mediaBag) + mediaBag, + warnings) -docxToOutput :: ReaderOptions -> Docx -> Either PandocError (Meta, [Block], MediaBag) +docxToOutput :: ReaderOptions -> Docx -> Either PandocError (Meta, [Block], MediaBag, [String]) docxToOutput opts (Docx (Document _ body)) = let dEnv = def { docxOptions = opts} in evalDocxContext (bodyToOutput body) dEnv def diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -73,6 +73,7 @@ import Data.Char (readLitChar, ord, chr, isDigit) data ReaderEnv = ReaderEnv { envNotes :: Notes + , envComments :: Comments , envNumbering :: Numbering , envRelationships :: [Relationship] , envMedia :: Media @@ -160,6 +161,9 @@ (Maybe (M.Map String Element)) deriving Show +data Comments = Comments NameSpaces (M.Map String Element) + deriving Show + data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer , rightParIndent :: Maybe Integer , hangingParIndent :: Maybe Integer} @@ -210,6 +214,8 @@ data ParPart = PlainRun Run | Insertion ChangeId Author ChangeDate [Run] | Deletion ChangeId Author ChangeDate [Run] + | CommentStart CommentId Author CommentDate [BodyPart] + | CommentEnd CommentId | BookMark BookMarkId Anchor | InternalHyperLink Anchor [Run] | ExternalHyperLink URL [Run] @@ -259,8 +265,10 @@ type BookMarkId = String type RelId = String type ChangeId = String +type CommentId = String type Author = String type ChangeDate = String +type CommentDate = String archiveToDocx :: Archive -> Either DocxError Docx archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive @@ -268,12 +276,13 @@ archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [String]) archiveToDocxWithWarnings archive = do let notes = archiveToNotes archive + comments = archiveToComments archive numbering = archiveToNumbering archive rels = archiveToRelationships archive media = archiveToMedia archive (styles, parstyles) = archiveToStyles archive rEnv = - ReaderEnv notes numbering rels media Nothing styles parstyles InDocument + ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument rState = ReaderState { stateWarnings = [] } (eitherDoc, st) = runD (archiveToDocument archive) rEnv rState case eitherDoc of @@ -384,6 +393,20 @@ in Notes ns fn en +archiveToComments :: Archive -> Comments +archiveToComments zf = + let cmtsElem = findEntryByPath "word/comments.xml" zf + >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry) + cmts_namespaces = case cmtsElem of + Just e -> elemToNameSpaces e + Nothing -> [] + cmts = (elemToComments cmts_namespaces) <$> cmtsElem + in + case cmts of + Just c -> Comments cmts_namespaces c + Nothing -> Comments cmts_namespaces M.empty + + filePathToRelType :: FilePath -> Maybe DocumentLocation filePathToRelType "word/_rels/document.xml.rels" = Just InDocument filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote @@ -504,6 +527,18 @@ Just $ M.fromList $ pairs elemToNotes _ _ _ = Nothing +elemToComments :: NameSpaces -> Element -> M.Map String Element +elemToComments ns element + | isElem ns "w" "comments" element = + let pairs = mapMaybe + (\e -> findAttr (elemName ns "w" "id") e >>= + (\a -> Just (a, e))) + (findChildren (elemName ns "w" "comment") element) + in + M.fromList $ pairs +elemToComments _ _ = M.empty + + --------------------------------------------- --------------------------------------------- @@ -697,9 +732,30 @@ runs <- mapD (elemToRun ns) (elChildren element) return $ InternalHyperLink anchor runs elemToParPart ns element + | isElem ns "w" "commentRangeStart" element + , Just cmtId <- findAttr (elemName ns "w" "id") element = do + (Comments _ commentMap) <- asks envComments + case M.lookup cmtId commentMap of + Just cmtElem -> elemToCommentStart ns cmtElem + Nothing -> throwError WrongElem +elemToParPart ns element + | isElem ns "w" "commentRangeEnd" element + , Just cmtId <- findAttr (elemName ns "w" "id") element = + return $ CommentEnd cmtId +elemToParPart ns element | isElem ns "m" "oMath" element = (eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath) elemToParPart _ _ = throwError WrongElem + +elemToCommentStart :: NameSpaces -> Element -> D ParPart +elemToCommentStart ns element + | isElem ns "w" "comment" element + , Just cmtId <- findAttr (elemName ns "w" "id") element + , Just cmtAuthor <- findAttr (elemName ns "w" "author") element + , Just cmtDate <- findAttr (elemName ns "w" "date") element = do + bps <- mapD (elemToBodyPart ns) (elChildren element) + return $ CommentStart cmtId cmtAuthor cmtDate bps +elemToCommentStart _ _ = throwError WrongElem lookupFootnote :: String -> Notes -> Maybe Element lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s) diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -60,6 +60,10 @@ DocEmphasis _ -> inlineFallback DocMonospaced _ -> inlineFallback DocBold _ -> inlineFallback +#if MIN_VERSION_haddock_library(1,4,0) + DocMathInline _ -> inlineFallback + DocMathDisplay _ -> inlineFallback +#endif DocHeader h -> B.header (headerLevel h) (docHToInlines False $ headerTitle h) DocUnorderedList items -> B.bulletList (map docHToBlocks items) @@ -107,6 +111,10 @@ DocMonospaced (DocString s) -> B.code s DocMonospaced d -> docHToInlines True d DocBold d -> B.strong (docHToInlines isCode d) +#if MIN_VERSION_haddock_library(1,4,0) + DocMathInline s -> B.math s + DocMathDisplay s -> B.displayMath s +#endif DocHeader _ -> mempty DocUnorderedList _ -> mempty DocOrderedList _ -> mempty diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -556,11 +556,11 @@ tok >>= \lab -> pure (link url "" lab)) , ("includegraphics", do options <- option [] keyvals - src <- unescapeURL <$> braced + src <- unescapeURL . removeDoubleQuotes <$> braced mkImage options src) , ("enquote", enquote) - , ("cite", citation "cite" AuthorInText False) - , ("Cite", citation "cite" AuthorInText False) + , ("cite", citation "cite" NormalCitation False) + , ("Cite", citation "Cite" NormalCitation False) , ("citep", citation "citep" NormalCitation False) , ("citep*", citation "citep*" NormalCitation False) , ("citeal", citation "citeal" NormalCitation False) @@ -1396,3 +1396,10 @@ co <- braced setPosition $ newPos fn (fromMaybe 1 $ safeRead ln) (fromMaybe 1 $ safeRead co) return mempty + +removeDoubleQuotes :: String -> String +removeDoubleQuotes ('"':xs) = + case reverse xs of + '"':ys -> reverse ys + _ -> '"':xs +removeDoubleQuotes xs = xs diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -383,70 +383,70 @@ -- | Execute the second arrow if the first succeeds -(>>?) :: (ArrowChoice a, Monoid failure) +(>>?) :: (ArrowChoice a) => FallibleArrow a x failure success -> FallibleArrow a success failure success' -> FallibleArrow a x failure success' a >>? b = a >>> Left ^||| b -- | Execute the lifted second arrow if the first succeeds -(>>?^) :: (ArrowChoice a, Monoid failure) +(>>?^) :: (ArrowChoice a) => FallibleArrow a x failure success -> (success -> success') -> FallibleArrow a x failure success' a >>?^ f = a >>^ Left ^|||^ Right . f -- | Execute the lifted second arrow if the first succeeds -(>>?^?) :: (ArrowChoice a, Monoid failure) +(>>?^?) :: (ArrowChoice a) => FallibleArrow a x failure success -> (success -> Either failure success') -> FallibleArrow a x failure success' a >>?^? b = a >>> Left ^|||^ b -- | Execute the second arrow if the lifted first arrow succeeds -(^>>?) :: (ArrowChoice a, Monoid failure) +(^>>?) :: (ArrowChoice a) => (x -> Either failure success) -> FallibleArrow a success failure success' -> FallibleArrow a x failure success' a ^>>? b = a ^>> Left ^||| b -- | Execute the lifted second arrow if the lifted first arrow succeeds -(^>>?^) :: (ArrowChoice a, Monoid failure) +(^>>?^) :: (ArrowChoice a) => (x -> Either failure success) -> (success -> success') -> FallibleArrow a x failure success' a ^>>?^ f = arr $ a >>> right f -- | Execute the lifted second arrow if the lifted first arrow succeeds -(^>>?^?) :: (ArrowChoice a, Monoid failure) +(^>>?^?) :: (ArrowChoice a) => (x -> Either failure success) -> (success -> Either failure success') -> FallibleArrow a x failure success' a ^>>?^? f = a ^>> Left ^|||^ f -- | Execute the second, non-fallible arrow if the first arrow succeeds -(>>?!) :: (ArrowChoice a, Monoid failure) +(>>?!) :: (ArrowChoice a) => FallibleArrow a x failure success -> a success success' -> FallibleArrow a x failure success' a >>?! f = a >>> right f --- -(>>?%) :: (ArrowChoice a, Monoid f) +(>>?%) :: (ArrowChoice a) => FallibleArrow a x f (b,b') -> (b -> b' -> c) -> FallibleArrow a x f c a >>?% f = a >>?^ (uncurry f) --- -(^>>?%) :: (ArrowChoice a, Monoid f) +(^>>?%) :: (ArrowChoice a) => (x -> Either f (b,b')) -> (b -> b' -> c) -> FallibleArrow a x f c a ^>>?% f = arr a >>?^ (uncurry f) --- -(>>?%?) :: (ArrowChoice a, Monoid f) +(>>?%?) :: (ArrowChoice a) => FallibleArrow a x f (b,b') -> (b -> b' -> (Either f c)) -> FallibleArrow a x f c diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -52,41 +52,4 @@ parseOrg = do blocks' <- blockList meta' <- meta - return . Pandoc meta' $ removeUnwantedBlocks blocks' - where - removeUnwantedBlocks :: [Block] -> [Block] - removeUnwantedBlocks = dropCommentTrees . filter (/= Null) - --- | Drop COMMENT headers and the document tree below those headers. -dropCommentTrees :: [Block] -> [Block] -dropCommentTrees [] = [] -dropCommentTrees (b:bs) = - maybe (b:dropCommentTrees bs) - (dropCommentTrees . flip dropUntilHeaderAboveLevel bs) - (commentHeaderLevel b) - --- | Return the level of a header starting a comment or :noexport: tree and --- Nothing otherwise. -commentHeaderLevel :: Block -> Maybe Int -commentHeaderLevel blk = - case blk of - (Header level _ ((Str "COMMENT"):_)) -> Just level - (Header level _ title) | hasNoExportTag title -> Just level - _ -> Nothing - where - hasNoExportTag :: [Inline] -> Bool - hasNoExportTag = any isNoExportTag - - isNoExportTag :: Inline -> Bool - isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True - isNoExportTag _ = False - --- | Drop blocks until a header on or above the given level is seen -dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block] -dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n) - -isHeaderLevelLowerEq :: Int -> Block -> Bool -isHeaderLevelLowerEq n blk = - case blk of - (Header level _ _) -> n >= level - _ -> False + return $ Pandoc meta' blocks' diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} {- Copyright (C) 2014-2016 Albert Krewinkel @@ -32,6 +34,7 @@ ) where import Text.Pandoc.Readers.Org.BlockStarts +import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings ) import Text.Pandoc.Readers.Org.Inlines import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing @@ -46,24 +49,185 @@ import Text.Pandoc.Options import Text.Pandoc.Shared ( compactify', compactify'DL ) -import Control.Monad ( foldM, guard, mzero ) +import Control.Monad ( foldM, guard, mzero, void ) import Data.Char ( isSpace, toLower, toUpper) import Data.List ( foldl', intersperse, isPrefixOf ) import qualified Data.Map as M import Data.Maybe ( fromMaybe, isNothing ) import Network.HTTP ( urlEncode ) +-- +-- Org headers +-- +newtype Tag = Tag { fromTag :: String } + deriving (Show, Eq) +-- | Create a tag containing the given string. +toTag :: String -> Tag +toTag = Tag + +-- | The key (also called name or type) of a property. +newtype PropertyKey = PropertyKey { fromKey :: String } + deriving (Show, Eq, Ord) + +-- | Create a property key containing the given string. Org mode keys are +-- case insensitive and are hence converted to lower case. +toPropertyKey :: String -> PropertyKey +toPropertyKey = PropertyKey . map toLower + +-- | The value assigned to a property. +newtype PropertyValue = PropertyValue { fromValue :: String } + +-- | Create a property value containing the given string. +toPropertyValue :: String -> PropertyValue +toPropertyValue = PropertyValue + +-- | Key/value pairs from a PROPERTIES drawer +type Properties = [(PropertyKey, PropertyValue)] + +-- | Org mode headline (i.e. a document subtree). +data Headline = Headline + { headlineLevel :: Int + , headlineText :: Inlines + , headlineTags :: [Tag] + , headlineProperties :: Properties + , headlineContents :: Blocks + , headlineChildren :: [Headline] + } + -- +-- Parsing headlines and subtrees +-- + +-- | Read an Org mode headline and its contents (i.e. a document subtree). +-- @lvl@ gives the minimum acceptable level of the tree. +headline :: Int -> OrgParser (F Headline) +headline lvl = try $ do + level <- headerStart + guard (lvl <= level) + title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle + tags <- option [] headerTags + newline + properties <- option mempty propertiesDrawer + contents <- blocks + children <- many (headline (level + 1)) + return $ do + title' <- title + contents' <- contents + children' <- sequence children + return $ Headline + { headlineLevel = level + , headlineText = title' + , headlineTags = tags + , headlineProperties = properties + , headlineContents = contents' + , headlineChildren = children' + } + where + endOfTitle :: OrgParser () + endOfTitle = void . lookAhead $ optional headerTags *> newline + + headerTags :: OrgParser [Tag] + headerTags = try $ + let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':' + in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces) + +-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks +headlineToBlocks :: Headline -> OrgParser Blocks +headlineToBlocks hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels + case () of + _ | any isNoExportTag headlineTags -> return mempty + _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln + _ | isCommentTitle headlineText -> return mempty + _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln + _ | otherwise -> headlineToHeaderWithContents hdln + +isNoExportTag :: Tag -> Bool +isNoExportTag = (== toTag "noexport") + +isArchiveTag :: Tag -> Bool +isArchiveTag = (== toTag "ARCHIVE") + +-- | Check if the title starts with COMMENT. +-- FIXME: This accesses builder internals not intended for use in situations +-- like these. Replace once keyword parsing is supported. +isCommentTitle :: Inlines -> Bool +isCommentTitle (B.toList -> (Str "COMMENT":_)) = True +isCommentTitle _ = False + +archivedHeadlineToBlocks :: Headline -> OrgParser Blocks +archivedHeadlineToBlocks hdln = do + archivedTreesOption <- getExportSetting exportArchivedTrees + case archivedTreesOption of + ArchivedTreesNoExport -> return mempty + ArchivedTreesExport -> headlineToHeaderWithContents hdln + ArchivedTreesHeadlineOnly -> headlineToHeader hdln + +headlineToHeaderWithList :: Headline -> OrgParser Blocks +headlineToHeaderWithList hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels + header <- headlineToHeader hdln + listElements <- sequence (map headlineToBlocks headlineChildren) + let listBlock = if null listElements + then mempty + else B.orderedList listElements + let headerText = if maxHeadlineLevels == headlineLevel + then header + else flattenHeader header + return $ headerText <> headlineContents <> listBlock + where + flattenHeader :: Blocks -> Blocks + flattenHeader blks = + case B.toList blks of + (Header _ _ inlns:_) -> B.para (B.fromList inlns) + _ -> mempty + +headlineToHeaderWithContents :: Headline -> OrgParser Blocks +headlineToHeaderWithContents hdln@(Headline {..}) = do + header <- headlineToHeader hdln + childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren) + return $ header <> headlineContents <> childrenBlocks + +headlineToHeader :: Headline -> OrgParser Blocks +headlineToHeader (Headline {..}) = do + let text = tagTitle headlineText headlineTags + let propAttr = propertiesToAttr headlineProperties + attr <- registerHeader propAttr headlineText + return $ B.headerWith attr headlineLevel text + +propertiesToAttr :: Properties -> Attr +propertiesToAttr properties = + let + toStringPair prop = (fromKey (fst prop), fromValue (snd prop)) + customIdKey = toPropertyKey "custom_id" + classKey = toPropertyKey "class" + id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties + cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties + kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst) + $ properties + in + (id', words cls, kvs') + +tagTitle :: Inlines -> [Tag] -> Inlines +tagTitle title tags = title <> (mconcat $ map tagToInline tags) + +tagToInline :: Tag -> Inlines +tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty + + +-- -- parsing blocks -- -- | Get a list of blocks. blockList :: OrgParser [Block] blockList = do - blocks' <- blocks - st <- getState - return . B.toList $ runF blocks' st + initialBlocks <- blocks + headlines <- sequence <$> manyTill (headline 1) eof + st <- getState + headlineBlocks <- fmap mconcat . sequence . map headlineToBlocks $ runF headlines st + return . B.toList $ (runF initialBlocks st) <> headlineBlocks -- | Get the meta information safed in the state. meta :: OrgParser Meta @@ -72,7 +236,7 @@ return $ runF (orgStateMeta st) st blocks :: OrgParser (F Blocks) -blocks = mconcat <$> manyTill block eof +blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof) block :: OrgParser (F Blocks) block = choice [ mempty <$ blanklines @@ -82,7 +246,6 @@ , example , genericDrawer , specialLine - , header , horizontalRule , list , latexFragment @@ -98,6 +261,7 @@ -- | Attributes that may be added to figures (like a name or caption). data BlockAttributes = BlockAttributes { blockAttrName :: Maybe String + , blockAttrLabel :: Maybe String , blockAttrCaption :: Maybe (F Inlines) , blockAttrKeyValues :: [(String, String)] } @@ -117,12 +281,14 @@ let caption = foldl' (appendValues "CAPTION") Nothing kv let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv let name = lookup "NAME" kv + let label = lookup "LABEL" kv caption' <- maybe (return Nothing) (fmap Just . parseFromString inlines) caption kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs return $ BlockAttributes { blockAttrName = name + , blockAttrLabel = label , blockAttrCaption = caption' , blockAttrKeyValues = kvAttrs' } @@ -131,6 +297,7 @@ attrCheck attr = case attr of "NAME" -> True + "LABEL" -> True "CAPTION" -> True "ATTR_HTML" -> True _ -> False @@ -219,7 +386,7 @@ stripIndent strs = map (drop (shortestIndent strs)) strs shortestIndent :: [String] -> Int - shortestIndent = minimum + shortestIndent = foldr min maxBound . map (length . takeWhile isSpace) . filter (not . null) @@ -377,30 +544,22 @@ -- | Read a :PROPERTIES: drawer and return the key/value pairs contained -- within. -propertiesDrawer :: OrgParser [(String, String)] +propertiesDrawer :: OrgParser Properties propertiesDrawer = try $ do drawerType <- drawerStart guard $ map toUpper drawerType == "PROPERTIES" manyTill property (try drawerEnd) where - property :: OrgParser (String, String) + property :: OrgParser (PropertyKey, PropertyValue) property = try $ (,) <$> key <*> value - key :: OrgParser String - key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':') - - value :: OrgParser String - value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline) + key :: OrgParser PropertyKey + key = fmap toPropertyKey . try $ + skipSpaces *> char ':' *> many1Till nonspaceChar (char ':') -keyValuesToAttr :: [(String, String)] -> Attr -keyValuesToAttr kvs = - let - lowerKvs = map (\(k, v) -> (map toLower k, v)) kvs - id' = fromMaybe mempty . lookup "custom_id" $ lowerKvs - cls = fromMaybe mempty . lookup "class" $ lowerKvs - kvs' = filter (flip notElem ["custom_id", "class"] . fst) lowerKvs - in - (id', words cls, kvs') + value :: OrgParser PropertyValue + value = fmap toPropertyValue . try $ + skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline) -- @@ -415,9 +574,10 @@ guard . not . isNothing . blockAttrCaption $ figAttrs guard (isImageFilename src) let figName = fromMaybe mempty $ blockAttrName figAttrs + let figLabel = fromMaybe mempty $ blockAttrLabel figAttrs let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs let figKeyVals = blockAttrKeyValues figAttrs - let attr = (mempty, mempty, figKeyVals) + let attr = (figLabel, mempty, figKeyVals) return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption) where withFigPrefix :: String -> String @@ -481,7 +641,7 @@ key <- metaKey case key of "link" -> parseLinkFormat >>= uncurry addLinkFormat - "options" -> () <$ sepBy spaces exportSetting + "options" -> exportSettings _ -> mzero addLinkFormat :: String @@ -491,100 +651,6 @@ let fs = orgStateLinkFormatters s in s{ orgStateLinkFormatters = M.insert key formatter fs } - --- --- Export Settings --- - --- | Read and process org-mode specific export options. -exportSetting :: OrgParser () -exportSetting = choice - [ booleanSetting "^" setExportSubSuperscripts - , booleanSetting "'" setExportSmartQuotes - , booleanSetting "*" setExportEmphasizedText - , booleanSetting "-" setExportSpecialStrings - , ignoredSetting ":" - , ignoredSetting "<" - , ignoredSetting "\\n" - , ignoredSetting "arch" - , ignoredSetting "author" - , ignoredSetting "c" - , ignoredSetting "creator" - , complementableListSetting "d" setExportDrawers - , ignoredSetting "date" - , ignoredSetting "e" - , ignoredSetting "email" - , ignoredSetting "f" - , ignoredSetting "H" - , ignoredSetting "inline" - , ignoredSetting "num" - , ignoredSetting "p" - , ignoredSetting "pri" - , ignoredSetting "prop" - , ignoredSetting "stat" - , ignoredSetting "tags" - , ignoredSetting "tasks" - , ignoredSetting "tex" - , ignoredSetting "timestamp" - , ignoredSetting "title" - , ignoredSetting "toc" - , ignoredSetting "todo" - , ignoredSetting "|" - ] "export setting" - -booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () -booleanSetting settingIdentifier setter = try $ do - string settingIdentifier - char ':' - value <- elispBoolean - updateState $ modifyExportSettings setter value - --- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are --- interpreted as true. -elispBoolean :: OrgParser Bool -elispBoolean = try $ do - value <- many1 nonspaceChar - return $ case map toLower value of - "nil" -> False - "{}" -> False - "()" -> False - _ -> True - --- | A list or a complement list (i.e. a list starting with `not`). -complementableListSetting :: String - -> ExportSettingSetter (Either [String] [String]) - -> OrgParser () -complementableListSetting settingIdentifier setter = try $ do - _ <- string settingIdentifier <* char ':' - value <- choice [ Left <$> complementStringList - , Right <$> stringList - , (\b -> if b then Left [] else Right []) <$> elispBoolean - ] - updateState $ modifyExportSettings setter value - where - -- Read a plain list of strings. - stringList :: OrgParser [String] - stringList = try $ - char '(' - *> sepBy elispString spaces - <* char ')' - - -- Read an emacs lisp list specifying a complement set. - complementStringList :: OrgParser [String] - complementStringList = try $ - string "(not " - *> sepBy elispString spaces - <* char ')' - - elispString :: OrgParser String - elispString = try $ - char '"' - *> manyTill alphaNum (char '"') - -ignoredSetting :: String -> OrgParser () -ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar) - - parseLinkFormat :: OrgParser ((String, String -> String)) parseLinkFormat = try $ do linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces @@ -607,37 +673,7 @@ rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r") tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:"")) --- --- Headers --- --- | Headers -header :: OrgParser (F Blocks) -header = try $ do - level <- headerStart - title <- manyTill inline (lookAhead $ optional headerTags <* newline) - tags <- option [] headerTags - newline - let text = tagTitle title tags - propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer) - attr <- registerHeader propAttr (runF text def) - return (B.headerWith attr level <$> text) - where - tagTitle :: [F Inlines] -> [String] -> F Inlines - tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags - - tagToInlineF :: String -> F Inlines - tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - - headerTags :: OrgParser [String] - headerTags = try $ - let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':' - in skipSpaces - *> char ':' - *> many1 tag - <* skipSpaces - - -- -- Tables -- @@ -727,7 +763,9 @@ where refRow = if heads /= mempty then heads - else if rows == mempty then mempty else head rows + else case rows of + (r:_) -> r + _ -> mempty cols = length refRow fillColumns base padding = take cols $ base ++ repeat padding aligns' = fillColumns aligns AlignDefault @@ -799,6 +837,8 @@ -- Paragraphs or Plain text paraOrPlain :: OrgParser (F Blocks) paraOrPlain = try $ do + -- Make sure we are not looking at a headline + notFollowedBy' (char '*' *> (oneOf " *")) ils <- inlines nl <- option False (newline *> return True) -- Read block as paragraph, except if we are in a list context and the block diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -0,0 +1,167 @@ +{- +Copyright (C) 2014-2016 Albert Krewinkel + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.Org.Options + Copyright : Copyright (C) 2016 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + +Parsers for Org-mode export options. +-} +module Text.Pandoc.Readers.Org.ExportSettings + ( exportSettings + ) where + +import Text.Pandoc.Readers.Org.ParserState +import Text.Pandoc.Readers.Org.Parsing + +import Control.Monad ( mzero, void ) +import Data.Char ( toLower ) +import Data.Maybe ( listToMaybe ) + +-- | Read and handle space separated org-mode export settings. +exportSettings :: OrgParser () +exportSettings = void $ sepBy spaces exportSetting + +-- | Setter function for export settings. +type ExportSettingSetter a = a -> ExportSettings -> ExportSettings + +-- | Read and process a single org-mode export option. +exportSetting :: OrgParser () +exportSetting = choice + [ booleanSetting "^" (\val es -> es { exportSubSuperscripts = val }) + , booleanSetting "'" (\val es -> es { exportSmartQuotes = val }) + , booleanSetting "*" (\val es -> es { exportEmphasizedText = val }) + , booleanSetting "-" (\val es -> es { exportSpecialStrings = val }) + , ignoredSetting ":" + , ignoredSetting "<" + , ignoredSetting "\\n" + , archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val }) + , ignoredSetting "author" + , ignoredSetting "c" + , ignoredSetting "creator" + , complementableListSetting "d" (\val es -> es { exportDrawers = val }) + , ignoredSetting "date" + , ignoredSetting "e" + , ignoredSetting "email" + , ignoredSetting "f" + , integerSetting "H" (\val es -> es { exportHeadlineLevels = val }) + , ignoredSetting "inline" + , ignoredSetting "num" + , ignoredSetting "p" + , ignoredSetting "pri" + , ignoredSetting "prop" + , ignoredSetting "stat" + , ignoredSetting "tags" + , ignoredSetting "tasks" + , ignoredSetting "tex" + , ignoredSetting "timestamp" + , ignoredSetting "title" + , ignoredSetting "toc" + , ignoredSetting "todo" + , ignoredSetting "|" + ] "export setting" + +genericExportSetting :: OrgParser a + -> String + -> ExportSettingSetter a + -> OrgParser () +genericExportSetting optionParser settingIdentifier setter = try $ do + _ <- string settingIdentifier *> char ':' + value <- optionParser + updateState $ modifyExportSettings value + where + modifyExportSettings val st = + st { orgStateExportSettings = setter val . orgStateExportSettings $ st } + +-- | A boolean option, either nil (False) or non-nil (True). +booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () +booleanSetting = genericExportSetting elispBoolean + +-- | An integer-valued option. +integerSetting :: String -> ExportSettingSetter Int -> OrgParser () +integerSetting = genericExportSetting parseInt + where + parseInt = try $ + many1 digit >>= maybe mzero (return . fst) . listToMaybe . reads + +-- | Either the string "headline" or an elisp boolean and treated as an +-- @ArchivedTreesOption@. +archivedTreeSetting :: String + -> ExportSettingSetter ArchivedTreesOption + -> OrgParser () +archivedTreeSetting = + genericExportSetting $ archivedTreesHeadlineSetting <|> archivedTreesBoolean + where + archivedTreesHeadlineSetting = try $ do + _ <- string "headline" + lookAhead (newline <|> spaceChar) + return ArchivedTreesHeadlineOnly + + archivedTreesBoolean = try $ do + exportBool <- elispBoolean + return $ + if exportBool + then ArchivedTreesExport + else ArchivedTreesNoExport + +-- | A list or a complement list (i.e. a list starting with `not`). +complementableListSetting :: String + -> ExportSettingSetter (Either [String] [String]) + -> OrgParser () +complementableListSetting = genericExportSetting $ choice + [ Left <$> complementStringList + , Right <$> stringList + , (\b -> if b then Left [] else Right []) <$> elispBoolean + ] + where + -- Read a plain list of strings. + stringList :: OrgParser [String] + stringList = try $ + char '(' + *> sepBy elispString spaces + <* char ')' + + -- Read an emacs lisp list specifying a complement set. + complementStringList :: OrgParser [String] + complementStringList = try $ + string "(not " + *> sepBy elispString spaces + <* char ')' + + elispString :: OrgParser String + elispString = try $ + char '"' + *> manyTill alphaNum (char '"') + +-- | Read but ignore the export setting. +ignoredSetting :: String -> OrgParser () +ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar) + +-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are +-- interpreted as true. +elispBoolean :: OrgParser Bool +elispBoolean = try $ do + value <- many1 nonspaceChar + return $ case map toLower value of + "nil" -> False + "{}" -> False + "()" -> False + _ -> True diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs --- a/src/Text/Pandoc/Readers/Org/Inlines.hs +++ b/src/Text/Pandoc/Readers/Org/Inlines.hs @@ -49,11 +49,13 @@ import Text.TeXMath ( readTeX, writePandoc, DisplayType(..) ) import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap -import Control.Monad ( guard, mplus, mzero, when ) +import Prelude hiding (sequence) +import Control.Monad ( guard, mplus, mzero, when, void ) import Data.Char ( isAlphaNum, isSpace ) -import Data.List ( isPrefixOf ) +import Data.List ( intersperse, isPrefixOf ) import Data.Maybe ( fromMaybe ) import qualified Data.Map as M +import Data.Traversable (sequence) -- -- Functions acting on the parser state @@ -116,6 +118,7 @@ , subscript , superscript , inlineLaTeX + , exportSnippet , smart , symbol ] <* (guard =<< newlinesCountWithinLimits) @@ -127,7 +130,7 @@ -- treat these as potentially non-text when parsing inline: specialChars :: [Char] -specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~" +specialChars = "\"$'()*+-,./:;<=>@[\\]^_{|}~" whitespace :: OrgParser (F Inlines) @@ -166,19 +169,42 @@ updateLastPreCharPos return . return $ B.softbreak + +-- +-- Citations +-- + +-- The state of citations is a bit confusing due to the lack of an official +-- syntax and multiple syntaxes coexisting. The pandocOrgCite syntax was the +-- first to be implemented here and is almost identical to Markdown's citation +-- syntax. The org-ref package is in wide use to handle citations, but the +-- syntax is a bit limiting and not quite as simple to write. The +-- semi-offical Org-mode citation syntax is based on John MacFarlane's Pandoc +-- sytax and Org-oriented enhancements contributed by Richard Lawrence and +-- others. It's dubbed Berkeley syntax due the place of activity of its main +-- contributors. All this should be consolidated once an official Org-mode +-- citation syntax has emerged. + cite :: OrgParser (F Inlines) -cite = try $ do +cite = try $ berkeleyCite <|> do guardEnabled Ext_citations - (cs, raw) <- withRaw (pandocOrgCite <|> orgRefCite) + (cs, raw) <- withRaw $ choice + [ pandocOrgCite + , orgRefCite + , berkeleyTextualCite + ] return $ (flip B.cite (B.text raw)) <$> cs --- | A citation in Pandoc Org-mode style (@[\@citekey]@). +-- | A citation in Pandoc Org-mode style (@[prefix \@citekey suffix]@). pandocOrgCite :: OrgParser (F [Citation]) pandocOrgCite = try $ char '[' *> skipSpaces *> citeList <* skipSpaces <* char ']' orgRefCite :: OrgParser (F [Citation]) -orgRefCite = try $ normalOrgRefCite <|> (fmap (:[]) <$> linkLikeOrgRefCite) +orgRefCite = try $ choice + [ normalOrgRefCite + , fmap (:[]) <$> linkLikeOrgRefCite + ] normalOrgRefCite :: OrgParser (F [Citation]) normalOrgRefCite = try $ do @@ -199,6 +225,100 @@ , citationHash = 0 } +-- | Read an Berkeley-style Org-mode citation. Berkeley citation style was +-- develop and adjusted to Org-mode style by John MacFarlane and Richard +-- Lawrence, respectively, both philosophers at UC Berkeley. +berkeleyCite :: OrgParser (F Inlines) +berkeleyCite = try $ do + bcl <- berkeleyCitationList + return $ do + parens <- berkeleyCiteParens <$> bcl + prefix <- berkeleyCiteCommonPrefix <$> bcl + suffix <- berkeleyCiteCommonSuffix <$> bcl + citationList <- berkeleyCiteCitations <$> bcl + return $ + if parens + then toCite + . maybe id (\p -> alterFirst (prependPrefix p)) prefix + . maybe id (\s -> alterLast (appendSuffix s)) suffix + $ citationList + else maybe mempty (<> " ") prefix + <> (toListOfCites $ map toInTextMode citationList) + <> maybe mempty (", " <>) suffix + where + toCite :: [Citation] -> Inlines + toCite cs = B.cite cs mempty + + toListOfCites :: [Citation] -> Inlines + toListOfCites = mconcat . intersperse ", " . map (\c -> B.cite [c] mempty) + + toInTextMode :: Citation -> Citation + toInTextMode c = c { citationMode = AuthorInText } + + alterFirst, alterLast :: (a -> a) -> [a] -> [a] + alterFirst _ [] = [] + alterFirst f (c:cs) = (f c):cs + alterLast f = reverse . alterFirst f . reverse + + prependPrefix, appendSuffix :: Inlines -> Citation -> Citation + prependPrefix pre c = c { citationPrefix = B.toList pre <> citationPrefix c } + appendSuffix suf c = c { citationSuffix = citationSuffix c <> B.toList suf } + +data BerkeleyCitationList = BerkeleyCitationList + { berkeleyCiteParens :: Bool + , berkeleyCiteCommonPrefix :: Maybe Inlines + , berkeleyCiteCommonSuffix :: Maybe Inlines + , berkeleyCiteCitations :: [Citation] + } +berkeleyCitationList :: OrgParser (F BerkeleyCitationList) +berkeleyCitationList = try $ do + char '[' + parens <- choice [ False <$ berkeleyBareTag, True <$ berkeleyParensTag ] + char ':' + skipSpaces + commonPrefix <- optionMaybe (try $ citationListPart <* char ';') + citations <- citeList + commonSuffix <- optionMaybe (try $ citationListPart) + char ']' + return (BerkeleyCitationList parens + <$> sequence commonPrefix + <*> sequence commonSuffix + <*> citations) + where + citationListPart :: OrgParser (F Inlines) + citationListPart = fmap (trimInlinesF . mconcat) . try . many1 $ do + notFollowedBy' citeKey + notFollowedBy (oneOf ";]") + inline + +berkeleyBareTag :: OrgParser () +berkeleyBareTag = try $ void berkeleyBareTag' + +berkeleyParensTag :: OrgParser () +berkeleyParensTag = try . void $ enclosedByPair '(' ')' berkeleyBareTag' + +berkeleyBareTag' :: OrgParser () +berkeleyBareTag' = try $ void (string "cite") + +berkeleyTextualCite :: OrgParser (F [Citation]) +berkeleyTextualCite = try $ do + (suppressAuthor, key) <- citeKey + returnF . return $ Citation + { citationId = key + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = if suppressAuthor then SuppressAuthor else AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + +-- The following is what a Berkeley-style bracketed textual citation parser +-- would look like. However, as these citations are a subset of Pandoc's Org +-- citation style, this isn't used. +-- berkeleyBracketedTextualCite :: OrgParser (F [Citation]) +-- berkeleyBracketedTextualCite = try . (fmap head) $ +-- enclosedByPair '[' ']' berkeleyTextualCite + -- | Read a link-like org-ref style citation. The citation includes pre and -- post text. However, multiple citations are not possible due to limitations -- in the syntax. @@ -243,7 +363,7 @@ ] citeList :: OrgParser (F [Citation]) -citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces) +citeList = sequence <$> sepEndBy1 citation (try $ char ';' *> skipSpaces) citation :: OrgParser (F Citation) citation = try $ do @@ -494,7 +614,7 @@ ] updatePositions :: Char - -> OrgParser (Char) + -> OrgParser Char updatePositions c = do when (c `elem` emphasisPreChars) updateLastPreCharPos when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos @@ -517,7 +637,9 @@ -> OrgParser String verbatimBetween c = try $ emphasisStart c *> - many1TillNOrLessNewlines 1 (noneOf "\n\r") (emphasisEnd c) + many1TillNOrLessNewlines 1 verbatimChar (emphasisEnd c) + where + verbatimChar = noneOf "\n\r" >>= updatePositions -- | Parses a raw string delimited by @c@ using Org's math rules mathStringBetween :: Char @@ -721,6 +843,13 @@ -- Taken from Data.OldList. dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] + +exportSnippet :: OrgParser (F Inlines) +exportSnippet = try $ do + string "@@" + format <- many1Till (alphaNum <|> char '-') (char ':') + snippet <- manyTill anyChar (try $ string "@@") + returnF $ B.rawInline format snippet smart :: OrgParser (F Inlines) smart = do diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -40,14 +40,8 @@ , trimInlinesF , runF , returnF - , ExportSettingSetter , ExportSettings (..) - , setExportDrawers - , setExportEmphasizedText - , setExportSmartQuotes - , setExportSpecialStrings - , setExportSubSuperscripts - , modifyExportSettings + , ArchivedTreesOption (..) , optionsToParserState ) where @@ -78,19 +72,6 @@ -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) --- | Export settings --- These settings can be changed via OPTIONS statements. -data ExportSettings = ExportSettings - { exportDrawers :: Either [String] [String] - -- ^ Specify drawer names which should be exported. @Left@ names are - -- explicitly excluded from the resulting output while @Right@ means that - -- only the listed drawer names should be included. - , exportEmphasizedText :: Bool -- ^ Parse emphasized text - , exportSmartQuotes :: Bool -- ^ Parse quotes smartly - , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly - , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts - } - -- | Org-mode parser state data OrgParserState = OrgParserState { orgStateAnchorIds :: [String] @@ -133,9 +114,6 @@ extractHeaderMap = orgStateHeaderMap updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) } -instance Default ExportSettings where - def = defaultExportSettings - instance Default OrgParserState where def = defaultOrgParserState @@ -157,52 +135,49 @@ , orgStateParserContext = NullState } -defaultExportSettings :: ExportSettings -defaultExportSettings = ExportSettings - { exportDrawers = Left ["LOGBOOK"] - , exportEmphasizedText = True - , exportSmartQuotes = True - , exportSpecialStrings = True - , exportSubSuperscripts = True - } - optionsToParserState :: ReaderOptions -> OrgParserState optionsToParserState opts = def { orgStateOptions = opts } - -- --- Setter for exporting options +-- Export Settings -- -type ExportSettingSetter a = a -> ExportSettings -> ExportSettings --- | Set export options for drawers. See the @exportDrawers@ in ADT --- @ExportSettings@ for details. -setExportDrawers :: ExportSettingSetter (Either [String] [String]) -setExportDrawers val es = es { exportDrawers = val } - --- | Set export options for emphasis parsing. -setExportEmphasizedText :: ExportSettingSetter Bool -setExportEmphasizedText val es = es { exportEmphasizedText = val } - --- | Set export options for parsing of smart quotes. -setExportSmartQuotes :: ExportSettingSetter Bool -setExportSmartQuotes val es = es { exportSmartQuotes = val } +-- | Options for the way archived trees are handled. +data ArchivedTreesOption = + ArchivedTreesExport -- ^ Export the complete tree + | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting + | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents --- | Set export options for parsing of special strings (like em/en dashes or --- ellipses). -setExportSpecialStrings :: ExportSettingSetter Bool -setExportSpecialStrings val es = es { exportSpecialStrings = val } +-- | Export settings +-- These settings can be changed via OPTIONS statements. +data ExportSettings = ExportSettings + { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees + , exportDrawers :: Either [String] [String] + -- ^ Specify drawer names which should be exported. @Left@ names are + -- explicitly excluded from the resulting output while @Right@ means that + -- only the listed drawer names should be included. + , exportEmphasizedText :: Bool -- ^ Parse emphasized text + , exportHeadlineLevels :: Int + -- ^ Maximum depth of headlines, deeper headlines are convert to list + , exportSmartQuotes :: Bool -- ^ Parse quotes smartly + , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly + , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts + } --- | Set export options for sub/superscript parsing. The short syntax will --- not be parsed if this is set set to @False@. -setExportSubSuperscripts :: ExportSettingSetter Bool -setExportSubSuperscripts val es = es { exportSubSuperscripts = val } +instance Default ExportSettings where + def = defaultExportSettings --- | Modify a parser state -modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState -modifyExportSettings setter val state = - state { orgStateExportSettings = setter val . orgStateExportSettings $ state } +defaultExportSettings :: ExportSettings +defaultExportSettings = ExportSettings + { exportArchivedTrees = ArchivedTreesHeadlineOnly + , exportDrawers = Left ["LOGBOOK"] + , exportEmphasizedText = True + , exportHeadlineLevels = 3 + , exportSmartQuotes = True + , exportSpecialStrings = True + , exportSubSuperscripts = True + } -- diff --git a/src/Text/Pandoc/Readers/Org/Parsing.hs b/src/Text/Pandoc/Readers/Org/Parsing.hs --- a/src/Text/Pandoc/Readers/Org/Parsing.hs +++ b/src/Text/Pandoc/Readers/Org/Parsing.hs @@ -97,6 +97,7 @@ , try , sepBy , sepBy1 + , sepEndBy1 , option , optional , optionMaybe diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -1126,7 +1126,10 @@ 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/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -205,7 +205,7 @@ orderedList prefix = tryMsg "orderedList" $ parseList prefix (oneOf "1iIaA") (string ". ") -parseList :: Show a => String -> TWParser Char -> TWParser a -> TWParser B.Blocks +parseList :: String -> TWParser Char -> TWParser a -> TWParser B.Blocks parseList prefix marker delim = do (indent, style) <- lookAhead $ string prefix *> listStyle <* delim blocks <- many $ parseListItem (prefix ++ indent) (char style <* delim) @@ -281,7 +281,7 @@ tableEndOfRow :: TWParser Char tableEndOfRow = lookAhead (try $ char '|' >> char '\n') >> char '|' -tableColumnContent :: Show a => TWParser a -> TWParser B.Blocks +tableColumnContent :: TWParser a -> TWParser B.Blocks tableColumnContent end = manyTill content (lookAhead $ try end) >>= return . B.plain . mconcat where content = continuation <|> inline @@ -351,11 +351,11 @@ where lastNewline = eof >> return mempty innerNewline = return B.space -between :: (Show b, Monoid c) => TWParser a -> TWParser b -> (TWParser b -> TWParser c) -> TWParser c +between :: (Monoid c) => TWParser a -> TWParser b -> (TWParser b -> TWParser c) -> TWParser c between start end p = mconcat <$> try (start >> notFollowedBy whitespace >> many1Till (p end) end) -enclosed :: (Show a, Monoid b) => TWParser a -> (TWParser a -> TWParser b) -> TWParser b +enclosed :: (Monoid b) => TWParser a -> (TWParser a -> TWParser b) -> TWParser b enclosed sep p = between sep (try $ sep <* endMarker) p where endMarker = lookAhead $ skip endSpace <|> skip (oneOf ".,!?:)|") <|> eof diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -63,7 +63,7 @@ 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 @@ -277,6 +277,7 @@ definitionListStart = try $ do char '-' whitespace + notFollowedBy newline trimInlines . mconcat <$> many1Till inline (try (string ":=")) <* optional whitespace @@ -540,8 +541,8 @@ 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) @@ -594,10 +595,12 @@ ("justify" <$ try (string "<>")) <|> ("right" <$ char '>') <|> ("left" <$ char '<') + notFollowedBy spaceChar return $ addStyle ("text-align:" ++ alignStr) attribute :: Parser [Char] ParserState (Attr -> Attr) -attribute = classIdAttr <|> styleAttr <|> langAttr +attribute = try $ + (classIdAttr <|> styleAttr <|> langAttr) <* notFollowedBy spaceChar classIdAttr :: Parser [Char] ParserState (Attr -> Attr) classIdAttr = try $ do -- (class class #id) @@ -637,10 +640,7 @@ -> (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/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -285,7 +285,7 @@ (zip aligns (replicate ncolumns 0.0)) headerPadded rowsPadded -pad :: (Show a, Monoid a) => Int -> [a] -> [a] +pad :: (Monoid a) => Int -> [a] -> [a] pad n xs = xs ++ (replicate (n - length xs) mempty) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -89,6 +89,8 @@ warn, mapLeft, hush, + -- * for squashing blocks + blocksToInlines, -- * Safe read safeRead, -- * Temp directory @@ -148,9 +150,13 @@ import Paths_pandoc (getDataFileName) #endif #ifdef HTTP_CLIENT -import Network.HTTP.Client (httpLbs, parseUrl, - responseBody, responseHeaders, +import Network.HTTP.Client (httpLbs, responseBody, responseHeaders, Request(port,host)) +#if MIN_VERSION_http_client(0,4,30) +import Network.HTTP.Client (parseRequest) +#else +import Network.HTTP.Client (parseUrl) +#endif #if MIN_VERSION_http_client(0,4,18) import Network.HTTP.Client (newManager) #else @@ -318,18 +324,24 @@ -- Date/time -- --- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. +-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We +-- limit years to the range 1601-9999 (ISO 8601 accepts greater than +-- or equal to 1583, but MS Word only accepts dates starting 1601). normalizeDate :: String -> Maybe String normalizeDate s = fmap (formatTime defaultTimeLocale "%F") - (msum $ map (\fs -> parsetimeWith fs s) formats :: Maybe Day) - where parsetimeWith = + (msum $ map (\fs -> parsetimeWith fs s >>= rejectBadYear) formats :: Maybe Day) + where rejectBadYear day = case toGregorian day of + (y, _, _) | y >= 1601 && y <= 9999 -> Just day + _ -> Nothing + parsetimeWith = #if MIN_VERSION_time(1,5,0) parseTimeM True defaultTimeLocale #else parseTime defaultTimeLocale #endif - formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y", - "%d %B %Y", "%b. %d, %Y", "%B %d, %Y", "%Y"] + formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y", + "%d %B %Y", "%b. %d, %Y", "%B %d, %Y", + "%Y%m%d", "%Y%m", "%Y"] -- -- Pandoc block and inline list processing @@ -944,13 +956,18 @@ in return $ Right (decodeLenient contents, Just mime) #ifdef HTTP_CLIENT | otherwise = withSocketsDo $ E.try $ do - req <- parseUrl u +#if MIN_VERSION_http_client(0,4,30) + let parseReq = parseRequest +#else + let parseReq = parseUrl +#endif (proxy :: Either E.SomeException String) <- E.try $ getEnv "http_proxy" - let req' = case proxy of - Left _ -> req - Right pr -> case parseUrl pr of - Just r -> addProxy (host r) (port r) req - Nothing -> req + req <- parseReq u + req' <- case proxy of + Left _ -> return req + Right pr -> (parseReq pr >>= \r -> + return $ addProxy (host r) (port r) req) + `mplus` return req #if MIN_VERSION_http_client(0,4,18) resp <- newManager tlsManagerSettings >>= httpLbs req' #else @@ -1019,6 +1036,42 @@ isSingleton [x] = Just x isSingleton _ = Nothing checkPathSeperator = fmap isPathSeparator . isSingleton + +--- +--- Squash blocks into inlines +--- + +blockToInlines :: Block -> [Inline] +blockToInlines (Plain ils) = ils +blockToInlines (Para ils) = ils +blockToInlines (CodeBlock attr str) = [Code attr str] +blockToInlines (RawBlock fmt str) = [RawInline fmt str] +blockToInlines (BlockQuote blks) = blocksToInlines blks +blockToInlines (OrderedList _ blkslst) = + concatMap blocksToInlines blkslst +blockToInlines (BulletList blkslst) = + concatMap blocksToInlines blkslst +blockToInlines (DefinitionList pairslst) = + concatMap f pairslst + where + f (ils, blkslst) = ils ++ + [Str ":", Space] ++ + (concatMap blocksToInlines blkslst) +blockToInlines (Header _ _ ils) = ils +blockToInlines (HorizontalRule) = [] +blockToInlines (Table _ _ _ headers rows) = + intercalate [LineBreak] $ map (concatMap blocksToInlines) tbl + where + tbl = headers : rows +blockToInlines (Div _ blks) = blocksToInlines blks +blockToInlines Null = [] + +blocksToInlinesWithSep :: [Inline] -> [Block] -> [Inline] +blocksToInlinesWithSep sep blks = intercalate sep $ map blockToInlines blks + +blocksToInlines :: [Block] -> [Inline] +blocksToInlines = blocksToInlinesWithSep [Space, Str "¶", Space] + -- -- Safe read diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -117,7 +117,7 @@ else "sect" ++ show n | otherwise -> "simplesect" idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')] - nsAttr = if writerDocbook5 opts && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook")] + nsAttr = if writerDocbook5 opts && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")] else [] attribs = nsAttr ++ idAttr in inTags True tag attribs $ diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -38,7 +38,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Codec.Archive.Zip import Data.Time.Clock.POSIX -import Data.Time.Clock import System.Environment import Text.Pandoc.Compat.Time import Text.Pandoc.Definition @@ -440,10 +439,9 @@ ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")] $ mknode "dc:title" [] (stringify $ docTitle meta) : mknode "dc:creator" [] (intercalate "; " (map stringify $ docAuthors meta)) - : maybe [] - (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x - , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x - ]) (normalizeDate $ stringify $ docDate meta) + : (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x + , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x + ]) (formatTime defaultTimeLocale "%FT%XZ" utctime) let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps let relsPath = "_rels/.rels" @@ -1045,6 +1043,7 @@ let displayType = if mathType == DisplayMath then DisplayBlock else DisplayInline + when (displayType == DisplayBlock) setFirstPara case writeOMML displayType <$> readTeX str of Right r -> return [r] Left _ -> inlinesToOpenXML opts (texMathToInlines mathType str) diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -888,7 +888,7 @@ return $ RawInline fmt (renderTags' tags') transformInline _ _ x = return x -(!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element +(!) :: (t -> Element) -> [(String, String)] -> t -> Element (!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n) -- | Version of 'ppTopElement' that specifies UTF-8 encoding. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -483,11 +483,9 @@ else addAttrs opts (ident, classes', kvs) $ divtag $ contents' blockToHtml opts (RawBlock f str) | f == Format "html" = return $ preEscapedString str - | f == Format "latex" = - case writerHTMLMathMethod opts of - MathJax _ -> do modify (\st -> st{ stMath = True }) - return $ toHtml str - _ -> return mempty + | (f == Format "latex" || f == Format "tex") && + allowsMathEnvironments (writerHTMLMathMethod opts) && + isMathEnvironment str = blockToHtml opts $ Plain [Math DisplayMath str] | otherwise = return mempty blockToHtml opts (HorizontalRule) = return $ if writerHtml5 opts then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do @@ -811,13 +809,6 @@ InlineMath -> m DisplayMath -> brtag >> m >> brtag (RawInline f str) - | f == Format "latex" -> - case writerHTMLMathMethod opts of - LaTeXMathML _ -> do modify (\st -> st {stMath = True}) - return $ toHtml str - MathJax _ -> do modify (\st -> st {stMath = True}) - return $ toHtml str - _ -> return mempty | f == Format "html" -> return $ preEscapedString str | otherwise -> return mempty (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do @@ -915,3 +906,41 @@ , " katex.render(texText.data, mathElements[i])" , "}}" ] + +isMathEnvironment :: String -> Bool +isMathEnvironment s = "\\begin{" `isPrefixOf` s && + envName `elem` mathmlenvs + where envName = takeWhile (/= '}') (drop 7 s) + mathmlenvs = [ "align" + , "align*" + , "alignat" + , "alignat*" + , "aligned" + , "alignedat" + , "array" + , "Bmatrix" + , "bmatrix" + , "cases" + , "CD" + , "eqnarray" + , "eqnarray*" + , "equation" + , "equation*" + , "gather" + , "gather*" + , "gathered" + , "matrix" + , "multline" + , "multline*" + , "pmatrix" + , "smallmatrix" + , "split" + , "subarray" + , "Vmatrix" + , "vmatrix" ] + +allowsMathEnvironments :: HTMLMathMethod -> Bool +allowsMathEnvironments (MathJax _) = True +allowsMathEnvironments (MathML _) = True +allowsMathEnvironments (WebTeX _) = True +allowsMathEnvironments _ = False diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -345,7 +345,7 @@ not (null $ query hasCodeBlock elts ++ query hasCode elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "b", "c", "t", "environment", - "label", "plain", "shrink"] + "label", "plain", "shrink", "standout"] let optionslist = ["fragile" | fragile] ++ [k | k <- classes, k `elem` frameoptions] ++ [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] @@ -973,7 +973,7 @@ source' = if isURI source then source else unEscapeString source - source'' <- stringToLaTeX URLString (escapeURI source') + source'' <- stringToLaTeX URLString source' inHeading <- gets stInHeading return $ (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -39,6 +39,7 @@ import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space) import Data.Maybe (fromMaybe) +import Data.Monoid (Any(..)) import Data.List ( group, stripPrefix, find, intersperse, transpose, sortBy ) import Data.Char ( isSpace, isPunctuation, ord, chr ) import Data.Ord ( comparing ) @@ -54,6 +55,7 @@ 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) @@ -436,7 +438,10 @@ else blankline <> ": " <> caption' <> blankline rawHeaders <- mapM (blockListToMarkdown opts) headers rawRows <- mapM (mapM (blockListToMarkdown opts)) rows - let isSimple = all (==0) widths + let isLineBreak LineBreak = Any True + isLineBreak _ = Any False + let isSimple = all (==0) widths && + not ( getAny (query isLineBreak (headers:rows)) ) let isPlainBlock (Plain _) = True isPlainBlock _ = False let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows) @@ -852,18 +857,22 @@ 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/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2010-2015 Puneeth Chaganti + Albert Krewinkel , and John MacFarlane This program is free software; you can redistribute it and/or modify @@ -38,7 +39,8 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty import Text.Pandoc.Templates (renderTemplate') -import Data.List ( intersect, intersperse, transpose ) +import Data.Char ( toLower ) +import Data.List ( intersect, intersperse, partition, transpose ) import Control.Monad.State data WriterState = @@ -123,12 +125,34 @@ blankline blockToOrg (Div attrs bs) = do contents <- blockListToOrg bs - let startTag = tagWithAttrs "div" attrs - let endTag = text "" - return $ blankline $$ "#+BEGIN_HTML" $$ - nest 2 startTag $$ "#+END_HTML" $$ blankline $$ - contents $$ blankline $$ "#+BEGIN_HTML" $$ - nest 2 endTag $$ "#+END_HTML" $$ blankline + let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower + return $ case attrs of + ("", [], []) -> + -- nullAttr, treat contents as if it wasn't wrapped + blankline $$ contents $$ blankline + (ident, [], []) -> + -- only an id: add id as an anchor, unwrap the rest + blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline + (ident, classes, kv) -> + -- if one class looks like the name of a greater block then output as + -- such: The ID, if present, is added via the #+NAME keyword; other + -- classes and key-value pairs are kept as #+ATTR_HTML attributes. + let + (blockTypeCand, classes') = partition isGreaterBlockClass classes + in case blockTypeCand of + (blockType:classes'') -> + blankline $$ attrHtml (ident, classes'' <> classes', kv) $$ + "#+BEGIN_" <> text blockType $$ contents $$ + "#+END_" <> text blockType $$ blankline + _ -> + -- fallback: wrap in div tags + let + startTag = tagWithAttrs "div" attrs + endTag = text "" + in blankline $$ "#+BEGIN_HTML" $$ + nest 2 startTag $$ "#+END_HTML" $$ blankline $$ + contents $$ blankline $$ "#+BEGIN_HTML" $$ + nest 2 endTag $$ "#+END_HTML" $$ blankline blockToOrg (Plain inlines) = inlineListToOrg inlines -- title beginning with fig: indicates that the image is a figure blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do @@ -260,6 +284,16 @@ kvToOrgProperty (key, value) = text ":" <> text key <> text ": " <> text value <> cr +attrHtml :: Attr -> Doc +attrHtml ("" , [] , []) = mempty +attrHtml (ident, classes, kvs) = + let + name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr + keyword = "#+ATTR_HTML" + classKv = ("class", unwords classes) + kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs) + in name <> keyword <> ": " <> text (unwords kvStrings) <> cr + -- | Convert list of Pandoc block elements to Org. blockListToOrg :: [Block] -- ^ List of block elements -> State WriterState Doc @@ -305,9 +339,10 @@ return $ if t == InlineMath then "$" <> text str <> "$" else "$$" <> text str <> "$$" -inlineToOrg (RawInline f str) | isRawFormat f = - return $ text str -inlineToOrg (RawInline _ _) = return empty +inlineToOrg (RawInline f@(Format f') str) = + return $ if isRawFormat f + then text str + else "@@" <> text f' <> ":" <> text str <> "@@" inlineToOrg (LineBreak) = return (text "\\\\" <> cr) inlineToOrg Space = return space inlineToOrg SoftBreak = do diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -148,6 +148,7 @@ stripLeadingTrailingSpace :: [Inline] -> [Inline] stripLeadingTrailingSpace = go . reverse . go . reverse where go (Space:xs) = xs + go (SoftBreak:xs) = xs go xs = xs -- Put display math in its own block (for ODT/DOCX). diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -0,0 +1,361 @@ +{- +Copyright (C) 2008-2015 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Writers.ZimWiki + Copyright : Copyright (C) 2008-2015 John MacFarlane, 2016 Alex Ivkin + License : GNU GPL, version 2 or above + + Maintainer : Alex Ivkin + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to ZimWiki markup. + +http://zim-wiki.org/manual/Help/Wiki_Syntax.html +-} + +module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where +import Text.Pandoc.Definition +import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerStandalone, writerTemplate, writerWrapText), WrapOption(..) ) +import Text.Pandoc.Shared ( escapeURI, removeFormatting, trimr, substitute ) +import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) +import Text.Pandoc.ImageSize +import Text.Pandoc.Templates ( renderTemplate' ) +import Data.List ( intercalate, isPrefixOf, transpose, isInfixOf ) +import Data.Text ( breakOnAll, pack ) +import Data.Default (Default(..)) +import Network.URI ( isURI ) +import Control.Monad ( zipWithM ) +import Control.Monad.State ( modify, State, get, evalState ) +--import Control.Monad.Reader ( ReaderT, runReaderT, ask, local ) + +data WriterState = WriterState { + stItemNum :: Int, + stIndent :: String -- Indent after the marker at the beginning of list items + } + +instance Default WriterState where + def = WriterState { stItemNum = 1, stIndent = "" } + +-- | Convert Pandoc to ZimWiki. +writeZimWiki :: WriterOptions -> Pandoc -> String +writeZimWiki opts document = evalState (pandocToZimWiki opts document) (WriterState 1 "") + +-- | Return ZimWiki representation of document. +pandocToZimWiki :: WriterOptions -> Pandoc -> State WriterState String +pandocToZimWiki opts (Pandoc meta blocks) = do + metadata <- metaToJSON opts + (fmap trimr . blockListToZimWiki opts) + (inlineListToZimWiki opts) + meta + body <- blockListToZimWiki opts blocks + --let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n" + let main = body + let context = defField "body" main + $ defField "toc" (writerTableOfContents opts) + $ metadata + if writerStandalone opts + then return $ renderTemplate' (writerTemplate opts) context + else return main + +-- | Escape special characters for ZimWiki. +escapeString :: String -> String +escapeString = substitute "__" "''__''" . + substitute "**" "''**''" . + substitute "~~" "''~~''" . + substitute "//" "''//''" + +-- | Convert Pandoc block element to ZimWiki. +blockToZimWiki :: WriterOptions -> Block -> State WriterState String + +blockToZimWiki _ Null = return "" + +blockToZimWiki opts (Div _attrs bs) = do + contents <- blockListToZimWiki opts bs + return $ contents ++ "\n" + +blockToZimWiki opts (Plain inlines) = inlineListToZimWiki opts inlines + +-- title beginning with fig: indicates that the image is a figure +-- ZimWiki doesn't support captions - so combine together alt and caption into alt +blockToZimWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do + capt <- if null txt + then return "" + else (" " ++) `fmap` inlineListToZimWiki opts txt + let opt = if null txt + then "" + else "|" ++ if null tit then capt else tit ++ capt + -- Relative links fail isURI and receive a colon + prefix = if isURI src then "" else ":" + return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n" + +blockToZimWiki opts (Para inlines) = do + indent <- stIndent <$> get + -- useTags <- stUseTags <$> get + contents <- inlineListToZimWiki opts inlines + return $ contents ++ if null indent then "\n" else "" + +blockToZimWiki opts (RawBlock f str) + | f == Format "zimwiki" = return str + | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | otherwise = return "" + +blockToZimWiki _ HorizontalRule = return "\n----\n" + +blockToZimWiki opts (Header level _ inlines) = do + contents <- inlineListToZimWiki opts $ removeFormatting inlines -- emphasis, links etc. not allowed in headers + let eqs = replicate ( 7 - level ) '=' + return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" + +blockToZimWiki _ (CodeBlock (_,classes,_) str) = do + return $ case classes of + [] -> "'''\n" ++ cleanupCode str ++ "\n'''\n" -- no lang block is a quote block + (x:_) -> "{{{code: lang=\"" ++ x ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec + +blockToZimWiki opts (BlockQuote blocks) = do + contents <- blockListToZimWiki opts blocks + return $ unlines $ map ("> " ++) $ lines contents + +blockToZimWiki opts (Table capt aligns _ headers rows) = do + captionDoc <- if null capt + then return "" + else do + c <- inlineListToZimWiki opts capt + return $ "" ++ c ++ "\n" + headers' <- if all null headers + then zipWithM (tableItemToZimWiki opts) aligns (rows !! 0) + else zipWithM (tableItemToZimWiki opts) aligns headers + rows' <- mapM (zipWithM (tableItemToZimWiki opts) aligns) rows + let widths = map (maximum . map length) $ transpose (headers':rows') + let padTo (width, al) s = + case (width - length s) of + x | x > 0 -> + if al == AlignLeft || al == AlignDefault + then s ++ replicate x ' ' + else if al == AlignRight + then replicate x ' ' ++ s + else replicate (x `div` 2) ' ' ++ + s ++ replicate (x - x `div` 2) ' ' + | otherwise -> s + let borderCell (width, al) _ = + if al == AlignLeft + then ":"++ replicate (width-1) '-' + else if al == AlignDefault + then replicate width '-' + else if al == AlignRight + then replicate (width-1) '-' ++ ":" + else ":" ++ replicate (width-2) '-' ++ ":" + let underheader = "|" ++ intercalate "|" (zipWith borderCell (zip widths aligns) headers') ++ "|" + let renderRow sep cells = sep ++ intercalate sep (zipWith padTo (zip widths aligns) cells) ++ sep + return $ captionDoc ++ + (if null headers' then "" else renderRow "|" headers' ++ "\n") ++ underheader ++ "\n" ++ + unlines (map (renderRow "|") rows') + +blockToZimWiki opts (BulletList items) = do + indent <- stIndent <$> get + modify $ \s -> s { stIndent = stIndent s ++ "\t" } + contents <- (mapM (listItemToZimWiki opts) items) + modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } + return $ vcat contents ++ if null indent then "\n" else "" + +blockToZimWiki opts (OrderedList _ items) = do + indent <- stIndent <$> get + modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 } + contents <- (mapM (orderedListItemToZimWiki opts) items) + modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } + return $ vcat contents ++ if null indent then "\n" else "" + +blockToZimWiki opts (DefinitionList items) = do + contents <- (mapM (definitionListItemToZimWiki opts) items) + return $ vcat contents + +definitionListItemToZimWiki :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState String +definitionListItemToZimWiki opts (label, items) = do + labelText <- inlineListToZimWiki opts label + contents <- mapM (blockListToZimWiki opts) items + indent <- stIndent <$> get + return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents + +-- Auxiliary functions for lists: +indentFromHTML :: WriterOptions -> String -> State WriterState String +indentFromHTML _ str = do + indent <- stIndent <$> get + itemnum <- stItemNum <$> get + if isInfixOf "
  • " str then return $ indent ++ show itemnum ++ "." + else if isInfixOf "
    • " str then return "\n" + else if isInfixOf "
  • " str then do + let olcount=countSubStrs "
      " str + modify $ \s -> s { stIndent = stIndent s ++ replicate olcount '\t', stItemNum = 1 } + return "" + else if isInfixOf "
    " str then do + let olcount=countSubStrs "/
      " str + modify $ \s -> s{ stIndent = drop olcount (stIndent s) } + return "" + else + return "" + +countSubStrs :: String -> String -> Int +countSubStrs sub str = length $ breakOnAll (pack sub) (pack str) + +cleanupCode :: String -> String +cleanupCode = substitute "" "" . substitute "" "" + +vcat :: [String] -> String +vcat = intercalate "\n" + +-- | Convert bullet list item (list of blocks) to ZimWiki. +listItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String +listItemToZimWiki opts items = do + contents <- blockListToZimWiki opts items + indent <- stIndent <$> get + return $ indent ++ "* " ++ contents + +-- | Convert ordered list item (list of blocks) to ZimWiki. +orderedListItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String +orderedListItemToZimWiki opts items = do + contents <- blockListToZimWiki opts items + indent <- stIndent <$> get + itemnum <- stItemNum <$> get + --modify $ \s -> s { stItemNum = itemnum + 1 } -- this is not strictly necessary for zim as zim does its own renumbering + return $ indent ++ show itemnum ++ ". " ++ contents + +-- Auxiliary functions for tables: +tableItemToZimWiki :: WriterOptions -> Alignment -> [Block] -> State WriterState String +tableItemToZimWiki opts align' item = do + let mkcell x = (if align' == AlignRight || align' == AlignCenter + then " " + else "") ++ x ++ + (if align' == AlignLeft || align' == AlignCenter + then " " + else "") + contents <- blockListToZimWiki opts item -- local (\s -> s { stBackSlashLB = True }) $ + return $ mkcell contents + +-- | Convert list of Pandoc block elements to ZimWiki. +blockListToZimWiki :: WriterOptions -> [Block] -> State WriterState String +blockListToZimWiki opts blocks = vcat <$> mapM (blockToZimWiki opts) blocks + +-- | Convert list of Pandoc inline elements to ZimWiki. +inlineListToZimWiki :: WriterOptions -> [Inline] -> State WriterState String +inlineListToZimWiki opts lst = concat <$> (mapM (inlineToZimWiki opts) lst) + +-- | Convert Pandoc inline element to ZimWiki. +inlineToZimWiki :: WriterOptions -> Inline -> State WriterState String + +inlineToZimWiki opts (Emph lst) = do + contents <- inlineListToZimWiki opts lst + return $ "//" ++ contents ++ "//" + +inlineToZimWiki opts (Strong lst) = do + contents <- inlineListToZimWiki opts lst + return $ "**" ++ contents ++ "**" + +inlineToZimWiki opts (Strikeout lst) = do + contents <- inlineListToZimWiki opts lst + return $ "~~" ++ contents ++ "~~" + +inlineToZimWiki opts (Superscript lst) = do + contents <- inlineListToZimWiki opts lst + return $ "^{" ++ contents ++ "}" + +inlineToZimWiki opts (Subscript lst) = do + contents <- inlineListToZimWiki opts lst + return $ "_{" ++ contents ++ "}" + +inlineToZimWiki opts (Quoted SingleQuote lst) = do + contents <- inlineListToZimWiki opts lst + return $ "\8216" ++ contents ++ "\8217" + +inlineToZimWiki opts (Quoted DoubleQuote lst) = do + contents <- inlineListToZimWiki opts lst + return $ "\8220" ++ contents ++ "\8221" + +inlineToZimWiki opts (Span _attrs ils) = inlineListToZimWiki opts ils + +inlineToZimWiki opts (SmallCaps lst) = inlineListToZimWiki opts lst + +inlineToZimWiki opts (Cite _ lst) = inlineListToZimWiki opts lst + +inlineToZimWiki _ (Code _ str) = return $ "''" ++ str ++ "''" + +inlineToZimWiki _ (Str str) = return $ escapeString str + +inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped + where delim = case mathType of + DisplayMath -> "$$" + InlineMath -> "$" + +-- | f == Format "html" = return $ "" ++ str ++ "" +inlineToZimWiki opts (RawInline f str) + | f == Format "zimwiki" = return str + | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | otherwise = return "" + +inlineToZimWiki _ (LineBreak) = return "\n" -- was \\\\ + +inlineToZimWiki opts SoftBreak = + case writerWrapText opts of + WrapNone -> return " " + WrapAuto -> return " " + WrapPreserve -> return "\n" + +inlineToZimWiki _ Space = return " " + +inlineToZimWiki opts (Link _ txt (src, _)) = do + label <- inlineListToZimWiki opts txt + case txt of + [Str s] | "mailto:" `isPrefixOf` src -> return $ "<" ++ s ++ ">" + | escapeURI s == src -> return src + _ -> if isURI src + then return $ "[[" ++ src ++ "|" ++ label ++ "]]" + else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" + where src' = case src of + '/':xs -> xs -- with leading / it's a + _ -> src -- link to a help page +inlineToZimWiki opts (Image attr alt (source, tit)) = do + alt' <- inlineListToZimWiki opts alt + let txt = case (tit, alt) of + ("", []) -> "" + ("", _ ) -> "|" ++ alt' + (_ , _ ) -> "|" ++ tit + -- Relative links fail isURI and receive a colon + prefix = if isURI source then "" else ":" + return $ "{{" ++ prefix ++ source ++ imageDims opts attr ++ txt ++ "}}" + +inlineToZimWiki opts (Note contents) = do + contents' <- blockListToZimWiki opts contents + return $ "((" ++ contents' ++ "))" + -- note - may not work for notes with multiple blocks + +imageDims :: WriterOptions -> Attr -> String +imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + where + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = "?" ++ w + go (Just w) (Just h) = "?" ++ w ++ "x" ++ h + go Nothing (Just h) = "?0x" ++ h + go Nothing Nothing = "" diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -8,6 +8,8 @@ packages: - '.' extra-deps: -- data-default-0.6.0 -- data-default-instances-base-0.1.0 -resolver: lts-6.1 +- http-client-0.5.0 +- http-client-tls-0.3.0 +- data-default-instances-base-0.1.0.1 +- cmark-0.5.3.1 +resolver: nightly-2016-07-11 diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs --- a/tests/Tests/Old.hs +++ b/tests/Tests/Old.hs @@ -166,7 +166,7 @@ "twiki-reader.twiki" "twiki-reader.native" ] , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) [ "opendocument" , "context" , "texinfo", "icml", "tei" - , "man" , "plain" , "rtf", "org", "asciidoc" + , "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki" ] , testGroup "writers-lang-and-dir" [ test "latex" ["-f", "native", "-t", "latex", "-s"] diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs --- a/tests/Tests/Readers/Docx.hs +++ b/tests/Tests/Readers/Docx.hs @@ -57,6 +57,19 @@ testCompare :: String -> FilePath -> FilePath -> Test testCompare = testCompareWithOpts def +testForWarningsWithOptsIO :: ReaderOptions -> String -> FilePath -> [String] -> IO Test +testForWarningsWithOptsIO opts name docxFile expected = do + df <- B.readFile docxFile + let (_, _, warns) = handleError $ readDocxWithWarnings opts df + return $ test id name (unlines warns, unlines expected) + +testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [String] -> Test +testForWarningsWithOpts opts name docxFile expected = + buildTest $ testForWarningsWithOptsIO opts name docxFile expected + +-- testForWarnings :: String -> FilePath -> [String] -> Test +-- testForWarnings = testForWarningsWithOpts def + getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString) getMedia archivePath mediaPath = do zf <- B.readFile archivePath >>= return . toArchive @@ -278,6 +291,30 @@ "move text (all)" "docx/track_changes_move.docx" "docx/track_changes_move_all.native" + , testCompareWithOpts def{readerTrackChanges=AcceptChanges} + "comments (accept -- no comments)" + "docx/comments.docx" + "docx/comments_no_comments.native" + , testCompareWithOpts def{readerTrackChanges=RejectChanges} + "comments (reject -- comments)" + "docx/comments.docx" + "docx/comments_no_comments.native" + , testCompareWithOpts def{readerTrackChanges=AllChanges} + "comments (all comments)" + "docx/comments.docx" + "docx/comments.native" + , testForWarningsWithOpts def{readerTrackChanges=AcceptChanges} + "comment warnings (accept -- no warnings)" + "docx/comments_warning.docx" + [] + , testForWarningsWithOpts def{readerTrackChanges=RejectChanges} + "comment warnings (reject -- no warnings)" + "docx/comments_warning.docx" + [] + , testForWarningsWithOpts def{readerTrackChanges=AllChanges} + "comment warnings (all)" + "docx/comments_warning.docx" + ["Docx comment 1 will not retain formatting"] ] , testGroup "media" [ testMediaBag diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -185,6 +185,9 @@ , "3" <> subscript "{}" , "4" <> superscript ("(a(" <> strong "b(c" <> ")d))") ]) + , "Verbatim text can contain equal signes (=)" =: + "=is_subst = True=" =?> + para (code "is_subst = True") , "Image" =: "[[./sunset.jpg]]" =?> @@ -336,6 +339,55 @@ } in (para $ cite [citation] "[[citep:Dominik201408][See page 20::, for example]]") + , testGroup "Berkeley-style citations" $ + let pandocCite = Citation + { citationId = "Pandoc" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + pandocInText = pandocCite { citationMode = AuthorInText } + dominikCite = Citation + { citationId = "Dominik201408" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + dominikInText = dominikCite { citationMode = AuthorInText } + in [ + "Berkeley-style in-text citation" =: + "See @Dominik201408." =?> + (para $ "See " + <> cite [dominikInText] "@Dominik201408" + <> ".") + + , "Berkeley-style parenthetical citation list" =: + "[(cite): see; @Dominik201408;also @Pandoc; and others]" =?> + let pandocCite' = pandocCite { + citationPrefix = toList "also" + , citationSuffix = toList "and others" + } + dominikCite' = dominikCite { + citationPrefix = toList "see" + } + in (para $ cite [dominikCite', pandocCite'] "") + + , "Berkeley-style plain citation list" =: + "[cite: See; @Dominik201408; and @Pandoc; and others]" =?> + let pandocCite' = pandocInText { + citationPrefix = toList "and" + } + in (para $ "See " + <> cite [dominikInText] "" + <> "," <> space + <> cite [pandocCite'] "" + <> "," <> space <> "and others") + ] + , "Inline LaTeX symbol" =: "\\dots" =?> para "…" @@ -356,6 +408,10 @@ "\\notacommand{foo}" =?> para (rawInline "latex" "\\notacommand{foo}") + , "Export snippet" =: + "@@html:M-x org-agenda@@" =?> + para (rawInline "html" "M-x org-agenda") + , "MathML symbol in LaTeX-style" =: "There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: '\\nbsp')." =?> para ("There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: ' ').") @@ -378,7 +434,7 @@ { citationId = "Coffee" , citationPrefix = [] , citationSuffix = [] - , citationMode = AuthorInText + , citationMode = NormalCitation , citationNoteNum = 0 , citationHash = 0} in (para . cite [citation] $ rawInline "latex" "\\cite{Coffee}") @@ -534,6 +590,42 @@ , ":END:" ] =?> divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") + + , "Export option: don't include archive trees" =: + unlines [ "#+OPTIONS: arch:nil" + , "* old :ARCHIVE:" + ] =?> + (mempty ::Blocks) + + , "Export option: include complete archive trees" =: + unlines [ "#+OPTIONS: arch:t" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + , para "boring" + ] + + , "Export option: include archive tree header only" =: + unlines [ "#+OPTIONS: arch:headline" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + + , "Export option: limit headline depth" =: + unlines [ "#+OPTIONS: H:2" + , "* section" + , "** subsection" + , "*** list item 1" + , "*** list item 2" + ] =?> + mconcat [ headerWith ("section", [], []) 1 "section" + , headerWith ("subsection", [], []) 2 "subsection" + , orderedList [ para "list item 1", para "list item 2" ] + ] ] , testGroup "Basic Blocks" $ @@ -714,37 +806,47 @@ , "#+END_COMMENT"] =?> (mempty::Blocks) - , "Figure" =: - unlines [ "#+caption: A very courageous man." - , "#+name: goodguy" - , "[[edward.jpg]]" - ] =?> - para (image "edward.jpg" "fig:goodguy" "A very courageous man.") + , testGroup "Figures" $ + [ "Figure" =: + unlines [ "#+caption: A very courageous man." + , "#+name: goodguy" + , "[[edward.jpg]]" + ] =?> + para (image "edward.jpg" "fig:goodguy" "A very courageous man.") - , "Figure with no name" =: - unlines [ "#+caption: I've been through the desert on this" - , "[[horse.png]]" - ] =?> - para (image "horse.png" "fig:" "I've been through the desert on this") + , "Figure with no name" =: + unlines [ "#+caption: I've been through the desert on this" + , "[[horse.png]]" + ] =?> + para (image "horse.png" "fig:" "I've been through the desert on this") - , "Figure with `fig:` prefix in name" =: - unlines [ "#+caption: Used as a metapher in evolutionary biology." - , "#+name: fig:redqueen" - , "[[the-red-queen.jpg]]" - ] =?> - para (image "the-red-queen.jpg" "fig:redqueen" - "Used as a metapher in evolutionary biology.") + , "Figure with `fig:` prefix in name" =: + unlines [ "#+caption: Used as a metapher in evolutionary biology." + , "#+name: fig:redqueen" + , "[[the-red-queen.jpg]]" + ] =?> + para (image "the-red-queen.jpg" "fig:redqueen" + "Used as a metapher in evolutionary biology.") - , "Figure with HTML attributes" =: - unlines [ "#+CAPTION: mah brain just explodid" - , "#+NAME: lambdacat" - , "#+ATTR_HTML: :style color: blue :role button" - , "[[lambdacat.jpg]]" - ] =?> - let kv = [("style", "color: blue"), ("role", "button")] - name = "fig:lambdacat" - caption = "mah brain just explodid" - in para (imageWith (mempty, mempty, kv) "lambdacat.jpg" name caption) + , "Figure with HTML attributes" =: + unlines [ "#+CAPTION: mah brain just explodid" + , "#+NAME: lambdacat" + , "#+ATTR_HTML: :style color: blue :role button" + , "[[lambdacat.jpg]]" + ] =?> + let kv = [("style", "color: blue"), ("role", "button")] + name = "fig:lambdacat" + caption = "mah brain just explodid" + in para (imageWith (mempty, mempty, kv) "lambdacat.jpg" name caption) + + , "Labelled figure" =: + unlines [ "#+CAPTION: My figure" + , "#+LABEL: fig:myfig" + , "[[blub.png]]" + ] =?> + let attr = ("fig:myfig", mempty, mempty) + in para (imageWith attr "blub.png" "fig:" "My figure") + ] , "Footnote" =: unlines [ "A footnote[1]" diff --git a/tests/Tests/Writers/AsciiDoc.hs b/tests/Tests/Writers/AsciiDoc.hs --- a/tests/Tests/Writers/AsciiDoc.hs +++ b/tests/Tests/Writers/AsciiDoc.hs @@ -6,7 +6,7 @@ import Tests.Helpers import Tests.Arbitrary() -asciidoc :: (ToString a, ToPandoc a) => a -> String +asciidoc :: (ToPandoc a) => a -> String asciidoc = writeAsciiDoc def{ writerWrapText = WrapNone } . toPandoc tests :: [Test] diff --git a/tests/Tests/Writers/ConTeXt.hs b/tests/Tests/Writers/ConTeXt.hs --- a/tests/Tests/Writers/ConTeXt.hs +++ b/tests/Tests/Writers/ConTeXt.hs @@ -7,10 +7,10 @@ import Tests.Helpers import Tests.Arbitrary() -context :: (ToString a, ToPandoc a) => a -> String +context :: (ToPandoc a) => a -> String context = writeConTeXt def . toPandoc -context' :: (ToString a, ToPandoc a) => a -> String +context' :: (ToPandoc a) => a -> String context' = writeConTeXt def{ writerWrapText = WrapNone } . toPandoc {- diff --git a/tests/Tests/Writers/Docbook.hs b/tests/Tests/Writers/Docbook.hs --- a/tests/Tests/Writers/Docbook.hs +++ b/tests/Tests/Writers/Docbook.hs @@ -7,7 +7,7 @@ import Tests.Helpers import Tests.Arbitrary() -docbook :: (ToString a, ToPandoc a) => a -> String +docbook :: (ToPandoc a) => a -> String docbook = writeDocbook def{ writerWrapText = WrapNone } . toPandoc {- diff --git a/tests/Tests/Writers/HTML.hs b/tests/Tests/Writers/HTML.hs --- a/tests/Tests/Writers/HTML.hs +++ b/tests/Tests/Writers/HTML.hs @@ -7,7 +7,7 @@ import Tests.Helpers import Tests.Arbitrary() -html :: (ToString a, ToPandoc a) => a -> String +html :: (ToPandoc a) => a -> String html = writeHtmlString def{ writerWrapText = WrapNone } . toPandoc {- diff --git a/tests/Tests/Writers/LaTeX.hs b/tests/Tests/Writers/LaTeX.hs --- a/tests/Tests/Writers/LaTeX.hs +++ b/tests/Tests/Writers/LaTeX.hs @@ -7,10 +7,10 @@ import Tests.Helpers import Tests.Arbitrary() -latex :: (ToString a, ToPandoc a) => a -> String +latex :: (ToPandoc a) => a -> String latex = writeLaTeX def{ writerHighlight = True } . toPandoc -latexListing :: (ToString a, ToPandoc a) => a -> String +latexListing :: (ToPandoc a) => a -> String latexListing = writeLaTeX def{ writerListings = True } . toPandoc {- diff --git a/tests/Tests/Writers/Markdown.hs b/tests/Tests/Writers/Markdown.hs --- a/tests/Tests/Writers/Markdown.hs +++ b/tests/Tests/Writers/Markdown.hs @@ -8,7 +8,7 @@ import Tests.Helpers import Tests.Arbitrary() -markdown :: (ToString a, ToPandoc a) => a -> String +markdown :: (ToPandoc a) => a -> String markdown = writeMarkdown def . toPandoc {- diff --git a/tests/docx/comments.docx b/tests/docx/comments.docx new file mode 100644 Binary files /dev/null and b/tests/docx/comments.docx differ diff --git a/tests/docx/comments.native b/tests/docx/comments.native new file mode 100644 --- /dev/null +++ b/tests/docx/comments.native @@ -0,0 +1,4 @@ +[Para [Str "I",Space,Str "want",Space,Span ("",["comment-start"],[("id","0"),("author","Jesse Rosenthal"),("date","2016-05-09T16:13:00Z")]) [Str "I",Space,Str "left",Space,Str "a",Space,Str "comment."],Str "some",Space,Str "text",Space,Str "to",Space,Str "have",Space,Str "a",Space,Str "comment",Space,Span ("",["comment-end"],[("id","0")]) [],Str "on",Space,Str "it."] +,Para [Str "This",Space,Str "is",Space,Span ("",["comment-start"],[("id","1"),("author","Jesse Rosenthal"),("date","2016-05-09T16:13:00Z")]) [Str "A",Space,Str "comment",Space,Str "across",Space,Str "paragraphs."],Str "a",Space,Str "new",Space,Str "paragraph."] +,Para [Str "And",Space,Str "so",Span ("",["comment-end"],[("id","1")]) [],Space,Str "is",Space,Str "this."] +,Para [Str "One",Space,Span ("",["comment-start"],[("id","2"),("author","Jesse Rosenthal"),("date","2016-05-09T16:14:00Z")]) [Str "This",Space,Str "one",Space,Str "has",Space,Str "multiple",Space,Str "paragraphs.",Space,Str "\182",Space,Str "See?"],Str "more",Span ("",["comment-end"],[("id","2")]) [],Str ".",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "one",Space,Str "with",Space,Str "a",Space,Span ("",["comment-start"],[("id","3"),("author","Jesse Rosenthal"),("date","2016-06-22T14:35:00Z")]) [Str "Do",Space,Str "something."],Span ("",["comment-start"],[("id","4"),("author","Jesse Rosenthal"),("date","2016-06-22T14:36:00Z")]) [Str "Do",Space,Str "something",Space,Str "else."],Str "comment",Space,Str "in",Space,Str "a",Space,Str "comment",Span ("",["comment-end"],[("id","3")]) [Span ("",["comment-end"],[("id","4")]) []],Str "."]] diff --git a/tests/docx/comments_no_comments.native b/tests/docx/comments_no_comments.native new file mode 100644 --- /dev/null +++ b/tests/docx/comments_no_comments.native @@ -0,0 +1,4 @@ +[Para [Str "I",Space,Str "want",Space,Str "some",Space,Str "text",Space,Str "to",Space,Str "have",Space,Str "a",Space,Str "comment",Space,Str "on",Space,Str "it."] +,Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "new",Space,Str "paragraph."] +,Para [Str "And",Space,Str "so",Space,Str "is",Space,Str "this."] +,Para [Str "One",Space,Str "more.",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "comment",Space,Str "in",Space,Str "a",Space,Str "comment."]] diff --git a/tests/docx/comments_warning.docx b/tests/docx/comments_warning.docx new file mode 100644 Binary files /dev/null and b/tests/docx/comments_warning.docx differ diff --git a/tests/latex-reader.native b/tests/latex-reader.native --- a/tests/latex-reader.native +++ b/tests/latex-reader.native @@ -260,7 +260,7 @@ ,HorizontalRule ,Header 1 ("latex",[],[]) [Str "LaTeX"] ,BulletList - [[Para [Cite [Citation {citationId = "smith.1899", citationPrefix = [], citationSuffix = [Str "22-23"], citationMode = AuthorInText, citationNoteNum = 0, citationHash = 0}] [RawInline (Format "latex") "\\cite[22-23]{smith.1899}"]]] + [[Para [Cite [Citation {citationId = "smith.1899", citationPrefix = [], citationSuffix = [Str "22-23"], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 0}] [RawInline (Format "latex") "\\cite[22-23]{smith.1899}"]]] ,[Para [RawInline (Format "latex") "\\doublespacing"]] ,[Para [Math InlineMath "2+2=4"]] ,[Para [Math InlineMath "x \\in y"]] diff --git a/tests/lhs-test.latex b/tests/lhs-test.latex --- a/tests/lhs-test.latex +++ b/tests/lhs-test.latex @@ -21,8 +21,8 @@ \usepackage{microtype} \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts }{} -\usepackage{hyperref} -\hypersetup{unicode=true, +\usepackage[unicode=true]{hyperref} +\hypersetup{ pdfborder={0 0 0}, breaklinks=true} \urlstyle{same} % don't use monospace font for urls diff --git a/tests/lhs-test.latex+lhs b/tests/lhs-test.latex+lhs --- a/tests/lhs-test.latex+lhs +++ b/tests/lhs-test.latex+lhs @@ -21,8 +21,8 @@ \usepackage{microtype} \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts }{} -\usepackage{hyperref} -\hypersetup{unicode=true, +\usepackage[unicode=true]{hyperref} +\hypersetup{ pdfborder={0 0 0}, breaklinks=true} \urlstyle{same} % don't use monospace font for urls diff --git a/tests/rst-reader.native b/tests/rst-reader.native --- a/tests/rst-reader.native +++ b/tests/rst-reader.native @@ -211,6 +211,7 @@ ,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 --- a/tests/rst-reader.rst +++ b/tests/rst-reader.rst @@ -378,6 +378,8 @@ Explicit: a `URL `_. +Explicit with no label: ``_. + Two anonymous links: `the first`__ and `the second`__ __ /url1/ diff --git a/tests/tables.zimwiki b/tests/tables.zimwiki new file mode 100644 --- /dev/null +++ b/tests/tables.zimwiki @@ -0,0 +1,56 @@ +Simple table with caption: + +Demonstration of simple table syntax. +| Right|Left | Center |Default| +|------:|:-----|:--------:|-------| +| 12|12 | 12 |12 | +| 123|123 | 123 |123 | +| 1|1 | 1 |1 | + +Simple table without caption: + +| Right|Left | Center |Default| +|------:|:-----|:--------:|-------| +| 12|12 | 12 |12 | +| 123|123 | 123 |123 | +| 1|1 | 1 |1 | + +Simple table indented two spaces: + +Demonstration of simple table syntax. +| Right|Left | Center |Default| +|------:|:-----|:--------:|-------| +| 12|12 | 12 |12 | +| 123|123 | 123 |123 | +| 1|1 | 1 |1 | + +Multiline table with caption: + +Here's the caption. It may span multiple lines. +| Centered Header |Left Aligned | Right Aligned|Default aligned | +|:-----------------:|:-------------|--------------:|:------------------------------------------------------| +| First |row | 12.0|Example of a row that spans multiple lines. | +| Second |row | 5.0|Here's another one. Note the blank line between rows. | + +Multiline table without caption: + +| Centered Header |Left Aligned | Right Aligned|Default aligned | +|:-----------------:|:-------------|--------------:|:------------------------------------------------------| +| First |row | 12.0|Example of a row that spans multiple lines. | +| Second |row | 5.0|Here's another one. Note the blank line between rows. | + +Table without column headers: + +| 12|12 | 12 | 12| +|----:|:----|:-----:|----:| +| 12|12 | 12 | 12| +| 123|123 | 123 | 123| +| 1|1 | 1 | 1| + +Multiline table without column headers: + +| First |row | 12.0|Example of a row that spans multiple lines. | +|:--------:|:----|-----:|-----------------------------------------------------| +| First |row | 12.0|Example of a row that spans multiple lines. | +| Second |row | 5.0|Here's another one. Note the blank line between rows.| + diff --git a/tests/textile-reader.native b/tests/textile-reader.native --- a/tests/textile-reader.native +++ b/tests/textile-reader.native @@ -146,6 +146,8 @@ ,[[Plain [Str "joan"]] ,[Plain [Str "24"]] ,[Plain [Str "f"]]]] +,Para [Emph [Str "(class#id)",Space,Str "emph"]] +,Para [Emph [Str "(no",Space,Str "class#id)",Space,Str "emph"]] ,Header 1 ("entities",[],[]) [Str "Entities"] ,Para [Str "*",LineBreak,Str "&"] ,Header 1 ("raw-html",[],[]) [Str "Raw",Space,Str "HTML"] diff --git a/tests/textile-reader.textile b/tests/textile-reader.textile --- a/tests/textile-reader.textile +++ b/tests/textile-reader.textile @@ -213,13 +213,17 @@ h2<>{color:blue}[en]. Justified -as well as *(foo)inline attributes* of %{color:red} all kind% +as well as *(foo)inline attributes* of %{color:red}all kind% p{color:green}. and paragraph attributes, and table attributes. table{foo:bar}. | name | age | sex | | joan | 24 | f | + +_(class#id) emph_ + +_(no class#id) emph_ h1. Entities diff --git a/tests/writer.html b/tests/writer.html --- a/tests/writer.html +++ b/tests/writer.html @@ -478,12 +478,7 @@

      URL and title

      URL and title

      with_underscore

      -

      +

      Email link

      Empty.

      Reference

      Foo bar.

      @@ -510,12 +505,7 @@
    1. http://example.com/
    2. It should.
      3. -

      An e-mail address:

      +

      An e-mail address: nobody@nowhere.net

      Blockquoted: http://example.com/

      diff --git a/tests/writer.latex b/tests/writer.latex --- a/tests/writer.latex +++ b/tests/writer.latex @@ -21,8 +21,8 @@ \usepackage{microtype} \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts }{} -\usepackage{hyperref} -\hypersetup{unicode=true, +\usepackage[unicode=true]{hyperref} +\hypersetup{ pdftitle={Pandoc Test Suite}, pdfauthor={John MacFarlane; Anonymous}, pdfborder={0 0 0}, diff --git a/tests/writer.org b/tests/writer.org --- a/tests/writer.org +++ b/tests/writer.org @@ -405,54 +405,14 @@ Simple block on one line: -#+BEGIN_HTML -
      -#+END_HTML - foo -#+BEGIN_HTML -
      -#+END_HTML - And nested without indentation: -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - foo -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - bar -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - Interpreted markdown in a table: #+BEGIN_HTML @@ -497,16 +457,8 @@ Here's a simple block: -#+BEGIN_HTML -
      -#+END_HTML - foo -#+BEGIN_HTML -
      -#+END_HTML - This should be a code block, though: #+BEGIN_EXAMPLE @@ -523,31 +475,7 @@ Now, nested: -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - foo - -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML - -#+BEGIN_HTML -
      -#+END_HTML This should just be an HTML comment: diff --git a/tests/writer.zimwiki b/tests/writer.zimwiki new file mode 100644 --- /dev/null +++ b/tests/writer.zimwiki @@ -0,0 +1,627 @@ +Content-Type: text/x-zim-wiki +Wiki-Format: zim 0.4 + +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 embedded link ===== + +==== Level 3 with emphasis ==== + +=== Level 4 === + +== Level 5 == + +====== Level 1 ====== + +===== Level 2 with emphasis ===== + +==== Level 3 ==== + +with no blank line + +===== Level 2 ===== + +with no blank line + + +---- + +====== 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. + +Here’s one with a bullet. * criminey. + +There should be a hard line break +here. + + +---- + +====== Block Quotes ====== + +E-mail style: + +> This is a block quote. It is pretty short. + +> Code in a block quote: +> +> ''' +> sub status { +> print "working"; +> } +> ''' +> +> A list: +> +> 1. item one +> 1. item two +> +> Nested block quotes: +> +> > nested +> +> > nested + +This should not be a block quote: 2 > 1. + +And a following paragraph. + + +---- + +====== Code Blocks ====== + +Code: + +''' +---- (should be four hyphens) + +sub status { + print "working"; +} + +this code block is indented by one tab +''' + +And: + +''' + this code block is indented by two tabs + +These should not be escaped: \$ \\ \> \[ \{ +''' + + +---- + +====== Lists ====== + +===== Unordered ===== + +Asterisks tight: + + * asterisk 1 + * asterisk 2 + * asterisk 3 + +Asterisks loose: + + * asterisk 1 + * asterisk 2 + * asterisk 3 + +Pluses tight: + + * Plus 1 + * Plus 2 + * Plus 3 + +Pluses loose: + + * Plus 1 + * Plus 2 + * Plus 3 + +Minuses tight: + + * Minus 1 + * Minus 2 + * Minus 3 + +Minuses loose: + + * Minus 1 + * Minus 2 + * Minus 3 + +===== Ordered ===== + +Tight: + + 1. First + 1. Second + 1. Third + +and: + + 1. One + 1. Two + 1. Three + +Loose using tabs: + + 1. First + 1. Second + 1. Third + +and using spaces: + + 1. One + 1. Two + 1. Three + +Multiple paragraphs: + + 1. Item 1, graf one. +Item 1. graf two. The quick brown fox jumped over the lazy dog’s back. + 1. Item 2. + 1. Item 3. + +===== Nested ===== + + * Tab + * Tab + * Tab + +Here’s another: + + 1. First + 1. Second: + * Fee + * Fie + * Foe + 1. Third + +Same thing but with paragraphs: + + 1. First + 1. Second: + * Fee + * Fie + * Foe + 1. Third + +===== Tabs and spaces ===== + + * this is a list item indented with tabs + * this is a list item indented with spaces + * this is an example list item indented with tabs + * this is an example list item indented with spaces + +===== Fancy list markers ===== + + 1. begins with 2 + 1. and now 3 +with a continuation + 1. sublist with roman numerals, starting with 4 + 1. more items + 1. a subsublist + 1. a subsublist + +Nesting: + + 1. Upper Alpha + 1. Upper Roman. + 1. Decimal start with 6 + 1. Lower alpha with paren + +Autonumbering: + + 1. Autonumber. + 1. More. + 1. Nested. + +Should not be a list item: + +M.A. 2007 + +B. Williams + + +---- + +====== Definition Lists ====== + +Tight using spaces: + +* **apple** red fruit +* **orange** orange fruit +* **banana** yellow fruit +Tight using tabs: + +* **apple** red fruit +* **orange** orange fruit +* **banana** yellow fruit +Loose: + +* **apple** red fruit + +* **orange** orange fruit + +* **banana** yellow fruit + +Multiple blocks with italics: + +* **//apple//** red fruit + +contains seeds, crisp, pleasant to taste + +* **//orange//** orange fruit + +''' +{ orange code block } +''' + +> orange block quote + +Multiple definitions, tight: + +* **apple** red fruitcomputer +* **orange** orange fruitbank +Multiple definitions, loose: + +* **apple** red fruit +computer + +* **orange** orange fruit +bank + +Blank line after term, indented marker, alternate markers: + +* **apple** red fruit +computer + +* **orange** orange fruit + + 1. sublist + 1. sublist + +====== HTML Blocks ====== + +Simple block on one line: + +foo + +And nested without indentation: + +foo + + + +bar + + +Interpreted markdown in a table: + + + + +This is //emphasized// + + +And this is **strong** + + + + +Here’s a simple block: + +foo + + +This should be a code block, though: + +''' +
      + foo +
      +''' + +As should this: + +''' +
      foo
      +''' + +Now, nested: + +foo + + + +This should just be an HTML comment: + + +Multiline: + + + +Code block: + +''' + +''' + +Just plain comment, with trailing spaces on the line: + + +Code: + +''' +
      +''' + +Hr’s: + + + + + + + + + + + +---- + +====== Inline Markup ====== + +This is //emphasized//, and so //is this//. + +This is **strong**, and so **is this**. + +An //[[url|emphasized link]]//. + +**//This is strong and em.//** + +So is **//this//** word. + +**//This is strong and em.//** + +So is **//this//** word. + +This is code: ''>'', ''$'', ''\'', ''\$'', ''''. + +~~This is //strikeout//.~~ + +Superscripts: a^{bc}d a^{//hello//} a^{hello there}. + +Subscripts: H_{2}O, H_{23}O, H_{many of them}O. + +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 “[[http://example.com/?foo=1&bar=2|quoted link]]”. + +Some dashes: one—two — three—four — five. + +Dashes between numbers: 5–7, 255–66, 1987–1999. + +Ellipses…and…and…. + + +---- + +====== LaTeX ====== + + * + * $2+2=4$ + * $x \in y$ + * $\alpha \wedge \omega$ + * $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: $\alpha + \omega \times x^2$. + +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.) + * Shoes ($20) and socks ($5). + * Escaped ''$'': $73 //this should be emphasized// 23$. + +Here’s a LaTeX table: + + + +---- + +====== Special Characters ====== + +Here is some unicode: + + * I hat: Î + * o umlaut: ö + * section: § + * set membership: ∈ + * copyright: © + +AT&T has an ampersand in their name. + +AT&T is another way to write it. + +This & that. + +4 < 5. + +6 > 5. + +Backslash: \ + +Backtick: ` + +Asterisk: * + +Underscore: _ + +Left brace: { + +Right brace: } + +Left bracket: [ + +Right bracket: ] + +Left paren: ( + +Right paren: ) + +Greater-than: > + +Hash: # + +Period: . + +Bang: ! + +Plus: + + +Minus: - + + +---- + +====== Links ====== + +===== Explicit ===== + +Just a [[url/|URL]]. + +[[url/|URL and title]]. + +[[url/|URL and title]]. + +[[url/|URL and title]]. + +[[url/|URL and title]] + +[[url/|URL and title]] + +[[url/with_underscore|with_underscore]] + +[[mailto:nobody@nowhere.net|Email link]] + +[[|Empty]]. + +===== Reference ===== + +Foo [[url/|bar]]. + +Foo [[url/|bar]]. + +Foo [[url/|bar]]. + +With [[url/|embedded [brackets]]]. + +[[url/|b]] by itself should be a link. + +Indented [[url|once]]. + +Indented [[url|twice]]. + +Indented [[url|thrice]]. + +This should [not][] be a link. + +''' +[not]: /url +''' + +Foo [[url/|bar]]. + +Foo [[url/|biz]]. + +===== With ampersands ===== + +Here’s a [[http://example.com/?foo=1&bar=2|link with an ampersand in the URL]]. + +Here’s a link with an amersand in the link text: [[http://att.com/|AT&T]]. + +Here’s an [[script?foo=1&bar=2|inline link]]. + +Here’s an [[script?foo=1&bar=2|inline link in pointy braces]]. + +===== Autolinks ===== + +With an ampersand: http://example.com/?foo=1&bar=2 + + * In a list? + * http://example.com/ + * It should. + +An e-mail address: + +> Blockquoted: http://example.com/ + +Auto-links should not occur here: '''' + +''' +or here: +''' + + +---- + +====== Images ====== + +From “Voyage dans la Lune” by Georges Melies (1902): + +{{:lalune.jpg|Voyage dans la Lune lalune}} + +Here is a movie {{:movie.jpg|movie}} icon. + + +---- + +====== Footnotes ====== + +Here is a footnote reference,((Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document. +)) and another.((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). + +''' + { } +''' + +If you want, you can indent every line, but you can also be lazy and just indent the first line of each block. +)) This should //not// be a footnote reference, because it contains a space.[^my note] Here is an inline note.((This is //easier// to type. Inline notes may contain [[http://google.com|links]] and '']'' verbatim characters, as well as [bracketed text]. +)) + +> Notes can go in quotes.((In quote. +> )) + + 1. And in list items.((In list.)) + +This paragraph should not be part of the note, as it is not indented. diff --git a/tests/writers-lang-and-dir.latex b/tests/writers-lang-and-dir.latex --- a/tests/writers-lang-and-dir.latex +++ b/tests/writers-lang-and-dir.latex @@ -21,8 +21,8 @@ \usepackage{microtype} \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts }{} -\usepackage{hyperref} -\hypersetup{unicode=true, +\usepackage[unicode=true]{hyperref} +\hypersetup{ pdfborder={0 0 0}, breaklinks=true} \urlstyle{same} % don't use monospace font for urls diff --git a/trypandoc/index.html b/trypandoc/index.html --- a/trypandoc/index.html +++ b/trypandoc/index.html @@ -39,7 +39,7 @@ if (text && text != "") { $.getJSON("/cgi-bin/trypandoc", { from: from, to: to, text: text }, function(res) { - $("#results").text(res.result); + $("#results").text(res.html); $("#version").text(res.version); $("#command").text("pandoc --from " + from + " --to " + to); }); diff --git a/trypandoc/trypandoc.hs b/trypandoc/trypandoc.hs --- a/trypandoc/trypandoc.hs +++ b/trypandoc/trypandoc.hs @@ -33,7 +33,7 @@ let result = case reader $ tabFilter 4 $ T.unpack text of Right doc -> T.pack $ writer doc Left err -> error (show err) - let output = encode $ object [ T.pack "result" .= result + let output = encode $ object [ T.pack "html" .= result , T.pack "name" .= if fromFormat == "markdown_strict" then T.pack "pandoc (strict)"