aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs11
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs63
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs2
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs2
-rw-r--r--src/Text/Pandoc/Writers/Man.hs10
-rw-r--r--src/Text/Pandoc/Writers/Org.hs61
6 files changed, 123 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 9b1c70166..8bb0810e4 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -176,7 +176,11 @@ blockToDocbook opts (Div (ident,_,_) [Para lst]) =
then flush $ nowrap $ inTags False "literallayout" attribs
$ inlinesToDocbook opts lst
else inTags True "para" attribs $ inlinesToDocbook opts lst
-blockToDocbook opts (Div _ bs) = blocksToDocbook opts $ map plainToPara bs
+blockToDocbook opts (Div (ident,_,_) bs) =
+ (if null ident
+ then mempty
+ else selfClosingTag "anchor" [("id", ident)]) $$
+ blocksToDocbook opts (map plainToPara bs)
blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize
blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
-- title beginning with fig: indicates that the image is a figure
@@ -313,7 +317,10 @@ inlineToDocbook opts (Quoted _ lst) =
inTagsSimple "quote" $ inlinesToDocbook opts lst
inlineToDocbook opts (Cite _ lst) =
inlinesToDocbook opts lst
-inlineToDocbook opts (Span _ ils) =
+inlineToDocbook opts (Span (ident,_,_) ils) =
+ (if null ident
+ then mempty
+ else selfClosingTag "anchor" [("id", ident)]) <>
inlinesToDocbook opts ils
inlineToDocbook _ (Code _ str) =
inTagsSimple "literal" $ text (escapeStringForXML str)
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index c3d1351e2..d31928b01 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -60,12 +60,12 @@ import Data.Unique (hashUnique, newUnique)
import System.Random (randomRIO)
import Text.Printf (printf)
import qualified Control.Exception as E
-import Text.Pandoc.Compat.Monoid ((<>))
+import Data.Monoid ((<>))
import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
extensionFromMimeType)
import Control.Applicative ((<|>))
-import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
-import Data.Char (ord)
+import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)
+import Data.Char (ord, isSpace, toLower)
data ListMarker = NoMarker
| BulletMarker
@@ -110,6 +110,8 @@ data WriterState = WriterState{
, stStyleMaps :: StyleMaps
, stFirstPara :: Bool
, stTocTitle :: [Inline]
+ , stDynamicParaProps :: [String]
+ , stDynamicTextProps :: [String]
}
defaultWriterState :: WriterState
@@ -132,6 +134,8 @@ defaultWriterState = WriterState{
, stStyleMaps = defaultStyleMaps
, stFirstPara = False
, stTocTitle = normalizeInlines [Str "Table of Contents"]
+ , stDynamicParaProps = []
+ , stDynamicTextProps = []
}
type WS a = StateT WriterState IO a
@@ -404,7 +408,21 @@ writeDocx opts doc@(Pandoc meta _) = do
linkrels
-- styles
- let newstyles = styleToOpenXml styleMaps $ writerHighlightStyle opts
+
+ -- We only want to inject paragraph and text properties that
+ -- are not already in the style map. Note that keys in the stylemap
+ -- are normalized as lowercase.
+ let newDynamicParaProps = filter
+ (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sParaStyleMap styleMaps)
+ (stDynamicParaProps st)
+
+ newDynamicTextProps = filter
+ (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sCharStyleMap styleMaps)
+ (stDynamicTextProps st)
+
+ let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
+ map newTextPropToOpenXml newDynamicTextProps ++
+ (styleToOpenXml styleMaps $ writerHighlightStyle opts)
let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
where
modifyContent
@@ -499,6 +517,28 @@ writeDocx opts doc@(Pandoc meta _) = do
miscRelEntries ++ otherMediaEntries
return $ fromArchive archive
+
+newParaPropToOpenXml :: String -> Element
+newParaPropToOpenXml s =
+ let styleId = filter (not . isSpace) s
+ in mknode "w:style" [ ("w:type", "paragraph")
+ , ("w:customStyle", "1")
+ , ("w:styleId", styleId)]
+ [ mknode "w:name" [("w:val", s)] ()
+ , mknode "w:basedOn" [("w:val","BodyText")] ()
+ , mknode "w:qFormat" [] ()
+ ]
+
+newTextPropToOpenXml :: String -> Element
+newTextPropToOpenXml s =
+ let styleId = filter (not . isSpace) s
+ in mknode "w:style" [ ("w:type", "character")
+ , ("w:customStyle", "1")
+ , ("w:styleId", styleId)]
+ [ mknode "w:name" [("w:val", s)] ()
+ , mknode "w:basedOn" [("w:val","BodyTextChar")] ()
+ ]
+
styleToOpenXml :: StyleMaps -> Style -> [Element]
styleToOpenXml sm style =
maybeToList parStyle ++ mapMaybe toStyle alltoktypes
@@ -722,9 +762,17 @@ getUniqueId :: MonadIO m => m String
-- already in word/document.xml.rel
getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique
+-- | Key for specifying user-defined docx styles.
+dynamicStyleKey :: String
+dynamicStyleKey = "custom-style"
+
-- | Convert a Pandoc block element to OpenXML.
blockToOpenXML :: WriterOptions -> Block -> WS [Element]
blockToOpenXML _ Null = return []
+blockToOpenXML opts (Div (_,_,kvs) bs)
+ | Just sty <- lookup dynamicStyleKey kvs = do
+ modify $ \s -> s{stDynamicParaProps = sty : (stDynamicParaProps s)}
+ withParaPropM (pStyleM sty) $ blocksToOpenXML opts bs
blockToOpenXML opts (Div (_,["references"],_) bs) = do
let (hs, bs') = span isHeaderBlock bs
header <- blocksToOpenXML opts hs
@@ -981,7 +1029,12 @@ inlineToOpenXML :: WriterOptions -> Inline -> WS [Element]
inlineToOpenXML _ (Str str) = formattedString str
inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ")
inlineToOpenXML opts SoftBreak = inlineToOpenXML opts (Str " ")
-inlineToOpenXML opts (Span (_,classes,kvs) ils)
+inlineToOpenXML opts (Span (ident,classes,kvs) ils)
+ | Just sty <- lookup dynamicStyleKey kvs = do
+ let kvs' = filter ((dynamicStyleKey, sty)/=) kvs
+ modify $ \s -> s{stDynamicTextProps = sty : (stDynamicTextProps s)}
+ withTextProp (rCustomStyle sty) $
+ inlineToOpenXML opts (Span (ident,classes,kvs') ils)
| "insertion" `elem` classes = do
defaultAuthor <- gets stChangesAuthor
defaultDate <- gets stChangesDate
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 433e28bf2..db8c301ef 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to HTML.
-}
module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where
import Text.Pandoc.Definition
-import Text.Pandoc.Compat.Monoid ((<>))
+import Data.Monoid ((<>))
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 29e8c962c..600685427 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -276,6 +276,7 @@ stringToLaTeX ctx (x:xs) = do
'€' -> "\\euro{}" ++ rest
'{' -> "\\{" ++ rest
'}' -> "\\}" ++ rest
+ '`' | ctx == CodeString -> "{`}" ++ rest
'$' | not isUrl -> "\\$" ++ rest
'%' -> "\\%" ++ rest
'&' -> "\\&" ++ rest
@@ -296,6 +297,7 @@ stringToLaTeX ctx (x:xs) = do
']' -> "{]}" ++ rest -- optional arguments
'\'' | ctx == CodeString -> "\\textquotesingle{}" ++ rest
'\160' -> "~" ++ rest
+ '\x202F' -> "\\," ++ rest
'\x2026' -> "\\ldots{}" ++ rest
'\x2018' | ligatures -> "`" ++ rest
'\x2019' | ligatures -> "'" ++ rest
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 5c7d760ac..caf26d515 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -41,7 +41,6 @@ import Data.Maybe (fromMaybe)
import Text.Pandoc.Pretty
import Text.Pandoc.Builder (deleteMeta)
import Control.Monad.State
-import Data.Char ( isDigit )
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes
@@ -62,10 +61,11 @@ pandocToMan opts (Pandoc meta blocks) = do
let title' = render' titleText
let setFieldsFromTitle =
case break (== ' ') title' of
- (cmdName, rest) -> case reverse cmdName of
- (')':d:'(':xs) | isDigit d ->
- defField "title" (reverse xs) .
- defField "section" [d] .
+ (cmdName, rest) -> case break (=='(') cmdName of
+ (xs, '(':ys) | not (null ys) &&
+ last ys == ')' ->
+ defField "title" xs .
+ defField "section" (init ys) .
case splitBy (=='|') rest of
(ft:hds) ->
defField "footer" (trim ft) .
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index e903e9e42..96baacbb6 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -39,8 +39,8 @@ import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Pretty
import Text.Pandoc.Templates (renderTemplate')
-import Data.Char ( toLower )
-import Data.List ( intersect, intersperse, partition, transpose )
+import Data.Char ( isAlphaNum, toLower )
+import Data.List ( isPrefixOf, intersect, intersperse, partition, transpose )
import Control.Monad.State
data WriterState =
@@ -158,10 +158,9 @@ blockToOrg (Plain inlines) = inlineListToOrg inlines
blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
capt <- if null txt
then return empty
- else (\c -> "#+CAPTION: " <> c <> blankline) `fmap`
- inlineListToOrg txt
+ else ("#+CAPTION: " <>) `fmap` inlineListToOrg txt
img <- inlineToOrg (Image attr txt (src,tit))
- return $ capt <> img
+ return $ capt $$ img $$ blankline
blockToOrg (Para inlines) = do
contents <- inlineListToOrg inlines
return $ contents <> blankline
@@ -182,11 +181,7 @@ blockToOrg (Header level attr inlines) = do
blockToOrg (CodeBlock (_,classes,_) str) = do
opts <- stOptions <$> get
let tabstop = writerTabStop opts
- let at = classes `intersect` ["asymptote", "C", "clojure", "css", "ditaa",
- "dot", "emacs-lisp", "gnuplot", "haskell", "js", "latex",
- "ledger", "lisp", "matlab", "mscgen", "ocaml", "octave",
- "oz", "perl", "plantuml", "python", "R", "ruby", "sass",
- "scheme", "screen", "sh", "sql", "sqlite"]
+ let at = map pandocLangToOrg classes `intersect` orgLangIdentifiers
let (beg, end) = case at of
[] -> ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE")
(x:_) -> ("#+BEGIN_SRC " ++ x, "#+END_SRC")
@@ -355,16 +350,56 @@ inlineToOrg (Link _ txt (src, _)) = do
case txt of
[Str x] | escapeURI x == src -> -- autolink
do modify $ \s -> s{ stLinks = True }
- return $ "[[" <> text x <> "]]"
+ return $ "[[" <> text (orgPath x) <> "]]"
_ -> do contents <- inlineListToOrg txt
modify $ \s -> s{ stLinks = True }
- return $ "[[" <> text src <> "][" <> contents <> "]]"
+ return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]"
inlineToOrg (Image _ _ (source, _)) = do
modify $ \s -> s{ stImages = True }
- return $ "[[" <> text source <> "]]"
+ return $ "[[" <> text (orgPath source) <> "]]"
inlineToOrg (Note contents) = do
-- add to notes in state
notes <- get >>= (return . stNotes)
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
return $ " [" <> text ref <> "]"
+
+orgPath :: String -> String
+orgPath src =
+ case src of
+ [] -> mempty -- wiki link
+ ('#':xs) -> xs -- internal link
+ _ | isUrl src -> src
+ _ | isFilePath src -> src
+ _ -> "file:" <> src
+ where
+ isFilePath :: String -> Bool
+ isFilePath cs = any (`isPrefixOf` cs) ["/", "./", "../", "file:"]
+
+ isUrl :: String -> Bool
+ isUrl cs =
+ let (scheme, path) = break (== ':') cs
+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme
+ && not (null path)
+
+-- | Translate from pandoc's programming language identifiers to those used by
+-- org-mode.
+pandocLangToOrg :: String -> String
+pandocLangToOrg cs =
+ case cs of
+ "c" -> "C"
+ "cpp" -> "C++"
+ "commonlisp" -> "lisp"
+ "r" -> "R"
+ "bash" -> "sh"
+ _ -> cs
+
+-- | List of language identifiers recognized by org-mode.
+orgLangIdentifiers :: [String]
+orgLangIdentifiers =
+ [ "asymptote", "awk", "C", "C++", "clojure", "css", "d", "ditaa", "dot"
+ , "calc", "emacs-lisp", "fortran", "gnuplot", "haskell", "java", "js"
+ , "latex", "ledger", "lisp", "lilypond", "matlab", "mscgen", "ocaml"
+ , "octave", "org", "oz", "perl", "plantuml", "processing", "python", "R"
+ , "ruby", "sass", "scheme", "screen", "sed", "sh", "sql", "sqlite"
+ ]
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-16 00:45:30 +0000