aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/App.hs2
-rw-r--r--src/Text/Pandoc/Lua.hs6
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs (renamed from src/Text/Pandoc/Lua/PandocModule.hs)106
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs135
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs50
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs9
-rw-r--r--src/Text/Pandoc/Lua/Util.hs33
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs5
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs18
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs2
-rw-r--r--src/Text/Pandoc/Templates.hs1
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs8
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs10
-rw-r--r--src/Text/Pandoc/Writers/Muse.hs2
-rw-r--r--src/Text/Pandoc/Writers/Org.hs19
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint.hs80
16 files changed, 354 insertions, 132 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index e70b606a9..df4bdc151 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -538,7 +538,7 @@ convertWithOpts opts = do
type Transform = Pandoc -> Pandoc
isTextFormat :: String -> Bool
-isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub"]
+isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx"]
externalFilter :: MonadIO m
=> ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index a56e89511..ee259e3fd 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -39,7 +39,7 @@ import Text.Pandoc.Class (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter)
import Text.Pandoc.Lua.Init (runPandocLua)
-import Text.Pandoc.Lua.PandocModule (pushPandocModule) -- TODO: remove
+import Text.Pandoc.Lua.Module.Pandoc (pushModule) -- TODO: remove
import qualified Foreign.Lua as Lua
-- | Run the Lua filter in @filterPath@ for a transformation to target
@@ -81,3 +81,7 @@ pushGlobalFilter = do
runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
runAll = foldr ((>=>) . walkMWithLuaFilter) return
+
+-- | DEPRECATED: Push the pandoc module to the Lua Stack.
+pushPandocModule :: Maybe FilePath -> Lua Lua.NumResults
+pushPandocModule = pushModule
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 6bc2618fd..33c441c99 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
{-
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -17,88 +15,39 @@ You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-{-# LANGUAGE CPP #-}
{- |
- Module : Text.Pandoc.Lua.PandocModule
+ Module : Text.Pandoc.Lua.Module.MediaBag
Copyright : Copyright © 2017 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
-Pandoc module for lua.
+The lua module @pandoc.mediabag@.
-}
-module Text.Pandoc.Lua.PandocModule
- ( pushPandocModule
- , pushMediaBagModule
+module Text.Pandoc.Lua.Module.MediaBag
+ ( pushModule
) where
import Control.Monad (zipWithM_)
-import Data.Default (Default (..))
-import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.IORef (IORef, modifyIORef', readIORef)
import Data.Maybe (fromMaybe)
-import Data.Text (pack)
-import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
-import Foreign.Lua.FunctionCalling (ToHaskellFunction)
-import System.Exit (ExitCode (..))
+import Foreign.Lua (Lua, NumResults, liftIO)
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
- runIO, runIOorExplode, setMediaBag)
-import Text.Pandoc.Definition (Block, Inline)
-import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
+ runIOorExplode, setMediaBag)
import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
-import Text.Pandoc.Walk (Walkable)
+import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction)
import Text.Pandoc.MIME (MimeType)
-import Text.Pandoc.Options (ReaderOptions (readerExtensions))
-import Text.Pandoc.Process (pipeProcess)
-import Text.Pandoc.Readers (Reader (..), getReader)
import qualified Data.ByteString.Lazy as BL
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.MediaBag as MB
--- | Push the "pandoc" on the lua stack. Requires the `list` module to be
--- loaded.
-pushPandocModule :: Maybe FilePath -> Lua NumResults
-pushPandocModule datadir = do
- loadScriptFromDataDir datadir "pandoc.lua"
- addFunction "_pipe" pipeFn
- addFunction "_read" readDoc
- addFunction "sha1" sha1HashFn
- addFunction "walk_block" walkBlock
- addFunction "walk_inline" walkInline
- return 1
-
-walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a)
- => a -> LuaFilter -> Lua a
-walkElement x f = walkInlines f x >>= walkBlocks f
-
-walkInline :: Inline -> LuaFilter -> Lua Inline
-walkInline = walkElement
-
-walkBlock :: Block -> LuaFilter -> Lua Block
-walkBlock = walkElement
-
-readDoc :: String -> String -> Lua NumResults
-readDoc formatSpec content = do
- case getReader formatSpec of
- Left s -> Lua.push s -- Unknown reader
- Right (reader, es) ->
- case reader of
- TextReader r -> do
- res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
- case res of
- Left s -> Lua.push $ show s -- error while reading
- Right pd -> Lua.push pd -- success, push Pandoc
- _ -> Lua.push "Only string formats are supported at the moment."
- return 1
-
--
-- MediaBag submodule
--
-pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
-pushMediaBagModule commonState mediaBagRef = do
+pushModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
+pushModule commonState mediaBagRef = do
Lua.newtable
addFunction "insert" (insertMediaFn mediaBagRef)
addFunction "lookup" (lookupMediaFn mediaBagRef)
@@ -106,30 +55,6 @@ pushMediaBagModule commonState mediaBagRef = do
addFunction "fetch" (fetch commonState mediaBagRef)
return 1
-addFunction :: ToHaskellFunction a => String -> a -> Lua ()
-addFunction name fn = do
- Lua.push name
- Lua.pushHaskellFunction fn
- Lua.rawset (-3)
-
-sha1HashFn :: BL.ByteString
- -> Lua NumResults
-sha1HashFn contents = do
- Lua.push $ showDigest (sha1 contents)
- return 1
-
-pipeFn :: String
- -> [String]
- -> BL.ByteString
- -> Lua NumResults
-pipeFn command args input = do
- (ec, output) <- liftIO $ pipeProcess Nothing command args input
- Lua.push $ case ec of
- ExitSuccess -> 0
- ExitFailure n -> n
- Lua.push output
- return 2
-
insertMediaFn :: IORef MB.MediaBag
-> FilePath
-> OrNil MimeType
@@ -181,16 +106,3 @@ fetch commonState mbRef src = do
Lua.push $ fromMaybe "" mimeType
Lua.push bs
return 2 -- returns 2 values: contents, mimetype
-
---
--- Helper types and orphan instances
---
-
-newtype OrNil a = OrNil { toMaybe :: Maybe a }
-
-instance FromLuaStack a => FromLuaStack (OrNil a) where
- peek idx = do
- noValue <- Lua.isnil idx
- if noValue
- then return (OrNil Nothing)
- else OrNil . Just <$> Lua.peek idx
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
new file mode 100644
index 000000000..5b8714e07
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -0,0 +1,135 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+{-# LANGUAGE FlexibleContexts #-}
+{- |
+ Module : Text.Pandoc.Lua.Module.Pandoc
+ Copyright : Copyright © 2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Pandoc module for lua.
+-}
+module Text.Pandoc.Lua.Module.Pandoc
+ ( pushModule
+ ) where
+
+import Control.Monad (when)
+import Data.Default (Default (..))
+import Data.Maybe (fromMaybe)
+import Data.Text (pack)
+import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
+import System.Exit (ExitCode (..))
+import Text.Pandoc.Class (runIO)
+import Text.Pandoc.Definition (Block, Inline)
+import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
+import Text.Pandoc.Lua.StackInstances ()
+import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction, addValue,
+ loadScriptFromDataDir, raiseError)
+import Text.Pandoc.Walk (Walkable)
+import Text.Pandoc.Options (ReaderOptions (readerExtensions))
+import Text.Pandoc.Process (pipeProcess)
+import Text.Pandoc.Readers (Reader (..), getReader)
+
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import qualified Foreign.Lua as Lua
+
+-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
+-- loaded.
+pushModule :: Maybe FilePath -> Lua NumResults
+pushModule datadir = do
+ loadScriptFromDataDir datadir "pandoc.lua"
+ addFunction "read" readDoc
+ addFunction "pipe" pipeFn
+ addFunction "walk_block" walkBlock
+ addFunction "walk_inline" walkInline
+ return 1
+
+walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a)
+ => a -> LuaFilter -> Lua a
+walkElement x f = walkInlines f x >>= walkBlocks f
+
+walkInline :: Inline -> LuaFilter -> Lua Inline
+walkInline = walkElement
+
+walkBlock :: Block -> LuaFilter -> Lua Block
+walkBlock = walkElement
+
+readDoc :: String -> OrNil String -> Lua NumResults
+readDoc content formatSpecOrNil = do
+ let formatSpec = fromMaybe "markdown" (toMaybe formatSpecOrNil)
+ case getReader formatSpec of
+ Left s -> raiseError s -- Unknown reader
+ Right (reader, es) ->
+ case reader of
+ TextReader r -> do
+ res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
+ case res of
+ Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc
+ Left s -> raiseError (show s) -- error while reading
+ _ -> raiseError "Only string formats are supported at the moment."
+
+-- | Pipes input through a command.
+pipeFn :: String
+ -> [String]
+ -> BL.ByteString
+ -> Lua NumResults
+pipeFn command args input = do
+ (ec, output) <- liftIO $ pipeProcess Nothing command args input
+ case ec of
+ ExitSuccess -> 1 <$ Lua.push output
+ ExitFailure n -> raiseError (PipeError command n output)
+
+data PipeError = PipeError
+ { pipeErrorCommand :: String
+ , pipeErrorCode :: Int
+ , pipeErrorOutput :: BL.ByteString
+ }
+
+instance FromLuaStack PipeError where
+ peek idx =
+ PipeError
+ <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1)
+
+instance ToLuaStack PipeError where
+ push pipeErr = do
+ Lua.newtable
+ addValue "command" (pipeErrorCommand pipeErr)
+ addValue "error_code" (pipeErrorCode pipeErr)
+ addValue "output" (pipeErrorOutput pipeErr)
+ pushPipeErrorMetaTable
+ Lua.setmetatable (-2)
+ where
+ pushPipeErrorMetaTable :: Lua ()
+ pushPipeErrorMetaTable = do
+ v <- Lua.newmetatable "pandoc pipe error"
+ when v $ addFunction "__tostring" pipeErrorMessage
+
+ pipeErrorMessage :: PipeError -> Lua BL.ByteString
+ pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat
+ [ BSL.pack "Error running "
+ , BSL.pack cmd
+ , BSL.pack " (error code "
+ , BSL.pack $ show errorCode
+ , BSL.pack "): "
+ , if output == mempty then BSL.pack "<no output>" else output
+ ]
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
new file mode 100644
index 000000000..496fdbc0a
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -0,0 +1,50 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+{- |
+ Module : Text.Pandoc.Lua.Module.Utils
+ Copyright : Copyright © 2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Utility module for lua, exposing internal helper functions.
+-}
+module Text.Pandoc.Lua.Module.Utils
+ ( pushModule
+ ) where
+
+import Data.Digest.Pure.SHA (sha1, showDigest)
+import Foreign.Lua (Lua, NumResults)
+import Text.Pandoc.Lua.StackInstances ()
+import Text.Pandoc.Lua.Util (addFunction)
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Foreign.Lua as Lua
+
+-- | Push the "pandoc.utils" module to the lua stack.
+pushModule :: Lua NumResults
+pushModule = do
+ Lua.newtable
+ addFunction "sha1" sha1HashFn
+ return 1
+
+-- | Calculate the hash of the given contents.
+sha1HashFn :: BSL.ByteString
+ -> Lua String
+sha1HashFn = return . showDigest . sha1
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index b2dbff496..f26c17084 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/src/Text/Pandoc/Lua/Packages.hs
@@ -38,10 +38,12 @@ import Data.IORef (IORef)
import Foreign.Lua (Lua, NumResults, liftIO)
import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir)
import Text.Pandoc.MediaBag (MediaBag)
-import Text.Pandoc.Lua.PandocModule (pushPandocModule, pushMediaBagModule)
import Text.Pandoc.Lua.Util (dostring')
import qualified Foreign.Lua as Lua
+import Text.Pandoc.Lua.Module.Pandoc as Pandoc
+import Text.Pandoc.Lua.Module.MediaBag as MediaBag
+import Text.Pandoc.Lua.Module.Utils as Utils
-- | Parameters used to create lua packages/modules.
data LuaPackageParams = LuaPackageParams
@@ -72,10 +74,11 @@ pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults
pandocPackageSearcher luaPkgParams pkgName =
case pkgName of
"pandoc" -> let datadir = luaPkgDataDir luaPkgParams
- in pushWrappedHsFun (pushPandocModule datadir)
+ in pushWrappedHsFun (Pandoc.pushModule datadir)
"pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams
mbRef = luaPkgMediaBag luaPkgParams
- in pushWrappedHsFun (pushMediaBagModule st mbRef)
+ in pushWrappedHsFun (MediaBag.pushModule st mbRef)
+ "pandoc.utils" -> pushWrappedHsFun Utils.pushModule
_ -> searchPureLuaLoader
where
pushWrappedHsFun f = do
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 5803e62dc..e688ad255 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -32,9 +32,12 @@ module Text.Pandoc.Lua.Util
( adjustIndexBy
, getTable
, addValue
+ , addFunction
, getRawInt
, setRawInt
, addRawInt
+ , raiseError
+ , OrNil (..)
, PushViaCall
, pushViaCall
, pushViaConstructor
@@ -44,8 +47,8 @@ module Text.Pandoc.Lua.Util
import Control.Monad (when)
import Data.ByteString.Char8 (unpack)
-import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex,
- ToLuaStack (..), getglobal')
+import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex,
+ ToLuaStack (..), ToHaskellFunction, getglobal')
import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti)
import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
@@ -66,13 +69,21 @@ getTable idx key = do
rawget (idx `adjustIndexBy` 1)
peek (-1) <* pop 1
--- | Add a key-value pair to the table at the top of the stack
+-- | Add a key-value pair to the table at the top of the stack.
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
addValue key value = do
push key
push value
rawset (-3)
+-- | Add a function to the table at the top of the stack, using the given name.
+addFunction :: ToHaskellFunction a => String -> a -> Lua ()
+addFunction name fn = do
+ Lua.push name
+ Lua.pushHaskellFunction fn
+ Lua.wrapHaskellFunction
+ Lua.rawset (-3)
+
-- | Get value behind key from table at given index.
getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
getRawInt idx key =
@@ -90,6 +101,22 @@ setRawInt idx key value = do
addRawInt :: ToLuaStack a => Int -> a -> Lua ()
addRawInt = setRawInt (-1)
+raiseError :: ToLuaStack a => a -> Lua NumResults
+raiseError e = do
+ Lua.push e
+ fromIntegral <$> Lua.lerror
+
+-- | Newtype wrapper intended to be used for optional Lua values. Nesting this
+-- type is strongly discouraged and will likely lead to a wrong result.
+newtype OrNil a = OrNil { toMaybe :: Maybe a }
+
+instance FromLuaStack a => FromLuaStack (OrNil a) where
+ peek idx = do
+ noValue <- Lua.isnoneornil idx
+ if noValue
+ then return (OrNil Nothing)
+ else OrNil . Just <$> Lua.peek idx
+
-- | Helper class for pushing a single value to the stack via a lua function.
-- See @pushViaCall@.
class PushViaCall a where
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index c82697704..e6ae4c11b 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -376,8 +376,9 @@ totoks pos t =
| d < '\128' ->
Tok pos Esc1 (T.pack ['^','^',d])
: totoks (incSourceColumn pos 3) rest''
- _ -> [Tok pos Symbol ("^"),
- Tok (incSourceColumn pos 1) Symbol ("^")]
+ _ -> Tok pos Symbol ("^") :
+ Tok (incSourceColumn pos 1) Symbol ("^") :
+ totoks (incSourceColumn pos 2) rest'
_ -> Tok pos Symbol ("^")
: totoks (incSourceColumn pos 1) rest
| otherwise ->
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 46dcf38d9..7142c249f 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -31,7 +31,6 @@ Conversion of Muse text to 'Pandoc' document.
{-
TODO:
- Page breaks (five "*")
-- Headings with anchors (make it round trip with Muse writer)
- Org tables
- table.el tables
- Images with attributes (floating and width)
@@ -241,7 +240,8 @@ header = try $ do
guard $ level <= 5
spaceChar
content <- trimInlinesF . mconcat <$> manyTill inline eol
- attr <- registerHeader ("", [], []) (runF content defaultParserState)
+ anchorId <- option "" parseAnchor
+ attr <- registerHeader (anchorId, [], []) (runF content defaultParserState)
return $ B.headerWith attr level <$> content
example :: PandocMonad m => MuseParser m (F Blocks)
@@ -336,7 +336,9 @@ para = do
noteMarker :: PandocMonad m => MuseParser m String
noteMarker = try $ do
char '['
- many1Till digit $ char ']'
+ first <- oneOf "123456789"
+ rest <- manyTill digit (char ']')
+ return $ first:rest
-- Amusewiki version of note
-- Parsing is similar to list item, except that note marker is used instead of list marker
@@ -627,14 +629,18 @@ endline = try $ do
notFollowedBy blankline
returnF B.softbreak
-anchor :: PandocMonad m => MuseParser m (F Inlines)
-anchor = try $ do
+parseAnchor :: PandocMonad m => MuseParser m String
+parseAnchor = try $ do
getPosition >>= \pos -> guard (sourceColumn pos == 1)
char '#'
first <- letter
rest <- many (letter <|> digit)
skipMany spaceChar <|> void newline
- let anchorId = first:rest
+ return $ first:rest
+
+anchor :: PandocMonad m => MuseParser m (F Inlines)
+anchor = try $ do
+ anchorId <- parseAnchor
return $ return $ B.spanWith (anchorId, [], []) mempty
footnote :: PandocMonad m => MuseParser m (F Inlines)
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 04a0efc15..cc6abbfa5 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -737,7 +737,7 @@ noteBlock = try $ do
paraOrPlain :: PandocMonad m => OrgParser m (F Blocks)
paraOrPlain = try $ do
-- Make sure we are not looking at a headline
- notFollowedBy' (char '*' *> oneOf " *")
+ notFollowedBy' headerStart
ils <- inlines
nl <- option False (newline *> return True)
-- Read block as paragraph, except if we are in a list context and the block
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 1ba8d5a05..d4524c333 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -59,6 +59,7 @@ getDefaultTemplate writer = do
"json" -> return ""
"docx" -> return ""
"fb2" -> return ""
+ "pptx" -> return ""
"odt" -> getDefaultTemplate "opendocument"
"html" -> getDefaultTemplate "html5"
"docbook" -> getDefaultTemplate "docbook5"
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 94529dad4..e4240ca4f 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -213,8 +213,12 @@ writeDocx opts doc@(Pandoc meta _) = do
let doc' = walk fixDisplayMath doc
username <- P.lookupEnv "USERNAME"
utctime <- P.getCurrentTime
- distArchive <- (toArchive . BL.fromStrict) <$>
- P.readDefaultDataFile "reference.docx"
+ distArchive <- (toArchive . BL.fromStrict) <$> do
+ oldUserDataDir <- P.getUserDataDir
+ P.setUserDataDir Nothing
+ res <- P.readDefaultDataFile "reference.docx"
+ P.setUserDataDir oldUserDataDir
+ return res
refArchive <- case writerReferenceDoc opts of
Just f -> toArchive <$> P.readFileLazy f
Nothing -> (toArchive . BL.fromStrict) <$>
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 8dda969d9..e9e380a6c 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -325,6 +325,9 @@ tableItemToJATS :: PandocMonad m
-> Bool
-> [Block]
-> JATS m Doc
+tableItemToJATS opts isHeader [Plain item] =
+ inTags True (if isHeader then "th" else "td") [] <$>
+ inlinesToJATS opts item
tableItemToJATS opts isHeader item =
(inTags True (if isHeader then "th" else "td") [] . vcat) <$>
mapM (blockToJATS opts) item
@@ -416,8 +419,11 @@ inlineToJATS opts (Link (ident,_,kvs) txt ('#':src, _)) = do
[("alt", stringify txt) | not (null txt)] ++
[("rid", src)] ++
[(k,v) | (k,v) <- kvs, k `elem` ["ref-type", "specific-use"]]
- contents <- inlinesToJATS opts txt
- return $ inTags False "xref" attr contents
+ if null txt
+ then return $ selfClosingTag "xref" attr
+ else do
+ contents <- inlinesToJATS opts txt
+ return $ inTags False "xref" attr contents
inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do
let attr = [("id", ident) | not (null ident)] ++
[("ext-link-type", "uri"),
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 545891d97..34936504e 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -229,7 +229,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do
else "#" <> text ident <> cr
let header' = text $ replicate level '*'
return $ blankline <> nowrap (header' <> space <> contents)
- <> blankline <> attr'
+ $$ attr' <> 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
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index e10fcd5ce..43b5b59ee 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -308,13 +308,18 @@ blockListToOrg blocks = vcat <$> mapM blockToOrg blocks
inlineListToOrg :: PandocMonad m
=> [Inline]
-> Org m Doc
-inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixNotes lst)
- where fixNotes [] = [] -- prevent note ref from wrapping, see #4171
- fixNotes (Space : n@Note{} : rest) =
- Str " " : n : fixNotes rest
- fixNotes (SoftBreak : n@Note{} : rest) =
- Str " " : n : fixNotes rest
- fixNotes (x : rest) = x : fixNotes rest
+inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst)
+ where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171
+ fixMarkers (Space : x : rest) | shouldFix x =
+ Str " " : x : fixMarkers rest
+ fixMarkers (SoftBreak : x : rest) | shouldFix x =
+ Str " " : x : fixMarkers rest
+ fixMarkers (x : rest) = x : fixMarkers rest
+
+ shouldFix Note{} = True -- Prevent footnotes
+ shouldFix (Str "-") = True -- Prevent bullet list items
+ -- TODO: prevent ordered list items
+ shouldFix _ = False
-- | Convert Pandoc inline element to Org.
inlineToOrg :: PandocMonad m => Inline -> Org m Doc
diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs
index b5f06c581..7a453ef1f 100644
--- a/src/Text/Pandoc/Writers/Powerpoint.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint.hs
@@ -105,6 +105,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
, envPresentationSize :: PresentationSize
, envSlideHasHeader :: Bool
, envInList :: Bool
+ , envInNoteSlide :: Bool
}
deriving (Show)
@@ -120,6 +121,7 @@ instance Default WriterEnv where
, envPresentationSize = def
, envSlideHasHeader = False
, envInList = False
+ , envInNoteSlide = False
}
data MediaInfo = MediaInfo { mInfoFilePath :: FilePath
@@ -139,6 +141,7 @@ data WriterState = WriterState { stCurSlideId :: Int
-- (FP, Local ID, Global ID, Maybe Mime)
, stMediaIds :: M.Map Int [MediaInfo]
, stMediaGlobalIds :: M.Map FilePath Int
+ , stNoteIds :: M.Map Int [Block]
} deriving (Show, Eq)
instance Default WriterState where
@@ -147,6 +150,7 @@ instance Default WriterState where
, stLinkIds = mempty
, stMediaIds = mempty
, stMediaGlobalIds = mempty
+ , stNoteIds = mempty
}
type P m = ReaderT WriterEnv (StateT WriterState m)
@@ -300,6 +304,7 @@ data RunProps = RunProps { rPropBold :: Bool
, rLink :: Maybe (URL, String)
, rPropCode :: Bool
, rPropBlockQuote :: Bool
+ , rPropForceSize :: Maybe Pixels
} deriving (Show, Eq)
instance Default RunProps where
@@ -311,6 +316,7 @@ instance Default RunProps where
, rLink = Nothing
, rPropCode = False
, rPropBlockQuote = False
+ , rPropForceSize = Nothing
}
--------------------------------------------------
@@ -351,6 +357,14 @@ inlineToParElems (Code _ str) = do
inlineToParElems $ Str str
inlineToParElems (Math mathtype str) =
return [MathElem mathtype (TeXString str)]
+inlineToParElems (Note blks) = do
+ notes <- gets stNoteIds
+ let maxNoteId = case M.keys notes of
+ [] -> 0
+ lst -> maximum lst
+ curNoteId = maxNoteId + 1
+ modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes }
+ inlineToParElems $ Superscript [Str $ show curNoteId]
inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils
inlineToParElems (RawInline _ _) = return []
inlineToParElems _ = return []
@@ -375,7 +389,7 @@ blockToParagraphs (CodeBlock attr str) =
-- TODO: work out the format
blockToParagraphs (BlockQuote blks) =
local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100}
- , envRunProps = (envRunProps r){rPropBlockQuote = True}})$
+ , envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$
concatMapM blockToParagraphs blks
-- TODO: work out the format
blockToParagraphs (RawBlock _ _) = return []
@@ -411,6 +425,15 @@ blockToParagraphs (OrderedList listAttr blksLst) = do
, pPropMarginLeft = Nothing
}}) $
concatMapM multiParBullet blksLst
+blockToParagraphs (DefinitionList entries) = do
+ let go :: PandocMonad m => ([Inline], [[Block]]) -> P m [Paragraph]
+ go (ils, blksLst) = do
+ term <-blockToParagraphs $ Para [Strong ils]
+ -- For now, we'll treat each definition term as a
+ -- blockquote. We can extend this further later.
+ definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst
+ return $ term ++ definition
+ concatMapM go entries
blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks
-- TODO
blockToParagraphs blk = do
@@ -527,12 +550,18 @@ blocksToSlide' lvl ((Header n _ ils) : blks)
return $ TitleSlide {titleSlideHeader = hdr}
| n == lvl = do
hdr <- inlinesToParElems ils
- shapes <- blocksToShapes blks
+ inNoteSlide <- asks envInNoteSlide
+ shapes <- if inNoteSlide
+ then forceFontSize noteSize $ blocksToShapes blks
+ else blocksToShapes blks
return $ ContentSlide { contentSlideHeader = hdr
, contentSlideContent = shapes
}
blocksToSlide' _ (blk : blks) = do
- shapes <- blocksToShapes (blk : blks)
+ inNoteSlide <- asks envInNoteSlide
+ shapes <- if inNoteSlide
+ then forceFontSize noteSize $ blocksToShapes (blk : blks)
+ else blocksToShapes (blk : blks)
return $ ContentSlide { contentSlideHeader = []
, contentSlideContent = shapes
}
@@ -545,6 +574,38 @@ blocksToSlide blks = do
slideLevel <- asks envSlideLevel
blocksToSlide' slideLevel blks
+makeNoteEntry :: Int -> [Block] -> [Block]
+makeNoteEntry n blks =
+ let enum = Str (show n ++ ".")
+ in
+ case blks of
+ (Para ils : blks') -> (Para $ enum : Space : ils) : blks'
+ _ -> (Para [enum]) : blks
+
+forceFontSize :: PandocMonad m => Pixels -> P m a -> P m a
+forceFontSize px x = do
+ rpr <- asks envRunProps
+ local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x
+
+-- Right now, there's no logic for making more than one slide, but I
+-- want to leave the option open to make multiple slides if we figure
+-- out how to guess at how much space the text of the notes will take
+-- up (or if we allow a way for it to be manually controlled). Plus a
+-- list will make it easier to put together in the final
+-- `blocksToPresentation` function (since we can just add an empty
+-- list without checking the state).
+makeNotesSlides :: PandocMonad m => P m [Slide]
+makeNotesSlides = local (\env -> env{envInNoteSlide=True}) $ do
+ noteIds <- gets stNoteIds
+ if M.null noteIds
+ then return []
+ else do let hdr = Header 2 nullAttr [Str "Notes"]
+ blks <- return $
+ concatMap (\(n, bs) -> makeNoteEntry n bs) $
+ M.toList noteIds
+ sld <- blocksToSlide $ hdr : blks
+ return [sld]
+
getMetaSlide :: PandocMonad m => P m (Maybe Slide)
getMetaSlide = do
meta <- asks envMetadata
@@ -570,11 +631,13 @@ blocksToPresentation :: PandocMonad m => [Block] -> P m Presentation
blocksToPresentation blks = do
blksLst <- splitBlocks blks
slides <- mapM blocksToSlide blksLst
+ noteSlides <- makeNotesSlides
+ let slides' = slides ++ noteSlides
metadataslide <- getMetaSlide
presSize <- asks envPresentationSize
return $ case metadataslide of
- Just metadataslide' -> Presentation presSize $ metadataslide' : slides
- Nothing -> Presentation presSize slides
+ Just metadataslide' -> Presentation presSize $ metadataslide' : slides'
+ Nothing -> Presentation presSize slides'
--------------------------------------------------------------------
@@ -1045,13 +1108,18 @@ makePicElement mInfo attr = do
blockQuoteSize :: Pixels
blockQuoteSize = 20
+noteSize :: Pixels
+noteSize = 18
+
paraElemToElement :: PandocMonad m => ParaElem -> P m Element
paraElemToElement Break = return $ mknode "a:br" [] ()
paraElemToElement (Run rpr s) = do
let attrs =
if rPropCode rpr
then []
- else (if rPropBlockQuote rpr then [("sz", (show $ blockQuoteSize * 100))] else []) ++
+ else (case rPropForceSize rpr of
+ Just n -> [("sz", (show $ n * 100))]
+ Nothing -> []) ++
(if rPropBold rpr then [("b", "1")] else []) ++
(if rPropItalics rpr then [("i", "1")] else []) ++
(case rStrikethrough rpr of
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 13:36:16 +0000