diff --git a/MANUAL.txt b/MANUAL.txt --- a/MANUAL.txt +++ b/MANUAL.txt @@ -1,6 +1,6 @@ % Pandoc User's Guide % John MacFarlane -% December 2, 2017 +% December 8, 2017 Synopsis ======== @@ -14,21 +14,21 @@ another, and a command-line tool that uses this library. It can read [Markdown], [CommonMark], [PHP Markdown Extra], [GitHub-Flavored Markdown], [MultiMarkdown], and (subsets of) [Textile], -[reStructuredText], [HTML], [LaTeX], [MediaWiki markup], [TWiki markup], -[TikiWiki markup], [Creole 1.0], [Haddock markup], [OPML], [Emacs Org mode], -[DocBook], [Muse], [txt2tags], [Vimwiki], [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], +[reStructuredText], [HTML], [LaTeX], [MediaWiki markup], [TWiki +markup], [TikiWiki markup], [Creole 1.0], [Haddock markup], [OPML], +[Emacs Org mode], [DocBook], [Muse], [txt2tags], [Vimwiki], [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], [groff ms], [Emacs Org mode], [AsciiDoc], [InDesign ICML], [TEI -Simple], [Muse] and [Slidy], [Slideous], [DZSlides], [reveal.js] -or [S5] HTML slide shows. It can also produce [PDF] output on -systems where LaTeX, ConTeXt, `pdfroff`, `wkhtmltopdf`, -`prince`, or `weasyprint` is installed. +Simple], [Muse], [PowerPoint] slide shows and [Slidy], [Slideous], +[DZSlides], [reveal.js] or [S5] HTML slide shows. It can also produce +[PDF] output on systems where LaTeX, ConTeXt, `pdfroff`, +`wkhtmltopdf`, `prince`, or `weasyprint` is installed. Pandoc's enhanced version of Markdown includes syntax for [footnotes], [tables], flexible [ordered lists], [definition lists], [fenced code @@ -102,6 +102,7 @@ [InDesign ICML]: https://www.adobe.com/content/dam/Adobe/en/devnet/indesign/cs55-docs/IDML/idml-specification.pdf [TEI Simple]: https://github.com/TEIC/TEI-Simple [Muse]: https://amusewiki.org/library/manual +[PowerPoint]: https://en.wikipedia.org/wiki/Microsoft_PowerPoint [Vimwiki]: https://vimwiki.github.io Using `pandoc` @@ -303,36 +304,35 @@ (original unextended Markdown), `markdown_phpextra` (PHP Markdown Extra), `markdown_mmd` (MultiMarkdown), `gfm` (GitHub-Flavored Markdown), `commonmark` (CommonMark Markdown), `rst` - (reStructuredText), `html4` (XHTML 1.0 Transitional), `html` - or `html5` (HTML5/XHTML [polyglot markup]), `latex` - (LaTeX), `beamer` (LaTeX beamer slide show), `context` (ConTeXt), - `man` (groff man), `mediawiki` (MediaWiki markup), - `dokuwiki` (DokuWiki markup), `zimwiki` (ZimWiki markup), - `textile` (Textile), `org` (Emacs Org mode), `texinfo` (GNU Texinfo), - `opml` (OPML), `docbook` or `docbook4` (DocBook 4), `docbook5` - (DocBook 5), `jats` (JATS XML), `opendocument` (OpenDocument), - `odt` (OpenOffice text document), `docx` (Word docx), `haddock` - (Haddock markup), `rtf` (rich text format), `epub2` (EPUB v2 book), - `epub` or `epub3` (EPUB v3), `fb2` (FictionBook2 e-book), - `asciidoc` (AsciiDoc), `icml` (InDesign ICML), `tei` (TEI - Simple), `slidy` (Slidy HTML and JavaScript slide show), - `slideous` (Slideous HTML and JavaScript slide show), - `dzslides` (DZSlides HTML5 + JavaScript slide show), - `revealjs` (reveal.js HTML5 + JavaScript slide show), `s5` - (S5 HTML and JavaScript slide show), or the path of a custom - lua writer (see [Custom writers], below). (`markdown_github` - provides deprecated and less accurate support for - Github-Flavored Markdown; please use `gfm` instead, unless - you use extensions that do not work with `gfm`.) Note that `odt`, - `epub`, and `epub3` output will not be directed to *stdout*; - an output filename must be specified using the `-o/--output` - option. If `+lhs` is appended to `markdown`, `rst`, `latex`, - `beamer`, `html4`, or `html5`, the output will be rendered as - literate Haskell source: see [Literate Haskell support], - below. Markdown syntax extensions can be individually - enabled or disabled by appending `+EXTENSION` or - `-EXTENSION` to the format name, as described above under `-f`. - See `--list-output-formats` and `--list-extensions`, below. + (reStructuredText), `html4` (XHTML 1.0 Transitional), `html` or + `html5` (HTML5/XHTML [polyglot markup]), `latex` (LaTeX), `beamer` + (LaTeX beamer slide show), `context` (ConTeXt), `man` (groff man), + `mediawiki` (MediaWiki markup), `dokuwiki` (DokuWiki markup), + `zimwiki` (ZimWiki markup), `textile` (Textile), `org` (Emacs Org + mode), `texinfo` (GNU Texinfo), `opml` (OPML), `docbook` or + `docbook4` (DocBook 4), `docbook5` (DocBook 5), `jats` (JATS XML), + `opendocument` (OpenDocument), `odt` (OpenOffice text document), + `docx` (Word docx), `haddock` (Haddock markup), `rtf` (rich text + format), `epub2` (EPUB v2 book), `epub` or `epub3` (EPUB v3), + `fb2` (FictionBook2 e-book), `asciidoc` (AsciiDoc), `icml` + (InDesign ICML), `tei` (TEI Simple), `slidy` (Slidy HTML and + JavaScript slide show), `slideous` (Slideous HTML and JavaScript + slide show), `dzslides` (DZSlides HTML5 + JavaScript slide show), + `revealjs` (reveal.js HTML5 + JavaScript slide show), `s5` (S5 + HTML and JavaScript slide show), `pptx` (PowerPoint slide show) or + the path of a custom lua writer (see [Custom writers], + below). (`markdown_github` provides deprecated and less accurate + support for Github-Flavored Markdown; please use `gfm` instead, + unless you use extensions that do not work with `gfm`.) Note that + `odt`, `epub`, and `epub3` output will not be directed to + *stdout*; an output filename must be specified using the + `-o/--output` option. If `+lhs` is appended to `markdown`, `rst`, + `latex`, `beamer`, `html4`, or `html5`, the output will be + rendered as literate Haskell source: see [Literate Haskell + support], below. Markdown syntax extensions can be individually + enabled or disabled by appending `+EXTENSION` or `-EXTENSION` to + the format name, as described above under `-f`. See + `--list-output-formats` and `--list-extensions`, below. `-o` *FILE*, `--output=`*FILE* @@ -429,7 +429,8 @@ `--strip-empty-paragraphs` -: Ignore paragraphs with non content. This option is useful +: *Deprecated. Use the `+empty_paragraphs` extension instead.* + Ignore paragraphs with no content. This option is useful for converting word processing documents where users have used empty paragraphs to create inter-paragraph space. @@ -1531,6 +1532,11 @@ `natbiboptions` : list of options for natbib. +`pagestyle` +: An option for LaTeX's `\pagestyle{}`. The default article class + supports 'plain' (default), 'empty', and 'headings'; headings puts + section titles in the header. + [`article`]: https://ctan.org/pkg/article [`report`]: https://ctan.org/pkg/report [`book`]: https://ctan.org/pkg/book @@ -2631,7 +2637,10 @@ row whose printable content is wider than the column width (see `--columns`), then the cell contents will wrap, with the relative cell widths determined by the widths of the separator -lines. +lines. (In this case, the table will take up the full text +width.) If no lines are wider than column width, then +cell contents will not be wrapped, and the cells will be sized +to their contents. Note: pandoc also recognizes pipe tables of the following form, as can be produced by Emacs' orgtbl-mode: @@ -3817,6 +3826,12 @@ we must either disallow lazy wrapping or require a blank line between list items. +#### Extension: `empty_paragraphs` #### + +Allows empty paragraphs. By default empty paragraphs are +omitted. This affects the `docx` reader and writer, the +`opendocument` and `odt` writer, and all HTML-based readers and writers. + Markdown variants ----------------- @@ -3860,8 +3875,9 @@ These can all be individually disabled. Note, however, that `commonmark` and `gfm` have limited support for extensions: - extensions other than those listed above (and `smart`) will have - no effect on `commonmark` or `gfm`. + extensions other than those listed above (and `smart` and + `raw_tex`) will have no effect on `commonmark` or `gfm`. + And `raw_tex` only affects `gfm` output, not input. Extensions with formats other than Markdown ------------------------------------------- @@ -3883,7 +3899,8 @@ You can use pandoc to produce an HTML + JavaScript slide presentation that can be viewed via a web browser. There are five ways to do this, using [S5], [DZSlides], [Slidy], [Slideous], or [reveal.js]. -You can also produce a PDF slide show using LaTeX [`beamer`]. +You can also produce a PDF slide show using LaTeX [`beamer`], or +slides shows in Microsoft [PowerPoint] format. Here's the Markdown source for a simple slide show, `habits.txt`: @@ -3944,6 +3961,10 @@ Note that a reveal.js slide show can also be converted to a PDF by printing it to a file from the browser. + +To produce a Powerpoint slide show, type + + pandoc habits.txt -o habits.pptx Structuring the slide show -------------------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -29,9 +29,9 @@ markup], [DokuWiki markup], [ZimWiki markup], [Haddock markup], [EPUB] \(v2 or v3\), [FictionBook2], [Textile], [groff man], [groff ms], [Emacs Org mode], [AsciiDoc], [InDesign ICML], [TEI -Simple], [Muse] and [Slidy], [Slideous], [DZSlides], [reveal.js] -or [S5] HTML slide shows. It can also produce [PDF] output on -systems where LaTeX, ConTeXt, `pdfroff`, `wkhtmltopdf`, +Simple], [Muse], [PowerPoint] slide shows and [Slidy], [Slideous], +[DZSlides], [reveal.js] or [S5] HTML slide shows. It can also produce +[PDF] output on systems where LaTeX, ConTeXt, `pdfroff`, `wkhtmltopdf`, `prince`, or `weasyprint` is installed. Pandoc's enhanced version of Markdown includes syntax for [footnotes], @@ -91,6 +91,7 @@ [TWiki markup]: http://twiki.org/cgi-bin/view/TWiki/TextFormattingRules [Haddock markup]: https://www.haskell.org/haddock/doc/html/ch03s08.html [groff man]: http://man7.org/linux/man-pages/man7/groff_man.7.html +[groff ms]: http://man7.org/linux/man-pages/man7/groff_ms.7.html [Haskell]: https://www.haskell.org [GNU Texinfo]: http://www.gnu.org/software/texinfo/ [Emacs Org mode]: http://orgmode.org @@ -103,6 +104,7 @@ [InDesign ICML]: https://www.adobe.com/content/dam/Adobe/en/devnet/indesign/cs55-docs/IDML/idml-specification.pdf [TEI Simple]: https://github.com/TEIC/TEI-Simple [Muse]: https://amusewiki.org/library/manual +[PowerPoint]: https://en.wikipedia.org/wiki/Microsoft_PowerPoint [Vimwiki]: https://vimwiki.github.io diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,101 @@ +pandoc (2.0.5) + + * Fix a bug in 2.0.4, whereby pandoc could not read the theme files + generated with `--print-highlight-style` (#4133). Improve JSON + serialization of styles. + + * Fix CSS issues involving line numbers (#4128). + Highlighted code blocks are now enclosed in a div with class `sourceCode`. + Highlighting CSS no longer sets a generic color for pre and code; we only + set these for class `sourceCode`. + + * `--pdf-engine-opt`: fix bug where option order was reversed (#4137). + + * Add PowerPoint (pptx) writer (Jesse Rosenthal). + It works following the standard Pandoc conventions for making other + sorts of slides. Caveats: + + + Syntax highlighting is not yet implemented. (This is difficult + because there are no character classes in Powerpoint.) + + Footnotes and Definition lists are not yet implemented. (Notes will + usually take the form of a final slide. + + Image placement and auto-resizing has a few glitches. + + Reference powerpoint files don't work dependably from the command + line. This will be implemented, but at the moment users are advised + to change themes from within Powerpoint. + + * Create shared Text.Pandoc.Writers.OOXML module (Jesse Rosenthal). + This is for functions used by both Powerpoint and Docx writers. + + * Add default pptx data for Powerpoint writer (Jesse Rosenthal). + + * Add `empty_paragraphs` extension. + + + Deprecate `--strip-empty-paragraphs` option. Instead we now + use an `empty_paragraphs` extension that can be enabled on + the reader or writer. By default, disabled. + + Add `Ext_empty_paragraphs` constructor to `Extension`. + + Revert "Docx reader: don't strip out empty paragraphs." + This reverts commit d6c58eb836f033a48955796de4d9ffb3b30e297b. + + Implement `empty_paragraphs` extension in docx reader and writer, + opendocument writer, html reader and writer. + + Add tests for `empty_paragraphs` extension. + + * Markdown reader: + + + Don't parse native div as table caption (#4119). + + Improved computation of column widths in pipe tables. + Pipe tables with lines longer than the text width (as set + by `--columns`) are now scaled to text width, with the relative + widths of columns determined by the ratios between the + header lines. Previously we computed column widths using + the ratio of header line lengths to column width, so that + tables with narrow header lines were extremely thin, which + was very rarely the desired result. + + * LaTeX reader: fix `\` before newline (#4134). This should be a space, + as long as it's not followed by a blank line. This has been fixed at the + tokenizer level. + + * Muse reader (Alexander Krotov): + + + Add test for `#disable-tables` directive in Emacs mode. + + Don't allow emphasis to be preceded by letter. + + Add underline support in Emacs Muse mode.. + + Support multiline directives in Amusewiki mode + + * Man writer: omit internal links (#4136). That is, just print the link + text without the URL. + + * Markdown reader: accept processing instructions as raw HTML (#4125). + + * Lua filters (Albert Krewinkel): + + + Use script to initialize the interpreter. The file `init.lua` is + used to initialize the Lua interpreter which is used in Lua filters. + This gives users the option to require libraries which they want to + use in all of their filters, and to extend default modules. + + Fix package loading for Lua 5.1. The list of package searchers is + named `package.loaders` in Lua 5.1 and LuaJIT, and `package.searchers` + in Lua 5.2 and later. + + Refactor lua module handling. The integration with Lua's package/module + system is improved: A pandoc-specific package searcher is prepended to + the searchers in `package.searchers`. The modules `pandoc` and + `pandoc.mediabag` can now be loaded via `require`. + + Bump lower bound of hslua. The release hslua 0.9.3 contains a new + function which makes using Haskell functions as package loaders much + easier. + + * reveal.js template: add title-slide identifier to title slide (#4120). + This allows it to be styled more easily. + + * LaTeX template: Added support for `pagestyle` variable (#4135, + Thomas Hodgson) + + * Add `-threaded` to ghc-options for executable (#4130, fixes a build + error on linux). + + pandoc (2.0.4) * Add `--print-highlight-style` option. This generates a JSON version @@ -583,7 +681,7 @@ specified if the `--resource-path` option is used. * Added --abbreviations=FILE option for custom abbreviations file - (#256). Dfault abbreviations file (`data/abbreviations`) contains + (#256). Default abbreviations file (`data/abbreviations`) contains a list of strings that will be recognized by pandoc's Markdown parser as abbreviations. (A nonbreaking space will be inserted after the period, preventing a sentence space in @@ -659,9 +757,9 @@ * Add `space_in_atx_header` extension (#3512). This is enabled by default in pandoc and GitHub markdown but not the other flavors. - This requirse a space between the opening #'s and the header + This requires a space between the opening #'s and the header text in ATX headers (as CommonMark does but many other implementations - do not). This is desirable to avoid falsely capturing things ilke + do not). This is desirable to avoid falsely capturing things like #hashtag @@ -1455,7 +1553,7 @@ interpreted using Markdown rules. + Preserve classes in JS obfuscated links (Timm Albers, #2989). HTML links containing classes originally now preserve them when using - javascript email obfuscation. + JavaScript email obfuscation. + Render `SmallCaps` as a native span when `native_spans` are enabled. + Always write attributes with `bracketed_spans` (d-dorazio). diff --git a/data/List.lua b/data/List.lua deleted file mode 100644 --- a/data/List.lua +++ /dev/null @@ -1,120 +0,0 @@ ---[[ -List.lua - -Copyright © 2017 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any purpose -with or without fee is hereby granted, provided that the above copyright notice -and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH -REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, -INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER -TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF -THIS SOFTWARE. -]] - ---- Pandoc's List type and helper methods --- @classmod pandoc.List --- @author Albert Krewinkel --- @copyright © 2017 Albert Krewinkel --- @license MIT -local List = { - _VERSION = "0.1.0" -} - -function List:new (o) - o = o or {} - setmetatable(o, self) - self.__index = self - return o -end - -function List:__call (o) - return self:new(o) -end - ---- Concatenates two lists. --- @param list second list concatenated to the first --- @return a new list containing all elements from list1 and list2 -function List:__concat (list) - local res = List.clone(self) - List.extend(res, list) - return res -end - ---- Returns a (shallow) copy of the list. -function List:clone () - local lst = setmetatable({}, getmetatable(self)) - List.extend(lst, self) - return lst -end - ---- Checks if the list has an item equal to the given needle. --- @param needle item to search for --- @param init index at which the search is started --- @return true if a list item is equal to the needle, false otherwise -function List:includes (needle, init) - return not (List.find(self, needle, init) == nil) -end - ---- Returns the value and index of the first occurrence of the given item. --- @param needle item to search for --- @param init index at which the search is started --- @return first item equal to the needle, or nil if no such item exists. --- @return index of that element -function List:find (needle, init) - return List.find_if(self, function(x) return x == needle end, init) -end - ---- Returns the value and index of the first element for which the predicate ---- holds true. --- @param pred the predicate function --- @param init index at which the search is started --- @return first item for which `test` succeeds, or nil if no such item exists. --- @return index of that element -function List:find_if (pred, init) - init = (init == nil and 1) or (init < 0 and #self - init) or init - for i = init, #self do - if pred(self[i], i) then - return self[i], i - end - end - return nil -end - ---- Adds the given list to the end of this list. --- @param list list to appended -function List:extend (list) - for i = 1, #list do - self[#self + 1] = list[i] - end -end - ---- Returns a copy of the current list by applying the given function to all --- elements. --- @param fn function which is applied to all list items. -function List:map (fn) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - res[i] = fn(self[i], i) - end - return res -end - ---- Returns a new list containing all items satisfying a given condition. --- @param pred condition items must satisfy. --- @return a new list containing all items for which `test` was true. -function List:filter (pred) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - if pred(self[i], i) then - res[#res + 1] = self[i] - end - end - return res -end - -return List diff --git a/data/init.lua b/data/init.lua new file mode 100644 --- /dev/null +++ b/data/init.lua @@ -0,0 +1,6 @@ +-- This Lua script is run every time the Lua interpreter is started when running +-- a Lua filter. It can be customized to load additional modules or to alter the +-- default modules. + +pandoc = require 'pandoc' +pandoc.mediabag = require 'pandoc.mediabag' diff --git a/data/pandoc.List.lua b/data/pandoc.List.lua new file mode 100644 --- /dev/null +++ b/data/pandoc.List.lua @@ -0,0 +1,120 @@ +--[[ +List.lua + +Copyright © 2017 Albert Krewinkel + +Permission to use, copy, modify, and/or distribute this software for any purpose +with or without fee is hereby granted, provided that the above copyright notice +and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF +THIS SOFTWARE. +]] + +--- Pandoc's List type and helper methods +-- @classmod pandoc.List +-- @author Albert Krewinkel +-- @copyright © 2017 Albert Krewinkel +-- @license MIT +local List = { + _VERSION = "0.1.0" +} + +function List:new (o) + o = o or {} + setmetatable(o, self) + self.__index = self + return o +end + +function List:__call (o) + return self:new(o) +end + +--- Concatenates two lists. +-- @param list second list concatenated to the first +-- @return a new list containing all elements from list1 and list2 +function List:__concat (list) + local res = List.clone(self) + List.extend(res, list) + return res +end + +--- Returns a (shallow) copy of the list. +function List:clone () + local lst = setmetatable({}, getmetatable(self)) + List.extend(lst, self) + return lst +end + +--- Checks if the list has an item equal to the given needle. +-- @param needle item to search for +-- @param init index at which the search is started +-- @return true if a list item is equal to the needle, false otherwise +function List:includes (needle, init) + return not (List.find(self, needle, init) == nil) +end + +--- Returns the value and index of the first occurrence of the given item. +-- @param needle item to search for +-- @param init index at which the search is started +-- @return first item equal to the needle, or nil if no such item exists. +-- @return index of that element +function List:find (needle, init) + return List.find_if(self, function(x) return x == needle end, init) +end + +--- Returns the value and index of the first element for which the predicate +--- holds true. +-- @param pred the predicate function +-- @param init index at which the search is started +-- @return first item for which `test` succeeds, or nil if no such item exists. +-- @return index of that element +function List:find_if (pred, init) + init = (init == nil and 1) or (init < 0 and #self - init) or init + for i = init, #self do + if pred(self[i], i) then + return self[i], i + end + end + return nil +end + +--- Adds the given list to the end of this list. +-- @param list list to appended +function List:extend (list) + for i = 1, #list do + self[#self + 1] = list[i] + end +end + +--- Returns a copy of the current list by applying the given function to all +-- elements. +-- @param fn function which is applied to all list items. +function List:map (fn) + local res = setmetatable({}, getmetatable(self)) + for i = 1, #self do + res[i] = fn(self[i], i) + end + return res +end + +--- Returns a new list containing all items satisfying a given condition. +-- @param pred condition items must satisfy. +-- @return a new list containing all items for which `test` was true. +function List:filter (pred) + local res = setmetatable({}, getmetatable(self)) + for i = 1, #self do + if pred(self[i], i) then + res[#res + 1] = self[i] + end + end + return res +end + +return List diff --git a/data/pandoc.lua b/data/pandoc.lua --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -162,7 +162,7 @@ -- @tparam meta table table containing document meta information M.Meta = {} M.Meta.__call = function(t, meta) - return setmetatable(meta, self) + return setmetatable(meta, t) end setmetatable(M.Meta, M.Meta) diff --git a/data/pptx/[Content_Types].xml b/data/pptx/[Content_Types].xml new file mode 100644 --- /dev/null +++ b/data/pptx/[Content_Types].xml @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/_rels/.rels b/data/pptx/_rels/.rels new file mode 100644 --- /dev/null +++ b/data/pptx/_rels/.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/docProps/app.xml b/data/pptx/docProps/app.xml new file mode 100644 --- /dev/null +++ b/data/pptx/docProps/app.xml @@ -0,0 +1,2 @@ + +18Microsoft Macintosh PowerPointOn-screen Show (4:3)42000falseTheme1Slide Titles2Office ThemeTitleSlide Titlefalsefalsefalse14.0000 diff --git a/data/pptx/docProps/core.xml b/data/pptx/docProps/core.xml new file mode 100644 --- /dev/null +++ b/data/pptx/docProps/core.xml @@ -0,0 +1,2 @@ + +TitleJesse RosenthalJesse Rosenthal12017-06-05T14:10:58Z2017-06-05T14:12:07Z diff --git a/data/pptx/docProps/thumbnail.jpeg b/data/pptx/docProps/thumbnail.jpeg new file mode 100644 Binary files /dev/null and b/data/pptx/docProps/thumbnail.jpeg differ diff --git a/data/pptx/ppt/_rels/presentation.xml.rels b/data/pptx/ppt/_rels/presentation.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/_rels/presentation.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/presProps.xml b/data/pptx/ppt/presProps.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/presProps.xml @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/presentation.xml b/data/pptx/ppt/presentation.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/presentation.xml @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout1.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout1.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout1.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout10.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout10.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout10.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout11.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout11.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout11.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout2.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout2.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout2.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout3.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout3.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout3.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout4.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout4.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout4.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout5.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout5.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout5.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout6.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout6.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout6.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout7.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout7.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout7.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout8.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout8.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout8.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/_rels/slideLayout9.xml.rels b/data/pptx/ppt/slideLayouts/_rels/slideLayout9.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/_rels/slideLayout9.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideLayouts/slideLayout1.xml b/data/pptx/ppt/slideLayouts/slideLayout1.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout1.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master subtitle style6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout10.xml b/data/pptx/ppt/slideLayouts/slideLayout10.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout10.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout11.xml b/data/pptx/ppt/slideLayouts/slideLayout11.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout11.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout2.xml b/data/pptx/ppt/slideLayouts/slideLayout2.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout2.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout3.xml b/data/pptx/ppt/slideLayouts/slideLayout3.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout3.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text styles6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout4.xml b/data/pptx/ppt/slideLayouts/slideLayout4.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout4.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth levelClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout5.xml b/data/pptx/ppt/slideLayouts/slideLayout5.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout5.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesClick to edit Master text stylesSecond levelThird levelFourth levelFifth levelClick to edit Master text stylesClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout6.xml b/data/pptx/ppt/slideLayouts/slideLayout6.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout6.xml @@ -0,0 +1,2 @@ + +Click to edit Master title style6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout7.xml b/data/pptx/ppt/slideLayouts/slideLayout7.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout7.xml @@ -0,0 +1,2 @@ + +6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout8.xml b/data/pptx/ppt/slideLayouts/slideLayout8.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout8.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth levelClick to edit Master text styles6/5/17‹#› diff --git a/data/pptx/ppt/slideLayouts/slideLayout9.xml b/data/pptx/ppt/slideLayouts/slideLayout9.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideLayouts/slideLayout9.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text styles6/5/17‹#› diff --git a/data/pptx/ppt/slideMasters/_rels/slideMaster1.xml.rels b/data/pptx/ppt/slideMasters/_rels/slideMaster1.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideMasters/_rels/slideMaster1.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slideMasters/slideMaster1.xml b/data/pptx/ppt/slideMasters/slideMaster1.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slideMasters/slideMaster1.xml @@ -0,0 +1,2 @@ + +Click to edit Master title styleClick to edit Master text stylesSecond levelThird levelFourth levelFifth level6/5/17‹#› diff --git a/data/pptx/ppt/slides/_rels/slide1.xml.rels b/data/pptx/ppt/slides/_rels/slide1.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slides/_rels/slide1.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slides/_rels/slide2.xml.rels b/data/pptx/ppt/slides/_rels/slide2.xml.rels new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slides/_rels/slide2.xml.rels @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/slides/slide1.xml b/data/pptx/ppt/slides/slide1.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slides/slide1.xml @@ -0,0 +1,2 @@ + +TitleSubtitle diff --git a/data/pptx/ppt/slides/slide2.xml b/data/pptx/ppt/slides/slide2.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/slides/slide2.xml @@ -0,0 +1,2 @@ + +Slide TitleHello, world. diff --git a/data/pptx/ppt/tableStyles.xml b/data/pptx/ppt/tableStyles.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/tableStyles.xml @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/theme/theme1.xml b/data/pptx/ppt/theme/theme1.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/theme/theme1.xml @@ -0,0 +1,2 @@ + + diff --git a/data/pptx/ppt/viewProps.xml b/data/pptx/ppt/viewProps.xml new file mode 100644 --- /dev/null +++ b/data/pptx/ppt/viewProps.xml @@ -0,0 +1,2 @@ + + diff --git a/data/templates/default.latex b/data/templates/default.latex --- a/data/templates/default.latex +++ b/data/templates/default.latex @@ -245,6 +245,9 @@ \fi $endif$ $endif$ +$if(pagestyle)$ +\pagestyle{$pagestyle$} +$endif$ % set default figure placement to htbp \makeatletter diff --git a/data/templates/default.revealjs b/data/templates/default.revealjs --- a/data/templates/default.revealjs +++ b/data/templates/default.revealjs @@ -66,7 +66,7 @@
$if(title)$ -
+

$title$

$if(subtitle)$

$subtitle$

diff --git a/man/pandoc.1 b/man/pandoc.1 --- a/man/pandoc.1 +++ b/man/pandoc.1 @@ -1,5 +1,5 @@ .\"t -.TH PANDOC 1 "December 2, 2017" "pandoc 2.0.4" +.TH PANDOC 1 "December 8, 2017" "pandoc 2.0.5" .SH NAME pandoc - general markup converter .SH SYNOPSIS @@ -19,8 +19,9 @@ \f[C]beamer\f[] 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, groff ms, Emacs Org mode, AsciiDoc, InDesign ICML, TEI Simple, Muse -and Slidy, Slideous, DZSlides, reveal.js or S5 HTML slide shows. +man, groff ms, Emacs Org mode, AsciiDoc, InDesign ICML, TEI Simple, +Muse, PowerPoint slide shows and Slidy, Slideous, DZSlides, reveal.js or +S5 HTML slide shows. It can also produce PDF output on systems where LaTeX, ConTeXt, \f[C]pdfroff\f[], \f[C]wkhtmltopdf\f[], \f[C]prince\f[], or \f[C]weasyprint\f[] is installed. @@ -286,8 +287,8 @@ slide show), \f[C]slideous\f[] (Slideous HTML and JavaScript slide show), \f[C]dzslides\f[] (DZSlides HTML5 + JavaScript slide show), \f[C]revealjs\f[] (reveal.js HTML5 + JavaScript slide show), \f[C]s5\f[] -(S5 HTML and JavaScript slide show), or the path of a custom lua writer -(see Custom writers, below). +(S5 HTML and JavaScript slide show), \f[C]pptx\f[] (PowerPoint slide +show) or the path of a custom lua writer (see Custom writers, below). (\f[C]markdown_github\f[] provides deprecated and less accurate support for Github\-Flavored Markdown; please use \f[C]gfm\f[] instead, unless you use extensions that do not work with \f[C]gfm\f[].) Note that @@ -432,7 +433,8 @@ .RE .TP .B \f[C]\-\-strip\-empty\-paragraphs\f[] -Ignore paragraphs with non content. +\f[I]Deprecated. Use the \f[CI]+empty_paragraphs\f[I] extension +instead.\f[] Ignore paragraphs with no content. This option is useful for converting word processing documents where users have used empty paragraphs to create inter\-paragraph space. .RS @@ -1809,6 +1811,14 @@ list of options for natbib. .RS .RE +.TP +.B \f[C]pagestyle\f[] +An option for LaTeX\[aq]s \f[C]\\pagestyle{}\f[]. +The default article class supports \[aq]plain\[aq] (default), +\[aq]empty\[aq], and \[aq]headings\[aq]; headings puts section titles in +the header. +.RS +.RE .SS Variables for ConTeXt .TP .B \f[C]papersize\f[] @@ -3223,6 +3233,9 @@ column width (see \f[C]\-\-columns\f[]), then the cell contents will wrap, with the relative cell widths determined by the widths of the separator lines. +(In this case, the table will take up the full text width.) If no lines +are wider than column width, then cell contents will not be wrapped, and +the cells will be sized to their contents. .PP Note: pandoc also recognizes pipe tables of the following form, as can be produced by Emacs\[aq] orgtbl\-mode: @@ -4752,6 +4765,13 @@ .IP \[bu] 2 Lazy wrapping of paragraphs is not allowed: the entire definition must be indented four spaces. +.SS Extension: \f[C]empty_paragraphs\f[] +.PP +Allows empty paragraphs. +By default empty paragraphs are omitted. +This affects the \f[C]docx\f[] reader and writer, the +\f[C]opendocument\f[] and \f[C]odt\f[] writer, and all HTML\-based +readers and writers. .SS Markdown variants .PP In addition to pandoc\[aq]s extended Markdown, the following Markdown @@ -4811,8 +4831,9 @@ \f[C] These\ can\ all\ be\ individually\ disabled.\ Note,\ however,\ that `commonmark`\ and\ `gfm`\ have\ limited\ support\ for\ extensions: -extensions\ other\ than\ those\ listed\ above\ (and\ `smart`)\ will\ have -no\ effect\ on\ `commonmark`\ or\ `gfm`. +extensions\ other\ than\ those\ listed\ above\ (and\ `smart`\ and +`raw_tex`)\ will\ have\ no\ effect\ on\ `commonmark`\ or\ `gfm`. +And\ `raw_tex`\ only\ affects\ `gfm`\ output,\ not\ input. \f[] .fi .SS Extensions with formats other than Markdown @@ -4833,7 +4854,8 @@ that can be viewed via a web browser. There are five ways to do this, using S5, DZSlides, Slidy, Slideous, or reveal.js. -You can also produce a PDF slide show using LaTeX \f[C]beamer\f[]. +You can also produce a PDF slide show using LaTeX \f[C]beamer\f[], or +slides shows in Microsoft PowerPoint format. .PP Here\[aq]s the Markdown source for a simple slide show, \f[C]habits.txt\f[]: @@ -4912,6 +4934,14 @@ .PP Note that a reveal.js slide show can also be converted to a PDF by printing it to a file from the browser. +.PP +To produce a Powerpoint slide show, type +.IP +.nf +\f[C] +pandoc\ habits.txt\ \-o\ habits.pptx +\f[] +.fi .SS Structuring the slide show .PP By default, the \f[I]slide level\f[] is the highest header level in the diff --git a/pandoc.cabal b/pandoc.cabal --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,5 +1,5 @@ name: pandoc -version: 2.0.4 +version: 2.0.5 cabal-version: >= 1.10 build-type: Custom license: GPL @@ -25,8 +25,9 @@ RTF, MediaWiki, DokuWiki, ZimWiki, Textile, groff man, groff ms, plain text, Emacs Org-Mode, AsciiDoc, Haddock markup, EPUB (v2 and v3), FictionBook2, InDesign - ICML, Muse, and several kinds of HTML/JavaScript slide - shows (S5, Slidy, Slideous, DZSlides, reveal.js). + ICML, Muse, LaTeX beamer slides, PowerPoint, 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 @@ -98,6 +99,46 @@ data/odt/Configurations2/accelerator/current.xml data/odt/Thumbnails/thumbnail.png data/odt/META-INF/manifest.xml + -- source files for reference.pptx + data/pptx/_rels/.rels + data/pptx/docProps/thumbnail.jpeg + data/pptx/docProps/app.xml + data/pptx/docProps/core.xml + data/pptx/ppt/slideLayouts/slideLayout4.xml + data/pptx/ppt/slideLayouts/_rels/slideLayout9.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout2.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout10.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout1.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout3.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout5.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout7.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout8.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout11.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout4.xml.rels + data/pptx/ppt/slideLayouts/_rels/slideLayout6.xml.rels + data/pptx/ppt/slideLayouts/slideLayout2.xml + data/pptx/ppt/slideLayouts/slideLayout8.xml + data/pptx/ppt/slideLayouts/slideLayout11.xml + data/pptx/ppt/slideLayouts/slideLayout3.xml + data/pptx/ppt/slideLayouts/slideLayout6.xml + data/pptx/ppt/slideLayouts/slideLayout9.xml + data/pptx/ppt/slideLayouts/slideLayout5.xml + data/pptx/ppt/slideLayouts/slideLayout7.xml + data/pptx/ppt/slideLayouts/slideLayout1.xml + data/pptx/ppt/slideLayouts/slideLayout10.xml + data/pptx/ppt/_rels/presentation.xml.rels + data/pptx/ppt/theme/theme1.xml + data/pptx/ppt/presProps.xml + data/pptx/ppt/slides/_rels/slide1.xml.rels + data/pptx/ppt/slides/_rels/slide2.xml.rels + data/pptx/ppt/slides/slide2.xml + data/pptx/ppt/slides/slide1.xml + data/pptx/ppt/viewProps.xml + data/pptx/ppt/tableStyles.xml + data/pptx/ppt/slideMasters/_rels/slideMaster1.xml.rels + data/pptx/ppt/slideMasters/slideMaster1.xml + data/pptx/ppt/presentation.xml + data/pptx/[Content_Types].xml -- stylesheet for EPUB writer data/epub.css -- data for LaTeXMathML writer @@ -108,10 +149,12 @@ data/abbreviations -- sample lua custom writer data/sample.lua + -- lua init script + data/init.lua -- pandoc lua module data/pandoc.lua -- lua List module - data/List.lua + data/pandoc.List.lua -- sample highlighting theme data/default.theme -- bash completion template @@ -320,7 +363,7 @@ tagsoup >= 0.14.2 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, - skylighting >= 0.4.4.1 && < 0.5, + skylighting >= 0.5 && < 0.6, data-default >= 0.4 && < 0.8, temporary >= 1.1 && < 1.3, blaze-html >= 0.5 && < 0.10, @@ -328,7 +371,7 @@ yaml >= 0.8.8.2 && < 0.9, scientific >= 0.2 && < 0.4, vector >= 0.10 && < 0.13, - hslua >= 0.9 && < 0.10, + hslua >= 0.9.3 && < 0.10, hslua-module-text >= 0.1.2 && < 0.2, binary >= 0.5 && < 0.10, SHA >= 1.6 && < 1.7, @@ -431,12 +474,14 @@ Text.Pandoc.Writers.RTF, Text.Pandoc.Writers.ODT, Text.Pandoc.Writers.Docx, + Text.Pandoc.Writers.Powerpoint, Text.Pandoc.Writers.EPUB, Text.Pandoc.Writers.FB2, Text.Pandoc.Writers.TEI, Text.Pandoc.Writers.Muse, Text.Pandoc.Writers.Math, Text.Pandoc.Writers.Shared, + Text.Pandoc.Writers.OOXML, Text.Pandoc.Lua, Text.Pandoc.PDF, Text.Pandoc.UTF8, @@ -478,6 +523,7 @@ Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, Text.Pandoc.Readers.Org.Shared, + Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocModule, Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.StackInstances, @@ -494,7 +540,7 @@ executable pandoc build-depends: pandoc, base >= 4.7 && < 5 - ghc-options: -rtsopts -with-rtsopts=-K16m -Wall -fno-warn-unused-do-bind + ghc-options: -rtsopts -with-rtsopts=-K16m -Wall -fno-warn-unused-do-bind -threaded ghc-prof-options: -fprof-auto-exported -rtsopts -with-rtsopts=-K16m if flag(static) ld-options: -static diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -815,6 +815,7 @@ ".tei" -> "tei" ".ms" -> "ms" ".roff" -> "ms" + ".pptx" -> "pptx" ['.',y] | y `elem` ['1'..'9'] -> "man" _ -> "html" @@ -947,7 +948,10 @@ , Option "" ["strip-empty-paragraphs"] (NoArg - (\opt -> return opt{ optStripEmptyParagraphs = True })) + (\opt -> do + deprecatedOption "--stripEmptyParagraphs" + "Use +empty_paragraphs extension." + return opt{ optStripEmptyParagraphs = True })) "" -- "Strip empty paragraphs" , Option "" ["indented-code-classes"] @@ -1071,7 +1075,8 @@ (map T.pack ["text-color" ,"background-color" - ,"line-numbers" + ,"line-number-color" + ,"line-number-background-color" ,"bold" ,"italic" ,"underline" @@ -1400,7 +1405,7 @@ (ReqArg (\arg opt -> do let oldArgs = optPdfEngineArgs opt - return opt { optPdfEngineArgs = arg : oldArgs }) + return opt { optPdfEngineArgs = oldArgs ++ [arg]}) "STRING") "" -- "Flags to pass to the PDF-engine, all instances of this option are accumulated and used" @@ -1472,7 +1477,7 @@ , Option "m" ["latexmathml", "asciimathml"] (OptArg (\arg opt -> do - deprecatedOption "--latexmathml, --asciimathml, -m" + deprecatedOption "--latexmathml, --asciimathml, -m" "" return opt { optHTMLMathMethod = LaTeXMathML arg }) "URL") "" -- "Use LaTeXMathML script in html output" @@ -1480,7 +1485,7 @@ , Option "" ["mimetex"] (OptArg (\arg opt -> do - deprecatedOption "--mimetex" + deprecatedOption "--mimetex" "" let url' = case arg of Just u -> u ++ "?" Nothing -> "/cgi-bin/mimetex.cgi?" @@ -1491,7 +1496,7 @@ , Option "" ["jsmath"] (OptArg (\arg opt -> do - deprecatedOption "--jsmath" + deprecatedOption "--jsmath" "" return opt { optHTMLMathMethod = JsMath arg}) "URL") "" -- "Use jsMath for HTML math" @@ -1499,7 +1504,7 @@ , Option "" ["gladtex"] (NoArg (\opt -> do - deprecatedOption "--gladtex" + deprecatedOption "--gladtex" "" return opt { optHTMLMathMethod = GladTeX })) "" -- "Use gladtex for HTML math" @@ -1699,9 +1704,9 @@ baseWriterName :: String -> String baseWriterName = takeWhile (\c -> c /= '+' && c /= '-') -deprecatedOption :: String -> IO () -deprecatedOption o = - runIO (report $ Deprecated o "") >>= +deprecatedOption :: String -> String -> IO () +deprecatedOption o msg = + runIO (report $ Deprecated o msg) >>= \r -> case r of Right () -> return () Left e -> E.throwIO e diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -674,6 +674,66 @@ Nothing -> foldr addEntryToArchive emptyArchive <$> mapM pathToEntry paths +getDefaultReferencePptx :: PandocMonad m => m Archive +getDefaultReferencePptx = do + -- We're going to narrow this down substantially once we get it + -- working. + let paths = [ "[Content_Types].xml" + , "_rels/.rels" + , "docProps/app.xml" + , "docProps/core.xml" + , "ppt/_rels/presentation.xml.rels" + , "ppt/presProps.xml" + , "ppt/presentation.xml" + , "ppt/slideLayouts/_rels/slideLayout1.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout10.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout11.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout2.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout3.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout4.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout5.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout6.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout7.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout8.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout9.xml.rels" + , "ppt/slideLayouts/slideLayout1.xml" + , "ppt/slideLayouts/slideLayout10.xml" + , "ppt/slideLayouts/slideLayout11.xml" + , "ppt/slideLayouts/slideLayout2.xml" + , "ppt/slideLayouts/slideLayout3.xml" + , "ppt/slideLayouts/slideLayout4.xml" + , "ppt/slideLayouts/slideLayout5.xml" + , "ppt/slideLayouts/slideLayout6.xml" + , "ppt/slideLayouts/slideLayout7.xml" + , "ppt/slideLayouts/slideLayout8.xml" + , "ppt/slideLayouts/slideLayout9.xml" + , "ppt/slideMasters/_rels/slideMaster1.xml.rels" + , "ppt/slideMasters/slideMaster1.xml" + , "ppt/slides/_rels/slide1.xml.rels" + , "ppt/slides/slide1.xml" + , "ppt/tableStyles.xml" + , "ppt/theme/theme1.xml" + , "ppt/viewProps.xml" + ] + let toLazy = BL.fromChunks . (:[]) + let pathToEntry path = do + epochtime <- (floor . utcTimeToPOSIXSeconds) <$> getCurrentTime + contents <- toLazy <$> readDataFile ("pptx/" ++ path) + return $ toEntry path epochtime contents + datadir <- getUserDataDir + mbArchive <- case datadir of + Nothing -> return Nothing + Just d -> do + exists <- fileExists (d "reference.pptx") + if exists + then return (Just (d "reference.pptx")) + else return Nothing + case mbArchive of + Just arch -> toArchive <$> readFileLazy arch + Nothing -> foldr addEntryToArchive emptyArchive <$> + mapM pathToEntry paths + + -- | Read file from user data directory or, -- if not found there, from Cabal data directory. readDataFile :: PandocMonad m => FilePath -> m B.ByteString @@ -691,6 +751,8 @@ readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString readDefaultDataFile "reference.docx" = (B.concat . BL.toChunks . fromArchive) <$> getDefaultReferenceDocx +readDefaultDataFile "reference.pptx" = + (B.concat . BL.toChunks . fromArchive) <$> getDefaultReferencePptx readDefaultDataFile "reference.odt" = (B.concat . BL.toChunks . fromArchive) <$> getDefaultReferenceODT readDefaultDataFile fname = @@ -806,6 +868,7 @@ , stTime :: UTCTime , stTimeZone :: TimeZone , stReferenceDocx :: Archive + , stReferencePptx :: Archive , stReferenceODT :: Archive , stFiles :: FileTree , stUserDataFiles :: FileTree @@ -820,6 +883,7 @@ , stTime = posixSecondsToUTCTime 0 , stTimeZone = utc , stReferenceDocx = emptyArchive + , stReferencePptx = emptyArchive , stReferenceODT = emptyArchive , stFiles = mempty , stUserDataFiles = mempty diff --git a/src/Text/Pandoc/Data.hs b/src/Text/Pandoc/Data.hs --- a/src/Text/Pandoc/Data.hs +++ b/src/Text/Pandoc/Data.hs @@ -18,4 +18,5 @@ -- handle the hidden file separately, since embedDir doesn't -- include it: ("docx/_rels/.rels", $(embedFile "data/docx/_rels/.rels")) : + ("pptx/_rels/.rels", $(embedFile "data/pptx/_rels/.rels")) : $(embedDir "data") diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -152,6 +152,7 @@ | Ext_old_dashes -- ^ -- = em, - before number = en | Ext_spaced_reference_links -- ^ Allow space between two parts of ref link | Ext_amuse -- ^ Enable Text::Amuse extensions to Emacs Muse markup + | Ext_empty_paragraphs -- ^ Allow empty paragraphs deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable, Generic) -- | Extensions to be used with pandoc-flavored markdown. diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -31,45 +31,47 @@ Pandoc lua utils. -} -module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where +module Text.Pandoc.Lua + ( LuaException (..) + , LuaPackageParams (..) + , pushPandocModule + , runLuaFilter + , initLuaState + , luaPackageParams + ) where import Control.Monad (when, (>=>)) import Control.Monad.Identity (Identity) import Control.Monad.Trans (MonadIO (..)) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (newIORef, readIORef) import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..), Status (OK), ToLuaStack (push)) -import Text.Pandoc.Class (CommonState, PandocIO, getCommonState, getMediaBag, - setMediaBag) +import Text.Pandoc.Class (PandocIO, getCommonState, getMediaBag, setMediaBag) import Text.Pandoc.Definition -import Text.Pandoc.Lua.PandocModule (pushMediaBagModule, pushPandocModule) import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) -import Text.Pandoc.MediaBag (MediaBag) +import Text.Pandoc.Lua.Packages (LuaPackageParams (..), + installPandocPackageSearcher) +import Text.Pandoc.Lua.PandocModule (pushPandocModule) -- TODO: remove +import Text.Pandoc.Lua.Util (loadScriptFromDataDir) import qualified Foreign.Lua as Lua import qualified Foreign.Lua.Module.Text as Lua runLuaFilter :: Maybe FilePath -> FilePath -> String -> Pandoc -> PandocIO (Either LuaException Pandoc) runLuaFilter datadir filterPath format pd = do - commonState <- getCommonState - mediaBag <- getMediaBag - mediaBagRef <- liftIO (newIORef mediaBag) + luaPkgParams <- luaPackageParams datadir res <- liftIO . Lua.runLuaEither $ - runLuaFilter' commonState datadir filterPath format mediaBagRef pd - newMediaBag <- liftIO (readIORef mediaBagRef) + runLuaFilter' luaPkgParams filterPath format pd + newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams)) setMediaBag newMediaBag return res -runLuaFilter' :: CommonState - -> Maybe FilePath -> FilePath -> String -> IORef MediaBag +runLuaFilter' :: LuaPackageParams + -> FilePath -> String -> Pandoc -> Lua Pandoc -runLuaFilter' commonState datadir filterPath format mbRef pd = do - Lua.openlibs - Lua.preloadTextModule "text" +runLuaFilter' luaPkgOpts filterPath format pd = do + initLuaState luaPkgOpts -- store module in global "pandoc" - pushPandocModule datadir - Lua.setglobal "pandoc" - addMediaBagModule registerFormat top <- Lua.gettop stat <- Lua.dofile filterPath @@ -84,15 +86,27 @@ luaFilters <- peek (-1) runAll luaFilters pd where - addMediaBagModule = do - Lua.getglobal "pandoc" - push "mediabag" - pushMediaBagModule commonState mbRef - Lua.rawset (-3) registerFormat = do push format Lua.setglobal "FORMAT" +luaPackageParams :: Maybe FilePath -> PandocIO LuaPackageParams +luaPackageParams datadir = do + commonState <- getCommonState + mbRef <- liftIO . newIORef =<< getMediaBag + return LuaPackageParams + { luaPkgCommonState = commonState + , luaPkgDataDir = datadir + , luaPkgMediaBag = mbRef + } + +-- Initialize the lua state with all required values +initLuaState :: LuaPackageParams -> Lua () +initLuaState luaPkgParams = do + Lua.openlibs + Lua.preloadTextModule "text" + installPandocPackageSearcher luaPkgParams + loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua" pushGlobalFilter :: Lua () pushGlobalFilter = do diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -0,0 +1,112 @@ +{- +Copyright © 2017 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 +-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{- | + Module : Text.Pandoc.Lua.Packages + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Pandoc module for lua. +-} +module Text.Pandoc.Lua.Packages + ( LuaPackageParams (..) + , installPandocPackageSearcher + ) where + +import Control.Monad (forM_) +import Data.ByteString.Char8 (unpack) +import Data.IORef (IORef) +import Foreign.Lua (Lua, NumResults, liftIO) +import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir) +import Text.Pandoc.MediaBag (MediaBag) +import Text.Pandoc.Lua.PandocModule (pushPandocModule, pushMediaBagModule) +import Text.Pandoc.Lua.Util (dostring') + +import qualified Foreign.Lua as Lua + +-- | Parameters used to create lua packages/modules. +data LuaPackageParams = LuaPackageParams + { luaPkgCommonState :: CommonState + , luaPkgDataDir :: Maybe FilePath + , luaPkgMediaBag :: IORef MediaBag + } + +-- | Insert pandoc's package loader as the first loader, making it the default. +installPandocPackageSearcher :: LuaPackageParams -> Lua () +installPandocPackageSearcher luaPkgParams = do + luaVersion <- Lua.getglobal "_VERSION" *> Lua.peek (-1) + if luaVersion == "Lua 5.1" + then Lua.getglobal' "package.loaders" + else Lua.getglobal' "package.searchers" + shiftArray + Lua.pushHaskellFunction (pandocPackageSearcher luaPkgParams) + Lua.wrapHaskellFunction + Lua.rawseti (-2) 1 + Lua.pop 1 -- remove 'package.searchers' from stack + where + shiftArray = forM_ [4, 3, 2, 1] $ \i -> do + Lua.rawgeti (-1) i + Lua.rawseti (-2) (i + 1) + +-- | Load a pandoc module. +pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults +pandocPackageSearcher luaPkgParams pkgName = + case pkgName of + "pandoc" -> let datadir = luaPkgDataDir luaPkgParams + in pushWrappedHsFun (pushPandocModule datadir) + "pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams + mbRef = luaPkgMediaBag luaPkgParams + in pushWrappedHsFun (pushMediaBagModule st mbRef) + _ -> searchPureLuaLoader + where + pushWrappedHsFun f = do + Lua.pushHaskellFunction f + Lua.wrapHaskellFunction + return 1 + searchPureLuaLoader = do + let filename = pkgName ++ ".lua" + modScript <- liftIO (dataDirScript (luaPkgDataDir luaPkgParams) filename) + case modScript of + Just script -> pushWrappedHsFun (loadStringAsPackage pkgName script) + Nothing -> do + Lua.push ("no file '" ++ filename ++ "' in pandoc's datadir") + return 1 + +loadStringAsPackage :: String -> String -> Lua NumResults +loadStringAsPackage pkgName script = do + status <- dostring' script + if status == Lua.OK + then return (1 :: NumResults) + else do + msg <- Lua.peek (-1) <* Lua.pop 1 + Lua.push ("Error while loading ``" ++ pkgName ++ "`.\n" ++ msg) + Lua.lerror + return (2 :: NumResults) + +-- | Get the string representation of the pandoc module +dataDirScript :: Maybe FilePath -> FilePath -> IO (Maybe String) +dataDirScript datadir moduleFile = do + res <- runIO $ setUserDataDir datadir >> readDataFile moduleFile + return $ case res of + Left _ -> Nothing + Right s -> Just (unpack s) + diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs --- a/src/Text/Pandoc/Lua/PandocModule.hs +++ b/src/Text/Pandoc/Lua/PandocModule.hs @@ -33,21 +33,21 @@ , pushMediaBagModule ) where -import Control.Monad (unless, zipWithM_) -import Data.ByteString.Char8 (unpack) +import Control.Monad (zipWithM_) import Data.Default (Default (..)) import Data.Digest.Pure.SHA (sha1, showDigest) -import Data.IORef +import Data.IORef (IORef, modifyIORef', readIORef) import Data.Maybe (fromMaybe) import Data.Text (pack) import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO) import Foreign.Lua.FunctionCalling (ToHaskellFunction) import System.Exit (ExitCode (..)) import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState, - readDataFile, runIO, runIOorExplode, setMediaBag, - setUserDataDir) -import Text.Pandoc.Lua.StackInstances () + runIO, runIOorExplode, setMediaBag) import Text.Pandoc.Definition (Block, Inline) +import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) +import Text.Pandoc.Lua.StackInstances () +import Text.Pandoc.Lua.Util (loadScriptFromDataDir) import Text.Pandoc.Walk (Walkable) import Text.Pandoc.MIME (MimeType) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) @@ -57,42 +57,18 @@ import qualified Data.ByteString.Lazy as BL import qualified Foreign.Lua as Lua import qualified Text.Pandoc.MediaBag as MB -import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) -- | Push the "pandoc" on the lua stack. Requires the `list` module to be -- loaded. -pushPandocModule :: Maybe FilePath -> Lua () +pushPandocModule :: Maybe FilePath -> Lua NumResults pushPandocModule datadir = do - loadListModule datadir - script <- liftIO (moduleScript datadir "pandoc.lua") - status <- Lua.loadstring script - unless (status /= Lua.OK) $ Lua.call 0 1 + loadScriptFromDataDir datadir "pandoc.lua" addFunction "_pipe" pipeFn addFunction "_read" readDoc addFunction "sha1" sha1HashFn addFunction "walk_block" walkBlock addFunction "walk_inline" walkInline - --- | Get the string representation of the pandoc module -moduleScript :: Maybe FilePath -> FilePath -> IO String -moduleScript datadir moduleFile = unpack <$> - runIOorExplode (setUserDataDir datadir >> readDataFile moduleFile) - --- Loads pandoc's list module without assigning it to a variable. -pushListModule :: Maybe FilePath -> Lua () -pushListModule datadir = do - script <- liftIO (moduleScript datadir "List.lua") - status <- Lua.loadstring script - if status == Lua.OK - then Lua.call 0 1 - else Lua.throwTopMessageAsError' ("Error while loading module `list`\n" ++) - -loadListModule :: Maybe FilePath -> Lua () -loadListModule datadir = do - Lua.getglobal' "package.loaded" - pushListModule datadir - Lua.setfield (-2) "pandoc.List" - Lua.pop 1 + return 1 walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a) => a -> LuaFilter -> Lua NumResults @@ -124,14 +100,14 @@ -- -- MediaBag submodule -- -pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua () +pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults pushMediaBagModule commonState mediaBagRef = do Lua.newtable addFunction "insert" (insertMediaFn mediaBagRef) addFunction "lookup" (lookupMediaFn mediaBagRef) addFunction "list" (mediaDirectoryFn mediaBagRef) addFunction "fetch" (fetch commonState mediaBagRef) - return () + return 1 addFunction :: ToHaskellFunction a => String -> a -> Lua () addFunction name fn = do diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -38,12 +38,19 @@ , PushViaCall , pushViaCall , pushViaConstructor + , loadScriptFromDataDir + , dostring' ) where +import Control.Monad (when) +import Data.ByteString.Char8 (unpack) import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex, ToLuaStack (..), getglobal') -import Foreign.Lua.Api (call, pop, rawget, rawgeti, rawset, rawseti) +import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti) +import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir) +import qualified Foreign.Lua as Lua + -- | Adjust the stack index, assuming that @n@ new elements have been pushed on -- the stack. adjustIndexBy :: StackIndex -> StackIndex -> StackIndex @@ -107,3 +114,27 @@ -- | Call a pandoc element constructor within lua, passing all given arguments. pushViaConstructor :: PushViaCall a => String -> a pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn) + +-- | Load a file from pandoc's data directory. +loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua () +loadScriptFromDataDir datadir scriptFile = do + script <- fmap unpack . Lua.liftIO . runIOorExplode $ + setUserDataDir datadir >> readDataFile scriptFile + status <- dostring' script + when (status /= Lua.OK) . + Lua.throwTopMessageAsError' $ \msg -> + "Couldn't load '" ++ scriptFile ++ "'.\n" ++ msg + +-- | Load a string and immediately perform a full garbage collection. This is +-- important to keep the program from hanging: If the program contained a call +-- to @require@, the a new loader function was created which then become +-- garbage. If that function is collected at an inopportune times, i.e. when the +-- Lua API is called via a function that doesn't allow calling back into Haskell +-- (getraw, setraw, …). The function's finalizer, and the full program, hangs +-- when that happens. +dostring' :: String -> Lua Status +dostring' script = do + loadRes <- Lua.loadstring script + if loadRes == Lua.OK + then Lua.pcall 0 1 Nothing <* Lua.gc Lua.GCCOLLECT 0 + else return loadRes 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 @@ -534,7 +534,10 @@ then do modify $ \s -> s { docxDropCap = ils' } return mempty else do modify $ \s -> s { docxDropCap = mempty } - return $ parStyleToTransform pPr $ para ils' + opts <- asks docxOptions + if isNull ils' && not (isEnabled Ext_empty_paragraphs opts) + then return mempty + else return $ parStyleToTransform pPr $ para ils' bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do let kvs = case levelInfo of diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -68,9 +68,11 @@ import Text.Pandoc.Definition import Text.Pandoc.Error import Text.Pandoc.Logging -import Text.Pandoc.Options (Extension (Ext_epub_html_exts, Ext_native_divs, Ext_native_spans, Ext_raw_html), - ReaderOptions (readerExtensions, readerStripComments), - extensionEnabled) +import Text.Pandoc.Options ( + Extension (Ext_epub_html_exts, Ext_empty_paragraphs, Ext_native_divs, + Ext_native_spans, Ext_raw_html), + ReaderOptions (readerExtensions, readerStripComments), + extensionEnabled) import Text.Pandoc.Parsing hiding ((<|>)) import Text.Pandoc.Shared (addMetaField, crFilter, escapeURI, extractSpaces, safeRead, underlineSpan) @@ -575,7 +577,10 @@ pPara :: PandocMonad m => TagParser m Blocks pPara = do contents <- trimInlines <$> pInTags "p" inline - return $ B.para contents + (do guardDisabled Ext_empty_paragraphs + guard (B.isNull contents) + return mempty) + <|> return (B.para contents) pFigure :: PandocMonad m => TagParser m Blocks pFigure = try $ do @@ -1150,8 +1155,9 @@ -- in XML element names let isNameChar c = isAlphaNum c || c == ':' || c == '-' || c == '_' let isName s = case s of - [] -> False - (c:cs) -> isLetter c && all isNameChar cs + [] -> False + ('?':_) -> True -- processing instruction + (c:cs) -> isLetter c && all isNameChar cs let endpos = if ln == 1 then setSourceColumn startpos 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 @@ -332,9 +332,20 @@ in Tok pos (CtrlSeq ws) ("\\" <> ws <> ss) : totoks (incSourceColumn pos (1 + T.length ws + T.length ss)) rest''' - | d == '\t' || d == '\n' -> - Tok pos Symbol "\\" - : totoks (incSourceColumn pos 1) rest + | isSpaceOrTab d || d == '\n' -> + let (w1, r1) = T.span isSpaceOrTab rest + (w2, (w3, r3)) = case T.uncons r1 of + Just ('\n', r2) + -> (T.pack "\n", + T.span isSpaceOrTab r2) + _ -> (mempty, (w1, r1)) + in case T.uncons r3 of + Just ('\n', _) -> + Tok pos (CtrlSeq " ") ("\\" <> w1) + : totoks (incSourceColumn pos 1) r1 + _ -> + Tok pos (CtrlSeq " ") ("\\" <> w1 <> w2 <> w3) + : totoks (incSourceColumn pos 1) r3 | otherwise -> Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d]) : totoks (incSourceColumn pos 2) rest' diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1267,7 +1267,7 @@ tableCaption = try $ do guardEnabled Ext_table_captions skipNonindentSpaces - string ":" <|> string "Table:" + (string ":" <* notFollowedBy (string "::")) <|> string "Table:" trimInlinesF <$> inlines1 <* blanklines -- Parse a simple table with '---' header and one line per row. @@ -1353,8 +1353,8 @@ numColumns <- getOption readerColumns let widths = if maxlength > numColumns then map (\len -> - fromIntegral (len + 1) / fromIntegral numColumns) - seplengths + fromIntegral len / fromIntegral (sum seplengths)) + seplengths else replicate (length aligns) 0.0 return (aligns, widths, heads', sequence lines'') diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -57,7 +57,7 @@ import Text.Pandoc.Options import Text.Pandoc.Parsing import Text.Pandoc.Readers.HTML (htmlTag) -import Text.Pandoc.Shared (crFilter) +import Text.Pandoc.Shared (crFilter, underlineSpan) -- | Read Muse from an input string and return a Pandoc document. readMuse :: PandocMonad m @@ -136,23 +136,50 @@ | x == y = x : commonPrefix xs ys | otherwise = [] +atStart :: PandocMonad m => MuseParser m a -> MuseParser m a +atStart p = do + pos <- getPosition + st <- getState + guard $ stateLastStrPos st /= Just pos + p + -- -- directive parsers -- -parseDirective :: PandocMonad m => MuseParser m (String, F Inlines) -parseDirective = do +-- While not documented, Emacs Muse allows "-" in directive name +parseDirectiveKey :: PandocMonad m => MuseParser m String +parseDirectiveKey = do char '#' - key <- many letter + many (letter <|> char '-') + +parseEmacsDirective :: PandocMonad m => MuseParser m (String, F Inlines) +parseEmacsDirective = do + key <- parseDirectiveKey space spaces raw <- manyTill anyChar eol value <- parseFromString (trimInlinesF . mconcat <$> many inline) raw return (key, value) +parseAmuseDirective :: PandocMonad m => MuseParser m (String, F Inlines) +parseAmuseDirective = do + key <- parseDirectiveKey + space + spaces + first <- manyTill anyChar eol + rest <- manyTill anyLine endOfDirective + many blankline + value <- parseFromString (trimInlinesF . mconcat <$> many inline) $ unlines (first : rest) + return (key, value) + where + endOfDirective = lookAhead $ endOfInput <|> try (void blankline) <|> try (void parseDirectiveKey) + endOfInput = try $ skipMany blankline >> skipSpaces >> eof + directive :: PandocMonad m => MuseParser m () directive = do - (key, value) <- parseDirective + ext <- getOption readerExtensions + (key, value) <- if extensionEnabled Ext_amuse ext then parseAmuseDirective else parseEmacsDirective updateState $ \st -> st { stateMeta' = B.setMeta key <$> value <*> stateMeta' st } -- @@ -401,7 +428,7 @@ dropSpacePrefix :: [String] -> [String] dropSpacePrefix lns = map (drop maxIndent) lns - where flns = filter (\s -> not $ all (== ' ') s) lns + where flns = filter (not . all (== ' ')) lns maxIndent = if null flns then 0 else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns listItemContents :: PandocMonad m => Int -> MuseParser m (F Blocks) @@ -577,6 +604,7 @@ , strongTag , emph , emphTag + , underlined , superscriptTag , subscriptTag , strikeoutTag @@ -592,7 +620,7 @@ ] inline :: PandocMonad m => MuseParser m (F Inlines) -inline = (choice inlineList) "inline" +inline = choice inlineList "inline" endline :: PandocMonad m => MuseParser m (F Inlines) endline = try $ do @@ -647,7 +675,7 @@ -> MuseParser m b -> MuseParser m (F Inlines) enclosedInlines start end = try $ - trimInlinesF . mconcat <$> (enclosed start end inline <* notFollowedBy (satisfy isLetter)) + trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter)) inlineTag :: PandocMonad m => (Inlines -> Inlines) @@ -666,6 +694,11 @@ emph :: PandocMonad m => MuseParser m (F Inlines) emph = fmap B.emph <$> emphasisBetween (char '*') +underlined :: PandocMonad m => MuseParser m (F Inlines) +underlined = do + guardDisabled Ext_amuse -- Supported only by Emacs Muse + fmap underlineSpan <$> emphasisBetween (char '_') + emphTag :: PandocMonad m => MuseParser m (F Inlines) emphTag = inlineTag B.emph "em" @@ -719,7 +752,10 @@ rawInline (attrs, content) = B.rawInline (format attrs) content str :: PandocMonad m => MuseParser m (F Inlines) -str = return . B.str <$> many1 alphaNum +str = do + result <- many1 alphaNum + updateLastStrPos + return $ return $ B.str result symbol :: PandocMonad m => MuseParser m (F Inlines) symbol = return . B.str <$> count 1 nonspaceChar diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs --- a/src/Text/Pandoc/Writers.hs +++ b/src/Text/Pandoc/Writers.hs @@ -68,6 +68,7 @@ , writeOpenDocument , writeOrg , writePlain + , writePowerpoint , writeRST , writeRTF , writeRevealJs @@ -113,6 +114,7 @@ import Text.Pandoc.Writers.OpenDocument import Text.Pandoc.Writers.OPML import Text.Pandoc.Writers.Org +import Text.Pandoc.Writers.Powerpoint import Text.Pandoc.Writers.RST import Text.Pandoc.Writers.RTF import Text.Pandoc.Writers.TEI @@ -131,6 +133,7 @@ ,("json" , TextWriter $ \o d -> return $ writeJSON o d) ,("docx" , ByteStringWriter writeDocx) ,("odt" , ByteStringWriter writeODT) + ,("pptx" , ByteStringWriter writePowerpoint) ,("epub" , ByteStringWriter writeEPUB3) ,("epub2" , ByteStringWriter writeEPUB2) ,("epub3" , ByteStringWriter writeEPUB3) 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 @@ -40,12 +40,10 @@ import Control.Monad.State.Strict import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Char (isSpace, ord, toLower) import Data.List (intercalate, isPrefixOf, isSuffixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList) -import Data.Monoid ((<>)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Time.Clock.POSIX @@ -65,7 +63,6 @@ import Text.Pandoc.Options import Text.Pandoc.Readers.Docx.StyleMap import Text.Pandoc.Shared hiding (Element) -import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared (fixDisplayMath) @@ -73,6 +70,7 @@ import Text.TeXMath import Text.XML.Light as XML import Text.XML.Light.Cursor as XMLC +import Text.Pandoc.Writers.OOXML data ListMarker = NoMarker | BulletMarker @@ -156,23 +154,7 @@ type WS m = ReaderT WriterEnv (StateT WriterState m) -mknode :: Node t => String -> [(String,String)] -> t -> Element -mknode s attrs = - add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s) -nodename :: String -> QName -nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix } - where (name, prefix) = case break (==':') s of - (xs,[]) -> (xs, Nothing) - (ys, _:zs) -> (zs, Just ys) - -toLazy :: B.ByteString -> BL.ByteString -toLazy = BL.fromChunks . (:[]) - -renderXml :: Element -> BL.ByteString -renderXml elt = BL8.pack "\n" <> - UTF8.fromStringLazy (showElement elt) - renumIdMap :: Int -> [Element] -> M.Map String String renumIdMap _ [] = M.empty renumIdMap n (e:es) @@ -625,12 +607,12 @@ [ mknode "w:u" [] () | tokFeature tokenUnderline toktype ] ] tokStyles = tokenStyles style - tokFeature f toktype = maybe False f $ lookup toktype tokStyles + tokFeature f toktype = maybe False f $ M.lookup toktype tokStyles tokCol toktype = maybe "auto" (drop 1 . fromColor) - $ (tokenColor =<< lookup toktype tokStyles) + $ (tokenColor =<< M.lookup toktype tokStyles) `mplus` defaultColor style tokBg toktype = maybe "auto" (drop 1 . fromColor) - $ (tokenBackground =<< lookup toktype tokStyles) + $ (tokenBackground =<< M.lookup toktype tokStyles) `mplus` backgroundColor style parStyle | hasStyleName "Source Code" (sParaStyleMap sm) = Nothing | otherwise = Just $ @@ -922,19 +904,22 @@ captionNode <- withParaProp (pCustomStyle "ImageCaption") $ blockToOpenXML opts (Para alt) return $ mknode "w:p" [] (paraProps ++ contents) : captionNode -blockToOpenXML' opts (Para lst) = do - isFirstPara <- gets stFirstPara - paraProps <- getParaProps $ case lst of - [Math DisplayMath _] -> True - _ -> False - bodyTextStyle <- pStyleM "Body Text" - let paraProps' = case paraProps of - [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]] - [] -> [mknode "w:pPr" [] [bodyTextStyle]] - ps -> ps - modify $ \s -> s { stFirstPara = False } - contents <- inlinesToOpenXML opts lst - return [mknode "w:p" [] (paraProps' ++ contents)] +blockToOpenXML' opts (Para lst) + | null lst && not (isEnabled Ext_empty_paragraphs opts) = return [] + | otherwise = do + isFirstPara <- gets stFirstPara + paraProps <- getParaProps $ case lst of + [Math DisplayMath _] -> True + _ -> False + bodyTextStyle <- pStyleM "Body Text" + let paraProps' = case paraProps of + [] | isFirstPara -> [mknode "w:pPr" [] + [pCustomStyle "FirstParagraph"]] + [] -> [mknode "w:pPr" [] [bodyTextStyle]] + ps -> ps + modify $ \s -> s { stFirstPara = False } + contents <- inlinesToOpenXML opts lst + return [mknode "w:p" [] (paraProps' ++ contents)] blockToOpenXML' opts (LineBlock lns) = blockToOpenXML opts $ linesToPara lns blockToOpenXML' _ b@(RawBlock format str) | format == Format "openxml" = return [ x | Elem x <- parseXML str ] @@ -1390,23 +1375,6 @@ [ mknode "w:r" [] $ [ mknode "w:continuationSeparator" [] ()]]]] -parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element -parseXml refArchive distArchive relpath = - case findEntryByPath relpath refArchive `mplus` - findEntryByPath relpath distArchive of - Nothing -> fail $ relpath ++ " missing in reference docx" - Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of - Nothing -> fail $ relpath ++ " corrupt in reference docx" - Just d -> return d - --- | Scales the image to fit the page --- sizes are passed in emu -fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) -fitToPage (x, y) pageWidth - -- Fixes width to the page width and scales the height - | x > fromIntegral pageWidth = - (pageWidth, floor $ (fromIntegral pageWidth / x) * y) - | otherwise = (floor x, floor y) withDirection :: PandocMonad m => WS m a -> WS m a withDirection x = do 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 @@ -56,7 +56,7 @@ import Network.HTTP (urlEncode) import Network.URI (URI (..), parseURIReference, unEscapeString) import Numeric (showHex) -import Text.Blaze.Internal (customLeaf) +import Text.Blaze.Internal (customLeaf, MarkupM(Empty)) import Text.Blaze.Html hiding (contents) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, @@ -658,6 +658,7 @@ figure opts attr txt (s,tit) blockToHtml opts (Para lst) | isEmptyRaw lst = return mempty + | null lst && not (isEnabled Ext_empty_paragraphs opts) = return mempty | otherwise = do contents <- inlineListToHtml opts lst return $ H.p contents @@ -902,8 +903,7 @@ let tag'' = if null alignStr then tag' else tag' ! attribs - return $ ( - tag'' contents) >> nl opts + return $ tag'' contents >> nl opts toListItems :: WriterOptions -> [Html] -> [Html] toListItems opts items = map (toListItem opts) items ++ [nl opts] @@ -911,9 +911,13 @@ toListItem :: WriterOptions -> Html -> Html toListItem opts item = nl opts >> H.li item -blockListToHtml :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Html +blockListToHtml :: PandocMonad m + => WriterOptions -> [Block] -> StateT WriterState m Html blockListToHtml opts lst = - (mconcat . intersperse (nl opts)) <$> mapM (blockToHtml opts) lst + (mconcat . intersperse (nl opts) . filter nonempty) + <$> mapM (blockToHtml opts) lst + where nonempty (Empty _) = False + nonempty _ = True -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -373,6 +373,8 @@ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr inlineToMan _ SoftBreak = return space inlineToMan _ Space = return space +inlineToMan opts (Link _ txt ('#':_, _)) = + inlineListToMan opts txt -- skip internal links inlineToMan opts (Link _ txt (src, _)) = do linktext <- inlineListToMan opts txt let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -586,7 +586,7 @@ allcolors = catMaybes $ ordNub $ [defaultColor sty, backgroundColor sty, lineNumberColor sty, lineNumberBackgroundColor sty] ++ - concatMap (colorsForToken. snd) (tokenStyles sty) + concatMap (colorsForToken. snd) (Map.toList (tokenStyles sty)) colorsForToken ts = [tokenColor ts, tokenBackground ts] hexColor :: Color -> String @@ -611,7 +611,7 @@ resetfont = if tokBold || tokItalic then text "\\\\f[C]" else empty - tokSty = lookup toktype (tokenStyles sty) + tokSty = Map.lookup toktype (tokenStyles sty) tokCol = (tokSty >>= tokenColor) `mplus` defaultColor sty -- tokBg = (tokSty >>= tokenBackground) `mplus` backgroundColor sty tokBold = fromMaybe False (tokenBold <$> tokSty) diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Writers/OOXML.hs @@ -0,0 +1,109 @@ +module Text.Pandoc.Writers.OOXML ( mknode + , nodename + , toLazy + , renderXml + , parseXml + , elemToNameSpaces + , elemName + , isElem + , NameSpaces + , fitToPage + ) where +import Codec.Archive.Zip +--import Control.Applicative ((<|>)) +-- import Control.Monad.Except (catchError) +import Control.Monad.Reader +-- import Control.Monad.State +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BL8 +-- import Data.Char (isSpace, ord, toLower) +-- import Data.List (intercalate, isPrefixOf, isSuffixOf) +-- import qualified Data.Map as M +import Data.Maybe (mapMaybe) +import Data.Monoid ((<>)) +-- import qualified Data.Set as Set +-- import qualified Data.Text as T +-- import Data.Time.Clock.POSIX +-- import Skylighting +-- import System.Random (randomR) +import Text.Pandoc.Class (PandocMonad) +-- import qualified Text.Pandoc.Class as P +-- import Text.Pandoc.Compat.Time +-- import Text.Pandoc.Definition +-- import Text.Pandoc.Generic +-- import Text.Pandoc.Highlighting (highlight) +-- import Text.Pandoc.ImageSize +-- import Text.Pandoc.Logging +-- import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType, +-- getMimeTypeDef) +-- import Text.Pandoc.Options +-- import Text.Pandoc.Readers.Docx.StyleMap +-- import Text.Pandoc.Shared hiding (Element) +import qualified Text.Pandoc.UTF8 as UTF8 +-- import Text.Pandoc.Walk +-- import Text.Pandoc.Writers.Math +-- import Text.Pandoc.Writers.Shared (fixDisplayMath) +-- import Text.Printf (printf) +-- import Text.TeXMath +import Text.XML.Light as XML +-- import Text.XML.Light.Cursor as XMLC + + +mknode :: Node t => String -> [(String,String)] -> t -> Element +mknode s attrs = + add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s) + +nodename :: String -> QName +nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix } + where (name, prefix) = case break (==':') s of + (xs,[]) -> (xs, Nothing) + (ys, _:zs) -> (zs, Just ys) + +toLazy :: B.ByteString -> BL.ByteString +toLazy = BL.fromChunks . (:[]) + +renderXml :: Element -> BL.ByteString +renderXml elt = BL8.pack "\n" <> + UTF8.fromStringLazy (showElement elt) + +parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element +parseXml refArchive distArchive relpath = + case findEntryByPath relpath refArchive `mplus` + findEntryByPath relpath distArchive of + Nothing -> fail $ relpath ++ " missing in reference file" + Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of + Nothing -> fail $ relpath ++ " corrupt in reference file" + Just d -> return d + +-- Copied from Util + +attrToNSPair :: XML.Attr -> Maybe (String, String) +attrToNSPair (XML.Attr (QName s _ (Just "xmlns")) val) = Just (s, val) +attrToNSPair _ = Nothing + + +elemToNameSpaces :: Element -> NameSpaces +elemToNameSpaces = mapMaybe attrToNSPair . elAttribs + +elemName :: NameSpaces -> String -> String -> QName +elemName ns prefix name = + QName name (lookup prefix ns) (if null prefix then Nothing else Just prefix) + +isElem :: NameSpaces -> String -> String -> Element -> Bool +isElem ns prefix name element = + let ns' = ns ++ elemToNameSpaces element + in qName (elName element) == name && + qURI (elName element) == lookup prefix ns' + +type NameSpaces = [(String, String)] + +-- | Scales the image to fit the page +-- sizes are passed in emu +fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) +fitToPage (x, y) pageWidth + -- Fixes width to the page width and scales the height + | x > fromIntegral pageWidth = + (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + | otherwise = (floor x, floor y) + diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -130,7 +130,6 @@ setFirstPara = modify $ \s -> s { stFirstPara = True } inParagraphTags :: PandocMonad m => Doc -> OD m Doc -inParagraphTags d | isEmpty d = return empty inParagraphTags d = do b <- gets stFirstPara a <- if b @@ -323,7 +322,8 @@ else inParagraphTags =<< inlinesToOpenDocument o b | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs = figure attr c s t - | Para b <- bs = if null b + | Para b <- bs = if null b && + not (isEnabled Ext_empty_paragraphs o) then return empty else inParagraphTags =<< inlinesToOpenDocument o b | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Writers/Powerpoint.hs @@ -0,0 +1,1663 @@ +{-# LANGUAGE PatternGuards, MultiWayIf, OverloadedStrings #-} + +{- +Copyright (C) 2017 Jesse Rosenthal + +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.Powerpoint + Copyright : Copyright (C) 2017 Jesse Rosenthal + License : GNU GPL, version 2 or above + + Maintainer : Jesse Rosenthal + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to powerpoint (pptx). +-} + +module Text.Pandoc.Writers.Powerpoint (writePowerpoint) where + +import Control.Monad.Except (throwError) +import Control.Monad.Reader +import Control.Monad.State +import Codec.Archive.Zip +import Data.List (intercalate, stripPrefix, isPrefixOf, nub) +-- import Control.Monad (mplus) +import Data.Default +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) +import System.FilePath.Posix (splitDirectories, splitExtension) +import Text.XML.Light +import Text.Pandoc.Definition +import qualified Text.Pandoc.UTF8 as UTF8 +import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Error (PandocError(..)) +import qualified Text.Pandoc.Class as P +import Text.Pandoc.Options +import Text.Pandoc.MIME +import Text.Pandoc.Logging +import qualified Data.ByteString.Lazy as BL +-- import qualified Data.ByteString.Lazy.Char8 as BL8 +-- import qualified Text.Pandoc.UTF8 as UTF8 +import Text.Pandoc.Walk +import Text.Pandoc.Writers.Shared (fixDisplayMath) +import Text.Pandoc.Writers.OOXML +import qualified Data.Map as M +import Data.Maybe (mapMaybe, listToMaybe) +import Text.Pandoc.ImageSize +import Control.Applicative ((<|>)) + +import Text.TeXMath +import Text.Pandoc.Writers.Math (convertMath) + + +writePowerpoint :: (PandocMonad m) + => WriterOptions -- ^ Writer options + -> Pandoc -- ^ Document to convert + -> m BL.ByteString +writePowerpoint opts (Pandoc meta blks) = do + let blks' = walk fixDisplayMath blks + distArchive <- (toArchive . BL.fromStrict) <$> + P.readDefaultDataFile "reference.pptx" + refArchive <- case writerReferenceDoc opts of + Just f -> toArchive <$> P.readFileLazy f + Nothing -> (toArchive . BL.fromStrict) <$> + P.readDataFile "reference.pptx" + + utctime <- P.getCurrentTime + + let env = def { envMetadata = meta + , envRefArchive = refArchive + , envDistArchive = distArchive + , envUTCTime = utctime + , envOpts = opts + } + runP env def $ do pres <- blocksToPresentation blks' + archv <- presentationToArchive pres + return $ fromArchive archv + +concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] +concatMapM f xs = liftM concat (mapM f xs) + +data WriterEnv = WriterEnv { envMetadata :: Meta + , envRunProps :: RunProps + , envParaProps :: ParaProps + , envSlideLevel :: Int + , envRefArchive :: Archive + , envDistArchive :: Archive + , envUTCTime :: UTCTime + , envOpts :: WriterOptions + , envPresentationSize :: PresentationSize + , envSlideHasHeader :: Bool + , envInList :: Bool + } + deriving (Show) + +instance Default WriterEnv where + def = WriterEnv { envMetadata = mempty + , envRunProps = def + , envParaProps = def + , envSlideLevel = 2 + , envRefArchive = emptyArchive + , envDistArchive = emptyArchive + , envUTCTime = posixSecondsToUTCTime 0 + , envOpts = def + , envPresentationSize = def + , envSlideHasHeader = False + , envInList = False + } + +data MediaInfo = MediaInfo { mInfoFilePath :: FilePath + , mInfoLocalId :: Int + , mInfoGlobalId :: Int + , mInfoMimeType :: Maybe MimeType + , mInfoExt :: Maybe String + , mInfoCaption :: Bool + } deriving (Show, Eq) + +data WriterState = WriterState { stCurSlideId :: Int + -- the difference between the number at + -- the end of the slide file name and + -- the rId number + , stSlideIdOffset :: Int + , stLinkIds :: M.Map Int (M.Map Int (URL, String)) + -- (FP, Local ID, Global ID, Maybe Mime) + , stMediaIds :: M.Map Int [MediaInfo] + , stMediaGlobalIds :: M.Map FilePath Int + } deriving (Show, Eq) + +instance Default WriterState where + def = WriterState { stCurSlideId = 0 + , stSlideIdOffset = 1 + , stLinkIds = mempty + , stMediaIds = mempty + , stMediaGlobalIds = mempty + } + +type P m = ReaderT WriterEnv (StateT WriterState m) + +runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a +runP env st p = evalStateT (runReaderT p env) st + +type Pixels = Integer + +data Presentation = Presentation PresentationSize [Slide] + deriving (Show) + +data PresentationSize = PresentationSize { presSizeWidth :: Pixels + , presSizeRatio :: PresentationRatio + } + deriving (Show, Eq) + +data PresentationRatio = Ratio4x3 + | Ratio16x9 + | Ratio16x10 + deriving (Show, Eq) + +-- Note that right now we're only using Ratio4x3. +getPageHeight :: PresentationSize -> Pixels +getPageHeight sz = case presSizeRatio sz of + Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double) + Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double) + Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double) + +instance Default PresentationSize where + def = PresentationSize 720 Ratio4x3 + +data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem] + , metadataSlideSubtitle :: [ParaElem] + , metadataSlideAuthors :: [[ParaElem]] + , metadataSlideDate :: [ParaElem] + } + | TitleSlide { titleSlideHeader :: [ParaElem]} + | ContentSlide { contentSlideHeader :: [ParaElem] + , contentSlideContent :: [Shape] + } + deriving (Show, Eq) + +data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape + deriving (Show, Eq) + +data Shape = Pic FilePath Text.Pandoc.Definition.Attr [ParaElem] + | GraphicFrame [Graphic] [ParaElem] + | TextBox [Paragraph] + deriving (Show, Eq) + +type Cell = [Paragraph] + +data TableProps = TableProps { tblPrFirstRow :: Bool + , tblPrBandRow :: Bool + } deriving (Show, Eq) + +type ColWidth = Integer + +data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]] + deriving (Show, Eq) + + +data Paragraph = Paragraph { paraProps :: ParaProps + , paraElems :: [ParaElem] + } deriving (Show, Eq) + +data HeaderType = TitleHeader | SlideHeader | InternalHeader Int + deriving (Show, Eq) + +-- type StartingAt = Int + +-- data AutoNumType = ArabicNum +-- | AlphaUpperNum +-- | AlphaLowerNum +-- | RomanUpperNum +-- | RomanLowerNum +-- deriving (Show, Eq) + +-- data AutoNumDelim = PeriodDelim +-- | OneParenDelim +-- | TwoParensDelim +-- deriving (Show, Eq) + +autoNumberingToType :: ListAttributes -> String +autoNumberingToType (_, numStyle, numDelim) = + typeString ++ delimString + where + typeString = case numStyle of + Decimal -> "arabic" + UpperAlpha -> "alphaUc" + LowerAlpha -> "alphaLc" + UpperRoman -> "romanUc" + LowerRoman -> "romanLc" + _ -> "arabic" + delimString = case numDelim of + Period -> "Period" + OneParen -> "ParenR" + TwoParens -> "ParenBoth" + _ -> "Period" + +data BulletType = Bullet + | AutoNumbering ListAttributes + deriving (Show, Eq) + +data Algnment = AlgnLeft | AlgnRight | AlgnCenter + deriving (Show, Eq) + +data ParaProps = ParaProps { pPropHeaderType :: Maybe HeaderType + , pPropMarginLeft :: Maybe Pixels + , pPropMarginRight :: Maybe Pixels + , pPropLevel :: Int + , pPropBullet :: Maybe BulletType + , pPropAlign :: Maybe Algnment + } deriving (Show, Eq) + +instance Default ParaProps where + def = ParaProps { pPropHeaderType = Nothing + , pPropMarginLeft = Just 0 + , pPropMarginRight = Just 0 + , pPropLevel = 0 + , pPropBullet = Nothing + , pPropAlign = Nothing + } + +newtype TeXString = TeXString {unTeXString :: String} + deriving (Eq, Show) + +data ParaElem = Break + | Run RunProps String + -- It would be more elegant to have native TeXMath + -- Expressions here, but this allows us to use + -- `convertmath` from T.P.Writers.Math. Will perhaps + -- revisit in the future. + | MathElem MathType TeXString + deriving (Show, Eq) + +data Strikethrough = NoStrike | SingleStrike | DoubleStrike + deriving (Show, Eq) + +data Capitals = NoCapitals | SmallCapitals | AllCapitals + deriving (Show, Eq) + +type URL = String + +data RunProps = RunProps { rPropBold :: Bool + , rPropItalics :: Bool + , rStrikethrough :: Maybe Strikethrough + , rBaseline :: Maybe Int + , rCap :: Maybe Capitals + , rLink :: Maybe (URL, String) + , rPropCode :: Bool + , rPropBlockQuote :: Bool + } deriving (Show, Eq) + +instance Default RunProps where + def = RunProps { rPropBold = False + , rPropItalics = False + , rStrikethrough = Nothing + , rBaseline = Nothing + , rCap = Nothing + , rLink = Nothing + , rPropCode = False + , rPropBlockQuote = False + } + +-------------------------------------------------- + +inlinesToParElems :: Monad m => [Inline] -> P m [ParaElem] +inlinesToParElems ils = concatMapM inlineToParElems ils + +inlineToParElems :: Monad m => Inline -> P m [ParaElem] +inlineToParElems (Str s) = do + pr <- asks envRunProps + return [Run pr s] +inlineToParElems (Emph ils) = + local (\r -> r{envRunProps = (envRunProps r){rPropItalics=True}}) $ + inlinesToParElems ils +inlineToParElems (Strong ils) = + local (\r -> r{envRunProps = (envRunProps r){rPropBold=True}}) $ + inlinesToParElems ils +inlineToParElems (Strikeout ils) = + local (\r -> r{envRunProps = (envRunProps r){rStrikethrough=Just SingleStrike}}) $ + inlinesToParElems ils +inlineToParElems (Superscript ils) = + local (\r -> r{envRunProps = (envRunProps r){rBaseline=Just 30000}}) $ + inlinesToParElems ils +inlineToParElems (Subscript ils) = + local (\r -> r{envRunProps = (envRunProps r){rBaseline=Just (-25000)}}) $ + inlinesToParElems ils +inlineToParElems (SmallCaps ils) = + local (\r -> r{envRunProps = (envRunProps r){rCap = Just SmallCapitals}}) $ + inlinesToParElems ils +inlineToParElems Space = inlineToParElems (Str " ") +inlineToParElems SoftBreak = inlineToParElems (Str " ") +inlineToParElems LineBreak = return [Break] +inlineToParElems (Link _ ils (url, title)) = do + local (\r ->r{envRunProps = (envRunProps r){rLink = Just (url, title)}}) $ + inlinesToParElems ils +inlineToParElems (Code _ str) = do + local (\r ->r{envRunProps = def{rPropCode = True}}) $ + inlineToParElems $ Str str +inlineToParElems (Math mathtype str) = + return [MathElem mathtype (TeXString str)] +inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils +inlineToParElems (RawInline _ _) = return [] +inlineToParElems _ = return [] + +blockToParagraphs :: PandocMonad m => Block -> P m [Paragraph] +blockToParagraphs (Plain ils) = do + parElems <- inlinesToParElems ils + pProps <- asks envParaProps + return [Paragraph pProps parElems] +blockToParagraphs (Para ils) = do + parElems <- inlinesToParElems ils + pProps <- asks envParaProps + return [Paragraph pProps parElems] +blockToParagraphs (LineBlock ilsList) = do + parElems <- inlinesToParElems $ intercalate [LineBreak] ilsList + pProps <- asks envParaProps + return [Paragraph pProps parElems] +-- TODO: work out the attributes +blockToParagraphs (CodeBlock attr str) = + local (\r -> r{envParaProps = def{pPropMarginLeft = Just 100}}) $ + blockToParagraphs $ Para [Code attr str] +-- TODO: work out the format +blockToParagraphs (BlockQuote blks) = + local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100} + , envRunProps = (envRunProps r){rPropBlockQuote = True}})$ + concatMapM blockToParagraphs blks +-- TODO: work out the format +blockToParagraphs (RawBlock _ _) = return [] + -- parElems <- inlinesToParElems [Str str] + -- paraProps <- asks envParaProps + -- return [Paragraph paraProps parElems] +-- TODO: work out the format +blockToParagraphs (Header n _ ils) = do + slideLevel <- asks envSlideLevel + parElems <- inlinesToParElems ils + -- For the time being we're not doing headers inside of bullets, but + -- we might change that. + let headerType = case n `compare` slideLevel of + LT -> TitleHeader + EQ -> SlideHeader + GT -> InternalHeader (n - slideLevel) + return [Paragraph def{pPropHeaderType = Just headerType} parElems] +blockToParagraphs (BulletList blksLst) = do + pProps <- asks envParaProps + let lvl = pPropLevel pProps + local (\env -> env{ envInList = True + , envParaProps = pProps{ pPropLevel = lvl + 1 + , pPropBullet = Just Bullet + , pPropMarginLeft = Nothing + }}) $ + concatMapM multiParBullet blksLst +blockToParagraphs (OrderedList listAttr blksLst) = do + pProps <- asks envParaProps + let lvl = pPropLevel pProps + local (\env -> env{ envInList = True + , envParaProps = pProps{ pPropLevel = lvl + 1 + , pPropBullet = Just (AutoNumbering listAttr) + , pPropMarginLeft = Nothing + }}) $ + concatMapM multiParBullet blksLst +blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks +-- TODO +blockToParagraphs blk = do + P.report $ BlockNotRendered blk + return [] + +-- Make sure the bullet env gets turned off after the first para. +multiParBullet :: PandocMonad m => [Block] -> P m [Paragraph] +multiParBullet [] = return [] +multiParBullet (b:bs) = do + pProps <- asks envParaProps + p <- blockToParagraphs b + ps <- local (\env -> env{envParaProps = pProps{pPropBullet = Nothing}}) $ + concatMapM blockToParagraphs bs + return $ p ++ ps + +cellToParagraphs :: PandocMonad m => Alignment -> TableCell -> P m [Paragraph] +cellToParagraphs algn tblCell = do + paras <- mapM (blockToParagraphs) tblCell + let alignment = case algn of + AlignLeft -> Just AlgnLeft + AlignRight -> Just AlgnRight + AlignCenter -> Just AlgnCenter + AlignDefault -> Nothing + paras' = map (map (\p -> p{paraProps = (paraProps p){pPropAlign = alignment}})) paras + return $ concat paras' + +rowToParagraphs :: PandocMonad m => [Alignment] -> [TableCell] -> P m [[Paragraph]] +rowToParagraphs algns tblCells = do + -- We have to make sure we have the right number of alignments + let pairs = zip (algns ++ repeat AlignDefault) tblCells + mapM (\(a, tc) -> cellToParagraphs a tc) pairs + +blockToShape :: PandocMonad m => Block -> P m Shape +blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il = + Pic url attr <$> (inlinesToParElems ils) +blockToShape (Para (il:_)) | Image attr ils (url, _) <- il = + Pic url attr <$> (inlinesToParElems ils) +blockToShape (Table caption algn _ hdrCells rows) = do + caption' <- inlinesToParElems caption + pageWidth <- presSizeWidth <$> asks envPresentationSize + hdrCells' <- rowToParagraphs algn hdrCells + rows' <- mapM (rowToParagraphs algn) rows + let tblPr = if null hdrCells + then TableProps { tblPrFirstRow = False + , tblPrBandRow = True + } + else TableProps { tblPrFirstRow = True + , tblPrBandRow = True + } + colWidths = if null hdrCells + then case rows of + r : _ | not (null r) -> replicate (length r) $ + (pageWidth - (2 * hardcodedTableMargin))`div` (toInteger $ length r) + -- satisfy the compiler. This is the same as + -- saying that rows is empty, but the compiler + -- won't understand that `[]` exhausts the + -- alternatives. + _ -> [] + else replicate (length hdrCells) $ + (pageWidth - (2 * hardcodedTableMargin)) `div` (toInteger $ length hdrCells) + + return $ GraphicFrame [Tbl tblPr colWidths hdrCells' rows'] caption' +blockToShape blk = TextBox <$> blockToParagraphs blk + +blocksToShapes :: PandocMonad m => [Block] -> P m [Shape] +blocksToShapes blks = combineShapes <$> mapM blockToShape blks + +splitBlocks' :: Monad m => [Block] -> [[Block]] -> [Block] -> P m [[Block]] +splitBlocks' cur acc [] = return $ acc ++ (if null cur then [] else [cur]) +splitBlocks' cur acc (HorizontalRule : blks) = + splitBlocks' [] (acc ++ (if null cur then [] else [cur])) blks +splitBlocks' cur acc (h@(Header n _ _) : blks) = do + slideLevel <- asks envSlideLevel + case compare n slideLevel of + LT -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[h]]) blks + EQ -> splitBlocks' [h] (acc ++ (if null cur then [] else [cur])) blks + GT -> splitBlocks' (cur ++ [h]) acc blks +splitBlocks' cur acc ((Para (img@(Image _ _ _):ils)) : blks) = do + slideLevel <- asks envSlideLevel + case cur of + (Header n _ _) : [] | n == slideLevel -> + splitBlocks' [] + (acc ++ [cur ++ [Para [img]]]) + (if null ils then blks else (Para ils) : blks) + _ -> splitBlocks' [] + (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]]) + (if null ils then blks else (Para ils) : blks) +splitBlocks' cur acc ((Plain (img@(Image _ _ _):ils)) : blks) = do + slideLevel <- asks envSlideLevel + case cur of + (Header n _ _) : [] | n == slideLevel -> + splitBlocks' [] + (acc ++ [cur ++ [Para [img]]]) + (if null ils then blks else (Plain ils) : blks) + _ -> splitBlocks' [] + (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]]) + (if null ils then blks else (Plain ils) : blks) +splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do + slideLevel <- asks envSlideLevel + case cur of + (Header n _ _) : [] | n == slideLevel -> + splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks + _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks +splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks + +splitBlocks :: Monad m => [Block] -> P m [[Block]] +splitBlocks = splitBlocks' [] [] + +blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide +blocksToSlide' lvl ((Header n _ ils) : blks) + | n < lvl = do + hdr <- inlinesToParElems ils + return $ TitleSlide {titleSlideHeader = hdr} + | n == lvl = do + hdr <- inlinesToParElems ils + shapes <- blocksToShapes blks + return $ ContentSlide { contentSlideHeader = hdr + , contentSlideContent = shapes + } +blocksToSlide' _ (blk : blks) = do + shapes <- blocksToShapes (blk : blks) + return $ ContentSlide { contentSlideHeader = [] + , contentSlideContent = shapes + } +blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = [] + , contentSlideContent = [] + } + +blocksToSlide :: PandocMonad m => [Block] -> P m Slide +blocksToSlide blks = do + slideLevel <- asks envSlideLevel + blocksToSlide' slideLevel blks + +getMetaSlide :: PandocMonad m => P m (Maybe Slide) +getMetaSlide = do + meta <- asks envMetadata + title <- inlinesToParElems $ docTitle meta + subtitle <- inlinesToParElems $ + case lookupMeta "subtitle" meta of + Just (MetaString s) -> [Str s] + Just (MetaInlines ils) -> ils + Just (MetaBlocks [Plain ils]) -> ils + Just (MetaBlocks [Para ils]) -> ils + _ -> [] + authors <- mapM inlinesToParElems $ docAuthors meta + date <- inlinesToParElems $ docDate meta + if null title && null subtitle && null authors && null date + then return Nothing + else return $ Just $ MetadataSlide { metadataSlideTitle = title + , metadataSlideSubtitle = subtitle + , metadataSlideAuthors = authors + , metadataSlideDate = date + } + +blocksToPresentation :: PandocMonad m => [Block] -> P m Presentation +blocksToPresentation blks = do + blksLst <- splitBlocks blks + slides <- mapM blocksToSlide blksLst + metadataslide <- getMetaSlide + presSize <- asks envPresentationSize + return $ case metadataslide of + Just metadataslide' -> Presentation presSize $ metadataslide' : slides + Nothing -> Presentation presSize slides + +-------------------------------------------------------------------- + +copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive +copyFileToArchive arch fp = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of + Nothing -> fail $ fp ++ " missing in reference file" + Just e -> return $ addEntryToArchive e arch + +getMediaFiles :: PandocMonad m => P m [FilePath] +getMediaFiles = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + let allEntries = nub $ filesInArchive refArchive ++ filesInArchive distArchive + return $ filter (isPrefixOf "ppt/media") allEntries + + +copyFileToArchiveIfExists :: PandocMonad m => Archive -> FilePath -> P m Archive +copyFileToArchiveIfExists arch fp = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of + Nothing -> return $ arch + Just e -> return $ addEntryToArchive e arch + +inheritedFiles :: [FilePath] +inheritedFiles = [ "_rels/.rels" + , "docProps/app.xml" + , "docProps/core.xml" + , "ppt/slideLayouts/slideLayout4.xml" + , "ppt/slideLayouts/_rels/slideLayout9.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout2.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout10.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout1.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout3.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout5.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout7.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout8.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout11.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout4.xml.rels" + , "ppt/slideLayouts/_rels/slideLayout6.xml.rels" + , "ppt/slideLayouts/slideLayout2.xml" + , "ppt/slideLayouts/slideLayout8.xml" + , "ppt/slideLayouts/slideLayout11.xml" + , "ppt/slideLayouts/slideLayout3.xml" + , "ppt/slideLayouts/slideLayout6.xml" + , "ppt/slideLayouts/slideLayout9.xml" + , "ppt/slideLayouts/slideLayout5.xml" + , "ppt/slideLayouts/slideLayout7.xml" + , "ppt/slideLayouts/slideLayout1.xml" + , "ppt/slideLayouts/slideLayout10.xml" + -- , "ppt/_rels/presentation.xml.rels" + , "ppt/theme/theme1.xml" + , "ppt/presProps.xml" + -- , "ppt/slides/_rels/slide1.xml.rels" + -- , "ppt/slides/_rels/slide2.xml.rels" + -- This is the one we're + -- going to build + -- , "ppt/slides/slide2.xml" + -- , "ppt/slides/slide1.xml" + , "ppt/viewProps.xml" + , "ppt/tableStyles.xml" + , "ppt/slideMasters/_rels/slideMaster1.xml.rels" + , "ppt/slideMasters/slideMaster1.xml" + -- , "ppt/presentation.xml" + -- , "[Content_Types].xml" + ] + +-- Here are some that might not be there. We won't fail if they're not +possibleInheritedFiles :: [FilePath] +possibleInheritedFiles = [ "ppt/theme/_rels/theme1.xml.rels" ] + +presentationToArchive :: PandocMonad m => Presentation -> P m Archive +presentationToArchive p@(Presentation _ slides) = do + newArch <- foldM copyFileToArchive emptyArchive inheritedFiles + mediaDir <- getMediaFiles + newArch' <- foldM copyFileToArchiveIfExists newArch $ + possibleInheritedFiles ++ mediaDir + -- presentation entry and rels. We have to do the rels first to make + -- sure we know the correct offset for the rIds. + presEntry <- presentationToPresEntry p + presRelsEntry <- presentationToRelsEntry p + slideEntries <- mapM (\(s, n) -> slideToEntry s n) $ zip slides [1..] + slideRelEntries <- mapM (\(s,n) -> slideToSlideRelEntry s n) $ zip slides [1..] + -- These have to come after everything, because they need the info + -- built up in the state. + mediaEntries <- makeMediaEntries + contentTypesEntry <- presentationToContentTypes p >>= contentTypesToEntry + -- fold everything into our inherited archive and return it. + return $ foldr addEntryToArchive newArch' $ + slideEntries ++ + slideRelEntries ++ + mediaEntries ++ + [contentTypesEntry, presEntry, presRelsEntry] + +-------------------------------------------------- + +combineShapes :: [Shape] -> [Shape] +combineShapes [] = [] +combineShapes (s : []) = [s] +combineShapes (pic@(Pic _ _ _) : ss) = pic : combineShapes ss +combineShapes ((TextBox []) : ss) = combineShapes ss +combineShapes (s : TextBox [] : ss) = combineShapes (s : ss) +combineShapes (s@(TextBox (p:ps)) : s'@(TextBox (p':ps')) : ss) + | pPropHeaderType (paraProps p) == Just TitleHeader || + pPropHeaderType (paraProps p) == Just SlideHeader = + TextBox [p] : (combineShapes $ TextBox ps : s' : ss) + | pPropHeaderType (paraProps p') == Just TitleHeader || + pPropHeaderType (paraProps p') == Just SlideHeader = + s : TextBox [p'] : (combineShapes $ TextBox ps' : ss) + | otherwise = combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss +combineShapes (s:ss) = s : combineShapes ss + +-------------------------------------------------- + +getLayout :: PandocMonad m => Slide -> P m Element +getLayout slide = do + let layoutpath = case slide of + (MetadataSlide _ _ _ _) -> "ppt/slideLayouts/slideLayout1.xml" + (TitleSlide _) -> "ppt/slideLayouts/slideLayout3.xml" + (ContentSlide _ _) -> "ppt/slideLayouts/slideLayout2.xml" + distArchive <- asks envDistArchive + root <- case findEntryByPath layoutpath distArchive of + Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of + Just element -> return $ element + Nothing -> throwError $ + PandocSomeError $ + layoutpath ++ " corrupt in reference file" + Nothing -> throwError $ + PandocSomeError $ + layoutpath ++ " missing in reference file" + return root + -- let ns = elemToNameSpaces root + -- case findChild (elemName ns "p" "cSld") root of + -- Just element' -> return element' + -- Nothing -> throwError $ + -- PandocSomeError $ + -- layoutpath ++ " not correctly formed layout file" + +shapeHasName :: NameSpaces -> String -> Element -> Bool +shapeHasName ns name element + | Just nvSpPr <- findChild (elemName ns "p" "nvSpPr") element + , Just cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr + , Just nm <- findAttr (QName "name" Nothing Nothing) cNvPr = + nm == name + | otherwise = False + +-- getContentTitleShape :: NameSpaces -> Element -> Maybe Element +-- getContentTitleShape ns spTreeElem +-- | isElem ns "p" "spTree" spTreeElem = +-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Title 1" e)) spTreeElem +-- | otherwise = Nothing + +-- getSubtitleShape :: NameSpaces -> Element -> Maybe Element +-- getSubtitleShape ns spTreeElem +-- | isElem ns "p" "spTree" spTreeElem = +-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Subtitle 2" e)) spTreeElem +-- | otherwise = Nothing + +-- getDateShape :: NameSpaces -> Element -> Maybe Element +-- getDateShape ns spTreeElem +-- | isElem ns "p" "spTree" spTreeElem = +-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Date Placeholder 3" e)) spTreeElem +-- | otherwise = Nothing + +getContentShape :: NameSpaces -> Element -> Maybe Element +getContentShape ns spTreeElem + | isElem ns "p" "spTree" spTreeElem = + filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Content Placeholder 2" e)) spTreeElem + | otherwise = Nothing + + +-- cursorHasName :: QName -> XMLC.Cursor -> Bool +-- cursorHasName nm cur = case XMLC.current cur of +-- Elem element -> case XMLC.tagName $ XMLC.getTag element of +-- nm -> True +-- _ -> False +-- _ -> False + +-- fillInTxBody :: NameSpaces -> [Paragraph] -> Element -> Element +-- fillInTxBody ns paras txBodyElem +-- | isElem ns "p" "txBody" txBodyElem = +-- replaceNamedChildren ns "a" "p" (map paragraphToElement paras) txBodyElem +-- | otherwise = txBodyElem + +-- fillInShape :: NameSpaces -> Shape -> Element -> Element +-- fillInShape ns shape spElem +-- | TextBox paras <- shape +-- , isElemn ns "p" "sp" spElem = +-- replaceNamedChildren ns "p" "txBody" (fillInTxBody ns paras sp + + +-- fillInShape :: NameSpaces -> Element -> Shape -> Element +-- fillInShape ns spElem (TextBox paras) = fillInParagraphs ns spElem paras +-- fillInShape _ spElem pic = spElem + +contentIsElem :: NameSpaces -> String -> String -> Content -> Bool +contentIsElem ns prefix name (Elem element) = isElem ns prefix name element +contentIsElem _ _ _ _ = False + +replaceNamedChildren :: NameSpaces -> String -> String -> [Element] -> Element -> Element +replaceNamedChildren ns prefix name newKids element = + let content = elContent element + content' = filter (\c -> not (contentIsElem ns prefix name c)) content + in + element{elContent = content' ++ map Elem newKids} + + +---------------------------------------------------------------- + +registerLink :: PandocMonad m => (URL, String) -> P m Int +registerLink link = do + curSlideId <- gets stCurSlideId + linkReg <- gets stLinkIds + mediaReg <- gets stMediaIds + let maxLinkId = case M.lookup curSlideId linkReg of + Just mp -> case M.keys mp of + [] -> 1 + ks -> maximum ks + Nothing -> 1 + maxMediaId = case M.lookup curSlideId mediaReg of + Just [] -> 1 + Just mInfos -> maximum $ map mInfoLocalId mInfos + Nothing -> 1 + maxId = max maxLinkId maxMediaId + slideLinks = case M.lookup curSlideId linkReg of + Just mp -> M.insert (maxId + 1) link mp + Nothing -> M.singleton (maxId + 1) link + modify $ \st -> st{ stLinkIds = M.insert curSlideId slideLinks linkReg} + return $ maxId + 1 + +registerMedia :: PandocMonad m => FilePath -> [ParaElem] -> P m MediaInfo +registerMedia fp caption = do + curSlideId <- gets stCurSlideId + linkReg <- gets stLinkIds + mediaReg <- gets stMediaIds + globalIds <- gets stMediaGlobalIds + let maxLinkId = case M.lookup curSlideId linkReg of + Just mp -> case M.keys mp of + [] -> 1 + ks -> maximum ks + Nothing -> 1 + maxMediaId = case M.lookup curSlideId mediaReg of + Just [] -> 1 + Just mInfos -> maximum $ map mInfoLocalId mInfos + Nothing -> 1 + maxLocalId = max maxLinkId maxMediaId + + maxGlobalId = case M.elems globalIds of + [] -> 0 + ids -> maximum ids + + (imgBytes, mbMt) <- P.fetchItem fp + let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ '.':x)) + <|> + case imageType imgBytes of + Just Png -> Just ".png" + Just Jpeg -> Just ".jpeg" + Just Gif -> Just ".gif" + Just Pdf -> Just ".pdf" + Just Eps -> Just ".eps" + Just Svg -> Just ".svg" + Nothing -> Nothing + + let newGlobalId = case M.lookup fp globalIds of + Just ident -> ident + Nothing -> maxGlobalId + 1 + + let newGlobalIds = M.insert fp newGlobalId globalIds + + let mediaInfo = MediaInfo { mInfoFilePath = fp + , mInfoLocalId = maxLocalId + 1 + , mInfoGlobalId = newGlobalId + , mInfoMimeType = mbMt + , mInfoExt = imgExt + , mInfoCaption = (not . null) caption + } + + let slideMediaInfos = case M.lookup curSlideId mediaReg of + Just minfos -> mediaInfo : minfos + Nothing -> [mediaInfo] + + + modify $ \st -> st{ stMediaIds = M.insert curSlideId slideMediaInfos mediaReg + , stMediaGlobalIds = newGlobalIds + } + return mediaInfo + +makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry +makeMediaEntry mInfo = do + epochtime <- (floor . utcTimeToPOSIXSeconds) <$> asks envUTCTime + (imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo) + let ext = case mInfoExt mInfo of + Just e -> e + Nothing -> "" + let fp = "ppt/media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext + return $ toEntry fp epochtime $ BL.fromStrict imgBytes + +makeMediaEntries :: PandocMonad m => P m [Entry] +makeMediaEntries = do + mediaInfos <- gets stMediaIds + let allInfos = mconcat $ M.elems mediaInfos + mapM makeMediaEntry allInfos + +-- | Scales the image to fit the page +-- sizes are passed in emu +fitToPage' :: (Double, Double) -- image size in emu + -> Integer -- pageWidth + -> Integer -- pageHeight + -> (Integer, Integer) -- imagesize +fitToPage' (x, y) pageWidth pageHeight + -- Fixes width to the page width and scales the height + | x <= fromIntegral pageWidth && y <= fromIntegral pageHeight = + (floor x, floor y) + | x / fromIntegral pageWidth > y / fromIntegral pageWidth = + (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + | otherwise = + (floor $ ((fromIntegral pageHeight) / y) * x, pageHeight) + +positionImage :: (Double, Double) -> Integer -> Integer -> (Integer, Integer) +positionImage (x, y) pageWidth pageHeight = + let (x', y') = fitToPage' (x, y) pageWidth pageHeight + in + ((pageWidth - x') `div` 2, (pageHeight - y') `div` 2) + +getMaster :: PandocMonad m => P m Element +getMaster = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + parseXml refArchive distArchive "ppt/slideMasters/slideMaster1.xml" + +-- We want to get the header dimensions, so we can make sure that the +-- image goes underneath it. We only use this in a content slide if it +-- has a header. + +getHeaderSize :: PandocMonad m => P m ((Integer, Integer), (Integer, Integer)) +getHeaderSize = do + master <- getMaster + let ns = elemToNameSpaces master + sps = [master] >>= + findChildren (elemName ns "p" "cSld") >>= + findChildren (elemName ns "p" "spTree") >>= + findChildren (elemName ns "p" "sp") + mbXfrm = + listToMaybe (filter (shapeHasName ns "Title Placeholder 1") sps) >>= + findChild (elemName ns "p" "spPr") >>= + findChild (elemName ns "a" "xfrm") + xoff = mbXfrm >>= + findChild (elemName ns "a" "off") >>= + findAttr (QName "x" Nothing Nothing) >>= + (listToMaybe . (\s -> reads s :: [(Integer, String)])) + yoff = mbXfrm >>= + findChild (elemName ns "a" "off") >>= + findAttr (QName "y" Nothing Nothing) >>= + (listToMaybe . (\s -> reads s :: [(Integer, String)])) + xext = mbXfrm >>= + findChild (elemName ns "a" "ext") >>= + findAttr (QName "cx" Nothing Nothing) >>= + (listToMaybe . (\s -> reads s :: [(Integer, String)])) + yext = mbXfrm >>= + findChild (elemName ns "a" "ext") >>= + findAttr (QName "cy" Nothing Nothing) >>= + (listToMaybe . (\s -> reads s :: [(Integer, String)])) + off = case xoff of + Just (xoff', _) | Just (yoff',_) <- yoff -> (xoff', yoff') + _ -> (1043490, 1027664) + ext = case xext of + Just (xext', _) | Just (yext',_) <- yext -> (xext', yext') + _ -> (7024744, 1143000) + return $ (off, ext) + + +-- Hard-coded for now +captionPosition :: ((Integer, Integer), (Integer, Integer)) +captionPosition = ((457200, 6061972), (8229600, 527087)) + +createCaption :: PandocMonad m => [ParaElem] -> P m Element +createCaption paraElements = do + let para = Paragraph def{pPropAlign = Just AlgnCenter} paraElements + elements <- mapM paragraphToElement [para] + let ((x, y), (cx, cy)) = captionPosition + let txBody = mknode "p:txBody" [] $ + [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements + return $ + mknode "p:sp" [] [ mknode "p:nvSpPr" [] + [ mknode "p:cNvPr" [("id","1"), ("name","TextBox 3")] () + , mknode "p:cNvSpPr" [("txBox", "1")] () + , mknode "p:nvPr" [] () + ] + , mknode "p:spPr" [] + [ mknode "a:xfrm" [] + [ mknode "a:off" [("x", show x), ("y", show y)] () + , mknode "a:ext" [("cx", show cx), ("cy", show cy)] () + ] + , mknode "a:prstGeom" [("prst", "rect")] + [ mknode "a:avLst" [] () + ] + , mknode "a:noFill" [] () + ] + , txBody + ] + +-- Largely lifted from inlineToOpenXML' in T.P.W.Docx. Can't be easily +-- abstracted because of some different namespaces and monads. TODO. +makePicElement :: PandocMonad m + => MediaInfo + -> Text.Pandoc.Definition.Attr + -> P m Element +makePicElement mInfo attr = do + opts <- asks envOpts + pageWidth <- presSizeWidth <$> asks envPresentationSize + pageHeight <- getPageHeight <$> asks envPresentationSize + hasHeader <- asks envSlideHasHeader + let hasCaption = mInfoCaption mInfo + (imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo) + -- We're not using x exts + ((hXoff, hYoff), (_, hYext)) <- if hasHeader + then getHeaderSize + else return ((0, 0), (0, 0)) + + let ((capX, capY), (_, _)) = if hasCaption + then captionPosition + else ((0,0), (0,0)) + let (xpt,ypt) = desiredSizeInPoints opts attr + (either (const def) id (imageSize opts imgBytes)) + -- 12700 emu = 1 pt + let (xemu,yemu) = fitToPage' (xpt * 12700, ypt * 12700) + ((pageWidth * 12700) - (2 * hXoff) - (2 * capX)) + ((if hasCaption then capY else (pageHeight * 12700)) - (hYoff + hYext)) + (xoff, yoff) = positionImage (xpt * 12700, ypt * 12700) (pageWidth * 12700) (pageHeight * 12700) + xoff' = if hasHeader then xoff + hXoff else xoff + xoff'' = if hasCaption then xoff' + capX else xoff' + yoff' = if hasHeader then hYoff + hYext else yoff + -- let (xemu,yemu)=((floor $ xpt * 12700), (floor $ ypt * 12700)) + let cNvPicPr = mknode "p:cNvPicPr" [] $ + mknode "a:picLocks" [("noGrp","1") + ,("noChangeAspect","1")] () + let nvPicPr = mknode "p:nvPicPr" [] + [ mknode "p:cNvPr" + [("descr", mInfoFilePath mInfo),("id","0"),("name","Picture 1")] () + , cNvPicPr + , mknode "p:nvPr" [] ()] + let blipFill = mknode "p:blipFill" [] + [ mknode "a:blip" [("r:embed", "rId" ++ (show $ mInfoLocalId mInfo))] () + , mknode "a:stretch" [] $ + mknode "a:fillRect" [] () ] + let xfrm = mknode "a:xfrm" [] + [ mknode "a:off" [("x",show xoff''), ("y",show yoff')] () + , mknode "a:ext" [("cx",show xemu) + ,("cy",show yemu)] () ] + let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ + mknode "a:avLst" [] () + let ln = mknode "a:ln" [("w","9525")] + [ mknode "a:noFill" [] () + , mknode "a:headEnd" [] () + , mknode "a:tailEnd" [] () ] + let spPr = mknode "p:spPr" [("bwMode","auto")] + [xfrm, prstGeom, mknode "a:noFill" [] (), ln] + return $ + mknode "p:pic" [] + [ nvPicPr + , blipFill + , spPr ] + +-- Currently hardcoded, until I figure out how to make it dynamic. +blockQuoteSize :: Pixels +blockQuoteSize = 20 + +paraElemToElement :: PandocMonad m => ParaElem -> P m Element +paraElemToElement Break = return $ mknode "a:br" [] () +paraElemToElement (Run rpr s) = do + let attrs = + if rPropCode rpr + then [] + else (if rPropBlockQuote rpr then [("sz", (show $ blockQuoteSize * 100))] else []) ++ + (if rPropBold rpr then [("b", "1")] else []) ++ + (if rPropItalics rpr then [("i", "1")] else []) ++ + (case rStrikethrough rpr of + Just NoStrike -> [("strike", "noStrike")] + Just SingleStrike -> [("strike", "sngStrike")] + Just DoubleStrike -> [("strike", "dblStrike")] + Nothing -> []) ++ + (case rBaseline rpr of + Just n -> [("baseline", show n)] + Nothing -> []) ++ + (case rCap rpr of + Just NoCapitals -> [("cap", "none")] + Just SmallCapitals -> [("cap", "small")] + Just AllCapitals -> [("cap", "all")] + Nothing -> []) ++ + [] + linkProps <- case rLink rpr of + Just link -> do idNum <- registerLink link + return [mknode "a:hlinkClick" + [("r:id", "rId" ++ show idNum)] + () + ] + Nothing -> return [] + let propContents = if rPropCode rpr + then [mknode "a:latin" [("typeface", "Courier")] ()] + else linkProps + return $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents + , mknode "a:t" [] s + ] +paraElemToElement (MathElem mathType texStr) = do + res <- convertMath writeOMML mathType (unTeXString texStr) + case res of + Right r -> return $ mknode "a14:m" [] $ addMathInfo r + Left (Str s) -> paraElemToElement (Run def s) + Left _ -> throwError $ PandocShouldNeverHappenError "non-string math fallback" + +-- This is a bit of a kludge -- really requires adding an option to +-- TeXMath, but since that's a different package, we'll do this one +-- step at a time. +addMathInfo :: Element -> Element +addMathInfo element = + let mathspace = Attr { attrKey = (QName "m" Nothing (Just "xmlns")) + , attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math" + } + in add_attr mathspace element + +-- We look through the element to see if it contains an a14:m +-- element. If so, we surround it. This is a bit ugly, but it seems +-- more dependable than looking through shapes for math. Plus this is +-- an xml implementation detail, so it seems to make sense to do it at +-- the xml level. +surroundWithMathAlternate :: Element -> Element +surroundWithMathAlternate element = + case findElement (QName "m" Nothing (Just "a14")) element of + Just _ -> + mknode "mc:AlternateContent" + [("xmlns:mc", "http://schemas.openxmlformats.org/markup-compatibility/2006") + ] [ mknode "mc:Choice" + [ ("xmlns:a14", "http://schemas.microsoft.com/office/drawing/2010/main") + , ("Requires", "a14")] [ element ] + ] + Nothing -> element + +paragraphToElement :: PandocMonad m => Paragraph -> P m Element +paragraphToElement par = do + let + attrs = [("lvl", show $ pPropLevel $ paraProps par)] ++ + (case pPropMarginLeft (paraProps par) of + Just px -> [("marL", show $ 12700 * px), ("indent", "0")] + Nothing -> [] + ) ++ + (case pPropAlign (paraProps par) of + Just AlgnLeft -> [("algn", "l")] + Just AlgnRight -> [("algn", "r")] + Just AlgnCenter -> [("algn", "ctr")] + Nothing -> [] + ) + props = [] ++ + (case pPropBullet $ paraProps par of + Just Bullet -> [] + Just (AutoNumbering attrs') -> + [mknode "a:buAutoNum" [("type", autoNumberingToType attrs')] ()] + Nothing -> [mknode "a:buNone" [] ()] + ) + paras <- mapM paraElemToElement (paraElems par) + return $ mknode "a:p" [] $ [mknode "a:pPr" attrs props] ++ paras + +shapeToElement :: PandocMonad m => Element -> Shape -> P m Element +shapeToElement layout (TextBox paras) + | ns <- elemToNameSpaces layout + , Just cSld <- findChild (elemName ns "p" "cSld") layout + , Just spTree <- findChild (elemName ns "p" "spTree") cSld + , Just sp <- getContentShape ns spTree = do + elements <- mapM paragraphToElement paras + let txBody = mknode "p:txBody" [] $ + [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements + emptySpPr = mknode "p:spPr" [] () + return $ + surroundWithMathAlternate $ + replaceNamedChildren ns "p" "txBody" [txBody] $ + replaceNamedChildren ns "p" "spPr" [emptySpPr] $ + sp + -- XXX: TODO + | otherwise = return $ mknode "p:sp" [] () +-- XXX: TODO +shapeToElement layout (Pic fp attr alt) = do + mInfo <- registerMedia fp alt + case mInfoExt mInfo of + Just _ -> makePicElement mInfo attr + Nothing -> shapeToElement layout $ TextBox [Paragraph def alt] +shapeToElement _ (GraphicFrame tbls _) = do + elements <- mapM graphicToElement tbls + return $ mknode "p:graphicFrame" [] $ + [ mknode "p:nvGraphicFramePr" [] $ + [ mknode "p:cNvPr" [("id", "6"), ("name", "Content Placeholder 5")] () + , mknode "p:cNvGraphicFramePr" [] $ + [mknode "a:graphicFrameLocks" [("noGrp", "1")] ()] + , mknode "p:nvPr" [] $ + [mknode "p:ph" [("idx", "1")] ()] + ] + , mknode "p:xfrm" [] $ + [ mknode "a:off" [("x", "457200"), ("y", "1600200")] () + , mknode "a:ext" [("cx", "8029388"), ("cy", "3644152")] () + ] + ] ++ elements + +shapeToElements :: PandocMonad m => Element -> Shape -> P m [Element] +shapeToElements layout shp = do + case shp of + (Pic _ _ alt) | (not . null) alt -> do + element <- shapeToElement layout shp + caption <- createCaption alt + return [element, caption] + (GraphicFrame _ cptn) | (not . null) cptn -> do + element <- shapeToElement layout shp + caption <- createCaption cptn + return [element, caption] + _ -> do + element <- shapeToElement layout shp + return [element] + +shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [Element] +shapesToElements layout shps = do + concat <$> mapM (shapeToElements layout) shps + +hardcodedTableMargin :: Integer +hardcodedTableMargin = 36 + + +graphicToElement :: PandocMonad m => Graphic -> P m Element +graphicToElement (Tbl tblPr colWidths hdrCells rows) = do + let cellToOpenXML paras = do elements <- mapM paragraphToElement paras + return $ + [mknode "a:txBody" [] $ + ([ mknode "a:bodyPr" [] () + , mknode "a:lstStyle" [] ()] + ++ elements)] + headers' <- mapM cellToOpenXML hdrCells + rows' <- mapM (mapM cellToOpenXML) rows + let borderProps = mknode "a:tcPr" [] () + let emptyCell = [mknode "a:p" [] [mknode "a:pPr" [] ()]] + let mkcell border contents = mknode "a:tc" [] + $ (if null contents + then emptyCell + else contents) ++ [ borderProps | border ] + let mkrow border cells = mknode "a:tr" [("h", "0")] $ map (mkcell border) cells + -- let textwidth = 14400 -- 5.5 in in twips, 1/20 pt + -- let fullrow = 14400 -- 100% specified in pct + -- let rowwidth = fullrow * sum colWidths + + let mkgridcol w = mknode "a:gridCol" + [("w", show ((12700 * w) :: Integer))] () + let hasHeader = not (all null hdrCells) + return $ mknode "a:graphic" [] $ + [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")] $ + [mknode "a:tbl" [] $ + [ mknode "a:tblPr" [ ("firstRow", if tblPrFirstRow tblPr then "1" else "0") + , ("bandRow", if tblPrBandRow tblPr then "1" else "0") + ] () + , mknode "a:tblGrid" [] (if all (==0) colWidths + then [] + else map mkgridcol colWidths) + ] + ++ [ mkrow True headers' | hasHeader ] ++ map (mkrow False) rows' + ] + ] + +getShapeByName :: NameSpaces -> Element -> String -> Maybe Element +getShapeByName ns spTreeElem name + | isElem ns "p" "spTree" spTreeElem = + filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns name e)) spTreeElem + | otherwise = Nothing + +nonBodyTextToElement :: PandocMonad m => Element -> String -> [ParaElem] -> P m Element +nonBodyTextToElement layout shapeName paraElements + | ns <- elemToNameSpaces layout + , Just cSld <- findChild (elemName ns "p" "cSld") layout + , Just spTree <- findChild (elemName ns "p" "spTree") cSld + , Just sp <- getShapeByName ns spTree shapeName = do + let hdrPara = Paragraph def paraElements + element <- paragraphToElement hdrPara + let txBody = mknode "p:txBody" [] $ + [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ + [element] + return $ replaceNamedChildren ns "p" "txBody" [txBody] sp + -- XXX: TODO + | otherwise = return $ mknode "p:sp" [] () + + +-- hdrToElement :: Element -> [ParaElem] -> Element +-- hdrToElement layout paraElems +-- | ns <- elemToNameSpaces layout +-- , Just cSld <- findChild (elemName ns "p" "cSld") layout +-- , Just spTree <- findChild (elemName ns "p" "spTree") cSld +-- , Just sp <- getContentTitleShape ns spTree = +-- let hdrPara = Paragraph def paraElems +-- txBody = mknode "p:txBody" [] $ +-- [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ +-- [paragraphToElement hdrPara] +-- in +-- replaceNamedChildren ns "p" "txBody" [txBody] sp +-- -- XXX: TODO +-- | otherwise = mknode "p:sp" [] () +-- -- XXX: TODO +-- hdrToElement _ _ = mknode "p:sp" [] () + +contentToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> P m Element +contentToElement layout hdrShape shapes + | ns <- elemToNameSpaces layout + , Just cSld <- findChild (elemName ns "p" "cSld") layout + , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do + element <- nonBodyTextToElement layout "Title 1" hdrShape + let hdrShapeElements = if null hdrShape + then [] + else [element] + contentElements <- shapesToElements layout shapes + return $ + replaceNamedChildren ns "p" "sp" + (hdrShapeElements ++ contentElements) + spTree +contentToElement _ _ _ = return $ mknode "p:sp" [] () + +titleToElement :: PandocMonad m => Element -> [ParaElem] -> P m Element +titleToElement layout titleElems + | ns <- elemToNameSpaces layout + , Just cSld <- findChild (elemName ns "p" "cSld") layout + , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do + element <- nonBodyTextToElement layout "Title 1" titleElems + let titleShapeElements = if null titleElems + then [] + else [element] + return $ replaceNamedChildren ns "p" "sp" titleShapeElements spTree +titleToElement _ _ = return $ mknode "p:sp" [] () + +metadataToElement :: PandocMonad m => Element -> [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> P m Element +metadataToElement layout titleElems subtitleElems authorsElems dateElems + | ns <- elemToNameSpaces layout + , Just cSld <- findChild (elemName ns "p" "cSld") layout + , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do + titleShapeElements <- if null titleElems + then return [] + else sequence [nonBodyTextToElement layout "Title 1" titleElems] + let combinedAuthorElems = intercalate [Break] authorsElems + subtitleAndAuthorElems = intercalate [Break, Break] [subtitleElems, combinedAuthorElems] + subtitleShapeElements <- if null subtitleAndAuthorElems + then return [] + else sequence [nonBodyTextToElement layout "Subtitle 2" subtitleAndAuthorElems] + dateShapeElements <- if null dateElems + then return [] + else sequence [nonBodyTextToElement layout "Date Placeholder 3" dateElems] + return $ replaceNamedChildren ns "p" "sp" + (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements) + spTree +metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] () + +slideToElement :: PandocMonad m => Slide -> P m Element +slideToElement s@(ContentSlide hdrElems shapes) = do + layout <- getLayout s + spTree <- local (\env -> if null hdrElems + then env + else env{envSlideHasHeader=True}) $ + contentToElement layout hdrElems shapes + return $ mknode "p:sld" + [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), + ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), + ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") + ] [mknode "p:cSld" [] [spTree]] +slideToElement s@(TitleSlide hdrElems) = do + layout <- getLayout s + spTree <- titleToElement layout hdrElems + return $ mknode "p:sld" + [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), + ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), + ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") + ] [mknode "p:cSld" [] [spTree]] +slideToElement s@(MetadataSlide titleElems subtitleElems authorElems dateElems) = do + layout <- getLayout s + spTree <- metadataToElement layout titleElems subtitleElems authorElems dateElems + return $ mknode "p:sld" + [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), + ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), + ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") + ] [mknode "p:cSld" [] [spTree]] + +----------------------------------------------------------------------- + +slideToFilePath :: Slide -> Int -> FilePath +slideToFilePath _ idNum = "slide" ++ (show $ idNum) ++ ".xml" + +slideToSlideId :: Monad m => Slide -> Int -> P m String +slideToSlideId _ idNum = do + n <- gets stSlideIdOffset + return $ "rId" ++ (show $ idNum + n) + + +data Relationship = Relationship { relId :: Int + , relType :: MimeType + , relTarget :: FilePath + } deriving (Show, Eq) + +elementToRel :: Element -> Maybe Relationship +elementToRel element + | elName element == QName "Relationship" (Just "http://schemas.openxmlformats.org/package/2006/relationships") Nothing = + do rId <- findAttr (QName "Id" Nothing Nothing) element + numStr <- stripPrefix "rId" rId + num <- case reads numStr :: [(Int, String)] of + (n, _) : _ -> Just n + [] -> Nothing + type' <- findAttr (QName "Type" Nothing Nothing) element + target <- findAttr (QName "Target" Nothing Nothing) element + return $ Relationship num type' target + | otherwise = Nothing + +slideToPresRel :: Monad m => Slide -> Int -> P m Relationship +slideToPresRel slide idNum = do + n <- gets stSlideIdOffset + let rId = idNum + n + fp = "slides/" ++ slideToFilePath slide idNum + return $ Relationship { relId = rId + , relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide" + , relTarget = fp + } + +getRels :: PandocMonad m => P m [Relationship] +getRels = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + relsElem <- parseXml refArchive distArchive "ppt/_rels/presentation.xml.rels" + let globalNS = "http://schemas.openxmlformats.org/package/2006/relationships" + let relElems = findChildren (QName "Relationship" (Just globalNS) Nothing) relsElem + return $ mapMaybe elementToRel relElems + +presentationToRels :: PandocMonad m => Presentation -> P m [Relationship] +presentationToRels (Presentation _ slides) = do + mySlideRels <- mapM (\(s, n) -> slideToPresRel s n) $ zip slides [1..] + rels <- getRels + let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels + -- We want to make room for the slides in the id space. The slides + -- will start at Id2 (since Id1 is for the slide master). There are + -- two slides in the data file, but that might change in the future, + -- so we will do this: + -- + -- 1. We look to see what the minimum relWithoutSlide id (greater than 1) is. + -- 2. We add the difference between this and the number of slides to + -- all relWithoutSlide rels (unless they're 1) + + let minRelNotOne = case filter (1<) $ map relId relsWithoutSlides of + [] -> 0 -- doesn't matter in this case, since + -- there will be nothing to map the + -- function over + l -> minimum l + + modifyRelNum :: Int -> Int + modifyRelNum 1 = 1 + modifyRelNum n = n - minRelNotOne + 2 + length slides + + relsWithoutSlides' = map (\r -> r{relId = modifyRelNum $ relId r}) relsWithoutSlides + + return $ mySlideRels ++ relsWithoutSlides' + +relToElement :: Relationship -> Element +relToElement rel = mknode "Relationship" [ ("Id", "rId" ++ (show $ relId rel)) + , ("Type", relType rel) + , ("Target", relTarget rel) ] () + +relsToElement :: [Relationship] -> Element +relsToElement rels = mknode "Relationships" + [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")] + (map relToElement rels) + +presentationToRelsEntry :: PandocMonad m => Presentation -> P m Entry +presentationToRelsEntry pres = do + rels <- presentationToRels pres + elemToEntry "ppt/_rels/presentation.xml.rels" $ relsToElement rels + +elemToEntry :: PandocMonad m => FilePath -> Element -> P m Entry +elemToEntry fp element = do + epochtime <- (floor . utcTimeToPOSIXSeconds) <$> asks envUTCTime + return $ toEntry fp epochtime $ renderXml element + +slideToEntry :: PandocMonad m => Slide -> Int -> P m Entry +slideToEntry slide idNum = do + modify $ \st -> st{stCurSlideId = idNum} + element <- slideToElement slide + elemToEntry ("ppt/slides/" ++ slideToFilePath slide idNum) element + +slideToSlideRelEntry :: PandocMonad m => Slide -> Int -> P m Entry +slideToSlideRelEntry slide idNum = do + element <- slideToSlideRelElement slide idNum + elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element + +linkRelElement :: Int -> (URL, String) -> Element +linkRelElement idNum (url, _) = + mknode "Relationship" [ ("Id", "rId" ++ show idNum) + , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink") + , ("Target", url) + , ("TargetMode", "External") + ] () + +linkRelElements :: M.Map Int (URL, String) -> [Element] +linkRelElements mp = map (\(n, lnk) -> linkRelElement n lnk) (M.toList mp) + +mediaRelElement :: MediaInfo -> Element +mediaRelElement mInfo = + let ext = case mInfoExt mInfo of + Just e -> e + Nothing -> "" + in + mknode "Relationship" [ ("Id", "rId" ++ (show $ mInfoLocalId mInfo)) + , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image") + , ("Target", "../media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext) + ] () + +slideToSlideRelElement :: PandocMonad m => Slide -> Int -> P m Element +slideToSlideRelElement slide idNum = do + let target = case slide of + (MetadataSlide _ _ _ _) -> "../slideLayouts/slideLayout1.xml" + (TitleSlide _) -> "../slideLayouts/slideLayout3.xml" + (ContentSlide _ _) -> "../slideLayouts/slideLayout2.xml" + + linkIds <- gets stLinkIds + mediaIds <- gets stMediaIds + + let linkRels = case M.lookup idNum linkIds of + Just mp -> linkRelElements mp + Nothing -> [] + mediaRels = case M.lookup idNum mediaIds of + Just mInfos -> map mediaRelElement mInfos + Nothing -> [] + + return $ + mknode "Relationships" + [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")] + ([mknode "Relationship" [ ("Id", "rId1") + , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout") + , ("Target", target)] () + ] ++ linkRels ++ mediaRels) + +-- slideToSlideRelEntry :: PandocMonad m => Slide -> Int -> P m Entry +-- slideToSlideRelEntry slide idNum = do +-- let fp = "ppt/slides/_rels/slide" ++ (show idNum) ++ ".xml.rels" +-- elemToEntry fp $ slideToSlideRelElement slide + +slideToSldIdElement :: PandocMonad m => Slide -> Int -> P m Element +slideToSldIdElement slide idNum = do + let id' = show $ idNum + 255 + rId <- slideToSlideId slide idNum + return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] () + +presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element +presentationToSldIdLst (Presentation _ slides) = do + ids <- mapM (\(s,n) -> slideToSldIdElement s n) (zip slides [1..]) + return $ mknode "p:sldIdLst" [] ids + +presentationToPresentationElement :: PandocMonad m => Presentation -> P m Element +presentationToPresentationElement pres = do + refArchive <- asks envRefArchive + distArchive <- asks envDistArchive + element <- parseXml refArchive distArchive "ppt/presentation.xml" + sldIdLst <- presentationToSldIdLst pres + + let modifySldIdLst :: Content -> Content + modifySldIdLst (Elem e) = case elName e of + (QName "sldIdLst" _ _) -> Elem sldIdLst + _ -> Elem e + modifySldIdLst ct = ct + + newContent = map modifySldIdLst $ elContent element + + return $ element{elContent = newContent} + +presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry +presentationToPresEntry pres = presentationToPresentationElement pres >>= + elemToEntry "ppt/presentation.xml" + + + + +defaultContentTypeToElem :: DefaultContentType -> Element +defaultContentTypeToElem dct = + mknode "Default" + [("Extension", defContentTypesExt dct), + ("ContentType", defContentTypesType dct)] + () + +overrideContentTypeToElem :: OverrideContentType -> Element +overrideContentTypeToElem oct = + mknode "Override" + [("PartName", overrideContentTypesPart oct), + ("ContentType", overrideContentTypesType oct)] + () + +contentTypesToElement :: ContentTypes -> Element +contentTypesToElement ct = + let ns = "http://schemas.openxmlformats.org/package/2006/content-types" + in + mknode "Types" [("xmlns", ns)] $ + (map defaultContentTypeToElem $ contentTypesDefaults ct) ++ + (map overrideContentTypeToElem $ contentTypesOverrides ct) + +data DefaultContentType = DefaultContentType + { defContentTypesExt :: String + , defContentTypesType:: MimeType + } + deriving (Show, Eq) + +data OverrideContentType = OverrideContentType + { overrideContentTypesPart :: FilePath + , overrideContentTypesType :: MimeType + } + deriving (Show, Eq) + +data ContentTypes = ContentTypes { contentTypesDefaults :: [DefaultContentType] + , contentTypesOverrides :: [OverrideContentType] + } + deriving (Show, Eq) + +contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry +contentTypesToEntry ct = elemToEntry "[Content_Types].xml" $ contentTypesToElement ct + +pathToOverride :: FilePath -> Maybe OverrideContentType +pathToOverride fp = OverrideContentType ("/" ++ fp) <$> (getContentType fp) + +mediaContentType :: MediaInfo -> Maybe DefaultContentType +mediaContentType mInfo + | Just ('.' : ext) <- mInfoExt mInfo = + Just $ DefaultContentType { defContentTypesExt = ext + , defContentTypesType = + case mInfoMimeType mInfo of + Just mt -> mt + Nothing -> "application/octet-stream" + } + | otherwise = Nothing + +presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes +presentationToContentTypes (Presentation _ slides) = do + mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds + let defaults = [ DefaultContentType "xml" "application/xml" + , DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml" + ] + mediaDefaults = nub $ mapMaybe mediaContentType mediaInfos + inheritedOverrides = mapMaybe pathToOverride inheritedFiles + presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"] + slideOverrides = + mapMaybe + (\(s, n) -> + pathToOverride $ "ppt/slides/" ++ slideToFilePath s n) + (zip slides [1..]) + -- propOverride = mapMaybe pathToOverride ["docProps/core.xml"] + return $ ContentTypes + (defaults ++ mediaDefaults) + (inheritedOverrides ++ presOverride ++ slideOverrides) + +-- slideToElement :: Element -> Slide -> Element +-- slideToElement layout (ContentSlide _ shapes) = +-- let sps = map (shapeToElement layout) shapes + +presML :: String +presML = "application/vnd.openxmlformats-officedocument.presentationml" + +noPresML :: String +noPresML = "application/vnd.openxmlformats-officedocument" + +getContentType :: FilePath -> Maybe MimeType +getContentType fp + | fp == "ppt/presentation.xml" = Just $ presML ++ ".presentation.main+xml" + | fp == "ppt/presProps.xml" = Just $ presML ++ ".presProps+xml" + | fp == "ppt/viewProps.xml" = Just $ presML ++ ".viewProps+xml" + | fp == "ppt/tableStyles.xml" = Just $ presML ++ ".tableStyles+xml" + | fp == "docProps/core.xml" = Just $ "application/vnd.openxmlformats-package.core-properties+xml" + | fp == "docProps/app.xml" = Just $ noPresML ++ ".extended-properties+xml" + | "ppt" : "slideMasters" : f : [] <- splitDirectories fp + , (_, ".xml") <- splitExtension f = + Just $ presML ++ ".slideMaster+xml" + | "ppt" : "slides" : f : [] <- splitDirectories fp + , (_, ".xml") <- splitExtension f = + Just $ presML ++ ".slide+xml" + | "ppt" : "notesMasters" : f : [] <- splitDirectories fp + , (_, ".xml") <- splitExtension f = + Just $ presML ++ ".notesMaster+xml" + | "ppt" : "notesSlides" : f : [] <- splitDirectories fp + , (_, ".xml") <- splitExtension f = + Just $ presML ++ ".notesSlide+xml" + | "ppt" : "theme" : f : [] <- splitDirectories fp + , (_, ".xml") <- splitExtension f = + Just $ noPresML ++ ".theme+xml" + | "ppt" : "slideLayouts" : _ : [] <- splitDirectories fp= + Just $ presML ++ ".slideLayout+xml" + | otherwise = Nothing diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -5,12 +5,11 @@ old-locale: false network-uri: true packages: -- '.' extra-deps: - pandoc-types-1.17.3 -- hslua-0.9.2 +- hslua-0.9.3 - hslua-module-text-0.1.2 -- skylighting-0.4.4.1 +- skylighting-0.5 - texmath-0.10 - cmark-gfm-0.1.1 - QuickCheck-2.10.0.1 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -12,9 +12,9 @@ singleQuoted, space, str, strong, (<>)) import Text.Pandoc.Class (runIOorExplode) import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc) -import Text.Pandoc.Lua +import Text.Pandoc.Lua (initLuaState, runLuaFilter, luaPackageParams) -import Foreign.Lua +import qualified Foreign.Lua as Lua tests :: [TestTree] tests = map (localOption (QuickCheckTests 20)) @@ -101,20 +101,18 @@ Left _ -> fail "lua filter failed" Right docRes -> assertEqual msg docExpected docRes -roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool +roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool roundtripEqual x = (x ==) <$> roundtripped where - roundtripped :: (FromLuaStack a, ToLuaStack a) => IO a - roundtripped = runLua $ do - openlibs - pushPandocModule (Just "../data") - setglobal "pandoc" - oldSize <- gettop - push x - size <- gettop - when ((size - oldSize) /= 1) $ + roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a + roundtripped = Lua.runLua $ do + initLuaState =<< Lua.liftIO (runIOorExplode (luaPackageParams (Just "../data"))) + oldSize <- Lua.gettop + Lua.push x + size <- Lua.gettop + when (size - oldSize /= 1) $ error ("not exactly one additional element on the stack: " ++ show size) - res <- peekEither (-1) + res <- Lua.peekEither (-1) case res of Left _ -> error "could not read from stack" Right y -> return y diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs --- a/test/Tests/Readers/Docx.hs +++ b/test/Tests/Readers/Docx.hs @@ -10,7 +10,6 @@ import Test.Tasty.HUnit import Tests.Helpers import Text.Pandoc -import Text.Pandoc.Shared (stripEmptyParagraphs) import qualified Text.Pandoc.Class as P import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory) import Text.Pandoc.UTF8 as UTF8 @@ -38,23 +37,20 @@ instance ToPandoc NoNormPandoc where toPandoc = unNoNorm -compareOutput :: Bool - -> ReaderOptions - -> FilePath - -> FilePath - -> IO (NoNormPandoc, NoNormPandoc) -compareOutput strip opts docxFile nativeFile = do +compareOutput :: ReaderOptions + -> FilePath + -> FilePath + -> IO (NoNormPandoc, NoNormPandoc) +compareOutput opts docxFile nativeFile = do df <- B.readFile docxFile nf <- UTF8.toText <$> BS.readFile nativeFile p <- runIOorExplode $ readDocx opts df df' <- runIOorExplode $ readNative def nf - return $ (noNorm (if strip - then stripEmptyParagraphs p - else p), noNorm df') + return $ (noNorm p, noNorm df') testCompareWithOptsIO :: ReaderOptions -> String -> FilePath -> FilePath -> IO TestTree testCompareWithOptsIO opts name docxFile nativeFile = do - (dp, np) <- compareOutput True opts docxFile nativeFile + (dp, np) <- compareOutput opts docxFile nativeFile return $ test id name (dp, np) testCompareWithOpts :: ReaderOptions -> String -> FilePath -> FilePath -> TestTree @@ -75,11 +71,6 @@ testForWarningsWithOpts opts name docxFile expected = unsafePerformIO $ testForWarningsWithOptsIO opts name docxFile expected -testCompareNoStrip :: String -> FilePath -> FilePath -> TestTree -testCompareNoStrip name docxFile nativeFile = unsafePerformIO $ do - (dp, np) <- compareOutput False defopts docxFile nativeFile - return $ test id name (dp, np) - -- testForWarnings :: String -> FilePath -> [String] -> TestTree -- testForWarnings = testForWarningsWithOpts defopts @@ -266,10 +257,6 @@ "dropcap paragraphs" "docx/drop_cap.docx" "docx/drop_cap.native" - , testCompareNoStrip - "empty paragraphs without stripping" - "docx/drop_cap.docx" - "docx/drop_cap_nostrip.native" ] , testGroup "track changes" [ testCompare diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -10,6 +10,7 @@ import Text.Pandoc import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder +import Text.Pandoc.Shared (underlineSpan) -- import Text.Pandoc.Walk (walk) amuse :: Text -> Pandoc @@ -69,6 +70,10 @@ "Foo *bar*x baz" =?> para "Foo *bar*x baz" + , "Letter before opening *" =: + "Foo x*bar* baz" =?> + para "Foo x*bar* baz" + , "Emphasis tag" =: "Foo bar" =?> para (emph . spcSep $ ["Foo", "bar"]) @@ -83,6 +88,9 @@ "***strength***" =?> para (strong . emph $ "strength") + , test emacsMuse "Underline" + ("_Underline_" =?> para (underlineSpan "Underline")) + , "Superscript tag" =: "Superscript" =?> para (superscript "Superscript") , "Subscript tag" =: "Subscript" =?> para (subscript "Subscript") @@ -108,7 +116,7 @@ , "Linebreak" =: "Line
break" =?> para ("Line" <> linebreak <> "break") , test emacsMuse "Non-breaking space" - ("Foo~~bar" =?> para ("Foo\160bar")) + ("Foo~~bar" =?> para "Foo\160bar") , testGroup "Code markup" [ "Code" =: "=foo(bar)=" =?> para (code "foo(bar)") @@ -446,6 +454,19 @@ ] =?> blockQuote (para "* Hi") ] + , testGroup "Directives" + [ "Title" =: + "#title Document title" =?> + let titleInline = toList "Document title" + meta = setMeta "title" (MetaInlines titleInline) nullMeta + in Pandoc meta mempty + -- Emacs Muse documentation says that "You can use any combination + -- of uppercase and lowercase letters for directives", + -- but also allows '-', which is not documented, but used for disable-tables. + , test emacsMuse "Disable tables" + ("#disable-tables t" =?> + Pandoc (setMeta "disable-tables" (MetaInlines $ toList "t") nullMeta) mempty) + ] , testGroup "Anchors" [ "Anchor" =: T.unlines [ "; A comment to make sure anchor is not parsed as a directive" @@ -931,12 +952,5 @@ , para "Second" , para "Third" ]) - ] - , testGroup "Meta" - [ "Title" =: - "#title Document title" =?> - let titleInline = toList $ "Document title" - meta = setMeta "title" (MetaInlines titleInline) $ nullMeta - in Pandoc meta mempty ] ] diff --git a/test/command/2649.md b/test/command/2649.md --- a/test/command/2649.md +++ b/test/command/2649.md @@ -88,20 +88,17 @@

1

- -

Sébastien Loeb

+

Sébastien Loeb

78

2

- -

Sébastien Ogier

+

Sébastien Ogier

38

10

- -

Hannu Mikkola

+

Hannu Mikkola

18

diff --git a/test/command/3494.md b/test/command/3494.md --- a/test/command/3494.md +++ b/test/command/3494.md @@ -25,8 +25,7 @@ thank you - -

blah

+

blah

blah blah diff --git a/test/command/3734.md b/test/command/3734.md --- a/test/command/3734.md +++ b/test/command/3734.md @@ -6,9 +6,9 @@ ^D ---+++ diff --git a/test/command/4119.md b/test/command/4119.md new file mode 100644 --- /dev/null +++ b/test/command/4119.md @@ -0,0 +1,18 @@ +``` +pandoc -t native +| col1 | col2 | +| ---- | ---- | +| 1 | 2 | + +::: {.notes} ::: +not a caption! +:::::::::::::::: +^D +[Table [] [AlignDefault,AlignDefault] [0.0,0.0] + [[Plain [Str "col1"]] + ,[Plain [Str "col2"]]] + [[[Plain [Str "1"]] + ,[Plain [Str "2"]]]] +,Div ("",["notes"],[]) + [Para [Str "not",Space,Str "a",Space,Str "caption!"]]] +``` diff --git a/test/command/4125.md b/test/command/4125.md new file mode 100644 --- /dev/null +++ b/test/command/4125.md @@ -0,0 +1,6 @@ +``` +% pandoc + +^D + +``` diff --git a/test/command/4134.md b/test/command/4134.md new file mode 100644 --- /dev/null +++ b/test/command/4134.md @@ -0,0 +1,25 @@ +``` +% pandoc -f latex -t native +Hello.\ +world. +^D +[Para [Str "Hello.\160world."]] +``` + +``` +% pandoc -f latex -t native +Hello.\ + world. +^D +[Para [Str "Hello.\160world."]] +``` + +``` +% pandoc -f latex -t native +Hello.\ + +World. +^D +[Para [Str "Hello.\160"] +,Para [Str "World."]] +``` diff --git a/test/command/empty_paragraphs.md b/test/command/empty_paragraphs.md new file mode 100644 --- /dev/null +++ b/test/command/empty_paragraphs.md @@ -0,0 +1,95 @@ +``` +% pandoc -f native -t docx -o - | pandoc -f docx -t native +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +[Para [Str "hi"] +,Para [Str "lo"]] +``` + +``` +% pandoc -f native -t docx+empty_paragraphs -o - | pandoc -f docx -t native +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +[Para [Str "hi"] +,Para [Str "lo"]] +``` + +``` +% pandoc -f native -t docx -o - | pandoc -f docx+empty_paragraphs -t native +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +[Para [Str "hi"] +,Para [Str "lo"]] +``` + +``` +% pandoc -f native -t docx+empty_paragraphs -o - | pandoc -f docx+empty_paragraphs -t native +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +[Para [Str "hi"] +,Para [] +,Para [] +,Para [Str "lo"]] +``` + +``` +% pandoc -f native -t html5 +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +

hi

+ + +

lo

+``` + +``` +% pandoc -f native -t html5+empty_paragraphs +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +

hi

+

+

+

lo

+``` + +``` +% pandoc -f html+empty_paragraphs -t native +

hi

+

+

+

lo

+^D +[Para [Str "hi"] +,Para [] +,Para [] +,Para [Str "lo"]] +``` + +``` +% pandoc -f html -t native +

hi

+

+

+

lo

+^D +[Para [Str "hi"] +,Para [Str "lo"]] +``` + +``` +% pandoc -f native -t opendocument+empty_paragraphs +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +hi + + +lo +``` + +``` +% pandoc -f native -t opendocument +[Para [Str "hi"], Para [], Para [], Para [Str "lo"]] +^D +hi +lo +``` diff --git a/test/docx/0_level_headers.native b/test/docx/0_level_headers.native --- a/test/docx/0_level_headers.native +++ b/test/docx/0_level_headers.native @@ -1,15 +1,15 @@ [Table [] [AlignDefault] [0.0] [[]] - [[[Plain []]] + [[[]] ,[[Plain [Str "User\8217s",Space,Str "Guide"]]] - ,[[Plain []]] - ,[[Plain []]] - ,[[Plain []]] + ,[[]] + ,[[]] + ,[[]] ,[[Plain [Str "11",Space,Str "August",Space,Str "2017"]]] - ,[[Plain []]] - ,[[Plain []]] - ,[[Plain []]] - ,[[Plain []]]] + ,[[]] + ,[[]] + ,[[]] + ,[[]]] ,Para [Str "CONTENTS"] ,Para [Strong [Str "Section",Space,Str "Page"]] ,Para [Str "FIGURES",Space,Str "iv"] diff --git a/test/docx/comments.native b/test/docx/comments.native --- a/test/docx/comments.native +++ b/test/docx/comments.native @@ -1,4 +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 "\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 "."]] +,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/test/docx/drop_cap_nostrip.native b/test/docx/drop_cap_nostrip.native deleted file mode 100644 --- a/test/docx/drop_cap_nostrip.native +++ /dev/null @@ -1,9 +0,0 @@ -[Para [Str "Drop",Space,Str "cap."] -,Para [] -,Para [Str "Next",Space,Str "paragraph."] -,Para [] -,Para [Str "Drop",Space,Str "cap",Space,Str "in",Space,Str "margin."] -,Para [] -,Para [] -,Para [] -,Para [Str "Drop",Space,Str "cap",Space,Str "(not",Space,Str "really)."]] diff --git a/test/lhs-test.html b/test/lhs-test.html --- a/test/lhs-test.html +++ b/test/lhs-test.html @@ -13,16 +13,24 @@ div.column{display: inline-block; vertical-align: top; width: 50%;}