aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/App.hs23
-rw-r--r--src/Text/Pandoc/Extensions.hs1
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs25
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs28
-rw-r--r--src/Text/Pandoc/Lua/Util.hs4
-rw-r--r--src/Text/Pandoc/MIME.hs1
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs32
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs14
-rw-r--r--src/Text/Pandoc/Readers/JATS.hs169
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs30
-rw-r--r--src/Text/Pandoc/Readers/RST.hs4
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs15
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs3
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs4
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs22
15 files changed, 305 insertions, 70 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index df4bdc151..50464830b 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -58,6 +58,9 @@ import Data.Monoid
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TE
+import qualified Data.Text.Encoding.Error as TE
import Data.Yaml (decode)
import qualified Data.Yaml as Yaml
import GHC.Generics
@@ -143,7 +146,7 @@ pdfWriterAndProg :: Maybe String -- ^ user-specified writer name
-> IO (String, Maybe String) -- ^ IO (writerName, maybePdfEngineProg)
pdfWriterAndProg mWriter mEngine = do
let panErr msg = liftIO $ E.throwIO $ PandocAppError msg
- case go (baseWriterName <$> mWriter) mEngine of
+ case go mWriter mEngine of
Right (writ, prog) -> return (writ, Just prog)
Left err -> panErr err
where
@@ -151,7 +154,7 @@ pdfWriterAndProg mWriter mEngine = do
go (Just writer) Nothing = (writer,) <$> engineForWriter writer
go Nothing (Just engine) = (,engine) <$> writerForEngine engine
go (Just writer) (Just engine) =
- case find (== (writer, engine)) engines of
+ case find (== (baseWriterName writer, engine)) engines of
Just _ -> Right (writer, engine)
Nothing -> Left $ "pdf-engine " ++ engine ++
" is not compatible with output format " ++ writer
@@ -161,7 +164,7 @@ pdfWriterAndProg mWriter mEngine = do
[] -> Left $
"pdf-engine " ++ eng ++ " not known"
- engineForWriter w = case [e | (f,e) <- engines, f == w] of
+ engineForWriter w = case [e | (f,e) <- engines, f == baseWriterName w] of
eng : _ -> Right eng
[] -> Left $
"cannot produce pdf output from " ++ w
@@ -513,7 +516,9 @@ convertWithOpts opts = do
case res of
Right pdf -> writeFnBinary outputFile pdf
Left err' -> liftIO $
- E.throwIO $ PandocPDFError (UTF8.toStringLazy err')
+ E.throwIO $ PandocPDFError $
+ TL.unpack (TE.decodeUtf8With TE.lenientDecode err')
+
Nothing -> do
let htmlFormat = format `elem`
["html","html4","html5","s5","slidy",
@@ -1584,15 +1589,17 @@ options =
""
, Option "" ["list-extensions"]
- (NoArg
- (\_ -> do
+ (OptArg
+ (\arg _ -> do
+ let exts = getDefaultExtensions (fromMaybe "markdown" arg)
let showExt x = drop 4 (show x) ++
- if extensionEnabled x pandocExtensions
+ if extensionEnabled x exts
then " +"
else " -"
mapM_ (UTF8.hPutStrLn stdout . showExt)
([minBound..maxBound] :: [Extension])
- exitSuccess ))
+ exitSuccess )
+ "FORMAT")
""
, Option "" ["list-highlight-languages"]
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index bea293891..7fa75cdd9 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -321,6 +321,7 @@ getDefaultExtensions "org" = extensionsFromList
getDefaultExtensions "html" = extensionsFromList
[Ext_auto_identifiers,
Ext_native_divs,
+ Ext_line_blocks,
Ext_native_spans]
getDefaultExtensions "html4" = getDefaultExtensions "html"
getDefaultExtensions "html5" = getDefaultExtensions "html"
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 3a3727355..35495dae1 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -30,10 +30,10 @@ module Text.Pandoc.Lua.Module.Utils
) where
import Control.Applicative ((<|>))
-import Foreign.Lua (FromLuaStack, Lua, NumResults)
+import Foreign.Lua (FromLuaStack, Lua, LuaInteger, NumResults)
import Text.Pandoc.Definition (Pandoc, Meta, Block, Inline)
import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (addFunction)
+import Text.Pandoc.Lua.Util (OrNil (OrNil), addFunction)
import qualified Data.Digest.Pure.SHA as SHA
import qualified Data.ByteString.Lazy as BSL
@@ -44,15 +44,32 @@ import qualified Text.Pandoc.Shared as Shared
pushModule :: Lua NumResults
pushModule = do
Lua.newtable
+ addFunction "hierarchicalize" hierarchicalize
+ addFunction "normalize_date" normalizeDate
addFunction "sha1" sha1
addFunction "stringify" stringify
+ addFunction "to_roman_numeral" toRomanNumeral
return 1
+-- | Convert list of Pandoc blocks into (hierarchical) list of Elements.
+hierarchicalize :: [Block] -> Lua [Shared.Element]
+hierarchicalize = return . Shared.hierarchicalize
+
+-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
+-- limit years to the range 1601-9999 (ISO 8601 accepts greater than
+-- or equal to 1583, but MS Word only accepts dates starting 1601).
+-- Returns nil instead of a string if the conversion failed.
+normalizeDate :: String -> Lua (OrNil String)
+normalizeDate = return . OrNil . Shared.normalizeDate
+
-- | Calculate the hash of the given contents.
sha1 :: BSL.ByteString
-> Lua String
sha1 = return . SHA.showDigest . SHA.sha1
+-- | Convert pandoc structure to a string with formatting removed.
+-- Footnotes are skipped (since we don't want their contents in link
+-- labels).
stringify :: AstElement -> Lua String
stringify el = return $ case el of
PandocElement pd -> Shared.stringify pd
@@ -77,3 +94,7 @@ instance FromLuaStack AstElement where
Right x -> return x
Left _ -> Lua.throwLuaError
"Expected an AST element, but could not parse value as such."
+
+-- | Convert a number < 4000 to uppercase roman numeral.
+toRomanNumeral :: LuaInteger -> Lua String
+toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index ce6dbdb98..119946b78 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -33,13 +33,15 @@ StackValue instances for pandoc types.
module Text.Pandoc.Lua.StackInstances () where
import Control.Applicative ((<|>))
+import Control.Monad (when)
import Foreign.Lua (FromLuaStack (peek), Lua, LuaInteger, LuaNumber, StackIndex,
ToLuaStack (push), Type (..), throwLuaError, tryLua)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (adjustIndexBy, getTable, pushViaConstructor)
-import Text.Pandoc.Shared (safeRead)
+import Text.Pandoc.Shared (Element (Blk, Sec), safeRead)
import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
instance ToLuaStack Pandoc where
push (Pandoc meta blocks) =
@@ -306,3 +308,27 @@ instance ToLuaStack LuaAttr where
instance FromLuaStack LuaAttr where
peek idx = LuaAttr <$> peek idx
+
+--
+-- Hierarchical elements
+--
+instance ToLuaStack Element where
+ push (Blk blk) = push blk
+ push (Sec lvl num attr label contents) = do
+ Lua.newtable
+ LuaUtil.addValue "level" lvl
+ LuaUtil.addValue "numbering" num
+ LuaUtil.addValue "attr" (LuaAttr attr)
+ LuaUtil.addValue "label" label
+ LuaUtil.addValue "contents" contents
+ pushSecMetaTable
+ Lua.setmetatable (-2)
+ where
+ pushSecMetaTable :: Lua ()
+ pushSecMetaTable = do
+ inexistant <- Lua.newmetatable "PandocElementSec"
+ when inexistant $ do
+ LuaUtil.addValue "t" "Sec"
+ Lua.push "__index"
+ Lua.pushvalue (-2)
+ Lua.rawset (-3)
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 28d09d339..1f7664fc0 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -125,6 +125,10 @@ instance FromLuaStack a => FromLuaStack (OrNil a) where
then return (OrNil Nothing)
else OrNil . Just <$> Lua.peek idx
+instance ToLuaStack a => ToLuaStack (OrNil a) where
+ push (OrNil Nothing) = Lua.pushnil
+ push (OrNil (Just x)) = Lua.push x
+
-- | 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/MIME.hs b/src/Text/Pandoc/MIME.hs
index fb85910bb..eba8d512f 100644
--- a/src/Text/Pandoc/MIME.hs
+++ b/src/Text/Pandoc/MIME.hs
@@ -325,6 +325,7 @@ mimeTypesList = -- List borrowed from happstack-server.
,("ogv","video/ogg")
,("ogx","application/ogg")
,("old","application/x-trash")
+ ,("opus","audio/ogg")
,("otg","application/vnd.oasis.opendocument.graphics-template")
,("oth","application/vnd.oasis.opendocument.text-web")
,("otp","application/vnd.oasis.opendocument.presentation-template")
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 99e6f99e6..48a512be2 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -73,6 +73,7 @@ import Text.TeXMath (Exp)
import Text.TeXMath.Readers.OMML (readOMML)
import Text.TeXMath.Unicode.Fonts (Font (..), getUnicode, stringToFont)
import Text.XML.Light
+import qualified Text.XML.Light.Cursor as XMLC
data ReaderEnv = ReaderEnv { envNotes :: Notes
, envComments :: Comments
@@ -117,6 +118,32 @@ mapD f xs =
in
concatMapM handler xs
+unwrapSDT :: NameSpaces -> Content -> Content
+unwrapSDT ns (Elem element)
+ | isElem ns "w" "sdt" element
+ , Just sdtContent <- findChildByName ns "w" "sdtContent" element
+ , child : _ <- elChildren sdtContent
+ = Elem child
+unwrapSDT _ content = content
+
+walkDocument' :: NameSpaces -> XMLC.Cursor -> XMLC.Cursor
+walkDocument' ns cur =
+ let modifiedCur = XMLC.modifyContent (unwrapSDT ns) cur
+ in
+ case XMLC.nextDF modifiedCur of
+ Just cur' -> walkDocument' ns cur'
+ Nothing -> XMLC.root modifiedCur
+
+walkDocument :: NameSpaces -> Element -> Maybe Element
+walkDocument ns element =
+ let cur = XMLC.fromContent (Elem element)
+ cur' = walkDocument' ns cur
+ in
+ case XMLC.toTree cur' of
+ Elem element' -> Just element'
+ _ -> Nothing
+
+
data Docx = Docx Document
deriving Show
@@ -298,7 +325,10 @@ archiveToDocument zf = do
docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
let namespaces = elemToNameSpaces docElem
bodyElem <- maybeToD $ findChildByName namespaces "w" "body" docElem
- body <- elemToBody namespaces bodyElem
+ let bodyElem' = case walkDocument namespaces bodyElem of
+ Just e -> e
+ Nothing -> bodyElem
+ body <- elemToBody namespaces bodyElem'
return $ Document namespaces body
elemToBody :: NameSpaces -> Element -> D Body
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 3e59c4bf7..05a80335a 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -51,7 +51,7 @@ import Data.Char (isAlphaNum, isDigit, isLetter)
import Data.Default (Default (..), def)
import Data.Foldable (for_)
import Data.List (intercalate, isPrefixOf)
-import Data.List.Split (wordsBy)
+import Data.List.Split (wordsBy, splitWhen)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Monoid (First (..), (<>))
@@ -66,6 +66,7 @@ import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad (..))
import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps)
import Text.Pandoc.Definition
+import Text.Pandoc.Extensions (Extension(..))
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options (
@@ -191,6 +192,7 @@ block = do
, pHtml
, pHead
, pBody
+ , pLineBlock
, pDiv
, pPlain
, pFigure
@@ -377,6 +379,16 @@ pRawTag = do
then return mempty
else return $ renderTags' [tag]
+pLineBlock :: PandocMonad m => TagParser m Blocks
+pLineBlock = try $ do
+ guardEnabled Ext_line_blocks
+ _ <- pSatisfy $ tagOpen (=="div") (== [("class","line-block")])
+ ils <- trimInlines . mconcat <$> manyTill inline (pSatisfy (tagClose (=="div")))
+ let lns = map B.fromList $
+ splitWhen (== LineBreak) $ filter (/= SoftBreak) $
+ B.toList ils
+ return $ B.lineBlock lns
+
pDiv :: PandocMonad m => TagParser m Blocks
pDiv = try $ do
guardEnabled Ext_native_divs
diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs
index 851fbec35..9223db68c 100644
--- a/src/Text/Pandoc/Readers/JATS.hs
+++ b/src/Text/Pandoc/Readers/JATS.hs
@@ -5,6 +5,7 @@ import Data.Char (isDigit, isSpace, toUpper)
import Data.Default
import Data.Generics
import Data.List (intersperse)
+import qualified Data.Map as Map
import Data.Maybe (maybeToList, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -23,7 +24,6 @@ type JATS m = StateT JATSState m
data JATSState = JATSState{ jatsSectionLevel :: Int
, jatsQuoteType :: QuoteType
, jatsMeta :: Meta
- , jatsAcceptsMeta :: Bool
, jatsBook :: Bool
, jatsFigureTitle :: Inlines
, jatsContent :: [Content]
@@ -33,7 +33,6 @@ instance Default JATSState where
def = JATSState{ jatsSectionLevel = 0
, jatsQuoteType = DoubleQuote
, jatsMeta = mempty
- , jatsAcceptsMeta = False
, jatsBook = False
, jatsFigureTitle = mempty
, jatsContent = [] }
@@ -79,19 +78,6 @@ named s e = qName (elName e) == s
--
-acceptingMetadata :: PandocMonad m => JATS m a -> JATS m a
-acceptingMetadata p = do
- modify (\s -> s { jatsAcceptsMeta = True } )
- res <- p
- modify (\s -> s { jatsAcceptsMeta = False })
- return res
-
-checkInMeta :: (PandocMonad m, Monoid a) => JATS m () -> JATS m a
-checkInMeta p = do
- accepts <- jatsAcceptsMeta <$> get
- when accepts p
- return mempty
-
addMeta :: PandocMonad m => ToMetaValue a => String -> a -> JATS m ()
addMeta field val = modify (setMeta field val)
@@ -179,18 +165,16 @@ parseBlock (Elem e) =
<$> listitems
"def-list" -> definitionList <$> deflistitems
"sec" -> gets jatsSectionLevel >>= sect . (+1)
- "title" -> return mempty
- "title-group" -> checkInMeta getTitle
"graphic" -> para <$> getGraphic e
- "journal-meta" -> metaBlock
- "article-meta" -> metaBlock
- "custom-meta" -> metaBlock
+ "journal-meta" -> parseMetadata e
+ "article-meta" -> parseMetadata e
+ "custom-meta" -> parseMetadata e
+ "title" -> return mempty -- processed by header
"table" -> parseTable
"fig" -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e
"table-wrap" -> divWith (attrValue "id" e, ["table-wrap"], []) <$> getBlocks e
"caption" -> divWith (attrValue "id" e, ["caption"], []) <$> sect 6
- "ref-list" -> divWith ("refs", [], []) <$> getBlocks e
- "ref" -> divWith ("ref-" <> attrValue "id" e, [], []) <$> getBlocks e
+ "ref-list" -> parseRefList e
"?xml" -> return mempty
_ -> getBlocks e
where parseMixed container conts = do
@@ -231,16 +215,6 @@ parseBlock (Elem e) =
terms' <- mapM getInlines terms
items' <- mapM getBlocks items
return (mconcat $ intersperse (str "; ") terms', items')
- getTitle = do
- tit <- case filterChild (named "article-title") e of
- Just s -> getInlines s
- Nothing -> return mempty
- subtit <- case filterChild (named "subtitle") e of
- Just s -> (text ": " <>) <$>
- getInlines s
- Nothing -> return mempty
- addMeta "title" (tit <> subtit)
-
parseTable = do
let isCaption x = named "title" x || named "caption" x
caption <- case filterChild isCaption e of
@@ -305,13 +279,127 @@ parseBlock (Elem e) =
let ident = attrValue "id" e
modify $ \st -> st{ jatsSectionLevel = oldN }
return $ headerWith (ident,[],[]) n' headerText <> b
--- lineItems = mapM getInlines $ filterChildren (named "line") e
- metaBlock = acceptingMetadata (getBlocks e) >> return mempty
getInlines :: PandocMonad m => Element -> JATS m Inlines
getInlines e' = (trimInlines . mconcat) <$>
mapM parseInline (elContent e')
+parseMetadata :: PandocMonad m => Element -> JATS m Blocks
+parseMetadata e = do
+ getTitle e
+ getAuthors e
+ getAffiliations e
+ return mempty
+
+getTitle :: PandocMonad m => Element -> JATS m ()
+getTitle e = do
+ tit <- case filterElement (named "article-title") e of
+ Just s -> getInlines s
+ Nothing -> return mempty
+ subtit <- case filterElement (named "subtitle") e of
+ Just s -> (text ": " <>) <$>
+ getInlines s
+ Nothing -> return mempty
+ when (tit /= mempty) $ addMeta "title" tit
+ when (subtit /= mempty) $ addMeta "subtitle" subtit
+
+getAuthors :: PandocMonad m => Element -> JATS m ()
+getAuthors e = do
+ authors <- mapM getContrib $ filterElements
+ (\x -> named "contrib" x &&
+ attrValue "contrib-type" x == "author") e
+ authorNotes <- mapM getInlines $ filterElements (named "author-notes") e
+ let authors' = case (reverse authors, authorNotes) of
+ ([], _) -> []
+ (_, []) -> authors
+ (a:as, ns) -> reverse as ++ [a <> mconcat ns]
+ unless (null authors) $ addMeta "author" authors'
+
+getAffiliations :: PandocMonad m => Element -> JATS m ()
+getAffiliations x = do
+ affs <- mapM getInlines $ filterChildren (named "aff") x
+ unless (null affs) $ addMeta "institute" affs
+
+getContrib :: PandocMonad m => Element -> JATS m Inlines
+getContrib x = do
+ given <- maybe (return mempty) getInlines
+ $ filterElement (named "given-names") x
+ family <- maybe (return mempty) getInlines
+ $ filterElement (named "surname") x
+ if given == mempty && family == mempty
+ then return mempty
+ else if given == mempty || family == mempty
+ then return $ given <> family
+ else return $ given <> space <> family
+
+parseRefList :: PandocMonad m => Element -> JATS m Blocks
+parseRefList e = do
+ refs <- mapM parseRef $ filterChildren (named "ref") e
+ addMeta "references" refs
+ return mempty
+
+parseRef :: PandocMonad m
+ => Element -> JATS m (Map.Map String MetaValue)
+parseRef e = do
+ let refId = text $ attrValue "id" e
+ let getInlineText n = maybe (return mempty) getInlines . filterChild (named n)
+ case filterChild (named "element-citation") e of
+ Just c -> do
+ let refType = text $
+ case attrValue "publication-type" c of
+ "journal" -> "article-journal"
+ x -> x
+ (refTitle, refContainerTitle) <- do
+ t <- getInlineText "article-title" c
+ ct <- getInlineText "source" c
+ if t == mempty
+ then return (ct, mempty)
+ else return (t, ct)
+ refLabel <- getInlineText "label" c
+ refYear <- getInlineText "year" c
+ refVolume <- getInlineText "volume" c
+ refFirstPage <- getInlineText "fpage" c
+ refLastPage <- getInlineText "lpage" c
+ refPublisher <- getInlineText "publisher-name" c
+ refPublisherPlace <- getInlineText "publisher-loc" c
+ let refPages = refFirstPage <> (if refLastPage == mempty
+ then mempty
+ else text "\x2013" <> refLastPage)
+ let personGroups' = filterChildren (named "person-group") c
+ let getName nm = do
+ given <- maybe (return mempty) getInlines
+ $ filterChild (named "given-names") nm
+ family <- maybe (return mempty) getInlines
+ $ filterChild (named "surname") nm
+ return $ toMetaValue $ Map.fromList [
+ ("given", given)
+ , ("family", family)
+ ]
+ personGroups <- mapM (\pg ->
+ do names <- mapM getName
+ (filterChildren (named "name") pg)
+ return (attrValue "person-group-type" pg,
+ toMetaValue names))
+ personGroups'
+ return $ Map.fromList $
+ [ ("id", toMetaValue refId)
+ , ("type", toMetaValue refType)
+ , ("title", toMetaValue refTitle)
+ , ("container-title", toMetaValue refContainerTitle)
+ , ("publisher", toMetaValue refPublisher)
+ , ("publisher-place", toMetaValue refPublisherPlace)
+ , ("title", toMetaValue refTitle)
+ , ("issued", toMetaValue
+ $ Map.fromList [
+ ("year", refYear)
+ ])
+ , ("volume", toMetaValue refVolume)
+ , ("page", toMetaValue refPages)
+ , ("citation-label", toMetaValue refLabel)
+ ] ++ personGroups
+ Nothing -> return $ Map.insert "id" (toMetaValue refId) mempty
+ -- TODO handle mixed-citation
+
strContentRecursive :: Element -> String
strContentRecursive = strContent .
(\e' -> e'{ elContent = map elementToStr $ elContent e' })
@@ -354,7 +442,15 @@ parseInline (Elem e) =
let rid = attrValue "rid" e
let refType = ("ref-type",) <$> maybeAttrValue "ref-type" e
let attr = (attrValue "id" e, [], maybeToList refType)
- return $ linkWith attr ('#' : rid) "" ils
+ return $ if refType == Just ("ref-type","bibr")
+ then cite [Citation{
+ citationId = rid
+ , citationPrefix = []
+ , citationSuffix = []
+ , citationMode = NormalCitation
+ , citationNoteNum = 0
+ , citationHash = 0}] ils
+ else linkWith attr ('#' : rid) "" ils
"ext-link" -> do
ils <- innerInlines
let title = fromMaybe "" $ findAttr (QName "title" (Just "http://www.w3.org/1999/xlink") Nothing) e
@@ -375,9 +471,6 @@ parseInline (Elem e) =
"uri" -> return $ link (strContent e) "" $ str $ strContent e
"fn" -> (note . mconcat) <$>
mapM parseBlock (elContent e)
- -- Note: this isn't a real docbook tag; it's what we convert
- -- <?asciidor-br?> to in handleInstructions, above. A kludge to
- -- work around xml-light's inability to parse an instruction.
_ -> innerInlines
where innerInlines = (trimInlines . mconcat) <$>
mapM parseInline (elContent e)
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index f7e45e01a..6c5567ffd 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -1489,8 +1489,17 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList $
-- biblatex misc
, ("RN", romanNumeralUpper)
, ("Rn", romanNumeralLower)
+ -- babel
+ , ("foreignlanguage", foreignlanguage)
]
+foreignlanguage :: PandocMonad m => LP m Inlines
+foreignlanguage = do
+ babelLang <- T.unpack . untokenize <$> braced
+ case babelLangToBCP47 babelLang of
+ Just lang -> spanWith ("", [], [("lang", renderLang $ lang)]) <$> tok
+ _ -> tok
+
inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
inlineLanguageCommands = M.fromList $ mk <$> M.toList polyglossiaLangToBCP47
where
@@ -2655,3 +2664,24 @@ polyglossiaLangToBCP47 = M.fromList
, ("urdu", \_ -> Lang "ur" "" "" [])
, ("vietnamese", \_ -> Lang "vi" "" "" [])
]
+
+babelLangToBCP47 :: String -> Maybe Lang
+babelLangToBCP47 s =
+ case s of
+ "austrian" -> Just $ Lang "de" "" "AT" ["1901"]
+ "naustrian" -> Just $ Lang "de" "" "AT" []
+ "swissgerman" -> Just $ Lang "de" "" "CH" ["1901"]
+ "nswissgerman" -> Just $ Lang "de" "" "CH" []
+ "german" -> Just $ Lang "de" "" "DE" ["1901"]
+ "ngerman" -> Just $ Lang "de" "" "DE" []
+ "lowersorbian" -> Just $ Lang "dsb" "" "" []
+ "uppersorbian" -> Just $ Lang "hsb" "" "" []
+ "polutonikogreek" -> Just $ Lang "el" "" "" ["polyton"]
+ "slovene" -> Just $ Lang "sl" "" "" []
+ "australian" -> Just $ Lang "en" "" "AU" []
+ "canadian" -> Just $ Lang "en" "" "CA" []
+ "british" -> Just $ Lang "en" "" "GB" []
+ "newzealand" -> Just $ Lang "en" "" "NZ" []
+ "american" -> Just $ Lang "en" "" "US" []
+ "classiclatin" -> Just $ Lang "la" "" "" ["x-classic"]
+ _ -> fmap ($ "") $ M.lookup s polyglossiaLangToBCP47
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 6b5d0a331..9f259d958 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -547,7 +547,7 @@ bulletListStart :: Monad m => ParserT [Char] st m Int
bulletListStart = try $ do
notFollowedBy' hrule -- because hrules start out just like lists
marker <- oneOf bulletListMarkers
- white <- many1 spaceChar
+ white <- many1 spaceChar <|> "" <$ lookAhead (char '\n')
return $ length (marker:white)
-- parses ordered list start and returns its length (inc following whitespace)
@@ -556,7 +556,7 @@ orderedListStart :: Monad m => ListNumberStyle
-> RSTParser m Int
orderedListStart style delim = try $ do
(_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)
- white <- many1 spaceChar
+ white <- many1 spaceChar <|> "" <$ lookAhead (char '\n')
return $ markerLen + length white
-- parse a line of a list item
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 72f443ed0..a33196cbe 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -87,6 +87,15 @@ instance ToLuaStack (Stringify Citation) where
addValue "citationNoteNum" $ citationNoteNum cit
addValue "citationHash" $ citationHash cit
+-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
+-- associated value.
+newtype KeyValue a b = KeyValue (a, b)
+
+instance (ToLuaStack a, ToLuaStack b) => ToLuaStack (KeyValue a b) where
+ push (KeyValue (k, v)) = do
+ newtable
+ addValue k v
+
data PandocLuaException = PandocLuaException String
deriving (Show, Typeable)
@@ -102,8 +111,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
-- to handle this more gracefully):
when (stat /= OK) $
tostring 1 >>= throw . PandocLuaException . UTF8.toString
- call 0 0
- -- TODO - call hierarchicalize, so we have that info
+ -- TODO - call hierarchicalize, so we have that info
rendered <- docToCustom opts doc
context <- metaToJSON opts
blockListToCustom
@@ -166,7 +174,8 @@ blockToCustom (OrderedList (num,sty,delim) items) =
callFunc "OrderedList" (map Stringify items) num (show sty) (show delim)
blockToCustom (DefinitionList items) =
- callFunc "DefinitionList" (map (Stringify *** map Stringify) items)
+ callFunc "DefinitionList"
+ (map (KeyValue . (Stringify *** map Stringify)) items)
blockToCustom (Div attr items) =
callFunc "Div" (Stringify items) (attrToMap attr)
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index f25bbadfb..7ff7284cc 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -670,8 +670,7 @@ blockToHtml opts (LineBlock lns) =
if writerWrapText opts == WrapNone
then blockToHtml opts $ linesToPara lns
else do
- let lf = preEscapedString "\n"
- htmlLines <- mconcat . intersperse lf <$> mapM (inlineListToHtml opts) lns
+ htmlLines <- inlineListToHtml opts $ intercalate [LineBreak] lns
return $ H.div ! A.class_ "line-block" $ htmlLines
blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do
html5 <- gets stHtml5
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 666aea07c..d6ccc1512 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -398,10 +398,10 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts)
hasCode _ = []
let fragile = "fragile" `elem` classes ||
not (null $ query hasCodeBlock elts ++ query hasCode elts)
- let frameoptions = ["allowdisplaybreaks", "allowframebreaks",
+ let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile",
"b", "c", "t", "environment",
"label", "plain", "shrink", "standout"]
- let optionslist = ["fragile" | fragile] ++
+ let optionslist = ["fragile" | fragile && lookup "fragile" kvs == Nothing] ++
[k | k <- classes, k `elem` frameoptions] ++
[k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions]
let options = if null optionslist
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 7a3d204f2..13572c466 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -305,22 +305,24 @@ escapeString opts (c:cs) =
_ -> c : escapeString opts cs
-- | Construct table of contents from list of header blocks.
-tableOfContents :: PandocMonad m => WriterOptions -> [Block] -> m Doc
-tableOfContents opts headers =
- let contents = BulletList $ map (elementToListItem opts) $ hierarchicalize headers
- in evalMD (blockToMarkdown opts contents) def def
+tableOfContents :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
+tableOfContents opts headers = do
+ contents <- BulletList <$> mapM (elementToListItem opts) (hierarchicalize headers)
+ blockToMarkdown opts contents
-- | Converts an Element to a list item for a table of contents,
-elementToListItem :: WriterOptions -> Element -> [Block]
+elementToListItem :: PandocMonad m => WriterOptions -> Element -> MD m [Block]
elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs)
- = Plain headerLink :
- [ BulletList (map (elementToListItem opts) subsecs) |
- not (null subsecs) && lev < writerTOCDepth opts ]
- where headerLink = if null ident
+ = do isPlain <- asks envPlain
+ let headerLink = if null ident || isPlain
then walk deNote headerText
else [Link nullAttr (walk deNote headerText)
('#':ident, "")]
-elementToListItem _ (Blk _) = []
+ listContents <- if null subsecs || lev >= writerTOCDepth opts
+ then return []
+ else mapM (elementToListItem opts) subsecs
+ return [Plain headerLink, BulletList listContents]
+elementToListItem _ (Blk _) = return []
attrsToMarkdown :: Attr -> Doc
attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-15 03:34:42 +0000