diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 29 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 30 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 39 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Muse.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 18 |
7 files changed, 115 insertions, 49 deletions
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 37fec9f0f..3ec8781be 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -36,18 +36,21 @@ import Control.Arrow ((***)) import Control.Exception import Control.Monad (when) import Data.Char (toLower) +import Data.Data (Data) import Data.List (intersperse) import qualified Data.Map as M import Data.Text (Text, pack) import Data.Typeable -import Foreign.Lua (Lua, Pushable) +import Foreign.Lua (Lua, Peekable, Pushable) +import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable + , metatableName) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition import Text.Pandoc.Error import Text.Pandoc.Lua.Init (LuaException (LuaException), runPandocLua, registerScriptPath) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addField, dofileWithTraceback) +import Text.Pandoc.Lua.Util (addField, addFunction, dofileWithTraceback) import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 @@ -106,17 +109,37 @@ data PandocLuaException = PandocLuaException String instance Exception PandocLuaException +-- | Readonly and lazy pandoc objects. +newtype LazyPandoc = LazyPandoc Pandoc + deriving (Data) + +instance Pushable LazyPandoc where + push lazyDoc = pushAnyWithMetatable pushPandocMetatable lazyDoc + where + pushPandocMetatable = ensureUserdataMetatable (metatableName lazyDoc) $ + addFunction "__index" indexLazyPandoc + +instance Peekable LazyPandoc where + peek = Lua.peekAny + +indexLazyPandoc :: LazyPandoc -> String -> Lua Lua.NumResults +indexLazyPandoc (LazyPandoc (Pandoc meta blks)) field = 1 <$ + case field of + "blocks" -> Lua.push blks + "meta" -> Lua.push meta + _ -> Lua.pushnil + -- | Convert Pandoc to custom markup. writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text writeCustom luaFile opts doc@(Pandoc meta _) = do res <- runPandocLua $ do + Lua.push (LazyPandoc doc) *> Lua.setglobal "PANDOC_DOCUMENT" registerScriptPath luaFile stat <- dofileWithTraceback luaFile -- check for error in lua script (later we'll change the return type -- to handle this more gracefully): when (stat /= Lua.OK) $ Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toString - -- TODO - call hierarchicalize, so we have that info rendered <- docToCustom opts doc context <- metaToJSON opts blockListToCustom diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 524d20fd1..d80b4a7bc 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -349,6 +349,8 @@ writeDocx opts doc@(Pandoc meta _) = do "application/vnd.openxmlformats-officedocument.extended-properties+xml") ,("/docProps/core.xml", "application/vnd.openxmlformats-package.core-properties+xml") + ,("/docProps/custom.xml", + "application/vnd.openxmlformats-officedocument.custom-properties+xml") ,("/word/styles.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml") ,("/word/document.xml", @@ -507,6 +509,19 @@ writeDocx opts doc@(Pandoc meta _) = do ]) (formatTime defaultTimeLocale "%FT%XZ" utctime) let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps + let customProperties :: [(String, String)] + customProperties = [] -- FIXME + let mkCustomProp (k, v) pid = mknode "property" + [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") + ,("pid", show pid) + ,("name", k)] $ mknode "vt:lpwstr" [] v + let customPropsPath = "docProps/custom.xml" + let customProps = mknode "Properties" + [("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties") + ,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes") + ] $ zipWith mkCustomProp customProperties [(2 :: Int)..] + let customPropsEntry = toEntry customPropsPath epochtime $ renderXml customProps + let relsPath = "_rels/.rels" let rels = mknode "Relationships" [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")] $ map (\attrs -> mknode "Relationship" attrs ()) @@ -519,6 +534,9 @@ writeDocx opts doc@(Pandoc meta _) = do , [("Id","rId3") ,("Type","http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties") ,("Target","docProps/core.xml")] + , [("Id","rId5") + ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties") + ,("Target","docProps/custom.xml")] ] let relsEntry = toEntry relsPath epochtime $ renderXml rels @@ -558,7 +576,8 @@ writeDocx opts doc@(Pandoc meta _) = do contentTypesEntry : relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : commentsEntry : - docPropsEntry : docPropsAppEntry : themeEntry : + docPropsEntry : docPropsAppEntry : customPropsEntry : + themeEntry : fontTableEntry : settingsEntry : webSettingsEntry : imageEntries ++ headerFooterEntries ++ miscRelEntries ++ otherMediaEntries @@ -945,8 +964,13 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do else withParaProp (pCustomStyle "TableCaption") $ blockToOpenXML opts (Para caption) let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] () - let cellToOpenXML (al, cell) = withParaProp (alignmentFor al) - $ blocksToOpenXML opts cell + -- Table cells require a <w:p> element, even an empty one! + -- Not in the spec but in Word 2007, 2010. See #4953. + let cellToOpenXML (al, cell) = do + es <- withParaProp (alignmentFor al) $ blocksToOpenXML opts cell + if any (\e -> qName (elName e) == "p") es + then return es + else return $ es ++ [mknode "w:p" [] ()] headers' <- mapM cellToOpenXML $ zip aligns headers rows' <- mapM (mapM cellToOpenXML . zip aligns) rows let borderProps = mknode "w:tcPr" [] diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index c1b5d0fa4..11d58b90a 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -655,7 +655,10 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do [ (if key == "startFrom" then "firstnumber" else key) ++ "=" ++ mbBraced attr | - (key,attr) <- keyvalAttr ] ++ + (key,attr) <- keyvalAttr, + key `notElem` ["exports", "tangle", "results"] + -- see #4889 + ] ++ (if identifier == "" then [] else [ "label=" ++ ref ]) @@ -1366,19 +1369,27 @@ citationsToBiblatex AuthorInText -> "textcite" NormalCitation -> "autocite" -citationsToBiblatex (c:cs) = do - args <- mapM convertOne (c:cs) - return $ text cmd <> foldl' (<>) empty args - where - cmd = case citationMode c of - SuppressAuthor -> "\\autocites*" - AuthorInText -> "\\textcites" - NormalCitation -> "\\autocites" - convertOne Citation { citationId = k - , citationPrefix = p - , citationSuffix = s - } - = citeArguments p s k +citationsToBiblatex (c:cs) + | all (\cit -> null (citationPrefix cit) && null (citationSuffix cit)) (c:cs) + = do + let cmd = case citationMode c of + SuppressAuthor -> "\\autocite*" + AuthorInText -> "\\textcite" + NormalCitation -> "\\autocite" + return $ text cmd <> + braces (text (intercalate "," (map citationId (c:cs)))) + | otherwise = do + let cmd = case citationMode c of + SuppressAuthor -> "\\autocites*" + AuthorInText -> "\\textcites" + NormalCitation -> "\\autocites" + let convertOne Citation { citationId = k + , citationPrefix = p + , citationSuffix = s + } + = citeArguments p s k + args <- mapM convertOne (c:cs) + return $ text cmd <> foldl' (<>) empty args citationsToBiblatex _ = return empty diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 9a4acb59d..ad8d5c483 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -847,6 +847,13 @@ blockListToMarkdown opts blocks = do Plain ils : fixBlocks bs fixBlocks (Plain ils : bs) = Para ils : fixBlocks bs + fixBlocks (r@(RawBlock f raw) : b : bs) + | not (null raw) + , last raw /= '\n' = + case b of + Plain{} -> r : fixBlocks (b:bs) + RawBlock{} -> r : fixBlocks (b:bs) + _ -> RawBlock f (raw ++ "\n") : fixBlocks (b:bs) -- #4629 fixBlocks (x : xs) = x : fixBlocks xs fixBlocks [] = [] isListBlock (BulletList _) = True diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 18aebc364..1374cdde3 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -250,11 +250,11 @@ blockToMuse (Header level (ident,_,_) inlines) = do let attr' = if null ident || (isEnabled Ext_auto_identifiers opts && ident == autoId) then empty else "#" <> text ident <> cr - let header' = if topLevel then (text $ replicate level '*') <> space else mempty + let header' = if topLevel then text (replicate level '*') <> space else mempty return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline -blockToMuse (Table caption _ _ headers rows) = do +blockToMuse (Table caption _ _ headers rows) = do caption' <- inlineListToMuse caption headers' <- mapM blockListToMuse headers rows' <- mapM (mapM blockListToMuse) rows @@ -294,10 +294,10 @@ noteToMuse :: PandocMonad m -> Muse m Doc noteToMuse num note = hang (length marker) (text marker) <$> - (local (\env -> env { envInsideBlock = True + local (\env -> env { envInsideBlock = True , envInlineStart = True , envAfterSpace = True - }) $ blockListToMuse note) + }) (blockListToMuse note) where marker = "[" ++ show num ++ "] " diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 1c9481630..ac2ed5b4c 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -36,8 +36,9 @@ import Control.Monad.Except (catchError) import Control.Monad.State.Strict import qualified Data.ByteString.Lazy as B import Data.Generics (everywhere', mkT) -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, intercalate) import Data.Maybe (fromMaybe) +import qualified Data.Map as Map import qualified Data.Text.Lazy as TL import System.FilePath (takeDirectory, takeExtension, (<.>)) import Text.Pandoc.BCP47 (Lang (..), getLang, renderLang) @@ -49,7 +50,8 @@ import Text.Pandoc.Logging import Text.Pandoc.MIME (extensionFromMimeType, getMimeType) import Text.Pandoc.Options (WrapOption (..), WriterOptions (..)) import Text.Pandoc.Pretty -import Text.Pandoc.Shared (stringify) +import Text.Pandoc.Shared (stringify, normalizeDate) +import Text.Pandoc.Writers.Shared (lookupMetaString) import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) @@ -81,6 +83,7 @@ pandocToODT :: PandocMonad m -> O m B.ByteString pandocToODT opts doc@(Pandoc meta _) = do let title = docTitle meta + let authors = docAuthors meta lang <- toLang (getLang opts meta) refArchive <- case writerReferenceDoc opts of @@ -123,6 +126,15 @@ pandocToODT opts doc@(Pandoc meta _) = do ) ) let archive' = addEntryToArchive manifestEntry archive + let userDefinedMetaFields = [k | k <- Map.keys (unMeta meta) + , k `notElem` ["title", "lang", "author", "date"]] + let escapedText = text . escapeStringForXML + let userDefinedMeta = + map (\k -> inTags False "meta:user-defined" + [ ("meta_name", escapeStringForXML k) + ,("meta-value-type", "string") + ] (escapedText $ lookupMetaString k meta)) userDefinedMetaFields + let metaTag metafield = inTagsSimple metafield . escapedText let metaEntry = toEntry "meta.xml" epochtime $ fromStringLazy $ render Nothing $ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>" @@ -134,14 +146,21 @@ pandocToODT opts doc@(Pandoc meta _) = do ,("xmlns:meta","urn:oasis:names:tc:opendocument:xmlns:meta:1.0") ,("xmlns:ooo","http://openoffice.org/2004/office") ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#") - ,("office:version","1.2")] ( inTagsSimple "office:meta" $ - ( inTagsSimple "dc:title" - (text $ escapeStringForXML (stringify title)) + ,("office:version","1.2")] ( inTags True "office:meta" [] $ + ( metaTag "dc:title" (stringify title) $$ case lang of - Just l -> inTagsSimple "dc:language" - (text (escapeStringForXML (renderLang l))) + Just l -> metaTag "dc:language" (renderLang l) Nothing -> empty + $$ + metaTag "dc:creator" + (intercalate "; " (map stringify authors)) + $$ + maybe mempty + (metaTag "dc:date") + (normalizeDate (lookupMetaString "date" meta)) + $$ + vcat userDefinedMeta ) ) ) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index ed2c46d7b..a7bf30aaa 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -41,7 +41,6 @@ module Text.Pandoc.Writers.Shared ( , isDisplayMath , fixDisplayMath , unsmartify - , hasSimpleCells , gridTable , lookupMetaBool , lookupMetaBlocks @@ -55,7 +54,6 @@ module Text.Pandoc.Writers.Shared ( where import Prelude import Control.Monad (zipWithM) -import Data.Monoid (Any (..)) import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object), encode, fromJSON) import Data.Char (chr, ord, isAscii, isSpace) @@ -72,7 +70,6 @@ import Text.Pandoc.Pretty import Text.Pandoc.Shared (stringify) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) -import Text.Pandoc.Walk (query) import Text.Printf (printf) -- | Create JSON value for template from a 'Meta' and an association list @@ -246,21 +243,6 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs unsmartify opts (x:xs) = x : unsmartify opts xs unsmartify _ [] = [] --- | True if block is a table that can be represented with --- one line per row. -hasSimpleCells :: Block -> Bool -hasSimpleCells (Table _caption _aligns _widths headers rows) = - all isSimpleCell (concat (headers:rows)) - where - isLineBreak LineBreak = Any True - isLineBreak _ = Any False - hasLineBreak = getAny . query isLineBreak - isSimpleCell [Plain ils] = not (hasLineBreak ils) - isSimpleCell [Para ils ] = not (hasLineBreak ils) - isSimpleCell [] = True - isSimpleCell _ = False -hasSimpleCells _ = False - gridTable :: Monad m => WriterOptions -> (WriterOptions -> [Block] -> m Doc) |