diff options
32 files changed, 1032 insertions, 372 deletions
@@ -5,19 +5,21 @@ ifeq "${makemanpages}" "" endif setup=dist/setup/setup MANPAGES=man/man1/pandoc.1 man/man5/pandoc_markdown.5 -CABALARGS=-fmake-pandoc-man-pages --enable-tests --enable-benchmarks - -all: build test quick: cabal configure --enable-tests --disable-optimization cabal build +full: + cabal configure --enable-tests --enable-optimization -ftrypandoc -fmake-pandoc-man-pages -fembed_data_files --enable-benchmarks + cabal build + cabal haddock + deps: - cabal install ${OPTIONS} ${CABALARGS} --only-dependencies + cabal install --only-dependencies --enable-tests -ftrypandoc -fmake-pandoc-man-pages -fembed_data_files --enable-benchmarks -build: - cabal configure ${OPTIONS} ${CABALARGS} +prof: + cabal configure --enable-library-profiling --enable-executable-profiling --enable-optimization --enable-tests cabal build test: @@ -26,12 +28,9 @@ test: bench: cabal bench -install: +install: full cabal install -haddock: - cabal haddock - sdist: man # note: cabal sdist doesn't work well with preprocessors for some cabal versions ${setup} sdist @@ -44,6 +43,9 @@ dist: sdist man: ${MANPAGES} +osxpkg: + ./make_osx_package.sh + %.1: %.1.template ${makemanpages} @@ -51,6 +53,7 @@ man: ${MANPAGES} ${makemanpages} clean: + cabal clean -rm ${MANPAGES} -.PHONY: all man clean test build bench haddock sdist +.PHONY: deps quick full install man clean test bench haddock sdist osxpkg dist prof @@ -424,10 +424,9 @@ Options affecting specific writers formats, including `html`, `html5`, `html+lhs`, `html5+lhs`, `s5`, `slidy`, `slideous`, `dzslides`, and `revealjs`. Scripts, images, and stylesheets at absolute URLs will be downloaded; those at relative URLs - will be sought first relative to the working directory, then relative to - the user data directory (see `--data-dir`), and finally relative to - pandoc's default data directory. `--self-contained` does not - work with `--mathjax`. + will be sought relative to the working directory (if the first source + file is local) or relative to the base URL (if the first source + file is remote). `--self-contained` does not work with `--mathjax`. `--offline` : Deprecated synonym for `--self-contained`. @@ -551,9 +550,9 @@ Options affecting specific writers used. The following styles are used by pandoc: [paragraph] Normal, Compact, Title, Subtitle, Authors, Date, Abstract, Heading 1, Heading 2, Heading 3, Heading 4, Heading 5, Block Quote, Definition Term, - Definition, Body Text, Table Caption, Image Caption; [character] Default - Paragraph Font, Body Text Char, Verbatim Char, Footnote Ref, - Link. + Definition, Bibliography, Body Text, Table Caption, Image Caption; + [character] Default Paragraph Font, Body Text Char, Verbatim Char, + Footnote Ref, Link. `--epub-stylesheet=`*FILE* : Use the specified CSS file to style the EPUB. If no stylesheet diff --git a/RELEASE-CHECKLIST b/RELEASE-CHECKLIST index a8237211c..0663e3f3a 100644 --- a/RELEASE-CHECKLIST +++ b/RELEASE-CHECKLIST @@ -20,7 +20,8 @@ _ Update website, including short description of changes _ Announce on pandoc-announce, pandoc-discuss -_ recompile trypandoc +_ on server, 'cabal install --enable-tests -ftrypandoc' + and then 'cd trypandoc; sudo make install' _ recompile gitit @@ -1,3 +1,127 @@ +pandoc (XXX) + + * Fixed `--self-contained` with Windows paths (#1558). + Previously `C:\foo.js` was being wrongly interpreted as a URI. + + * HTML reader: improved handling of tags that can be block or inline. + Previously a section like this would be enclosed in a paragraph, + with RawInline for the video tags (since video is a tag that can + be either block or inline): + + <video controls="controls"> + <source src="../videos/test.mp4" type="video/mp4" /> + <source src="../videos/test.webm" type="video/webm" /> + <p> + The videos can not be played back on your system.<br/> + Try viewing on Youtube (requires Internet connection): + <a href="http://youtu.be/etE5urBps_w">Relative Velocity on + Youtube</a>. + </p> + </video> + + This change will cause the video and source tags to be parsed + as RawBlock instead, giving better output. + The general change is this: when we're parsing a "plain" sequence + of inlines, we don't parse anything that COULD be a block-level tag. + + * Docx reader: + + + Be sensitive to user styles. Note that "Hyperlink" is + "blacklisted," as we don't want the default underline styling to be + inherited by all links by default (Jesse Rosenthal). + + Read single paragraph in table cell as `Plain` (Jesse Rosenthal). + This makes to docx reader's native output fit with the way the markdown + reader understands its markdown output. + + * Txt2Tags reader: + + + Header is now parsed only if standalone flag is set (Matthew Pickering). + + The header is now parsed as meta information. The first line is the + `title`, the second is the `author` and third line is the `date` + (Matthew Pickering). + + Corrected formatting of `%%mtime` macro (Matthew Pickering). + + Fixed crash when reading from stdin. + + * EPUB writer: Don't use page-progression-direction in EPUB2, which + doesn't support it. Also, if page-progression-direction not specified + in metadata, don't include the attribute even in EPUB3; not including it + is the same as including it with the value "default", as we did before. + (#1550) + + * Org writer: Accept example lines with indentation at the beginning + (Calvin Beck). + + * DokuWiki writer: + + + Refactor to use Reader monad (Matthew Pickering). + + Avoid using raw HTML in table cells; instead, use `\\` + instead of newlines (Jesse Rosenthal). + + * Docx writer: + + + Bibliography entries get `Bibliography` style (#1559). + + Implement change tracking (Jesse Rosenthal). + + * LaTeX writer: + + + Fixed a bug that caused a table caption to repeat across all pages + (Jose Luis Duran). + + Improved vertical spacing in tables and made it customizable using + standard lengths set by booktab. See + <https://groups.google.com/forum/#!msg/pandoc-discuss/qMu6_5lYy0o/ZAU7lzAIKw0J> + (Jose Luis Duran). + + Added `\strut` to fix spacing in multiline tables (Jose Luis Duran). + + Use `\tabularnewline` instead of `\\` in table cells (Jose Luis Duran). + + Made horizontal rules more flexible (Jose Luis Duran). + + * Templates: + + + LaTeX template: disable microtype protrusion for typewriter font (#1549, + thanks lemzwerg). + + * Improved OSX build procedure. + + * Added `network-uri` flag, to deal with split of `network-uri` from + `network`. + + * Fix build dependencies for the `trypandoc` flag, so that they are + ignored if `trypandoc` flag is set to False (Gabor Pali). + + * Updated README to remove outdated claim that `--self-contained` + looks in the user data directory for missing files. + +pandoc (1.13.0.1) + + * Docx writer: + + + Fixed regression which bungled list numbering (#1544), causing + all lists to appear as basic ordered lists. + + Include row width in table rows (Christoffer Ackelman, Viktor Kronvall). + Added a property to all table rows where the sum of column widths + is specified in pct (fraction of 5000). This helps persuade Word + to lay out the table with the widths we specify. + + * Fixed a bug in Windows 8 which caused pandoc not to find the + `pandoc-citeproc` filter (#1542). + + * Docx reader: miscellaneous under-the-hood improvements (Jesse Rosenthal). + Most significantly, the reader now uses Builder, leading to some + performance improvements. + + * HTML reader: Parse appropriately styled span as SmallCaps. + + * Markdown writer: don't escape `$`, `^`, `~` when `tex_math_dollars`, + `superscript`, and `subscript` extensions, respectively, are + deactivated (#1127). + + * Added `trypandoc` flag to build CGI executable used in the online + demo. + + * Makefile: Added 'quick', 'osxpkg' targets. + + * Updated README in templates to indicate templates license. + The templates are dual-licensed, BSD3 and GPL2+. + pandoc (1.13) [new features] diff --git a/data/reference.docx b/data/reference.docx Binary files differindex 08059eb3c..0c717b3b6 100644 --- a/data/reference.docx +++ b/data/reference.docx diff --git a/data/templates b/data/templates -Subproject 950b54c55c5e6577a09715d9654abafac445ab5 +Subproject 7be841cee65db23378e659f3be443effa15168a diff --git a/make_osx_package.sh b/make_osx_package.sh index ac6427af1..6030f7032 100755 --- a/make_osx_package.sh +++ b/make_osx_package.sh @@ -12,7 +12,6 @@ SCRIPTS=$OSX/osx-resources BASE=pandoc-$VERSION ME=$(whoami) PACKAGEMAKER=/Applications/PackageMaker.app/Contents/MacOS/PackageMaker -EXES="pandoc pandoc-citeproc" CPPHS=$SANDBOX/bin/cpphs # echo Removing old files... @@ -27,8 +26,7 @@ echo Building pandoc... cabal clean # Use cpphs to avoid problems with clang cpp on ghc 7.8 osx: cabal install cpphs hsb2hs -cabal install --ghc-options="-optl-mmacosx-version-min=10.6" --reinstall --flags="embed_data_files make-pandoc-man-pages" --ghc-options "-pgmP$CPPHS -optP--cpp" -cabal install --ghc-options="-optl-mmacosx-version-min=10.6" --reinstall --flags="embed_data_files" pandoc-citeproc --ghc-options "-pgmP$CPPHS -optP--cpp" +cabal install --ghc-options="-optl-mmacosx-version-min=10.6" --reinstall --flags="embed_data_files make-pandoc-man-pages" --ghc-options "-pgmP$CPPHS -optP--cpp" . pandoc-citeproc make man # get pandoc-citeproc man page: @@ -38,7 +36,7 @@ cp $PANDOC_CITEPROC_PATH/man/man1/pandoc-citeproc.1 $MANDIR/man1/ mkdir -p $DEST/bin mkdir -p $DEST/share/man/man1 mkdir -p $DEST/share/man/man5 -for f in $EXES; do +for f in pandoc pandoc-citeproc; do cp $SANDBOX/bin/$f $DEST/bin/; cp $MANDIR/man1/$f.1 $DEST/share/man/man1/ done diff --git a/pandoc.cabal b/pandoc.cabal index 3486ad48c..3031bc0e0 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,5 +1,5 @@ Name: pandoc -Version: 1.13 +Version: 1.13.0.1 Cabal-Version: >= 1.10 Build-Type: Custom License: GPL @@ -93,6 +93,9 @@ Extra-Source-Files: -- generated man pages (produced post-build) man/man1/pandoc.1 man/man5/pandoc_markdown.5 + -- trypandoc + trypandoc/Makefile + trypandoc/index.html -- tests tests/bodybg.gif tests/*.native @@ -116,6 +119,8 @@ Extra-Source-Files: tests/s5-inserts.html tests/tables.context tests/tables.docbook + tests/tables.dokuwiki + tests/tables.icml tests/tables.html tests/tables.latex tests/tables.man @@ -184,6 +189,10 @@ Flag embed_data_files Description: Embed data files in binary for relocatable executable. Default: False +Flag trypandoc + Description: Build trypandoc cgi executable. + Default: False + Flag https Description: Enable support for downloading of resources over https. Default: True @@ -192,6 +201,10 @@ Flag make-pandoc-man-pages Description: Build program to regenerate pandoc man pages from README. Default: False +Flag network-uri + Description: Get Network.URI from the network-uri package + Default: True + Library Build-Depends: base >= 4.2 && <5, syb >= 0.1 && < 0.5, @@ -200,7 +213,6 @@ Library array >= 0.3 && < 0.6, parsec >= 3.1 && < 3.2, mtl >= 1.1 && < 2.3, - network >= 2 && < 2.6, filepath >= 1.1 && < 1.4, process >= 1 && < 1.3, directory >= 1 && < 1.3, @@ -234,6 +246,10 @@ Library old-time, deepseq-generics >= 0.1 && < 0.2, JuicyPixels >= 3.1.6.1 && < 3.2 + if flag(network-uri) + Build-Depends: network-uri >= 2.6 && < 2.7, network >= 2.6 + else + Build-Depends: network >= 2 && < 2.6 if flag(https) Build-Depends: http-client >= 0.3.2 && < 0.4, http-client-tls >= 0.2 && < 0.3, @@ -330,7 +346,6 @@ Executable pandoc base >= 4.2 && <5, directory >= 1 && < 1.3, filepath >= 1.1 && < 1.4, - network >= 2 && < 2.6, text >= 0.11 && < 1.2, bytestring >= 0.9 && < 0.11, extensible-exceptions >= 0.1 && < 0.2, @@ -339,6 +354,10 @@ Executable pandoc yaml >= 0.8.8.2 && < 0.9, containers >= 0.1 && < 0.6, HTTP >= 4000.0.5 && < 4000.3 + if flag(network-uri) + Build-Depends: network-uri >= 2.6 && < 2.7 + else + Build-Depends: network >= 2 && < 2.6 Ghc-Options: -rtsopts -with-rtsopts=-K16m -Wall -fno-warn-unused-do-bind Ghc-Prof-Options: -auto-all -caf-all -rtsopts -with-rtsopts=-K16m if os(windows) @@ -352,6 +371,17 @@ Executable pandoc Main-Is: pandoc.hs Buildable: True +Executable trypandoc + Main-Is: trypandoc.hs + Hs-Source-Dirs: trypandoc + default-language: Haskell2010 + if flag(trypandoc) + Build-Depends: base, aeson, pandoc, highlighting-kate, + text, wai-extra, wai >= 0.3, http-types + Buildable: True + else + Buildable: False + -- NOTE: A trick in Setup.hs makes sure this won't be installed: Executable make-pandoc-man-pages Main-Is: make-pandoc-man-pages.hs @@ -44,7 +44,7 @@ import Text.Pandoc.SelfContained ( makeSelfContained ) import Text.Pandoc.Process (pipeProcess) import Text.Highlighting.Kate ( languages, Style, tango, pygments, espresso, zenburn, kate, haddock, monochrome ) -import System.Environment ( getArgs, getProgName, getEnvironment ) +import System.Environment ( getArgs, getProgName ) import System.Exit ( exitWith, ExitCode (..) ) import System.FilePath import System.Console.GetOpt @@ -75,7 +75,7 @@ import Data.Monoid type Transform = Pandoc -> Pandoc copyrightMessage :: String -copyrightMessage = unlines [ +copyrightMessage = intercalate "\n" [ "", "Copyright (C) 2006-2014 John MacFarlane", "Web: http://johnmacfarlane.net/pandoc", @@ -113,12 +113,15 @@ isTextFormat s = takeWhile (`notElem` "+-") s `notElem` binaries externalFilter :: FilePath -> [String] -> Pandoc -> IO Pandoc externalFilter f args' d = do - mbPath <- lookup "PATH" <$> getEnvironment - mbexe <- if '/' `elem` f || mbPath == Nothing - -- don't check PATH if filter name has a path, or - -- if the PATH is not set + mbexe <- if '/' `elem` f + -- don't check PATH if filter name has a path then return Nothing - else findExecutable f + -- we catch isDoesNotExistError because this will + -- be triggered if PATH not set: + else E.catch (findExecutable f) + (\e -> if isDoesNotExistError e + then return Nothing + else throwIO e) (f', args'') <- case mbexe of Just x -> return (x, args') Nothing -> do diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index a1c16a03a..8ebe59569 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -95,6 +95,7 @@ import Control.Monad.Reader import Control.Monad.State import Control.Applicative ((<$>)) import Data.Sequence (ViewL(..), viewl) +import qualified Data.Sequence as Seq (null) readDocx :: ReaderOptions -> B.ByteString @@ -196,12 +197,6 @@ fixAuthors mv = mv codeStyles :: [String] codeStyles = ["VerbatimChar"] -strongStyles :: [String] -strongStyles = ["Strong", "Bold"] - -emphStyles :: [String] -emphStyles = ["Emphasis", "Italic"] - blockQuoteDivs :: [String] blockQuoteDivs = ["Quote", "BlockQuote", "BlockQuotation"] @@ -228,27 +223,44 @@ parPartToString (InternalHyperLink _ runs) = concatMap runToString runs parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs parPartToString _ = "" +blacklistedCharStyles :: [String] +blacklistedCharStyles = ["Hyperlink"] + +resolveDependentRunStyle :: RunStyle -> RunStyle +resolveDependentRunStyle rPr + | Just (s, _) <- rStyle rPr, s `elem` blacklistedCharStyles = + rPr + | Just (_, cs) <- rStyle rPr = + let rPr' = resolveDependentRunStyle cs + in + RunStyle { isBold = case isBold rPr of + Just bool -> Just bool + Nothing -> isBold rPr' + , isItalic = case isItalic rPr of + Just bool -> Just bool + Nothing -> isItalic rPr' + , isSmallCaps = case isSmallCaps rPr of + Just bool -> Just bool + Nothing -> isSmallCaps rPr' + , isStrike = case isStrike rPr of + Just bool -> Just bool + Nothing -> isStrike rPr' + , rVertAlign = case rVertAlign rPr of + Just valign -> Just valign + Nothing -> rVertAlign rPr' + , rUnderline = case rUnderline rPr of + Just ulstyle -> Just ulstyle + Nothing -> rUnderline rPr' + , rStyle = rStyle rPr } + | otherwise = rPr + runStyleToTransform :: RunStyle -> (Inlines -> Inlines) runStyleToTransform rPr - | Just s <- rStyle rPr + | Just (s, _) <- rStyle rPr , s `elem` spansToKeep = let rPr' = rPr{rStyle = Nothing} in (spanWith ("", [s], [])) . (runStyleToTransform rPr') - | Just s <- rStyle rPr - , s `elem` emphStyles = - let rPr' = rPr{rStyle = Nothing, isItalic = Nothing} - in - case isItalic rPr of - Just False -> runStyleToTransform rPr' - _ -> emph . (runStyleToTransform rPr') - | Just s <- rStyle rPr - , s `elem` strongStyles = - let rPr' = rPr{rStyle = Nothing, isBold = Nothing} - in - case isBold rPr of - Just False -> runStyleToTransform rPr' - _ -> strong . (runStyleToTransform rPr') | Just True <- isItalic rPr = emph . (runStyleToTransform rPr {isItalic = Nothing}) | Just True <- isBold rPr = @@ -257,22 +269,22 @@ runStyleToTransform rPr smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) | Just True <- isStrike rPr = strikeout . (runStyleToTransform rPr {isStrike = Nothing}) - | isSuperScript rPr = - superscript . (runStyleToTransform rPr {isSuperScript = False}) - | isSubScript rPr = - subscript . (runStyleToTransform rPr {isSubScript = False}) + | Just SupScrpt <- rVertAlign rPr = + superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + | Just SubScrpt <- rVertAlign rPr = + subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) | Just "single" <- rUnderline rPr = emph . (runStyleToTransform rPr {rUnderline = Nothing}) | otherwise = id runToInlines :: Run -> DocxContext Inlines runToInlines (Run rs runElems) - | Just s <- rStyle rs + | Just (s, _) <- rStyle rs , s `elem` codeStyles = return $ code $ concatMap runElemToString runElems | otherwise = do let ils = concatReduce (map runElemToInlines runElems) - return $ (runStyleToTransform rs) ils + return $ (runStyleToTransform $ resolveDependentRunStyle rs) ils runToInlines (Footnote bps) = do blksList <- concatReduce <$> (mapM bodyPartToBlocks bps) return $ note blksList @@ -380,11 +392,21 @@ makeHeaderAnchor' (Header n (_, classes, kvs) ils) = return $ Header n (newIdent, classes, kvs) ils makeHeaderAnchor' blk = return blk +-- Rewrite a standalone paragraph block as a plain +singleParaToPlain :: Blocks -> Blocks +singleParaToPlain blks + | (Para (ils) :< seeq) <- viewl $ unMany blks + , Seq.null seeq = + singleton $ Plain ils +singleParaToPlain blks = blks + cellToBlocks :: Cell -> DocxContext Blocks cellToBlocks (Cell bps) = concatReduce <$> mapM bodyPartToBlocks bps rowToBlocksList :: Row -> DocxContext [Blocks] -rowToBlocksList (Row cells) = mapM cellToBlocks cells +rowToBlocksList (Row cells) = do + blksList <- mapM cellToBlocks cells + return $ map singleParaToPlain blksList trimLineBreaks :: [Inline] -> [Inline] trimLineBreaks [] = [] diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 939fcde27..e7a6c3ffb 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -43,13 +43,13 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , Relationship , Media , RunStyle(..) + , VertAlign(..) , ParIndentation(..) , ParagraphStyle(..) , Row(..) , Cell(..) , archiveToDocx ) where - import Codec.Archive.Zip import Text.XML.Light import Data.Maybe @@ -72,6 +72,7 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes , envRelationships :: [Relationship] , envMedia :: Media , envFont :: Maybe Font + , envCharStyles :: CharStyleMap } deriving Show @@ -119,6 +120,10 @@ data Body = Body [BodyPart] type Media = [(FilePath, B.ByteString)] +type CharStyle = (String, RunStyle) + +type CharStyleMap = M.Map String RunStyle + data Numbering = Numbering NameSpaces [Numb] [AbstractNumb] deriving Show @@ -196,14 +201,16 @@ data Run = Run RunStyle [RunElem] data RunElem = TextRun String | LnBrk | Tab deriving Show +data VertAlign = BaseLn | SupScrpt | SubScrpt + deriving Show + data RunStyle = RunStyle { isBold :: Maybe Bool , isItalic :: Maybe Bool , isSmallCaps :: Maybe Bool , isStrike :: Maybe Bool - , isSuperScript :: Bool - , isSubScript :: Bool + , rVertAlign :: Maybe VertAlign , rUnderline :: Maybe String - , rStyle :: Maybe String } + , rStyle :: Maybe CharStyle} deriving Show defaultRunStyle :: RunStyle @@ -211,11 +218,9 @@ defaultRunStyle = RunStyle { isBold = Nothing , isItalic = Nothing , isSmallCaps = Nothing , isStrike = Nothing - , isSuperScript = False - , isSubScript = False + , rVertAlign = Nothing , rUnderline = Nothing - , rStyle = Nothing - } + , rStyle = Nothing} type Target = String @@ -237,7 +242,8 @@ archiveToDocx archive = do numbering = archiveToNumbering archive rels = archiveToRelationships archive media = archiveToMedia archive - rEnv = ReaderEnv notes numbering rels media Nothing + styles = archiveToStyles archive + rEnv = ReaderEnv notes numbering rels media Nothing styles doc <- runD (archiveToDocument archive) rEnv return $ Docx doc @@ -257,6 +263,53 @@ elemToBody ns element | isElem ns "w" "body" element = (\bps -> return $ Body bps) elemToBody _ _ = throwError WrongElem +archiveToStyles :: Archive -> CharStyleMap +archiveToStyles zf = + let stylesElem = findEntryByPath "word/styles.xml" zf >>= + (parseXMLDoc . UTF8.toStringLazy . fromEntry) + in + case stylesElem of + Nothing -> M.empty + Just styElem -> + let namespaces = mapMaybe attrToNSPair (elAttribs styElem) + in + M.fromList $ buildBasedOnList namespaces styElem Nothing + +isBasedOnStyle :: NameSpaces -> Element -> Maybe CharStyle -> Bool +isBasedOnStyle ns element parentStyle + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Just basedOnVal <- findChild (elemName ns "w" "basedOn") element >>= + findAttr (elemName ns "w" "val") + , Just (parentId, _) <- parentStyle = (basedOnVal == parentId) + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Nothing <- findChild (elemName ns "w" "basedOn") element + , Nothing <- parentStyle = True + | otherwise = False + +elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle +elemToCharStyle ns element parentStyle + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Just styleId <- findAttr (elemName ns "w" "styleId") element = + Just (styleId, elemToRunStyle ns element parentStyle) + | otherwise = Nothing + +getStyleChildren :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle] +getStyleChildren ns element parentStyle + | isElem ns "w" "styles" element = + mapMaybe (\e -> elemToCharStyle ns e parentStyle) $ + filterChildren (\e' -> isBasedOnStyle ns e' parentStyle) element + | otherwise = [] + +buildBasedOnList :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle] +buildBasedOnList ns element rootStyle = + case (getStyleChildren ns element rootStyle) of + [] -> [] + stys -> stys ++ + (concatMap (\s -> buildBasedOnList ns element (Just s)) stys) + archiveToNotes :: Archive -> Notes archiveToNotes zf = let fnElem = findEntryByPath "word/footnotes.xml" zf @@ -627,7 +680,8 @@ elemToRun ns element elemToRun ns element | isElem ns "w" "r" element = do runElems <- elemToRunElems ns element - return $ Run (elemToRunStyle ns element) runElems + runStyle <- elemToRunStyleD ns element + return $ Run runStyle runElems elemToRun _ _ = throwError WrongElem elemToParagraphStyle :: NameSpaces -> Element -> ParagraphStyle @@ -667,9 +721,22 @@ checkOnOff ns rPr tag | Just _ <- findChild tag rPr = Just True checkOnOff _ _ _ = Nothing - -elemToRunStyle :: NameSpaces -> Element -> RunStyle -elemToRunStyle ns element +elemToRunStyleD :: NameSpaces -> Element -> D RunStyle +elemToRunStyleD ns element + | Just rPr <- findChild (elemName ns "w" "rPr") element = do + charStyles <- asks envCharStyles + let parentSty = case + findChild (elemName ns "w" "rStyle") rPr >>= + findAttr (elemName ns "w" "val") + of + Just styName | Just style <- M.lookup styName charStyles -> + Just (styName, style) + _ -> Nothing + return $ elemToRunStyle ns element parentSty +elemToRunStyleD _ _ = return defaultRunStyle + +elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle +elemToRunStyle ns element parentStyle | Just rPr <- findChild (elemName ns "w" "rPr") element = RunStyle { @@ -677,22 +744,19 @@ elemToRunStyle ns element , isItalic = checkOnOff ns rPr (elemName ns "w" "i") , isSmallCaps = checkOnOff ns rPr (elemName ns "w" "smallCaps") , isStrike = checkOnOff ns rPr (elemName ns "w" "strike") - , isSuperScript = - (Just "superscript" == - (findChild (elemName ns "w" "vertAlign") rPr >>= - findAttr (elemName ns "w" "val"))) - , isSubScript = - (Just "subscript" == - (findChild (elemName ns "w" "vertAlign") rPr >>= - findAttr (elemName ns "w" "val"))) + , rVertAlign = + findChild (elemName ns "w" "vertAlign") rPr >>= + findAttr (elemName ns "w" "val") >>= + \v -> Just $ case v of + "superscript" -> SupScrpt + "subscript" -> SubScrpt + _ -> BaseLn , rUnderline = findChild (elemName ns "w" "u") rPr >>= findAttr (elemName ns "w" "val") - , rStyle = - findChild (elemName ns "w" "rStyle") rPr >>= - findAttr (elemName ns "w" "val") + , rStyle = parentStyle } -elemToRunStyle _ _ = defaultRunStyle +elemToRunStyle _ _ _ = defaultRunStyle elemToRunElem :: NameSpaces -> Element -> D RunElem elemToRunElem ns element diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index bd60a74fa..4ea5f41d5 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -91,16 +91,20 @@ replaceNotes' x = return x data HTMLState = HTMLState { parserState :: ParserState, - noteTable :: [(String, Blocks)] + noteTable :: [(String, Blocks)] } data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext , inChapter :: Bool -- ^ Set if in chapter section + , inPlain :: Bool -- ^ Set if in pPlain } setInChapter :: HTMLParser s a -> HTMLParser s a setInChapter = local (\s -> s {inChapter = True}) +setInPlain :: HTMLParser s a -> HTMLParser s a +setInPlain = local (\s -> s {inPlain = True}) + type HTMLParser s = ParserT s HTMLState (Reader HTMLLocal) type TagParser = HTMLParser [Tag String] @@ -141,8 +145,8 @@ block = do , pTable , pHead , pBody - , pPlain , pDiv + , pPlain , pRawHtmlBlock ] when tr $ trace (printf "line %d: %s" (sourceLine pos) @@ -422,7 +426,7 @@ pBlockQuote = do pPlain :: TagParser Blocks pPlain = do - contents <- trimInlines . mconcat <$> many1 inline + contents <- setInPlain $ trimInlines . mconcat <$> many1 inline if B.isNull contents then return mempty else return $ B.plain contents @@ -579,7 +583,11 @@ pSpan = try $ do pRawHtmlInline :: TagParser Inlines pRawHtmlInline = do - result <- pSatisfy (tagComment (const True)) <|> pSatisfy isInlineTag + inplain <- asks inPlain + result <- pSatisfy (tagComment (const True)) + <|> if inplain + then pSatisfy (not . isBlockTag) + else pSatisfy isInlineTag parseRaw <- getOption readerParseRaw if parseRaw then return $ B.rawInline "html" $ renderTags' [result] @@ -919,7 +927,7 @@ instance HasMeta HTMLState where deleteMeta s st = st {parserState = deleteMeta s $ parserState st} instance Default HTMLLocal where - def = HTMLLocal NoQuote False + def = HTMLLocal NoQuote False False instance HasLastStrPosition HTMLState where setLastStrPos s st = st {parserState = setLastStrPos s (parserState st)} diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index e1c29d1e8..62421d2fb 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -483,7 +483,7 @@ exampleCode :: String -> Blocks exampleCode = B.codeBlockWith ("", ["example"], []) exampleLine :: OrgParser String -exampleLine = try $ string ": " *> anyLine +exampleLine = try $ skipSpaces *> string ": " *> anyLine -- Drawers for properties or a logbook drawer :: OrgParser (F Blocks) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 3a51b9d84..6f8c19ac7 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -73,11 +73,13 @@ instance Default T2TMeta where getT2TMeta :: [FilePath] -> FilePath -> IO T2TMeta getT2TMeta inps out = do curDate <- formatTime defaultTimeLocale "%F" <$> getZonedTime - let getModTime = fmap (formatTime defaultTimeLocale "%F") . + let getModTime = fmap (formatTime defaultTimeLocale "%T") . getModificationTime - curMtime <- catchIOError - (maximum <$> mapM getModTime inps) - (const (return "")) + curMtime <- case inps of + [] -> formatTime defaultTimeLocale "%T" <$> getZonedTime + _ -> catchIOError + (maximum <$> mapM getModTime inps) + (const (return "")) return $ T2TMeta curDate curMtime (intercalate ", " inps) out -- | Read Txt2Tags from an input string returning a Pandoc document @@ -91,13 +93,42 @@ readTxt2TagsNoMacros = readTxt2Tags def parseT2T :: T2T Pandoc parseT2T = do - _ <- (Nothing <$ try blankline) <|> (Just <$> (count 3 anyLine)) + -- Parse header if standalone flag is set + standalone <- getOption readerStandalone + when standalone parseHeader + body <- mconcat <$> manyTill block eof + meta' <- stateMeta <$> getState + return $ Pandoc meta' (B.toList body) + +parseHeader :: T2T () +parseHeader = do + () <$ try blankline <|> header + meta <- stateMeta <$> getState + optional blanklines config <- manyTill setting (notFollowedBy setting) -- TODO: Handle settings better - let settings = foldr (\(k,v) -> B.setMeta k (MetaString v)) nullMeta config - updateState (\s -> s {stateMeta = settings}) - body <- mconcat <$> manyTill block eof - return $ Pandoc mempty (B.toList body) + let settings = foldr (\(k,v) -> B.setMeta k (MetaString v)) meta config + updateState (\s -> s {stateMeta = settings}) <* optional blanklines + +header :: T2T () +header = titleline >> authorline >> dateline + +headerline :: B.ToMetaValue a => String -> T2T a -> T2T () +headerline field p = (() <$ try blankline) + <|> (p >>= updateState . B.setMeta field) + +titleline :: T2T () +titleline = + headerline "title" (trimInlines . mconcat <$> manyTill inline newline) + +authorline :: T2T () +authorline = + headerline "author" (sepBy author (char ';') <* newline) + where + author = trimInlines . mconcat <$> many (notFollowedBy (char ';' <|> newline) >> inline) + +dateline :: T2T () +dateline = headerline "date" (trimInlines . mconcat <$> manyTill inline newline) type Keyword = String type Value = String @@ -242,7 +273,7 @@ indentWith n = count n space table :: T2T Blocks table = try $ do - header <- fmap snd <$> option mempty (try headerRow) + tableHeader <- fmap snd <$> option mempty (try headerRow) rows <- many1 (many commentLine *> tableRow) let columns = transpose rows let ncolumns = length columns @@ -250,7 +281,7 @@ table = try $ do let rows' = map (map snd) rows let size = maximum (map length rows') let rowsPadded = map (pad size) rows' - let headerPadded = if (not (null header)) then pad size header else mempty + let headerPadded = if (not (null tableHeader)) then pad size tableHeader else mempty return $ B.table mempty (zip aligns (replicate ncolumns 0.0)) headerPadded rowsPadded @@ -497,7 +528,7 @@ image = try $ do -- Characters used in markup specialChars :: String -specialChars = "%*-_/|:+" +specialChars = "%*-_/|:+;" tab :: T2T Char tab = char '\t' diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index ced3a48db..54d252d43 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -796,7 +796,8 @@ fetchItem sourceURL s = mime = case takeExtension fp of ".gz" -> getMimeType $ dropExtension fp x -> getMimeType x - ensureEscaped = escapeURIString isAllowedInURI + ensureEscaped x@(_:':':'\\':_) = x -- likely windows path + ensureEscaped x = escapeURIString isAllowedInURI x -- | Like 'fetchItem', but also looks for items in a 'MediaBag'. fetchItem' :: MediaBag -> Maybe String -> String diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 21d440eb8..09321d1cc 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, PatternGuards #-} {- Copyright (C) 2012-2014 John MacFarlane <jgm@berkeley.edu> @@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to docx. -} module Text.Pandoc.Writers.Docx ( writeDocx ) where -import Data.Maybe (fromMaybe) import Data.List ( intercalate, isPrefixOf, isSuffixOf ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -39,6 +38,10 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Compat.Monoid ((<>)) import Codec.Archive.Zip import Data.Time.Clock.POSIX +import Data.Time.Clock +import Data.Time.Format +import System.Environment +import System.Locale import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.ImageSize @@ -60,7 +63,7 @@ import qualified Control.Exception as E import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, extensionFromMimeType) import Control.Applicative ((<$>), (<|>)) -import Data.Maybe (mapMaybe) +import Data.Maybe (fromMaybe, mapMaybe) data ListMarker = NoMarker | BulletMarker @@ -96,6 +99,11 @@ data WriterState = WriterState{ , stListLevel :: Int , stListNumId :: Int , stLists :: [ListMarker] + , stInsId :: Int + , stDelId :: Int + , stInDel :: Bool + , stChangesAuthor :: String + , stChangesDate :: String } defaultWriterState :: WriterState @@ -109,13 +117,24 @@ defaultWriterState = WriterState{ , stListLevel = -1 , stListNumId = 1 , stLists = [NoMarker] + , stInsId = 1 + , stDelId = 1 + , stInDel = False + , stChangesAuthor = "unknown" + , stChangesDate = "1969-12-31T19:00:00Z" } type WS a = StateT WriterState IO a mknode :: Node t => String -> [(String,String)] -> t -> Element mknode s attrs = - add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) . node (unqual s) + 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 . (:[]) @@ -131,6 +150,8 @@ writeDocx :: WriterOptions -- ^ Writer options writeDocx opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let doc' = walk fixDisplayMath doc + username <- lookup "USERNAME" <$> getEnvironment + utctime <- getCurrentTime refArchive <- liftM (toArchive . toLazy) $ case writerReferenceDocx opts of Just f -> B.readFile f @@ -138,8 +159,9 @@ writeDocx opts doc@(Pandoc meta _) = do distArchive <- liftM (toArchive . toLazy) $ readDataFile Nothing "reference.docx" ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc') - defaultWriterState - epochtime <- floor `fmap` getPOSIXTime + defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username + , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime} + let epochtime = floor $ utcTimeToPOSIXSeconds utctime let imgs = M.elems $ stImages st -- create entries for images in word/media/... @@ -151,7 +173,7 @@ writeDocx opts doc@(Pandoc meta _) = do let wname f qn = qPrefix qn == Just "w" && f (qName qn) let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc - let sectpr = maybe (mknode "w:sectPr" [] $ ()) id mbsectpr + let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr let stdAttributes = [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main") @@ -166,7 +188,7 @@ writeDocx opts doc@(Pandoc meta _) = do let contents' = contents ++ [sectpr] let docContents = mknode "w:document" stdAttributes - $ mknode "w:body" [] $ contents' + $ mknode "w:body" [] contents' parsedRels <- parseXml refArchive distArchive "word/_rels/document.xml.rels" let isHeaderNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header" @@ -174,7 +196,7 @@ writeDocx opts doc@(Pandoc meta _) = do let headers = filterElements isHeaderNode parsedRels let footers = filterElements isFooterNode parsedRels - let extractTarget e = findAttr (QName "Target" Nothing Nothing) e + let extractTarget = findAttr (QName "Target" Nothing Nothing) -- we create [Content_Types].xml and word/_rels/document.xml.rels -- from scratch rather than reading from reference.docx, @@ -277,7 +299,7 @@ writeDocx opts doc@(Pandoc meta _) = do -- footnote rels let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")] - $ linkrels + linkrels -- styles let newstyles = styleToOpenXml $ writerHighlightStyle opts @@ -297,7 +319,8 @@ writeDocx opts doc@(Pandoc meta _) = do -- otherwise things break: [Elem e | e <- allElts , qName (elName e) == "abstractNum" ] ++ - [Elem e | e <- allElts, qName (elName e) == "num" ] } + [Elem e | e <- allElts + , qName (elName e) == "num" ] } let docPropsPath = "docProps/core.xml" let docProps = mknode "cp:coreProperties" [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties") @@ -308,8 +331,8 @@ writeDocx opts doc@(Pandoc meta _) = do $ mknode "dc:title" [] (stringify $ docTitle meta) : mknode "dc:creator" [] (intercalate "; " (map stringify $ docAuthors meta)) : maybe [] - (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] $ x - , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] $ x + (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x + , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x ]) (normalizeDate $ stringify $ docDate meta) let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps @@ -340,7 +363,7 @@ writeDocx opts doc@(Pandoc meta _) = do settingsEntry <- entryFromArchive distArchive "word/settings.xml" webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml" headerFooterEntries <- mapM (entryFromArchive refArchive) $ - mapMaybe (\e -> fmap ("word/" ++) $ extractTarget e) + mapMaybe (fmap ("word/" ++) . extractTarget) (headers ++ footers) let miscRelEntries = [ e | e <- zEntries refArchive , "word/_rels/" `isPrefixOf` (eRelativePath e) @@ -470,7 +493,7 @@ mkLvl marker lvl = patternFor _ s = s ++ "." getNumId :: WS Int -getNumId = ((999 +) . length) `fmap` gets stLists +getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists -- | Convert Pandoc document to two lists of -- OpenXML elements (the main document and footnotes). @@ -501,7 +524,7 @@ writeOpenXML opts (Pandoc meta blocks) = do let convertSpace (Str x : Space : Str y : xs) = Str (x ++ " " ++ y) : xs convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs convertSpace xs = xs - let blocks' = bottomUp convertSpace $ blocks + let blocks' = bottomUp convertSpace blocks doc' <- blocksToOpenXML opts blocks' notes' <- reverse `fmap` gets stFootnotes let meta' = title ++ subtitle ++ authors ++ date ++ abstract @@ -525,13 +548,17 @@ getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique -- | Convert a Pandoc block element to OpenXML. blockToOpenXML :: WriterOptions -> Block -> WS [Element] blockToOpenXML _ Null = return [] +blockToOpenXML opts (Div (_,["references"],_) bs) = do + let (hs, bs') = span isHeaderBlock bs + header <- blocksToOpenXML opts hs + -- We put the Bibliography style on paragraphs after the header + rest <- withParaProp (pStyle "Bibliography") $ blocksToOpenXML opts bs' + return (header ++ rest) blockToOpenXML opts (Div _ bs) = blocksToOpenXML opts bs blockToOpenXML opts (Header lev (ident,_,_) lst) = do - paraProps <- withParaProp (pStyle $ "Heading" ++ show lev) $ getParaProps False contents <- inlinesToOpenXML opts lst - usedIdents <- gets stSectionIds let bookmarkName = if null ident then uniqueIdent lst usedIdents @@ -581,13 +608,12 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do let cellToOpenXML (al, cell) = withParaProp (alignmentFor al) $ blocksToOpenXML opts cell headers' <- mapM cellToOpenXML $ zip aligns headers - rows' <- mapM (\cells -> mapM cellToOpenXML $ zip aligns cells) - $ rows + rows' <- mapM (mapM cellToOpenXML . zip aligns) rows let borderProps = mknode "w:tcPr" [] [ mknode "w:tcBorders" [] $ mknode "w:bottom" [("w:val","single")] () , mknode "w:vAlign" [("w:val","bottom")] () ] - let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] $ + let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] [mknode "w:pStyle" [("w:val","Compact")] ()]]] let mkcell border contents = mknode "w:tc" [] $ [ borderProps | border ] ++ @@ -596,12 +622,15 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do else contents let mkrow border cells = mknode "w:tr" [] $ map (mkcell border) cells let textwidth = 7920 -- 5.5 in in twips, 1/20 pt + let fullrow = 5000 -- 100% specified in pct + let rowwidth = fullrow * sum widths let mkgridcol w = mknode "w:gridCol" - [("w:w", show $ (floor (textwidth * w) :: Integer))] () + [("w:w", show (floor (textwidth * w) :: Integer))] () return $ - [ mknode "w:tbl" [] + mknode "w:tbl" [] ( mknode "w:tblPr" [] - ( [ mknode "w:tblStyle" [("w:val","TableNormal")] () ] ++ + ( mknode "w:tblStyle" [("w:val","TableNormal")] () : + mknode "w:tblW" [("w:type", "pct"), ("w:w", show rowwidth)] () : [ mknode "w:tblCaption" [("w:val", captionStr)] () | not (null caption) ] ) : mknode "w:tblGrid" [] @@ -610,8 +639,7 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do else map mkgridcol widths) : [ mkrow True headers' | not (all null headers) ] ++ map (mkrow False) rows' - ) - ] ++ caption' + ) : caption' blockToOpenXML opts (BulletList lst) = do let marker = BulletMarker addList marker @@ -678,7 +706,7 @@ getTextProps = do props <- gets stTextProperties return $ if null props then [] - else [mknode "w:rPr" [] $ props] + else [mknode "w:rPr" [] props] pushTextProp :: Element -> WS () pushTextProp d = modify $ \s -> s{ stTextProperties = d : stTextProperties s } @@ -724,20 +752,49 @@ withParaProp d p = do formattedString :: String -> WS [Element] formattedString str = do props <- getTextProps + inDel <- gets stInDel return [ mknode "w:r" [] $ props ++ - [ mknode "w:t" [("xml:space","preserve")] str ] ] + [ mknode (if inDel then "w:delText" else "w:t") + [("xml:space","preserve")] str ] ] -- | Convert an inline element to OpenXML. inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") -inlineToOpenXML opts (Span (_,classes,_) ils) = do - let off x = withTextProp (mknode x [("w:val","0")] ()) - ((if "csl-no-emph" `elem` classes then off "w:i" else id) . - (if "csl-no-strong" `elem` classes then off "w:b" else id) . - (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id)) - $ inlinesToOpenXML opts ils +inlineToOpenXML opts (Span (_,classes,kvs) ils) + | "insertion" `elem` classes = do + defaultAuthor <- gets stChangesAuthor + defaultDate <- gets stChangesDate + let author = fromMaybe defaultAuthor (lookup "author" kvs) + date = fromMaybe defaultDate (lookup "date" kvs) + insId <- gets stInsId + modify $ \s -> s{stInsId = (insId + 1)} + x <- inlinesToOpenXML opts ils + return [ mknode "w:ins" [("w:id", (show insId)), + ("w:author", author), + ("w:date", date)] + x ] + | "deletion" `elem` classes = do + defaultAuthor <- gets stChangesAuthor + defaultDate <- gets stChangesDate + let author = fromMaybe defaultAuthor (lookup "author" kvs) + date = fromMaybe defaultDate (lookup "date" kvs) + delId <- gets stDelId + modify $ \s -> s{stDelId = (delId + 1)} + modify $ \s -> s{stInDel = True} + x <- inlinesToOpenXML opts ils + modify $ \s -> s{stInDel = False} + return [ mknode "w:del" [("w:id", (show delId)), + ("w:author", author), + ("w:date", date)] + x ] + | otherwise = do + let off x = withTextProp (mknode x [("w:val","0")] ()) + ((if "csl-no-emph" `elem` classes then off "w:i" else id) . + (if "csl-no-strong" `elem` classes then off "w:b" else id) . + (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id)) + $ inlinesToOpenXML opts ils inlineToOpenXML opts (Strong lst) = withTextProp (mknode "w:b" [] ()) $ inlinesToOpenXML opts lst inlineToOpenXML opts (Emph lst) = @@ -912,6 +969,6 @@ parseXml refArchive distArchive relpath = fitToPage :: (Integer, Integer) -> (Integer, Integer) fitToPage (x, y) --5440680 is the emu width size of a letter page in portrait, minus the margins - | x > 5440680 = + | x > 5440680 = (5440680, round $ (5440680 / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y)) | otherwise = (x, y) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 26f9b5f62..e02c6575d 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -40,35 +40,59 @@ DokuWiki: <https://www.dokuwiki.org/dokuwiki> module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where import Text.Pandoc.Definition -import Text.Pandoc.Options -import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared -import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.Options ( WriterOptions( + writerTableOfContents + , writerStandalone + , writerTemplate) ) +import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated + , trimr, normalize, substitute ) +import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) +import Text.Pandoc.Templates ( renderTemplate' ) import Data.List ( intersect, intercalate, isPrefixOf ) +import Data.Default (Default(..)) import Network.URI ( isURI ) -import Control.Monad.State +import Control.Monad ( zipWithM ) +import Control.Monad.State ( modify, State, get, evalState ) +import Control.Monad.Reader ( ReaderT, runReaderT, ask, local ) +import Control.Applicative ( (<$>) ) data WriterState = WriterState { stNotes :: Bool -- True if there are notes - , stIndent :: String -- Indent after the marker at the beginning of list items + } + +data WriterEnvironment = WriterEnvironment { + stIndent :: String -- Indent after the marker at the beginning of list items , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list + , stBackSlashLB :: Bool -- True if we should produce formatted strings with newlines (as in a table cell) } +instance Default WriterState where + def = WriterState { stNotes = False } + +instance Default WriterEnvironment where + def = WriterEnvironment { stIndent = "" + , stUseTags = False + , stBackSlashLB = False } + +type DokuWiki = ReaderT WriterEnvironment (State WriterState) + -- | Convert Pandoc to DokuWiki. writeDokuWiki :: WriterOptions -> Pandoc -> String writeDokuWiki opts document = - evalState (pandocToDokuWiki opts $ normalize document) - (WriterState { stNotes = False, stIndent = "", stUseTags = False }) + runDokuWiki (pandocToDokuWiki opts $ normalize document) + +runDokuWiki :: DokuWiki a -> a +runDokuWiki = flip evalState def . flip runReaderT def -- | Return DokuWiki representation of document. -pandocToDokuWiki :: WriterOptions -> Pandoc -> State WriterState String +pandocToDokuWiki :: WriterOptions -> Pandoc -> DokuWiki String pandocToDokuWiki opts (Pandoc meta blocks) = do metadata <- metaToJSON opts (fmap trimr . blockListToDokuWiki opts) (inlineListToDokuWiki opts) meta body <- blockListToDokuWiki opts blocks - notesExist <- get >>= return . stNotes + notesExist <- stNotes <$> get let notes = if notesExist then "" -- TODO Was "\n<references />" Check whether I can really remove this: -- if it is definitely to do with footnotes, can remove this whole bit @@ -90,7 +114,7 @@ escapeString = substitute "__" "%%__%%" . -- | Convert Pandoc block element to DokuWiki. blockToDokuWiki :: WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState String + -> DokuWiki String blockToDokuWiki _ Null = return "" @@ -113,8 +137,8 @@ blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do return $ "{{:" ++ src ++ opt ++ "}}\n" blockToDokuWiki opts (Para inlines) = do - indent <- gets stIndent - useTags <- gets stUseTags + indent <- stIndent <$> ask + useTags <- stUseTags <$> ask contents <- inlineListToDokuWiki opts inlines return $ if useTags then "<HTML><p></HTML>" ++ contents ++ "<HTML></p></HTML>" @@ -174,54 +198,54 @@ blockToDokuWiki opts (Table capt aligns _ headers rows') = do unlines body' blockToDokuWiki opts x@(BulletList items) = do - oldUseTags <- get >>= return . stUseTags - indent <- get >>= return . stIndent + oldUseTags <- stUseTags <$> ask + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM (listItemToDokuWiki opts) items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\s -> s { stUseTags = True }) + (mapM (listItemToDokuWiki opts) items) return $ "<HTML><ul></HTML>\n" ++ vcat contents ++ "<HTML></ul></HTML>\n" else do - modify $ \s -> s { stIndent = stIndent s ++ " " } - contents <- mapM (listItemToDokuWiki opts) items - modify $ \s -> s { stIndent = indent } + contents <- local (\s -> s { stIndent = stIndent s ++ " " + , stBackSlashLB = backSlash}) + (mapM (listItemToDokuWiki opts) items) return $ vcat contents ++ if null indent then "\n" else "" blockToDokuWiki opts x@(OrderedList attribs items) = do - oldUseTags <- get >>= return . stUseTags - indent <- get >>= return . stIndent + oldUseTags <- stUseTags <$> ask + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM (orderedListItemToDokuWiki opts) items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\s -> s { stUseTags = True }) + (mapM (orderedListItemToDokuWiki opts) items) return $ "<HTML><ol" ++ listAttribsToString attribs ++ "></HTML>\n" ++ vcat contents ++ "<HTML></ol></HTML>\n" else do - modify $ \s -> s { stIndent = stIndent s ++ " " } - contents <- mapM (orderedListItemToDokuWiki opts) items - modify $ \s -> s { stIndent = indent } + contents <- local (\s -> s { stIndent = stIndent s ++ " " + , stBackSlashLB = backSlash}) + (mapM (orderedListItemToDokuWiki opts) items) return $ vcat contents ++ if null indent then "\n" else "" -- TODO Need to decide how to make definition lists work on dokuwiki - I don't think there -- is a specific representation of them. -- TODO This creates double '; ; ' if there is a bullet or ordered list inside a definition list blockToDokuWiki opts x@(DefinitionList items) = do - oldUseTags <- get >>= return . stUseTags - indent <- get >>= return . stIndent + oldUseTags <- stUseTags <$> ask + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM (definitionListItemToDokuWiki opts) items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\s -> s { stUseTags = True }) + (mapM (definitionListItemToDokuWiki opts) items) return $ "<HTML><dl></HTML>\n" ++ vcat contents ++ "<HTML></dl></HTML>\n" else do - modify $ \s -> s { stIndent = stIndent s ++ " " } - contents <- mapM (definitionListItemToDokuWiki opts) items - modify $ \s -> s { stIndent = indent } + contents <- local (\s -> s { stIndent = stIndent s ++ " " + , stBackSlashLB = backSlash}) + (mapM (definitionListItemToDokuWiki opts) items) return $ vcat contents ++ if null indent then "\n" else "" -- Auxiliary functions for lists: @@ -238,42 +262,48 @@ listAttribsToString (startnum, numstyle, _) = else "") -- | Convert bullet list item (list of blocks) to DokuWiki. -listItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String +listItemToDokuWiki :: WriterOptions -> [Block] -> DokuWiki String listItemToDokuWiki opts items = do contents <- blockListToDokuWiki opts items - useTags <- get >>= return . stUseTags + useTags <- stUseTags <$> ask if useTags then return $ "<HTML><li></HTML>" ++ contents ++ "<HTML></li></HTML>" else do - indent <- get >>= return . stIndent - return $ indent ++ "* " ++ contents + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask + let indent' = if backSlash then (drop 2 indent) else indent + return $ indent' ++ "* " ++ contents -- | Convert ordered list item (list of blocks) to DokuWiki. -- | TODO Emiminate dreadful duplication of text from listItemToDokuWiki -orderedListItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String +orderedListItemToDokuWiki :: WriterOptions -> [Block] -> DokuWiki String orderedListItemToDokuWiki opts items = do contents <- blockListToDokuWiki opts items - useTags <- get >>= return . stUseTags + useTags <- stUseTags <$> ask if useTags then return $ "<HTML><li></HTML>" ++ contents ++ "<HTML></li></HTML>" else do - indent <- get >>= return . stIndent - return $ indent ++ "- " ++ contents + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask + let indent' = if backSlash then (drop 2 indent) else indent + return $ indent' ++ "- " ++ contents -- | Convert definition list item (label, list of blocks) to DokuWiki. definitionListItemToDokuWiki :: WriterOptions -> ([Inline],[[Block]]) - -> State WriterState String + -> DokuWiki String definitionListItemToDokuWiki opts (label, items) = do labelText <- inlineListToDokuWiki opts label contents <- mapM (blockListToDokuWiki opts) items - useTags <- get >>= return . stUseTags + useTags <- stUseTags <$> ask if useTags then return $ "<HTML><dt></HTML>" ++ labelText ++ "<HTML></dt></HTML>\n" ++ (intercalate "\n" $ map (\d -> "<HTML><dd></HTML>" ++ d ++ "<HTML></dd></HTML>") contents) else do - indent <- get >>= return . stIndent - return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents + indent <- stIndent <$> ask + backSlash <- stBackSlashLB <$> ask + let indent' = if backSlash then (drop 2 indent) else indent + return $ indent' ++ "* **" ++ labelText ++ "** " ++ concat contents -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -319,6 +349,13 @@ isSimpleBlockQuote _ = False vcat :: [String] -> String vcat = intercalate "\n" +backSlashLineBreaks :: String -> String +backSlashLineBreaks cs = reverse $ g $ reverse $ concatMap f cs + where f '\n' = "\\\\ " + f c = [c] + g (' ' : '\\':'\\': xs) = xs + g s = s + -- Auxiliary functions for tables: -- TODO Eliminate copy-and-pasted code in tableHeaderToDokuWiki and tableRowToDokuWiki @@ -326,11 +363,11 @@ tableHeaderToDokuWiki :: WriterOptions -> [String] -> Int -> [[Block]] - -> State WriterState String + -> DokuWiki String tableHeaderToDokuWiki opts alignStrings rownum cols' = do let celltype = if rownum == 0 then "" else "" - cols'' <- sequence $ zipWith - (\alignment item -> tableItemToDokuWiki opts celltype alignment item) + cols'' <- zipWithM + (tableItemToDokuWiki opts celltype) alignStrings cols' return $ "^ " ++ "" ++ joinHeaders cols'' ++ " ^" @@ -338,11 +375,11 @@ tableRowToDokuWiki :: WriterOptions -> [String] -> Int -> [[Block]] - -> State WriterState String + -> DokuWiki String tableRowToDokuWiki opts alignStrings rownum cols' = do let celltype = if rownum == 0 then "" else "" - cols'' <- sequence $ zipWith - (\alignment item -> tableItemToDokuWiki opts celltype alignment item) + cols'' <- zipWithM + (tableItemToDokuWiki opts celltype) alignStrings cols' return $ "| " ++ "" ++ joinColumns cols'' ++ " |" @@ -357,11 +394,12 @@ tableItemToDokuWiki :: WriterOptions -> String -> String -> [Block] - -> State WriterState String + -> DokuWiki String -- TODO Fix celltype and align' defined but not used tableItemToDokuWiki opts _celltype _align' item = do let mkcell x = "" ++ x ++ "" - contents <- blockListToDokuWiki opts item + contents <- local (\s -> s { stBackSlashLB = True }) $ + blockListToDokuWiki opts item return $ mkcell contents -- | Concatenates columns together. @@ -375,20 +413,23 @@ joinHeaders = intercalate " ^ " -- | Convert list of Pandoc block elements to DokuWiki. blockListToDokuWiki :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState String -blockListToDokuWiki opts blocks = - mapM (blockToDokuWiki opts) blocks >>= return . vcat + -> DokuWiki String +blockListToDokuWiki opts blocks = do + backSlash <- stBackSlashLB <$> ask + if backSlash + then (backSlashLineBreaks . vcat) <$> mapM (blockToDokuWiki opts) blocks + else vcat <$> mapM (blockToDokuWiki opts) blocks -- | Convert list of Pandoc inline elements to DokuWiki. -inlineListToDokuWiki :: WriterOptions -> [Inline] -> State WriterState String -inlineListToDokuWiki opts lst = mapM (inlineToDokuWiki opts) lst >>= return . concat +inlineListToDokuWiki :: WriterOptions -> [Inline] -> DokuWiki String +inlineListToDokuWiki opts lst = + concat <$> (mapM (inlineToDokuWiki opts) lst) -- | Convert Pandoc inline element to DokuWiki. -inlineToDokuWiki :: WriterOptions -> Inline -> State WriterState String +inlineToDokuWiki :: WriterOptions -> Inline -> DokuWiki String -inlineToDokuWiki opts (Span _attrs ils) = do - contents <- inlineListToDokuWiki opts ils - return contents +inlineToDokuWiki opts (Span _attrs ils) = + inlineListToDokuWiki opts ils inlineToDokuWiki opts (Emph lst) = do contents <- inlineListToDokuWiki opts lst @@ -461,11 +502,10 @@ inlineToDokuWiki opts (Link txt (src, _)) = do _ -> src -- link to a help page inlineToDokuWiki opts (Image alt (source, tit)) = do alt' <- inlineListToDokuWiki opts alt - let txt = if (null tit) - then if null alt - then "" - else "|" ++ alt' - else "|" ++ tit + let txt = case (tit, alt) of + ("", []) -> "" + ("", _ ) -> "|" ++ alt' + (_ , _ ) -> "|" ++ tit return $ "{{:" ++ source ++ txt ++ "}}" inlineToDokuWiki opts (Note contents) = do diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 62986df75..ffd5bf101 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -94,7 +94,7 @@ data EPUBMetadata = EPUBMetadata{ , epubRights :: Maybe String , epubCoverImage :: Maybe String , epubStylesheet :: Maybe Stylesheet - , epubPageDirection :: ProgressionDirection + , epubPageDirection :: Maybe ProgressionDirection } deriving Show data Stylesheet = StylesheetPath FilePath @@ -123,7 +123,7 @@ data Title = Title{ , titleType :: Maybe String } deriving Show -data ProgressionDirection = LTR | RTL | Default deriving Show +data ProgressionDirection = LTR | RTL deriving Show dcName :: String -> QName dcName n = QName n Nothing (Just "dc") @@ -322,14 +322,11 @@ metadataFromMeta opts meta = EPUBMetadata{ stylesheet = (StylesheetContents <$> writerEpubStylesheet opts) `mplus` ((StylesheetPath . metaValueToString) <$> lookupMeta "stylesheet" meta) - pageDirection = maybe Default stringToPageDirection - (lookupMeta "page-progression-direction" meta) - stringToPageDirection (metaValueToString -> s) = - case s of - "ltr" -> LTR - "rtl" -> RTL - _ -> Default - + pageDirection = case map toLower . metaValueToString <$> + lookupMeta "page-progression-direction" meta of + Just "ltr" -> Just LTR + Just "rtl" -> Just RTL + _ -> Nothing -- | Produce an EPUB file from a Pandoc document. writeEPUB :: WriterOptions -- ^ Writer options @@ -394,11 +391,13 @@ writeEPUB opts doc@(Pandoc meta _) = do let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f fontEntries <- mapM mkFontEntry $ writerEpubFonts opts' - -- set page progression direction + -- set page progression direction attribution let progressionDirection = case epubPageDirection metadata of - LTR -> "ltr" - RTL -> "rtl" - Default -> "default" + Just LTR | epub3 -> + [("page-progression-direction", "ltr")] + Just RTL | epub3 -> + [("page-progression-direction", "rtl")] + _ -> [] -- body pages @@ -519,8 +518,7 @@ writeEPUB opts doc@(Pandoc meta _) = do (pictureNode x)]) ++ map pictureNode picEntries ++ map fontNode fontEntries - , unode "spine" ! [("toc","ncx") - ,("page-progression-direction", progressionDirection)] $ + , unode "spine" ! ([("toc","ncx")] ++ progressionDirection) $ case epubCoverImage metadata of Nothing -> [] Just _ -> [ unode "itemref" ! diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index d200ecee1..acbe8a48d 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -465,18 +465,24 @@ blockToLaTeX (DefinitionList lst) = do return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$ "\\end{description}" blockToLaTeX HorizontalRule = return $ - "\\begin{center}\\rule{3in}{0.4pt}\\end{center}" + "\\begin{center}\\rule{0.5\\linewidth}{\\linethickness}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = sectionHeader ("unnumbered" `elem` classes) id' level lst blockToLaTeX (Table caption aligns widths heads rows) = do headers <- if all null heads then return empty - else ($$ "\\midrule\\endhead") `fmap` + else ($$ "\\midrule\n") `fmap` (tableRowToLaTeX True aligns widths) heads + let endhead = if all null heads + then empty + else text "\\endhead" captionText <- inlineListToLaTeX caption let capt = if isEmpty captionText then empty - else text "\\caption" <> braces captionText <> "\\\\" + else text "\\caption" <> braces captionText + <> "\\tabularnewline\n\\toprule\n" + <> headers + <> "\\endfirsthead" rows' <- mapM (tableRowToLaTeX False aligns widths) rows let colDescriptors = text $ concat $ map toColDescriptor aligns modify $ \s -> s{ stTable = True } @@ -484,8 +490,9 @@ blockToLaTeX (Table caption aligns widths heads rows) = do braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt - $$ "\\toprule\\addlinespace" + $$ "\\toprule" $$ headers + $$ endhead $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" @@ -512,7 +519,7 @@ tableRowToLaTeX header aligns widths cols = do let scaleFactor = 0.97 ** fromIntegral (length aligns) let widths' = map (scaleFactor *) widths cells <- mapM (tableCellToLaTeX header) $ zip3 widths' aligns cols - return $ hsep (intersperse "&" cells) $$ "\\\\\\addlinespace" + return $ hsep (intersperse "&" cells) <> "\\tabularnewline" -- For simple latex tables (without minipages or parboxes), -- we need to go to some lengths to get line breaks working: @@ -549,7 +556,8 @@ tableCellToLaTeX header (width, align, blocks) = do AlignDefault -> "\\raggedright" return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> - (halign <> cr <> cellContents <> cr) <> "\\end{minipage}") + (halign <> "\\strut" <> cr <> cellContents <> cr) <> + "\\strut\\end{minipage}") $$ case notes of [] -> empty ns -> (case length ns of diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs index 300430e79..256855a1d 100644 --- a/tests/Tests/Old.hs +++ b/tests/Tests/Old.hs @@ -141,7 +141,7 @@ tests = [ testGroup "markdown" "haddock-reader.haddock" "haddock-reader.native" ] , testGroup "txt2tags" - [ test "reader" ["-r", "t2t", "-w", "native"] + [ test "reader" ["-r", "t2t", "-w", "native", "-s"] "txt2tags.t2t" "txt2tags.native" ] , testGroup "epub" [ test "features" ["-r", "epub", "-w", "native"] diff --git a/tests/Tests/Readers/Txt2Tags.hs b/tests/Tests/Readers/Txt2Tags.hs index 4748cdc07..fd7c767e0 100644 --- a/tests/Tests/Readers/Txt2Tags.hs +++ b/tests/Tests/Readers/Txt2Tags.hs @@ -12,7 +12,7 @@ import Data.Monoid (mempty, mconcat) import Text.Pandoc.Readers.Txt2Tags t2t :: String -> Pandoc -t2t s = readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def ('\n' : s) +t2t s = readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def s infix 4 =: (=:) :: ToString c diff --git a/tests/docx/tables.docx b/tests/docx/tables.docx Binary files differindex 7dcff8d35..28087ead5 100644 --- a/tests/docx/tables.docx +++ b/tests/docx/tables.docx diff --git a/tests/docx/tables.native b/tests/docx/tables.native index 2564afcec..cf23cf404 100644 --- a/tests/docx/tables.native +++ b/tests/docx/tables.native @@ -1,24 +1,34 @@ [Header 2 ("a-table-with-and-without-a-header-row",[],[]) [Str "A",Space,Str "table,",Space,Str "with",Space,Str "and",Space,Str "without",Space,Str "a",Space,Str "header",Space,Str "row"] ,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] - [[Para [Str "Name"]] - ,[Para [Str "Game"]] - ,[Para [Str "Fame"]] - ,[Para [Str "Blame"]]] - [[[Para [Str "Lebron",Space,Str "James"]] - ,[Para [Str "Basketball"]] - ,[Para [Str "Very",Space,Str "High"]] - ,[Para [Str "Leaving",Space,Str "Cleveland"]]] - ,[[Para [Str "Ryan",Space,Str "Braun"]] - ,[Para [Str "Baseball"]] - ,[Para [Str "Moderate"]] - ,[Para [Str "Steroids"]]] - ,[[Para [Str "Russell",Space,Str "Wilson"]] - ,[Para [Str "Football"]] - ,[Para [Str "High"]] - ,[Para [Str "Tacky",Space,Str "uniform"]]]] + [[Plain [Str "Name"]] + ,[Plain [Str "Game"]] + ,[Plain [Str "Fame"]] + ,[Plain [Str "Blame"]]] + [[[Plain [Str "Lebron",Space,Str "James"]] + ,[Plain [Str "Basketball"]] + ,[Plain [Str "Very",Space,Str "High"]] + ,[Plain [Str "Leaving",Space,Str "Cleveland"]]] + ,[[Plain [Str "Ryan",Space,Str "Braun"]] + ,[Plain [Str "Baseball"]] + ,[Plain [Str "Moderate"]] + ,[Plain [Str "Steroids"]]] + ,[[Plain [Str "Russell",Space,Str "Wilson"]] + ,[Plain [Str "Football"]] + ,[Plain [Str "High"]] + ,[Plain [Str "Tacky",Space,Str "uniform"]]]] ,Table [] [AlignDefault,AlignDefault] [0.0,0.0] [] - [[[Para [Str "Sinple"]] - ,[Para [Str "Table"]]] - ,[[Para [Str "Without"]] - ,[Para [Str "Header"]]]]] + [[[Plain [Str "Sinple"]] + ,[Plain [Str "Table"]]] + ,[[Plain [Str "Without"]] + ,[Plain [Str "Header"]]]] +,Table [] [AlignDefault,AlignDefault] [0.0,0.0] + [] + [[[Para [Str "Simple"] + ,Para [Str "Multiparagraph"]] + ,[Para [Str "Table"] + ,Para [Str "Full"]]] + ,[[Para [Str "Of"] + ,Para [Str "Paragraphs"]] + ,[Para [Str "In",Space,Str "each"] + ,Para [Str "Cell."]]]]] diff --git a/tests/lhs-test.latex b/tests/lhs-test.latex index 6600608fe..6f2fdfb77 100644 --- a/tests/lhs-test.latex +++ b/tests/lhs-test.latex @@ -19,7 +19,10 @@ % use upquote if available, for straight quotes in verbatim environments \IfFileExists{upquote.sty}{\usepackage{upquote}}{} % use microtype if available -\IfFileExists{microtype.sty}{\usepackage{microtype}}{} +\IfFileExists{microtype.sty}{% +\usepackage{microtype} +\UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts +}{} \usepackage{color} \usepackage{fancyvrb} \newcommand{\VerbBar}{|} diff --git a/tests/lhs-test.latex+lhs b/tests/lhs-test.latex+lhs index d6cb7c497..77f0e08ff 100644 --- a/tests/lhs-test.latex+lhs +++ b/tests/lhs-test.latex+lhs @@ -19,7 +19,10 @@ % use upquote if available, for straight quotes in verbatim environments \IfFileExists{upquote.sty}{\usepackage{upquote}}{} % use microtype if available -\IfFileExists{microtype.sty}{\usepackage{microtype}}{} +\IfFileExists{microtype.sty}{% +\usepackage{microtype} +\UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts +}{} \usepackage{listings} \lstnewenvironment{code}{\lstset{language=Haskell,basicstyle=\small\ttfamily}}{} \ifxetex diff --git a/tests/tables.latex b/tests/tables.latex index eb665204d..850629499 100644 --- a/tests/tables.latex +++ b/tests/tables.latex @@ -1,166 +1,168 @@ Simple table with caption: \begin{longtable}[c]{@{}rlcl@{}} -\caption{Demonstration of simple table syntax.}\\ -\toprule\addlinespace -Right & Left & Center & Default -\\\addlinespace -\midrule\endhead -12 & 12 & 12 & 12 -\\\addlinespace -123 & 123 & 123 & 123 -\\\addlinespace -1 & 1 & 1 & 1 -\\\addlinespace +\caption{Demonstration of simple table syntax.}\tabularnewline +\toprule +Right & Left & Center & Default\tabularnewline +\midrule +\endfirsthead +\toprule +Right & Left & Center & Default\tabularnewline +\midrule +\endhead +12 & 12 & 12 & 12\tabularnewline +123 & 123 & 123 & 123\tabularnewline +1 & 1 & 1 & 1\tabularnewline \bottomrule \end{longtable} Simple table without caption: \begin{longtable}[c]{@{}rlcl@{}} -\toprule\addlinespace -Right & Left & Center & Default -\\\addlinespace -\midrule\endhead -12 & 12 & 12 & 12 -\\\addlinespace -123 & 123 & 123 & 123 -\\\addlinespace -1 & 1 & 1 & 1 -\\\addlinespace +\toprule +Right & Left & Center & Default\tabularnewline +\midrule +\endhead +12 & 12 & 12 & 12\tabularnewline +123 & 123 & 123 & 123\tabularnewline +1 & 1 & 1 & 1\tabularnewline \bottomrule \end{longtable} Simple table indented two spaces: \begin{longtable}[c]{@{}rlcl@{}} -\caption{Demonstration of simple table syntax.}\\ -\toprule\addlinespace -Right & Left & Center & Default -\\\addlinespace -\midrule\endhead -12 & 12 & 12 & 12 -\\\addlinespace -123 & 123 & 123 & 123 -\\\addlinespace -1 & 1 & 1 & 1 -\\\addlinespace +\caption{Demonstration of simple table syntax.}\tabularnewline +\toprule +Right & Left & Center & Default\tabularnewline +\midrule +\endfirsthead +\toprule +Right & Left & Center & Default\tabularnewline +\midrule +\endhead +12 & 12 & 12 & 12\tabularnewline +123 & 123 & 123 & 123\tabularnewline +1 & 1 & 1 & 1\tabularnewline \bottomrule \end{longtable} Multiline table with caption: \begin{longtable}[c]{@{}clrl@{}} -\caption{Here's the caption. It may span multiple lines.}\\ -\toprule\addlinespace -\begin{minipage}[b]{0.13\columnwidth}\centering +\caption{Here's the caption. It may span multiple lines.}\tabularnewline +\toprule +\begin{minipage}[b]{0.13\columnwidth}\centering\strut Centered Header -\end{minipage} & \begin{minipage}[b]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[b]{0.12\columnwidth}\raggedright\strut Left Aligned -\end{minipage} & \begin{minipage}[b]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[b]{0.14\columnwidth}\raggedleft\strut Right Aligned -\end{minipage} & \begin{minipage}[b]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[b]{0.30\columnwidth}\raggedright\strut Default aligned -\end{minipage} -\\\addlinespace -\midrule\endhead -\begin{minipage}[t]{0.13\columnwidth}\centering +\strut\end{minipage}\tabularnewline +\midrule +\endfirsthead +\toprule +\begin{minipage}[b]{0.13\columnwidth}\centering\strut +Centered Header +\strut\end{minipage} & \begin{minipage}[b]{0.12\columnwidth}\raggedright\strut +Left Aligned +\strut\end{minipage} & \begin{minipage}[b]{0.14\columnwidth}\raggedleft\strut +Right Aligned +\strut\end{minipage} & \begin{minipage}[b]{0.30\columnwidth}\raggedright\strut +Default aligned +\strut\end{minipage}\tabularnewline +\midrule +\endhead +\begin{minipage}[t]{0.13\columnwidth}\centering\strut First -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 12.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Example of a row that spans multiple lines. -\end{minipage} -\\\addlinespace -\begin{minipage}[t]{0.13\columnwidth}\centering +\strut\end{minipage}\tabularnewline +\begin{minipage}[t]{0.13\columnwidth}\centering\strut Second -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 5.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Here's another one. Note the blank line between rows. -\end{minipage} -\\\addlinespace +\strut\end{minipage}\tabularnewline \bottomrule \end{longtable} Multiline table without caption: \begin{longtable}[c]{@{}clrl@{}} -\toprule\addlinespace -\begin{minipage}[b]{0.13\columnwidth}\centering +\toprule +\begin{minipage}[b]{0.13\columnwidth}\centering\strut Centered Header -\end{minipage} & \begin{minipage}[b]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[b]{0.12\columnwidth}\raggedright\strut Left Aligned -\end{minipage} & \begin{minipage}[b]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[b]{0.14\columnwidth}\raggedleft\strut Right Aligned -\end{minipage} & \begin{minipage}[b]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[b]{0.30\columnwidth}\raggedright\strut Default aligned -\end{minipage} -\\\addlinespace -\midrule\endhead -\begin{minipage}[t]{0.13\columnwidth}\centering +\strut\end{minipage}\tabularnewline +\midrule +\endhead +\begin{minipage}[t]{0.13\columnwidth}\centering\strut First -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 12.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Example of a row that spans multiple lines. -\end{minipage} -\\\addlinespace -\begin{minipage}[t]{0.13\columnwidth}\centering +\strut\end{minipage}\tabularnewline +\begin{minipage}[t]{0.13\columnwidth}\centering\strut Second -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 5.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Here's another one. Note the blank line between rows. -\end{minipage} -\\\addlinespace +\strut\end{minipage}\tabularnewline \bottomrule \end{longtable} Table without column headers: \begin{longtable}[c]{@{}rlcr@{}} -\toprule\addlinespace -12 & 12 & 12 & 12 -\\\addlinespace -123 & 123 & 123 & 123 -\\\addlinespace -1 & 1 & 1 & 1 -\\\addlinespace +\toprule +12 & 12 & 12 & 12\tabularnewline +123 & 123 & 123 & 123\tabularnewline +1 & 1 & 1 & 1\tabularnewline \bottomrule \end{longtable} Multiline table without column headers: \begin{longtable}[c]{@{}clrl@{}} -\toprule\addlinespace -\begin{minipage}[t]{0.13\columnwidth}\centering +\toprule +\begin{minipage}[t]{0.13\columnwidth}\centering\strut First -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 12.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Example of a row that spans multiple lines. -\end{minipage} -\\\addlinespace -\begin{minipage}[t]{0.13\columnwidth}\centering +\strut\end{minipage}\tabularnewline +\begin{minipage}[t]{0.13\columnwidth}\centering\strut Second -\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.12\columnwidth}\raggedright\strut row -\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft +\strut\end{minipage} & \begin{minipage}[t]{0.14\columnwidth}\raggedleft\strut 5.0 -\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright +\strut\end{minipage} & \begin{minipage}[t]{0.30\columnwidth}\raggedright\strut Here's another one. Note the blank line between rows. -\end{minipage} -\\\addlinespace +\strut\end{minipage}\tabularnewline \bottomrule \end{longtable} diff --git a/tests/txt2tags.native b/tests/txt2tags.native index 9f80d6d2c..189c099e2 100644 --- a/tests/txt2tags.native +++ b/tests/txt2tags.native @@ -1,3 +1,4 @@ +Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "author"]]),("date",MetaInlines [Str "date"]),("includeconf",MetaString "rules.conf"),("title",MetaInlines [Str "Txt2tags",Space,Str "Markup",Space,Str "Rules"])]}) [Para [Str "This",Space,Str "document",Space,Str "describes",Space,Str "all",Space,Str "the",Space,Str "details",Space,Str "about",Space,Str "each",Space,Str "txt2tags",Space,Str "mark.",Space,Str "The",Space,Str "target",Space,Str "audience",Space,Str "are",Space,Strong [Str "experienced"],Space,Str "users.",Space,Str "You",Space,Str "may",Space,Str "find",Space,Str "it",Space,Str "useful",Space,Str "if",Space,Str "you",Space,Str "want",Space,Str "to",Space,Str "master",Space,Str "the",Space,Str "marks",Space,Str "or",Space,Str "solve",Space,Str "a",Space,Str "specific",Space,Str "problem",Space,Str "about",Space,Str "a",Space,Str "mark."] ,Para [Str "If",Space,Str "you",Space,Str "are",Space,Str "new",Space,Str "to",Space,Str "txt2tags",Space,Str "or",Space,Str "just",Space,Str "want",Space,Str "to",Space,Str "know",Space,Str "which",Space,Str "are",Space,Str "the",Space,Str "available",Space,Str "marks,",Space,Str "please",Space,Str "read",Space,Str "the",Space,Link [Str "Markup",Space,Str "Demo"] ("MARKUPDEMO",""),Str "."] ,Para [Str "Note",Space,Str "1:",Space,Str "This",Space,Str "document",Space,Str "is",Space,Str "generated",Space,Str "directly",Space,Str "from",Space,Str "the",Space,Str "txt2tags",Space,Str "test-suite.",Space,Str "All",Space,Str "the",Space,Str "rules",Space,Str "mentioned",Space,Str "here",Space,Str "are",Space,Str "100%",Space,Str "in",Space,Str "sync",Space,Str "with",Space,Str "the",Space,Str "current",Space,Str "program",Space,Str "code."] diff --git a/tests/txt2tags.t2t b/tests/txt2tags.t2t index e282498d0..d374b7a85 100644 --- a/tests/txt2tags.t2t +++ b/tests/txt2tags.t2t @@ -1,6 +1,6 @@ Txt2tags Markup Rules - - +author +date %!includeconf: rules.conf This document describes all the details about each txt2tags mark. diff --git a/tests/writer.latex b/tests/writer.latex index 5428e9ad7..8b3ca3192 100644 --- a/tests/writer.latex +++ b/tests/writer.latex @@ -19,7 +19,10 @@ % use upquote if available, for straight quotes in verbatim environments \IfFileExists{upquote.sty}{\usepackage{upquote}}{} % use microtype if available -\IfFileExists{microtype.sty}{\usepackage{microtype}}{} +\IfFileExists{microtype.sty}{% +\usepackage{microtype} +\UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts +}{} \usepackage{fancyvrb} \usepackage{graphicx} \makeatletter @@ -66,7 +69,7 @@ This is a set of tests for pandoc. Most of them are adapted from John Gruber's markdown test suite. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Headers}\label{headers} @@ -91,7 +94,7 @@ with no blank line with no blank line -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Paragraphs}\label{paragraphs} @@ -105,7 +108,7 @@ Here's one with a bullet. * criminey. There should be a hard line break\\here. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Block Quotes}\label{block-quotes} @@ -150,7 +153,7 @@ This should not be a block quote: 2 \textgreater{} 1. And a following paragraph. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Code Blocks}\label{code-blocks} @@ -174,7 +177,7 @@ And: These should not be escaped: \$ \\ \> \[ \{ \end{verbatim} -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Lists}\label{lists} @@ -482,7 +485,7 @@ M.A.~2007 B. Williams -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Definition Lists}\label{definition-lists} @@ -647,7 +650,7 @@ Code: Hr's: -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Inline Markup}\label{inline-markup} @@ -679,7 +682,7 @@ H\textsubscript{many~of~them}O. These should not be superscripts or subscripts, because of the unescaped spaces: a\^{}b c\^{}d, a\textasciitilde{}b c\textasciitilde{}d. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Smart quotes, ellipses, dashes}\label{smart-quotes-ellipses-dashes} @@ -700,7 +703,7 @@ Dashes between numbers: 5--7, 255--66, 1987--1999. Ellipses\ldots{}and\ldots{}and\ldots{}. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{LaTeX}\label{latex} @@ -748,7 +751,7 @@ Dog & 2 \\ Cat & 1 \\ \hline \end{tabular} -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Special Characters}\label{special-characters} @@ -810,7 +813,7 @@ Plus: + Minus: - -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Links}\label{links} @@ -902,7 +905,7 @@ Auto-links should not occur here: or here: <http://example.com/> \end{verbatim} -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Images}\label{images} @@ -916,7 +919,7 @@ From ``Voyage dans la Lune'' by Georges Melies (1902): Here is a movie \includegraphics{movie.jpg} icon. -\begin{center}\rule{3in}{0.4pt}\end{center} +\begin{center}\rule{0.5\linewidth}{\linethickness}\end{center} \section{Footnotes}\label{footnotes} diff --git a/trypandoc/Makefile b/trypandoc/Makefile new file mode 100644 index 000000000..29942ac00 --- /dev/null +++ b/trypandoc/Makefile @@ -0,0 +1,14 @@ +CGIBIN=/home/website/cgi-bin +TRYPANDOC=/home/website/html/pandoc/try/ +CGI=${CGIBIN}/trypandoc +BIN=../dist/build/trypandoc/trypandoc + +install: ${CGI} ${TRYPANDOC}/index.html + +${TRYPANDOC}/%: % + cp $< $@ && chown website:www-data $@ && chmod a+r $@ + +${CGI}: ${BIN} + cp $< $@ && chown website:www-data $@ && chmod a+rx $@ + +.PHONY: install diff --git a/trypandoc/index.html b/trypandoc/index.html new file mode 100644 index 000000000..2c9c55ef2 --- /dev/null +++ b/trypandoc/index.html @@ -0,0 +1,137 @@ +<!doctype html> +<html lang="en"> +<head> + <meta charset="utf-8"> + <title>Try pandoc!</title> + <script src="//code.jquery.com/jquery-1.11.0.min.js"></script> + <script src="//maxcdn.bootstrapcdn.com/bootstrap/3.1.1/js/bootstrap.min.js"></script> + <link href="//maxcdn.bootstrapcdn.com/bootstrap/3.1.1/css/bootstrap.min.css" rel="stylesheet"> + <script type="text/javascript"> +(function($) { // http://stackoverflow.com/questions/901115/how-can-i-get-query-string-values + $.QueryString = (function(a) { + if (a == "") return {}; + var b = {}; + for (var i = 0; i < a.length; ++i) + { + var p=a[i].split('='); + if (p.length != 2) continue; + b[p[0]] = decodeURIComponent(p[1].replace(/\+/g, " ")); + } + return b; + })(window.location.search.substr(1).split('&')) +})(jQuery); + +function newpage() { + var input = $("#text").val(); + var from = $("#from").val(); + var to = $("#to").val(); + var href = window.location.href; + window.location.href = href.replace(/([?].*)?$/,"?" + $.param({text: input, from: from, to: to})); +}; + +function process(res) { + $("#results").text(res.result); + $("#version").text(res.version); +} + +$(document).ready(function() { + var text = $.QueryString["text"]; + $("#text").val(text); + var from = $.QueryString["from"] || "markdown"; + $("#from").val(from); + var to = $.QueryString["to"] || "html"; + $("#to").val(to); + if (text && text != "") { + $.getJSON("http://johnmacfarlane.net/cgi-bin/trypandoc", { from: from, to: to, text: text }, process); + }; + $("#convert").click(newpage); +}); + </script> + <style type="text/css"> + h1 { margin-bottom: 1em; } + body { margin: auto; } + textarea { height: auto; width: 100%; font-family: monospace; margin-top: 15px; } + div.alert { margin: 1em; } + h3 { margin-top: 0; margin-bottom: 0; padding: 0; font-size: 100%; } + pre#results { width: 100%; margin-top: 15px; } + footer { color: #555; text-align: center; margin: 1em; } + p.version { color: #555; } + button#convert { vertical-align: bottom; } + </style> +</head> +<body> +<div class="container"> + <div class="row"> + <h1>Try <a href="http://johnmacfarlane.net/pandoc/">pandoc</a>!</h1> + </div> + <div class="row"> + <div class="col-md-6"> + <label for="from"> + from + </label> + <select id="from"> + <option value="markdown" selected>Markdown</option> + <option value="markdown_strict">Markdown/strict</option> + <option value="markdown_phpextra">PHP Markdown Extra</option> + <option value="markdown_github">Github Markdown</option> + <option value="markdown_mmd">MultiMarkdown</option> + <option value="rst">reStructuredText</option> + <option value="textile">Textile</option> + <option value="latex">LaTeX</option> + <option value="html">HTML</option> + <option value="docbook">DocBook</option> + <option value="opml">OPML</option> + <option value="org">Emacs Org Mode</option> + <option value="t2t">Txt2Tags</option> + <option value="mediawiki">MediaWiki</option> + <option value="haddock">Haddock markup</option> + </select> + <br/> + <textarea id="text" maxlength="3000" rows="15"></textarea> + </div> + <div class="col-md-6"> + <label for="to"> + to + </label> + <select id="to"> + <option value="html" selected>HTML</option> + <option value="html5">HTML 5</option> + <option value="markdown">Markdown</option> + <option value="markdown_strict">Markdown/strict</option> + <option value="markdown_phpextra">PHP Markdown Extra</option> + <option value="markdown_github">Github Markdown</option> + <option value="markdown_mmd">MultiMarkdown</option> + <option value="rst">reStructuredText</option> + <option value="asciidoc">AsciiDoc</option> + <option value="textile">Textile</option> + <option value="mediawiki">MediaWiki</option> + <option value="dokuwiki">DokuWiki</option> + <option value="org">Emacs Org Mode</option> + <option value="latex">LaTeX</option> + <option value="beamer">LaTeX Beamer</option> + <option value="context">ConTeXt</option> + <option value="man">Groff man</option> + <option value="texinfo">Texinfo</option> + <option value="docbook">DocBook</option> + <option value="opml">OPML</option> + <option value="icml">ICML</option> + <option value="opendocument">OpenDocument</option> + <option value="rtf">RTF</option> + <option value="dzslides">DZSlides</option> + <option value="slidy">Slidy</option> + <option value="S5">S5</option> + <option value="slideous">Slideous</option> + </select> + + <button class="btn btn-primary btn-xs" id="convert">Convert</button> + <br/> + <pre id="results"></pre> + </div> + </div> +</div> +<footer> + <p class="version">pandoc <span id="version"></span></p> + <p>© 2013–2014 <a href="http://johnmacfarlane.net">John MacFarlane</a></p> +</footer> +</body> +</html> diff --git a/trypandoc/trypandoc.hs b/trypandoc/trypandoc.hs new file mode 100644 index 000000000..c530f45f2 --- /dev/null +++ b/trypandoc/trypandoc.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where +import Network.Wai.Handler.CGI +import Network.Wai +import Control.Applicative ((<$>)) +import Data.Maybe (mapMaybe, fromMaybe) +import Network.HTTP.Types.Status (status200) +import Network.HTTP.Types.Header (hContentType) +import Network.HTTP.Types.URI (queryToQueryText) +import Text.Pandoc +import Text.Pandoc.Shared (tabFilter) +import Text.Highlighting.Kate (pygments) +import Data.Aeson +import qualified Data.Text as T +import Data.Text (Text) + +main :: IO () +main = run app + +app :: Application +app req respond = do + let query = queryToQueryText $ queryString req + let getParam x = maybe (error $ T.unpack x ++ " paramater not set") + return $ lookup x query + text <- getParam "text" >>= checkLength . fromMaybe T.empty + fromFormat <- fromMaybe "" <$> getParam "from" + toFormat <- fromMaybe "" <$> getParam "to" + reader <- maybe (error $ "could not find reader for " ++ T.unpack fromFormat) return + $ lookup fromFormat fromFormats + let writer = maybe (error $ "could not find writer for " ++ T.unpack toFormat) id + $ lookup toFormat toFormats + let result = T.pack $ writer $ reader $ tabFilter 4 $ T.unpack text + let output = encode $ object [ T.pack "result" .= result + , T.pack "name" .= + if fromFormat == "markdown_strict" + then T.pack "pandoc (strict)" + else T.pack "pandoc" + , T.pack "version" .= pandocVersion] + respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output + +checkLength :: Text -> IO Text +checkLength t = + if T.length t > 10000 + then error "exceeds length limit of 10,000 characters" + else return t + +writerOpts :: WriterOptions +writerOpts = def { writerReferenceLinks = True, + writerEmailObfuscation = NoObfuscation, + writerHTMLMathMethod = MathJax "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML", + writerHighlight = True, + writerHighlightStyle = pygments } + +readerOpts :: ReaderOptions +readerOpts = def { readerParseRaw = True, + readerSmart = True } + +fromFormats :: [(Text, String -> Pandoc)] +fromFormats = [ + ("native" , readNative) + ,("json" , Text.Pandoc.readJSON readerOpts) + ,("markdown" , readMarkdown readerOpts) + ,("markdown_strict" , readMarkdown readerOpts{ + readerExtensions = strictExtensions, + readerSmart = False }) + ,("markdown_phpextra" , readMarkdown readerOpts{ + readerExtensions = phpMarkdownExtraExtensions }) + ,("markdown_github" , readMarkdown readerOpts{ + readerExtensions = githubMarkdownExtensions }) + ,("markdown_mmd", readMarkdown readerOpts{ + readerExtensions = multimarkdownExtensions }) + ,("rst" , readRST readerOpts) + ,("mediawiki" , readMediaWiki readerOpts) + ,("docbook" , readDocBook readerOpts) + ,("opml" , readOPML readerOpts) + ,("t2t" , readTxt2TagsNoMacros readerOpts) + ,("org" , readOrg readerOpts) + ,("textile" , readTextile readerOpts) -- TODO : textile+lhs + ,("html" , readHtml readerOpts) + ,("latex" , readLaTeX readerOpts) + ,("haddock" , readHaddock readerOpts) + ] + +toFormats :: [(Text, Pandoc -> String)] +toFormats = mapMaybe (\(x,y) -> + case y of + PureStringWriter w -> Just (T.pack x, w writerOpts{ + writerExtensions = + case x of + "markdown_strict" -> strictExtensions + "markdown_phpextra" -> phpMarkdownExtraExtensions + "markdown_mmd" -> multimarkdownExtensions + "markdown_github" -> githubMarkdownExtensions + _ -> pandocExtensions + }) + _ -> + case x of + "rtf" -> Just (T.pack x, writeRTF writerOpts) + _ -> Nothing) writers + |