aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs45
-rw-r--r--src/Text/Pandoc/Readers/Docx/Lists.hs4
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs4
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs81
-rw-r--r--src/Text/Pandoc/Readers/Org/ExportSettings.hs8
-rw-r--r--src/Text/Pandoc/Readers/Org/Meta.hs181
-rw-r--r--src/Text/Pandoc/Readers/Org/ParserState.hs6
-rw-r--r--tests/Tests/Readers/Docx.hs4
-rw-r--r--tests/Tests/Readers/Org.hs196
-rw-r--r--tests/docx/nested_anchors_in_header.docxbin0 -> 17535 bytes
-rw-r--r--tests/docx/nested_anchors_in_header.native10
12 files changed, 381 insertions, 159 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 1db7ded0b..afe41fb9b 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -401,6 +401,7 @@ Library
Text.Pandoc.Readers.Org.Blocks,
Text.Pandoc.Readers.Org.ExportSettings,
Text.Pandoc.Readers.Org.Inlines,
+ Text.Pandoc.Readers.Org.Meta,
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
Text.Pandoc.Readers.Org.Shared,
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 2bc17c069..b51572783 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE PatternGuards, OverloadedStrings #-}
+{-# LANGUAGE PatternGuards, OverloadedStrings, CPP #-}
{-
-Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
+Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu>
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
@@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Readers.Docx
- Copyright : Copyright (C) 2014 Jesse Rosenthal
+ Copyright : Copyright (C) 2014-2016 Jesse Rosenthal
License : GNU GPL, version 2 or above
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -83,7 +83,7 @@ import Text.Pandoc.Readers.Docx.Lists
import Text.Pandoc.Readers.Docx.Combine
import Text.Pandoc.Shared
import Text.Pandoc.MediaBag (insertMedia, MediaBag)
-import Data.List (delete, (\\), intersect)
+import Data.List (delete, intersect)
import Text.TeXMath (writeTeX)
import Data.Default (Default)
import qualified Data.ByteString.Lazy as B
@@ -93,6 +93,9 @@ import Control.Monad.Reader
import Control.Monad.State
import Data.Sequence (ViewL(..), viewl)
import qualified Data.Sequence as Seq (null)
+#if !(MIN_VERSION_base(4,8,0))
+import Data.Traversable (traverse)
+#endif
import Text.Pandoc.Error
import Text.Pandoc.Compat.Except
@@ -412,39 +415,39 @@ parPartToInlines (PlainOMath exps) = do
return $ math $ writeTeX exps
isAnchorSpan :: Inline -> Bool
-isAnchorSpan (Span (_, classes, kvs) ils) =
+isAnchorSpan (Span (_, classes, kvs) _) =
classes == ["anchor"] &&
- null kvs &&
- null ils
+ null kvs
isAnchorSpan _ = False
dummyAnchors :: [String]
dummyAnchors = ["_GoBack"]
makeHeaderAnchor :: Blocks -> DocxContext Blocks
-makeHeaderAnchor bs = case viewl $ unMany bs of
- (x :< xs) -> do
- x' <- (makeHeaderAnchor' x)
- xs' <- (makeHeaderAnchor $ Many xs)
- return $ (singleton x') <> xs'
- EmptyL -> return mempty
+makeHeaderAnchor bs = traverse makeHeaderAnchor' bs
makeHeaderAnchor' :: Block -> DocxContext Block
-- If there is an anchor already there (an anchor span in the header,
-- to be exact), we rename and associate the new id with the old one.
-makeHeaderAnchor' (Header n (_, classes, kvs) ils)
- | (c:cs) <- filter isAnchorSpan ils
- , (Span (ident, ["anchor"], _) _) <- c = do
+makeHeaderAnchor' (Header n (ident, classes, kvs) ils)
+ | (c:_) <- filter isAnchorSpan ils
+ , (Span (anchIdent, ["anchor"], _) cIls) <- c = do
hdrIDMap <- gets docxAnchorMap
- let newIdent = uniqueIdent ils (Set.fromList $ M.elems hdrIDMap)
- modify $ \s -> s {docxAnchorMap = M.insert ident newIdent hdrIDMap}
- return $ Header n (newIdent, classes, kvs) (ils \\ (c:cs))
+ let newIdent = if null ident
+ then uniqueIdent ils (Set.fromList $ M.elems hdrIDMap)
+ else ident
+ newIls = concatMap f ils where f il | il == c = cIls
+ | otherwise = [il]
+ modify $ \s -> s {docxAnchorMap = M.insert anchIdent newIdent hdrIDMap}
+ makeHeaderAnchor' $ Header n (newIdent, classes, kvs) newIls
-- Otherwise we just give it a name, and register that name (associate
-- it with itself.)
-makeHeaderAnchor' (Header n (_, classes, kvs) ils) =
+makeHeaderAnchor' (Header n (ident, classes, kvs) ils) =
do
hdrIDMap <- gets docxAnchorMap
- let newIdent = uniqueIdent ils (Set.fromList $ M.elems hdrIDMap)
+ let newIdent = if null ident
+ then uniqueIdent ils (Set.fromList $ M.elems hdrIDMap)
+ else ident
modify $ \s -> s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap}
return $ Header n (newIdent, classes, kvs) ils
makeHeaderAnchor' blk = return blk
diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs
index c265ad074..395a53907 100644
--- a/src/Text/Pandoc/Readers/Docx/Lists.hs
+++ b/src/Text/Pandoc/Readers/Docx/Lists.hs
@@ -1,5 +1,5 @@
{-
-Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
+Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu>
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
@@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Readers.Docx.Lists
- Copyright : Copyright (C) 2014 Jesse Rosenthal
+ Copyright : Copyright (C) 2014-2016 Jesse Rosenthal
License : GNU GPL, version 2 or above
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 9ae7f22ec..3efdb70a8 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE PatternGuards, ViewPatterns, FlexibleInstances #-}
{-
-Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
+Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu>
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
@@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Readers.Docx.Parse
- Copyright : Copyright (C) 2014 Jesse Rosenthal
+ Copyright : Copyright (C) 2014-2016 Jesse Rosenthal
License : GNU GPL, version 2 or above
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 6a8bb8b28..f5873d55f 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -34,8 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks
) where
import Text.Pandoc.Readers.Org.BlockStarts
-import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
import Text.Pandoc.Readers.Org.Inlines
+import Text.Pandoc.Readers.Org.Meta ( metaExport, metaLine )
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
import Text.Pandoc.Readers.Org.Shared
@@ -52,9 +52,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )
import Control.Monad ( foldM, guard, mzero, void )
import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
-import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isNothing )
-import Network.HTTP ( urlEncode )
--
-- Org headers
@@ -82,6 +80,10 @@ newtype PropertyValue = PropertyValue { fromValue :: String }
toPropertyValue :: String -> PropertyValue
toPropertyValue = PropertyValue
+-- | Check whether the property value is non-nil (i.e. truish).
+isNonNil :: PropertyValue -> Bool
+isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"]
+
-- | Key/value pairs from a PROPERTIES drawer
type Properties = [(PropertyKey, PropertyValue)]
@@ -202,12 +204,16 @@ propertiesToAttr properties =
toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
customIdKey = toPropertyKey "custom_id"
classKey = toPropertyKey "class"
+ unnumberedKey = toPropertyKey "unnumbered"
+ specialProperties = [customIdKey, classKey, unnumberedKey]
id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties
- kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst)
+ kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
$ properties
+ isUnnumbered =
+ fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
in
- (id', words cls, kvs')
+ (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
tagTitle :: Inlines -> [Tag] -> Inlines
tagTitle title tags = title <> (mconcat $ map tagToInline tags)
@@ -232,8 +238,8 @@ blockList = do
-- | Get the meta information safed in the state.
meta :: OrgParser Meta
meta = do
- st <- getState
- return $ runF (orgStateMeta st) st
+ meta' <- metaExport
+ runF meta' <$> getState
blocks :: OrgParser (F Blocks)
blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof)
@@ -631,67 +637,9 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
specialLine :: OrgParser (F Blocks)
specialLine = fmap return . try $ metaLine <|> commentLine
--- The order, in which blocks are tried, makes sure that we're not looking at
--- the beginning of a block, so we don't need to check for it
-metaLine :: OrgParser Blocks
-metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
-
commentLine :: OrgParser Blocks
commentLine = commentLineStart *> anyLine *> pure mempty
-declarationLine :: OrgParser ()
-declarationLine = try $ do
- key <- metaKey
- value <- metaInlines
- updateState $ \st ->
- let meta' = B.setMeta key <$> value <*> pure nullMeta
- in st { orgStateMeta = orgStateMeta st <> meta' }
-
-metaInlines :: OrgParser (F MetaValue)
-metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
-
-metaKey :: OrgParser String
-metaKey = map toLower <$> many1 (noneOf ": \n\r")
- <* char ':'
- <* skipSpaces
-
-optionLine :: OrgParser ()
-optionLine = try $ do
- key <- metaKey
- case key of
- "link" -> parseLinkFormat >>= uncurry addLinkFormat
- "options" -> exportSettings
- _ -> mzero
-
-addLinkFormat :: String
- -> (String -> String)
- -> OrgParser ()
-addLinkFormat key formatter = updateState $ \s ->
- let fs = orgStateLinkFormatters s
- in s{ orgStateLinkFormatters = M.insert key formatter fs }
-
-parseLinkFormat :: OrgParser ((String, String -> String))
-parseLinkFormat = try $ do
- linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
- linkSubst <- parseFormat
- return (linkType, linkSubst)
-
--- | An ad-hoc, single-argument-only implementation of a printf-style format
--- parser.
-parseFormat :: OrgParser (String -> String)
-parseFormat = try $ do
- replacePlain <|> replaceUrl <|> justAppend
- where
- -- inefficient, but who cares
- replacePlain = try $ (\x -> concat . flip intersperse x)
- <$> sequence [tillSpecifier 's', rest]
- replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
- <$> sequence [tillSpecifier 'h', rest]
- justAppend = try $ (++) <$> rest
-
- rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
- tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
-
--
-- Tables
@@ -868,9 +816,6 @@ paraOrPlain = try $ do
*> return (B.para <$> ils))
<|> (return (B.plain <$> ils))
-inlinesTillNewline :: OrgParser (F Inlines)
-inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
-
--
-- list blocks
diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
index b48acc9c4..283cfa998 100644
--- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs
+++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
@@ -54,13 +54,15 @@ exportSetting = choice
, ignoredSetting "<"
, ignoredSetting "\\n"
, archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val })
- , ignoredSetting "author"
+ , booleanSetting "author" (\val es -> es { exportWithAuthor = val })
, ignoredSetting "c"
- , ignoredSetting "creator"
+ -- org-mode allows the special value `comment` for creator, which we'll
+ -- interpret as true as it doesn't make sense in the context of Pandoc.
+ , booleanSetting "creator" (\val es -> es { exportWithCreator = val })
, complementableListSetting "d" (\val es -> es { exportDrawers = val })
, ignoredSetting "date"
, ignoredSetting "e"
- , ignoredSetting "email"
+ , booleanSetting "email" (\val es -> es { exportWithEmail = val })
, ignoredSetting "f"
, integerSetting "H" (\val es -> es { exportHeadlineLevels = val })
, ignoredSetting "inline"
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
new file mode 100644
index 000000000..11eb18e36
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TupleSections #-}
+{-
+Copyright (C) 2014-2016 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.Readers.Org.Meta
+ Copyright : Copyright (C) 2014-2016 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Parsers for Org-mode meta declarations.
+-}
+module Text.Pandoc.Readers.Org.Meta
+ ( metaLine
+ , metaExport
+ ) where
+
+import Text.Pandoc.Readers.Org.BlockStarts
+import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
+import Text.Pandoc.Readers.Org.Inlines
+import Text.Pandoc.Readers.Org.ParserState
+import Text.Pandoc.Readers.Org.Parsing
+
+import qualified Text.Pandoc.Builder as B
+import Text.Pandoc.Builder ( Blocks, Inlines )
+import Text.Pandoc.Definition
+import Text.Pandoc.Compat.Monoid ((<>))
+
+import Control.Monad ( mzero )
+import Data.Char ( toLower )
+import Data.List ( intersperse )
+import qualified Data.Map as M
+import Network.HTTP ( urlEncode )
+
+-- | Returns the current meta, respecting export options.
+metaExport :: OrgParser (F Meta)
+metaExport = do
+ st <- getState
+ let settings = orgStateExportSettings st
+ return $ (if exportWithAuthor settings then id else removeMeta "author")
+ . (if exportWithCreator settings then id else removeMeta "creator")
+ . (if exportWithEmail settings then id else removeMeta "email")
+ <$> orgStateMeta st
+
+removeMeta :: String -> Meta -> Meta
+removeMeta key meta' =
+ let metaMap = unMeta meta'
+ in Meta $ M.delete key metaMap
+
+-- | Parse and handle a single line containing meta information
+-- The order, in which blocks are tried, makes sure that we're not looking at
+-- the beginning of a block, so we don't need to check for it
+metaLine :: OrgParser Blocks
+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
+
+declarationLine :: OrgParser ()
+declarationLine = try $ do
+ key <- map toLower <$> metaKey
+ (key', value) <- metaValue key
+ updateState $ \st ->
+ let meta' = B.setMeta key' <$> value <*> pure nullMeta
+ in st { orgStateMeta = meta' <> orgStateMeta st }
+
+metaKey :: OrgParser String
+metaKey = map toLower <$> many1 (noneOf ": \n\r")
+ <* char ':'
+ <* skipSpaces
+
+metaValue :: String -> OrgParser (String, (F MetaValue))
+metaValue key =
+ let inclKey = "header-includes"
+ in case key of
+ "author" -> (key,) <$> metaInlinesCommaSeparated
+ "title" -> (key,) <$> metaInlines
+ "date" -> (key,) <$> metaInlines
+ "header-includes" -> (key,) <$> accumulatingList key metaInlines
+ "latex_header" -> (inclKey,) <$>
+ accumulatingList inclKey (metaExportSnippet "latex")
+ "latex_class" -> ("documentclass",) <$> metaString
+ -- Org-mode expects class options to contain the surrounding brackets,
+ -- pandoc does not.
+ "latex_class_options" -> ("classoption",) <$>
+ metaModifiedString (filter (`notElem` "[]"))
+ "html_head" -> (inclKey,) <$>
+ accumulatingList inclKey (metaExportSnippet "html")
+ _ -> (key,) <$> metaString
+
+metaInlines :: OrgParser (F MetaValue)
+metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
+
+metaInlinesCommaSeparated :: OrgParser (F MetaValue)
+metaInlinesCommaSeparated = do
+ authStrs <- (many1 (noneOf ",\n")) `sepBy1` (char ',')
+ newline
+ authors <- mapM (parseFromString inlinesTillNewline . (++ "\n")) authStrs
+ let toMetaInlines = MetaInlines . B.toList
+ return $ MetaList . map toMetaInlines <$> sequence authors
+
+metaString :: OrgParser (F MetaValue)
+metaString = metaModifiedString id
+
+metaModifiedString :: (String -> String) -> OrgParser (F MetaValue)
+metaModifiedString f = return . MetaString . f <$> anyLine
+
+-- | Read an format specific meta definition
+metaExportSnippet :: String -> OrgParser (F MetaValue)
+metaExportSnippet format =
+ return . MetaInlines . B.toList . B.rawInline format <$> anyLine
+
+-- | Accumulate the result of the @parser@ in a list under @key@.
+accumulatingList :: String
+ -> OrgParser (F MetaValue)
+ -> OrgParser (F MetaValue)
+accumulatingList key p = do
+ value <- p
+ meta' <- orgStateMeta <$> getState
+ return $ (\m v -> MetaList (curList m ++ [v])) <$> meta' <*> value
+ where curList m = case lookupMeta key m of
+ Just (MetaList ms) -> ms
+ Just x -> [x]
+ _ -> []
+
+--
+-- export options
+--
+optionLine :: OrgParser ()
+optionLine = try $ do
+ key <- metaKey
+ case key of
+ "link" -> parseLinkFormat >>= uncurry addLinkFormat
+ "options" -> exportSettings
+ _ -> mzero
+
+addLinkFormat :: String
+ -> (String -> String)
+ -> OrgParser ()
+addLinkFormat key formatter = updateState $ \s ->
+ let fs = orgStateLinkFormatters s
+ in s{ orgStateLinkFormatters = M.insert key formatter fs }
+
+parseLinkFormat :: OrgParser ((String, String -> String))
+parseLinkFormat = try $ do
+ linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
+ linkSubst <- parseFormat
+ return (linkType, linkSubst)
+
+-- | An ad-hoc, single-argument-only implementation of a printf-style format
+-- parser.
+parseFormat :: OrgParser (String -> String)
+parseFormat = try $ do
+ replacePlain <|> replaceUrl <|> justAppend
+ where
+ -- inefficient, but who cares
+ replacePlain = try $ (\x -> concat . flip intersperse x)
+ <$> sequence [tillSpecifier 's', rest]
+ replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
+ <$> sequence [tillSpecifier 'h', rest]
+ justAppend = try $ (++) <$> rest
+
+ rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
+ tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
+
+inlinesTillNewline :: OrgParser (F Inlines)
+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 48e7717cd..84dbe9d33 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -163,6 +163,9 @@ data ExportSettings = ExportSettings
, exportSmartQuotes :: Bool -- ^ Parse quotes smartly
, exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly
, exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
+ , exportWithAuthor :: Bool -- ^ Include author in final meta-data
+ , exportWithCreator :: Bool -- ^ Include creator in final meta-data
+ , exportWithEmail :: Bool -- ^ Include email in final meta-data
}
instance Default ExportSettings where
@@ -177,6 +180,9 @@ defaultExportSettings = ExportSettings
, exportSmartQuotes = True
, exportSpecialStrings = True
, exportSubSuperscripts = True
+ , exportWithAuthor = True
+ , exportWithCreator = True
+ , exportWithEmail = True
}
diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs
index a9a9094f1..8ae0532e4 100644
--- a/tests/Tests/Readers/Docx.hs
+++ b/tests/Tests/Readers/Docx.hs
@@ -182,6 +182,10 @@ tests = [ testGroup "inlines"
"docx/already_auto_ident.docx"
"docx/already_auto_ident.native"
, testCompare
+ "nested anchor spans in header"
+ "docx/nested_anchors_in_header.docx"
+ "docx/nested_anchors_in_header.native"
+ , testCompare
"single numbered item not made into list"
"docx/numbered_header.docx"
"docx/numbered_header.native"
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 0a3f9c222..d4fedc797 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -467,7 +467,14 @@ tests =
, "Author" =:
"#+author: Albert /Emacs-Fanboy/ Krewinkel" =?>
let author = toList . spcSep $ [ "Albert", emph "Emacs-Fanboy", "Krewinkel" ]
- meta = setMeta "author" (MetaInlines author) $ nullMeta
+ meta = setMeta "author" (MetaList [MetaInlines author]) $ nullMeta
+ in Pandoc meta mempty
+
+ , "Multiple authors" =:
+ "#+author: James Dewey Watson, Francis Harry Compton Crick " =?>
+ let watson = MetaInlines $ toList "James Dewey Watson"
+ crick = MetaInlines $ toList "Francis Harry Compton Crick"
+ meta = setMeta "author" (MetaList [watson, crick]) $ nullMeta
in Pandoc meta mempty
, "Date" =:
@@ -478,8 +485,8 @@ tests =
, "Description" =:
"#+DESCRIPTION: Explanatory text" =?>
- let description = toList . spcSep $ [ "Explanatory", "text" ]
- meta = setMeta "description" (MetaInlines description) $ nullMeta
+ let description = "Explanatory text"
+ meta = setMeta "description" (MetaString description) $ nullMeta
in Pandoc meta mempty
, "Properties drawer" =:
@@ -489,6 +496,38 @@ tests =
] =?>
(mempty::Blocks)
+ , "LaTeX_headers options are translated to header-includes" =:
+ "#+LaTeX_header: \\usepackage{tikz}" =?>
+ let latexInlines = rawInline "latex" "\\usepackage{tikz}"
+ inclList = MetaList [MetaInlines (toList latexInlines)]
+ meta = setMeta "header-includes" inclList nullMeta
+ in Pandoc meta mempty
+
+ , "LaTeX_class option is translated to documentclass" =:
+ "#+LATEX_CLASS: article" =?>
+ let meta = setMeta "documentclass" (MetaString "article") nullMeta
+ in Pandoc meta mempty
+
+ , "LaTeX_class_options is translated to classoption" =:
+ "#+LATEX_CLASS_OPTIONS: [a4paper]" =?>
+ let meta = setMeta "classoption" (MetaString "a4paper") nullMeta
+ in Pandoc meta mempty
+
+ , "LaTeX_class_options is translated to classoption" =:
+ "#+html_head: <meta/>" =?>
+ let html = rawInline "html" "<meta/>"
+ inclList = MetaList [MetaInlines (toList html)]
+ meta = setMeta "header-includes" inclList nullMeta
+ in Pandoc meta mempty
+
+ , "later meta definitions take precedence" =:
+ unlines [ "#+AUTHOR: this will not be used"
+ , "#+author: Max"
+ ] =?>
+ let author = MetaInlines [Str "Max"]
+ meta = setMeta "author" (MetaList [author]) $ nullMeta
+ in Pandoc meta mempty
+
, "Logbook drawer" =:
unlines [ " :LogBook:"
, " - State \"DONE\" from \"TODO\" [2014-03-03 Mon 11:00]"
@@ -563,69 +602,91 @@ tests =
] =?>
(para (link "http://example.com/foo" "" "bar"))
- , "Export option: Disable simple sub/superscript syntax" =:
- unlines [ "#+OPTIONS: ^:nil"
- , "a^b"
- ] =?>
- para "a^b"
- , "Export option: directly select drawers to be exported" =:
- unlines [ "#+OPTIONS: d:(\"IMPORTANT\")"
- , ":IMPORTANT:"
- , "23"
- , ":END:"
- , ":BORING:"
- , "very boring"
- , ":END:"
- ] =?>
- divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23")
-
- , "Export option: exclude drawers from being exported" =:
- unlines [ "#+OPTIONS: d:(not \"BORING\")"
- , ":IMPORTANT:"
- , "5"
- , ":END:"
- , ":BORING:"
- , "very boring"
- , ":END:"
- ] =?>
- divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")
-
- , "Export option: don't include archive trees" =:
- unlines [ "#+OPTIONS: arch:nil"
- , "* old :ARCHIVE:"
- ] =?>
- (mempty ::Blocks)
+ , testGroup "export options"
+
+ [ "disable simple sub/superscript syntax" =:
+ unlines [ "#+OPTIONS: ^:nil"
+ , "a^b"
+ ] =?>
+ para "a^b"
+
+ , "directly select drawers to be exported" =:
+ unlines [ "#+OPTIONS: d:(\"IMPORTANT\")"
+ , ":IMPORTANT:"
+ , "23"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23")
+
+ , "exclude drawers from being exported" =:
+ unlines [ "#+OPTIONS: d:(not \"BORING\")"
+ , ":IMPORTANT:"
+ , "5"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")
+
+ , "don't include archive trees" =:
+ unlines [ "#+OPTIONS: arch:nil"
+ , "* old :ARCHIVE:"
+ ] =?>
+ (mempty ::Blocks)
+
+ , "include complete archive trees" =:
+ unlines [ "#+OPTIONS: arch:t"
+ , "* old :ARCHIVE:"
+ , " boring"
+ ] =?>
+ let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
+ in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
+ , para "boring"
+ ]
- , "Export option: include complete archive trees" =:
- unlines [ "#+OPTIONS: arch:t"
- , "* old :ARCHIVE:"
- , " boring"
- ] =?>
- let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
- in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
- , para "boring"
- ]
+ , "include archive tree header only" =:
+ unlines [ "#+OPTIONS: arch:headline"
+ , "* old :ARCHIVE:"
+ , " boring"
+ ] =?>
+ let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
+ in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
+
+ , "limit headline depth" =:
+ unlines [ "#+OPTIONS: H:2"
+ , "* section"
+ , "** subsection"
+ , "*** list item 1"
+ , "*** list item 2"
+ ] =?>
+ mconcat [ headerWith ("section", [], []) 1 "section"
+ , headerWith ("subsection", [], []) 2 "subsection"
+ , orderedList [ para "list item 1", para "list item 2" ]
+ ]
- , "Export option: include archive tree header only" =:
- unlines [ "#+OPTIONS: arch:headline"
- , "* old :ARCHIVE:"
- , " boring"
- ] =?>
- let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
- in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
-
- , "Export option: limit headline depth" =:
- unlines [ "#+OPTIONS: H:2"
- , "* section"
- , "** subsection"
- , "*** list item 1"
- , "*** list item 2"
- ] =?>
- mconcat [ headerWith ("section", [], []) 1 "section"
- , headerWith ("subsection", [], []) 2 "subsection"
- , orderedList [ para "list item 1", para "list item 2" ]
- ]
+ , "disable author export" =:
+ unlines [ "#+OPTIONS: author:nil"
+ , "#+AUTHOR: ShyGuy"
+ ] =?>
+ Pandoc nullMeta mempty
+
+ , "disable creator export" =:
+ unlines [ "#+OPTIONS: creator:nil"
+ , "#+creator: The Architect"
+ ] =?>
+ Pandoc nullMeta mempty
+
+ , "disable email export" =:
+ unlines [ "#+OPTIONS: email:nil"
+ , "#+email: no-mail-please@example.com"
+ ] =?>
+ Pandoc nullMeta mempty
+ ]
]
, testGroup "Basic Blocks" $
@@ -757,6 +818,15 @@ tests =
] =?>
headerWith ("fubar", [], [("bar", "baz")]) 1 "foo"
+
+ , "Headers marked with a unnumbered property get a class of the same name" =:
+ unlines [ "* Not numbered"
+ , " :PROPERTIES:"
+ , " :UNNUMBERED: t"
+ , " :END:"
+ ] =?>
+ headerWith ("not-numbered", ["unnumbered"], []) 1 "Not numbered"
+
, "Paragraph starting with an asterisk" =:
"*five" =?>
para "*five"
diff --git a/tests/docx/nested_anchors_in_header.docx b/tests/docx/nested_anchors_in_header.docx
new file mode 100644
index 000000000..ddebb7ff4
--- /dev/null
+++ b/tests/docx/nested_anchors_in_header.docx
Binary files differ
diff --git a/tests/docx/nested_anchors_in_header.native b/tests/docx/nested_anchors_in_header.native
new file mode 100644
index 000000000..e2b6eb1ef
--- /dev/null
+++ b/tests/docx/nested_anchors_in_header.native
@@ -0,0 +1,10 @@
+[Header 1 ("short-instructions",[],[]) [Str "Short",Space,Str "instructions"]
+,Para [Link ("",[],[]) [Str "Open",Space,Str "remote",Space,Str "folder"] ("#remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-opening","")]
+,Para [Str "Do",Space,Str "staff"]
+,Para [Link ("",[],[]) [Str "Close",Space,Str "remote",Space,Str "folder"] ("#remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-closing","")]
+,Header 1 ("some-instructions",[],[]) [Str "Some",Space,Str "instructions"]
+,Para [Str "Lines"]
+,Header 2 ("remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-opening",[],[]) [Str "Remote",Space,Str "folder",Space,Str "or",Space,Str "longlonglonglonglong",Space,Str "file",Space,Str "with",Space,Str "manymanymanymany",Space,Str "letters",Space,Str "inside",Space,Str "opening"]
+,Para [Str "Open",Space,Str "folder"]
+,Header 2 ("remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-closing",[],[]) [Str "Remote",Space,Str "folder",Space,Str "or",Space,Str "longlonglonglonglong",Space,Str "file",Space,Str "with",Space,Str "manymanymanymany",Space,Str "letters",Space,Str "inside",Space,Str "closing"]
+,Para [Str "Close",Space,Str "folder"]]
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-13 14:09:35 +0000