diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
26 files changed, 885 insertions, 423 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index c3406f31f..4ac6aa093 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -46,6 +46,7 @@ import Text.Pandoc.Parsing hiding (blankline, space) import Data.Maybe (fromMaybe) import Data.List ( stripPrefix, intersperse, intercalate ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Control.Monad.State import qualified Data.Map as M import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) @@ -72,7 +73,7 @@ pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String pandocToAsciiDoc opts (Pandoc meta blocks) = do let titleblock = not $ null (docTitle meta) && null (docAuthors meta) && null (docDate meta) - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing metadata <- metaToJSON opts @@ -126,8 +127,8 @@ blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do - blockToAsciiDoc opts (Para [Image alt (src,tit)]) +blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do + blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines -- escape if para starts with ordered list marker @@ -159,13 +160,12 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do _ -> empty) <> blankline else identifier $$ text (replicate level '=') <> space <> contents <> blankline) -blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ - flush (attrs <> dashes <> space <> attrs <> cr <> text str <> - cr <> dashes) <> blankline - where dashes = text $ replicate (maximum $ map length $ lines str) '-' - attrs = if null classes - then empty - else text $ intercalate "," $ "code" : classes +blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ (flush $ + if null classes + then "...." $$ text str $$ "...." + else attrs $$ "----" $$ text str $$ "----") + <> blankline + where attrs = "[" <> text (intercalate "," ("source" : classes)) <> "]" blockToAsciiDoc opts (BlockQuote blocks) = do contents <- blockListToAsciiDoc opts blocks let isBlock (BlockQuote _) = True @@ -227,7 +227,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do rows' <- mapM makeRow rows head' <- makeRow headers let head'' = if all null headers then empty else head' - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then writerColumns opts else 100000 let maxwidth = maximum $ map offset (head':rows') @@ -253,7 +253,10 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline -blockToAsciiDoc opts (Div _ bs) = blockListToAsciiDoc opts bs +blockToAsciiDoc opts (Div (ident,_,_) bs) = do + let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + contents <- blockListToAsciiDoc opts bs + return $ identifier $$ contents -- | Convert bullet list item (list of blocks) to asciidoc. bulletListItemToAsciiDoc :: WriterOptions -> [Block] -> State WriterState Doc @@ -335,7 +338,7 @@ inlineListToAsciiDoc opts lst = do x' <- withIntraword $ inlineToAsciiDoc opts x xs' <- go xs return (y' <> x' <> xs') - | x /= Space && x /= LineBreak = do + | not (isSpacy x) = do y' <- withIntraword $ inlineToAsciiDoc opts y xs' <- go (x:xs) return (y' <> xs') @@ -345,6 +348,7 @@ inlineListToAsciiDoc opts lst = do return (x' <> xs') isSpacy Space = True isSpacy LineBreak = True + isSpacy SoftBreak = True isSpacy _ = False setIntraword :: Bool -> State WriterState () @@ -391,8 +395,13 @@ inlineToAsciiDoc _ (RawInline f s) | otherwise = return empty inlineToAsciiDoc _ (LineBreak) = return $ " +" <> cr inlineToAsciiDoc _ Space = return space +inlineToAsciiDoc opts SoftBreak = + case writerWrapText opts of + WrapAuto -> return space + WrapPreserve -> return cr + WrapNone -> return space inlineToAsciiDoc opts (Cite _ lst) = inlineListToAsciiDoc opts lst -inlineToAsciiDoc opts (Link txt (src, _tit)) = do +inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do -- relative: link:downloads/foo.zip[download foo.zip] -- abs: http://google.cod[Google] -- or my@email.com[email john] @@ -408,7 +417,7 @@ inlineToAsciiDoc opts (Link txt (src, _tit)) = do return $ if useAuto then text srcSuffix else prefix <> text src <> "[" <> linktext <> "]" -inlineToAsciiDoc opts (Image alternate (src, tit)) = do +inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do -- image:images/logo.png[Company logo, title="blah"] let txt = if (null alternate) || (alternate == [Str ""]) then [Str "image"] @@ -416,8 +425,19 @@ inlineToAsciiDoc opts (Image alternate (src, tit)) = do linktext <- inlineListToAsciiDoc opts txt let linktitle = if null tit then empty - else text $ ",title=\"" ++ tit ++ "\"" - return $ "image:" <> text src <> "[" <> linktext <> linktitle <> "]" + else ",title=\"" <> text tit <> "\"" + showDim dir = case (dimension dir attr) of + Just (Percent a) -> + ["scaledwidth=" <> text (show (Percent a))] + Just dim -> + [text (show dir) <> "=" <> text (showInPixel opts dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else "," <> cat (intersperse "," dimList) + return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]" inlineToAsciiDoc opts (Note [Para inlines]) = inlineToAsciiDoc opts (Note [Plain inlines]) inlineToAsciiDoc opts (Note [Plain inlines]) = do @@ -425,4 +445,8 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do return $ text "footnote:[" <> contents <> "]" -- asciidoc can't handle blank lines in notes inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" -inlineToAsciiDoc opts (Span _ ils) = inlineListToAsciiDoc opts ils +inlineToAsciiDoc opts (Span (ident,_,_) ils) = do + let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + contents <- inlineListToAsciiDoc opts ils + return $ identifier <> contents + diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index fee36d454..a786dfd24 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -75,7 +75,7 @@ blocksToCommonMark opts bs = return $ T.unpack $ nodeToCommonmark cmarkOpts colwidth $ node DOCUMENT (blocksToNodes bs) where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts] - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -84,7 +84,7 @@ inlinesToCommonMark opts ils = return $ T.unpack $ nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils) where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts] - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -138,6 +138,7 @@ inlineToNodes :: Inline -> [Node] -> [Node] inlineToNodes (Str s) = (node (TEXT (T.pack s)) [] :) inlineToNodes Space = (node (TEXT (T.pack " ")) [] :) inlineToNodes LineBreak = (node LINEBREAK [] :) +inlineToNodes SoftBreak = (node SOFTBREAK [] :) inlineToNodes (Emph xs) = (node EMPH (inlinesToNodes xs) :) inlineToNodes (Strong xs) = (node STRONG (inlinesToNodes xs) :) inlineToNodes (Strikeout xs) = @@ -153,9 +154,9 @@ inlineToNodes (SmallCaps xs) = ((node (INLINE_HTML (T.pack "<span style=\"font-variant:small-caps;\">")) [] : inlinesToNodes xs ++ [node (INLINE_HTML (T.pack "</span>")) []]) ++ ) -inlineToNodes (Link ils (url,tit)) = +inlineToNodes (Link _ ils (url,tit)) = (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) -inlineToNodes (Image ils (url,tit)) = +inlineToNodes (Image _ ils (url,tit)) = (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) inlineToNodes (RawInline fmt xs) | fmt == Format "html" = (node (INLINE_HTML (T.pack xs)) [] :) diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 7d3830a60..6680e3003 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -35,10 +35,11 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Options import Text.Pandoc.Walk (query) import Text.Printf ( printf ) -import Data.List ( intercalate ) +import Data.List ( intercalate, intersperse ) import Data.Char ( ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Network.URI ( isURI, unEscapeString ) @@ -62,7 +63,7 @@ writeConTeXt options document = pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc meta blocks) = do - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -141,10 +142,14 @@ blockToConTeXt :: Block blockToConTeXt Null = return empty blockToConTeXt (Plain lst) = inlineListToConTeXt lst -- title beginning with fig: indicates that the image is a figure -blockToConTeXt (Para [Image txt (src,'f':'i':'g':':':_)]) = do +blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do capt <- inlineListToConTeXt txt - return $ blankline $$ "\\placefigure" <> braces capt <> - braces ("\\externalfigure" <> brackets (text src)) <> blankline + img <- inlineToConTeXt (Image attr txt (src, "")) + let (ident, _, _) = attr + label = if null ident + then empty + else "[]" <> brackets (text $ toLabel ident) + return $ blankline $$ "\\placefigure" <> label <> braces capt <> img <> blankline blockToConTeXt (Para lst) = do contents <- inlineListToConTeXt lst return $ contents <> blankline @@ -157,17 +162,21 @@ blockToConTeXt (CodeBlock _ str) = blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline blockToConTeXt (RawBlock _ _ ) = return empty blockToConTeXt (Div (ident,_,kvs) bs) = do - contents <- blockListToConTeXt bs - let contents' = if null ident - then contents - else ("\\reference" <> brackets (text $ toLabel ident) <> - braces empty <> "%") $$ contents - let align dir = blankline <> "\\startalignment[" <> dir <> "]" - $$ contents' $$ "\\stopalignment" <> blankline - return $ case lookup "dir" kvs of - Just "rtl" -> align "righttoleft" - Just "ltr" -> align "lefttoright" - _ -> contents' + let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" + let wrapRef txt = if null ident + then txt + else ("\\reference" <> brackets (text $ toLabel ident) <> + braces empty <> "%") $$ txt + wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "righttoleft" + Just "ltr" -> align "lefttoright" + _ -> id + wrapLang txt = case lookup "lang" kvs of + Just lng -> "\\start\\language[" + <> text (fromBcp47' lng) <> "]" $$ txt $$ "\\stop" + Nothing -> txt + wrapBlank txt = blankline <> txt <> blankline + fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ ("\\startitemize" <> if isTightList lst @@ -306,9 +315,15 @@ inlineToConTeXt (RawInline "context" str) = return $ text str inlineToConTeXt (RawInline "tex" str) = return $ text str inlineToConTeXt (RawInline _ _) = return empty inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr +inlineToConTeXt SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + return $ case wrapText of + WrapAuto -> space + WrapNone -> space + WrapPreserve -> cr inlineToConTeXt Space = return space -- Handle HTML-like internal document references to sections -inlineToConTeXt (Link txt (('#' : ref), _)) = do +inlineToConTeXt (Link _ txt (('#' : ref), _)) = do opts <- gets stOptions contents <- inlineListToConTeXt txt let ref' = toLabel $ stringToConTeXt opts ref @@ -316,7 +331,7 @@ inlineToConTeXt (Link txt (('#' : ref), _)) = do <> braces contents <> brackets (text ref') -inlineToConTeXt (Link txt (src, _)) = do +inlineToConTeXt (Link _ txt (src, _)) = do let isAutolink = txt == [Str (unEscapeString src)] st <- get let next = stNextRef st @@ -331,11 +346,29 @@ inlineToConTeXt (Link txt (src, _)) = do else brackets empty <> brackets contents) <> "\\from" <> brackets (text ref) -inlineToConTeXt (Image _ (src, _)) = do - let src' = if isURI src +inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + clas = if null cls + then empty + else brackets $ text $ toLabel $ head cls + src' = if isURI src then src else unEscapeString src - return $ braces $ "\\externalfigure" <> brackets (text src') + return $ braces $ "\\externalfigure" <> brackets (text src') <> dims <> clas inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents let codeBlock x@(CodeBlock _ _) = [x] @@ -346,11 +379,15 @@ inlineToConTeXt (Note contents) = do else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" inlineToConTeXt (Span (_,_,kvs) ils) = do - contents <- inlineListToConTeXt ils - return $ case lookup "dir" kvs of - Just "rtl" -> braces $ "\\righttoleft " <> contents - Just "ltr" -> braces $ "\\lefttoright " <> contents - _ -> contents + let wrapDir txt = case lookup "dir" kvs of + Just "rtl" -> braces $ "\\righttoleft " <> txt + Just "ltr" -> braces $ "\\lefttoright " <> txt + _ -> txt + wrapLang txt = case lookup "lang" kvs of + Just lng -> "\\start\\language[" <> text (fromBcp47' lng) + <> "]" <> txt <> "\\stop " + Nothing -> txt + fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: Attr @@ -377,6 +414,9 @@ sectionHeader (ident,classes,_) hdrLevel lst = do then char '\\' <> chapter <> braces contents else contents <> blankline +fromBcp47' :: String -> String +fromBcp47' = fromBcp47 . splitBy (=='-') + -- Takes a list of the constituents of a BCP 47 language code -- and irons out ConTeXt's exceptions -- https://tools.ietf.org/html/bcp47#section-2.1 diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 8b7dde3e5..9671fc05b 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -222,7 +222,7 @@ blockToCustom _ Null = return "" blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines -blockToCustom lua (Para [Image txt (src,tit)]) = +blockToCustom lua (Para [Image _ txt (src,tit)]) = callfunc lua "CaptionedImage" src tit txt blockToCustom lua (Para inlines) = callfunc lua "Para" inlines @@ -276,6 +276,8 @@ inlineToCustom lua (Str str) = callfunc lua "Str" str inlineToCustom lua Space = callfunc lua "Space" +inlineToCustom lua SoftBreak = callfunc lua "SoftBreak" + inlineToCustom lua (Emph lst) = callfunc lua "Emph" lst inlineToCustom lua (Strong lst) = callfunc lua "Strong" lst @@ -308,11 +310,11 @@ inlineToCustom lua (RawInline format str) = inlineToCustom lua (LineBreak) = callfunc lua "LineBreak" -inlineToCustom lua (Link txt (src,tit)) = - callfunc lua "Link" txt src tit +inlineToCustom lua (Link attr txt (src,tit)) = + callfunc lua "Link" txt src tit (attrToMap attr) -inlineToCustom lua (Image alt (src,tit)) = - callfunc lua "Image" alt src tit +inlineToCustom lua (Image attr alt (src,tit)) = + callfunc lua "Image" alt src tit (attrToMap attr) inlineToCustom lua (Note contents) = callfunc lua "Note" contents diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 8f9eecea8..2aaebf99f 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -42,6 +42,7 @@ import Data.Char ( toLower ) import Data.Monoid ( Any(..) ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import qualified Text.Pandoc.Builder as B import Text.TeXMath import qualified Text.XML.Light as Xml @@ -51,7 +52,7 @@ import Data.Generics (everywhere, mkT) authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines authorToDocbook opts name' = let name = render Nothing $ inlinesToDocbook opts name' - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing in B.rawInline "docbook" $ render colwidth $ @@ -75,7 +76,7 @@ authorToDocbook opts name' = writeDocbook :: WriterOptions -> Pandoc -> String writeDocbook opts (Pandoc meta blocks) = let elements = hierarchicalize blocks - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth @@ -150,6 +151,15 @@ listItemToDocbook :: WriterOptions -> [Block] -> Doc listItemToDocbook opts item = inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item +imageToDocbook :: WriterOptions -> Attr -> String -> Doc +imageToDocbook _ attr src = selfClosingTag "imagedata" $ + ("fileref", src) : idAndRole attr ++ dims + where + dims = go Width "width" ++ go Height "depth" + go dir dstr = case (dimension dir attr) of + Just a -> [(dstr, show a)] + Nothing -> [] + -- | Convert a Pandoc block element to Docbook. blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook _ Null = empty @@ -165,7 +175,7 @@ blockToDocbook opts (Div _ bs) = 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 -blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = +blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = let alt = inlinesToDocbook opts txt capt = if null txt then empty @@ -174,7 +184,7 @@ blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = capt $$ (inTagsIndented "mediaobject" $ (inTagsIndented "imageobject" - (selfClosingTag "imagedata" [("fileref",src)])) $$ + (imageToDocbook opts attr src)) $$ inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocbook opts (Para lst) | hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst @@ -321,7 +331,9 @@ inlineToDocbook _ (RawInline f x) | f == "html" || f == "docbook" = text x | otherwise = empty inlineToDocbook _ LineBreak = text "\n" inlineToDocbook _ Space = space -inlineToDocbook opts (Link txt (src, _)) +-- because we use \n for LineBreak, we can't do soft breaks: +inlineToDocbook _ SoftBreak = space +inlineToDocbook opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = let emailLink = inTagsSimple "email" $ text $ escapeStringForXML $ email @@ -331,19 +343,30 @@ inlineToDocbook opts (Link txt (src, _)) char '(' <> emailLink <> char ')' | otherwise = (if isPrefixOf "#" src - then inTags False "link" [("linkend", drop 1 src)] - else inTags False "ulink" [("url", src)]) $ + then inTags False "link" $ ("linkend", drop 1 src) : idAndRole attr + else inTags False "ulink" $ ("url", src) : idAndRole attr ) $ inlinesToDocbook opts txt -inlineToDocbook _ (Image _ (src, tit)) = +inlineToDocbook opts (Image attr _ (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ inTagsIndented "title" (text $ escapeStringForXML tit) in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ - titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] + titleDoc $$ imageToDocbook opts attr src inlineToDocbook opts (Note contents) = inTagsIndented "footnote" $ blocksToDocbook opts contents isMathML :: HTMLMathMethod -> Bool isMathML (MathML _) = True isMathML _ = False + +idAndRole :: Attr -> [(String, String)] +idAndRole (id',cls,_) = ident ++ role + where + ident = if null id' + then [] + else [("id", id')] + role = if null cls + then [] + else [("role", unwords cls)] + diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 639818f2e..827d32620 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -60,6 +60,7 @@ 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 Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, extensionFromMimeType) import Control.Applicative ((<|>)) @@ -244,7 +245,7 @@ writeDocx opts doc@(Pandoc meta _) = do let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ metaValueToInlines <$> lookupMeta "toc-title" meta - ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc') + ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = WrapNone} doc') defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime , stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) @@ -535,7 +536,6 @@ styleToOpenXml sm style = , mknode "w:link" [("w:val","VerbatimChar")] () , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () - : mknode "w:noProof" [] () : ( maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) $ backgroundColor style ) ] @@ -751,7 +751,7 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do blockToOpenXML opts (Plain lst) = withParaProp (pCustomStyle "Compact") $ blockToOpenXML opts (Para lst) -- title beginning with fig: indicates that the image is a figure -blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do +blockToOpenXML opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do setFirstPara pushParaProp $ pCustomStyle $ if null alt @@ -759,7 +759,7 @@ blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do else "FigureWithCaption" paraProps <- getParaProps False popParaProp - contents <- inlinesToOpenXML opts [Image alt (src,tit)] + contents <- inlinesToOpenXML opts [Image attr alt (src,tit)] captionNode <- withParaProp (pCustomStyle "ImageCaption") $ blockToOpenXML opts (Para alt) return $ mknode "w:p" [] (paraProps ++ contents) : captionNode @@ -981,6 +981,7 @@ setFirstPara = modify $ \s -> s { stFirstPara = True } 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) | "insertion" `elem` classes = do defaultAuthor <- gets stChangesAuthor @@ -1069,8 +1070,8 @@ inlineToOpenXML opts (Note bs) = do [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteRef" [] () ] let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker - let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : ils) : xs - insertNoteRef (Para ils : xs) = Para (notemarkerXml : ils) : xs + let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs + insertNoteRef (Para ils : xs) = Para (notemarkerXml : Space : ils) : xs insertNoteRef xs = Para [notemarkerXml] : xs oldListLevel <- gets stListLevel oldParaProperties <- gets stParaProperties @@ -1086,11 +1087,11 @@ inlineToOpenXML opts (Note bs) = do [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteReference" [("w:id", notenum)] () ] ] -- internal link: -inlineToOpenXML opts (Link txt ('#':xs,_)) = do +inlineToOpenXML opts (Link _ txt ('#':xs,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt return [ mknode "w:hyperlink" [("w:anchor",xs)] contents ] -- external link: -inlineToOpenXML opts (Link txt (src,_)) = do +inlineToOpenXML opts (Link _ txt (src,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt extlinks <- gets stExternalLinks id' <- case M.lookup src extlinks of @@ -1101,7 +1102,7 @@ inlineToOpenXML opts (Link txt (src,_)) = do M.insert src i extlinks } return i return [ mknode "w:hyperlink" [("r:id",id')] contents ] -inlineToOpenXML opts (Image alt (src, tit)) = do +inlineToOpenXML opts (Image attr alt (src, tit)) = do -- first, check to see if we've already done this image pageWidth <- gets stPrintWidth imgs <- gets stImages @@ -1117,13 +1118,8 @@ inlineToOpenXML opts (Image alt (src, tit)) = do inlinesToOpenXML opts alt Right (img, mt) -> do ident <- ("rId"++) `fmap` getUniqueId - (xpt,ypt) <- case imageSize img of - Right size -> return $ sizeInPoints size - Left msg -> do - liftIO $ warn $ - "Could not determine image size in `" ++ - src ++ "': " ++ msg - return (120,120) + let (xpt,ypt) = desiredSizeInPoints opts attr + (either (const def) id (imageSize img)) -- 12700 emu = 1 pt let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) (pageWidth * 12700) let cNvPicPr = mknode "pic:cNvPicPr" [] $ @@ -1210,11 +1206,9 @@ parseXml refArchive distArchive relpath = -- | Scales the image to fit the page -- sizes are passed in emu -fitToPage :: (Integer, Integer) -> Integer -> (Integer, Integer) +fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) fitToPage (x, y) pageWidth -- Fixes width to the page width and scales the height - | x > pageWidth = - (pageWidth, round $ - ((fromIntegral pageWidth) / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y)) - | otherwise = (x, y) - + | x > fromIntegral pageWidth = + (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + | otherwise = (floor x, floor y) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index b68c46c7e..f1088b158 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -43,10 +43,12 @@ import Text.Pandoc.Definition import Text.Pandoc.Options ( WriterOptions( writerTableOfContents , writerStandalone - , writerTemplate) ) + , writerTemplate + , writerWrapText), WrapOption(..) ) import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated , trimr, normalize, substitute ) import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Data.List ( intersect, intercalate, isPrefixOf, transpose ) import Data.Default (Default(..)) @@ -126,7 +128,7 @@ blockToDokuWiki opts (Plain inlines) = -- title beginning with fig: indicates that the image is a figure -- dokuwiki doesn't support captions - so combine together alt and caption into alt -blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToDokuWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else (" " ++) `fmap` inlineListToDokuWiki opts txt @@ -135,7 +137,7 @@ blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do else "|" ++ if null tit then capt else tit ++ capt -- Relative links fail isURI and receive a colon prefix = if isURI src then "" else ":" - return $ "{{" ++ prefix ++ src ++ opt ++ "}}\n" + return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n" blockToDokuWiki opts (Para inlines) = do indent <- stIndent <$> ask @@ -460,20 +462,26 @@ inlineToDokuWiki _ (RawInline f str) inlineToDokuWiki _ (LineBreak) = return "\\\\\n" +inlineToDokuWiki opts SoftBreak = + case writerWrapText opts of + WrapNone -> return " " + WrapAuto -> return " " + WrapPreserve -> return "\n" + inlineToDokuWiki _ Space = return " " -inlineToDokuWiki opts (Link txt (src, _)) = do +inlineToDokuWiki opts (Link _ txt (src, _)) = do label <- inlineListToDokuWiki opts txt case txt of [Str s] | "mailto:" `isPrefixOf` src -> return $ "<" ++ s ++ ">" | escapeURI s == src -> return src _ -> if isURI src - then return $ "[[" ++ src ++ "|" ++ label ++ "]]" + then return $ "[[" ++ src ++ "|" ++ label ++ "]]" else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" where src' = case src of '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToDokuWiki opts (Image alt (source, tit)) = do +inlineToDokuWiki opts (Image attr alt (source, tit)) = do alt' <- inlineListToDokuWiki opts alt let txt = case (tit, alt) of ("", []) -> "" @@ -481,10 +489,21 @@ inlineToDokuWiki opts (Image alt (source, tit)) = do (_ , _ ) -> "|" ++ tit -- Relative links fail isURI and receive a colon prefix = if isURI source then "" else ":" - return $ "{{" ++ prefix ++ source ++ txt ++ "}}" + return $ "{{" ++ prefix ++ source ++ imageDims opts attr ++ txt ++ "}}" inlineToDokuWiki opts (Note contents) = do contents' <- blockListToDokuWiki opts contents modify (\s -> s { stNotes = True }) return $ "((" ++ contents' ++ "))" -- note - may not work for notes with multiple blocks + +imageDims :: WriterOptions -> Attr -> String +imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + where + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = "?" ++ w + go (Just w) (Just h) = "?" ++ w ++ "x" ++ h + go Nothing (Just h) = "?0x" ++ h + go Nothing Nothing = "" diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 2843f8c74..64f94f41f 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -50,6 +50,7 @@ import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim import qualified Text.Pandoc.Shared as S (Element(..)) import Text.Pandoc.Builder (fromList, setMeta) import Text.Pandoc.Options ( WriterOptions(..) + , WrapOption(..) , HTMLMathMethod(..) , EPUBVersion(..) , ObfuscationMethod(NoObfuscation) ) @@ -350,7 +351,7 @@ writeEPUB opts doc@(Pandoc meta _) = do if epub3 then MathML Nothing else writerHTMLMathMethod opts - , writerWrapText = True } + , writerWrapText = WrapAuto } metadata <- getEPUBMetadata opts' meta -- cover page @@ -455,10 +456,10 @@ writeEPUB opts doc@(Pandoc meta _) = do chapters' [1..] let fixInternalReferences :: Inline -> Inline - fixInternalReferences (Link lab ('#':xs, tit)) = + fixInternalReferences (Link attr lab ('#':xs, tit)) = case lookup xs reftable of - Just ys -> Link lab (ys, tit) - Nothing -> Link lab ('#':xs, tit) + Just ys -> Link attr lab (ys, tit) + Nothing -> Link attr lab ('#':xs, tit) fixInternalReferences x = x -- internal reference IDs change when we chunk the file, @@ -816,7 +817,8 @@ transformTag :: WriterOptions -> Tag String -> IO (Tag String) transformTag opts mediaRef tag@(TagOpen name attr) - | name `elem` ["video", "source", "img", "audio"] = do + | name `elem` ["video", "source", "img", "audio"] && + lookup "data-external" attr == Nothing = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag newsrc <- modifyMediaRef opts mediaRef src @@ -869,14 +871,14 @@ transformInline :: WriterOptions -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media -> Inline -> IO Inline -transformInline opts mediaRef (Image lab (src,tit)) = do +transformInline opts mediaRef (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef opts mediaRef src - return $ Image lab (newsrc, tit) + return $ Image attr lab (newsrc, tit) transformInline opts mediaRef (x@(Math t m)) | WebTeX url <- writerHTMLMathMethod opts = do newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m) let mathclass = if t == DisplayMath then "display" else "inline" - return $ Span ("",["math",mathclass],[]) [Image [x] (newsrc, "")] + return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")] transformInline opts mediaRef (RawInline fmt raw) | fmt == Format "html" = do let tags = parseTags raw diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 31fa4bee8..80296e111 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -314,8 +314,8 @@ blockToXml :: Block -> FBM [Content] blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula -- title beginning with fig: indicates that the image is a figure -blockToXml (Para [Image alt (src,'f':'i':'g':':':tit)]) = - insertImage NormalImage (Image alt (src,tit)) +blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) = + insertImage NormalImage (Image atr alt (src,tit)) blockToXml (Para ss) = liftM (list . el "p") $ cMapM toXml ss blockToXml (CodeBlock _ s) = return . spaceBeforeAfter . map (el "p" . el "code") . lines $ s @@ -439,10 +439,11 @@ toXml (Quoted DoubleQuote ss) = do toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles toXml (Code _ s) = return [el "code" s] toXml Space = return [txt " "] +toXml SoftBreak = return [txt " "] toXml LineBreak = return [el "empty-line" ()] toXml (Math _ formula) = insertMath InlineImage formula toXml (RawInline _ _) = return [] -- raw TeX and raw HTML are suppressed -toXml (Link text (url,ttl)) = do +toXml (Link _ text (url,ttl)) = do fns <- footnotes `liftM` get let n = 1 + length fns let ln_id = linkID n @@ -459,7 +460,7 @@ toXml (Link text (url,ttl)) = do ( [ attr ("l","href") ('#':ln_id) , uattr "type" "note" ] , ln_ref) ] -toXml img@(Image _ _) = insertImage InlineImage img +toXml img@(Image _ _ _) = insertImage InlineImage img toXml (Note bs) = do fns <- footnotes `liftM` get let n = 1 + length fns @@ -478,12 +479,12 @@ insertMath immode formula = do WebTeX url -> do let alt = [Code nullAttr formula] let imgurl = url ++ urlEncode formula - let img = Image alt (imgurl, "") + let img = Image nullAttr alt (imgurl, "") insertImage immode img _ -> return [el "code" formula] insertImage :: ImageMode -> Inline -> FBM [Content] -insertImage immode (Image alt (url,ttl)) = do +insertImage immode (Image _ alt (url,ttl)) = do images <- imagesToFetch `liftM` get let n = 1 + length images let fname = "image" ++ show n @@ -569,11 +570,12 @@ plain (Quoted _ ss) = concat (map plain ss) plain (Cite _ ss) = concat (map plain ss) -- FIXME plain (Code _ s) = s plain Space = " " +plain SoftBreak = " " plain LineBreak = "\n" plain (Math _ s) = s plain (RawInline _ s) = s -plain (Link text (url,_)) = concat (map plain text ++ [" <", url, ">"]) -plain (Image alt _) = concat (map plain alt) +plain (Link _ text (url,_)) = concat (map plain text ++ [" <", url, ">"]) +plain (Image _ alt _) = concat (map plain alt) plain (Note _) = "" -- FIXME -- | Create an XML element. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index d06bec89f..73a8906c3 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -31,9 +31,11 @@ Conversion of 'Pandoc' documents to HTML. -} module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Options +import Text.Pandoc.ImageSize import Text.Pandoc.Templates import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Slides @@ -93,9 +95,9 @@ strToHtml [] = "" -- | Hard linebreak. nl :: WriterOptions -> Html -nl opts = if writerWrapText opts - then preEscapedString "\n" - else mempty +nl opts = if writerWrapText opts == WrapNone + then mempty + else preEscapedString "\n" -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String @@ -192,9 +194,6 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ defField "html5" (writerHtml5 opts) $ - defField "center" (case lookupMeta "center" meta of - Just (MetaBool False) -> False - _ -> True) $ metadata return (thebody, context) @@ -307,11 +306,9 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen $ if titleSlide -- title slides have no content of their own then filter isSec elements - else if slide - then case splitBy isPause elements of - [] -> [] - (x:xs) -> x ++ concatMap inDiv xs - else elements + else case splitBy isPause elements of + [] -> [] + (x:xs) -> x ++ concatMap inDiv xs let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] let classes' = ["titleslide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && @@ -360,10 +357,10 @@ parseMailto s = do _ -> fail "not a mailto: URL" -- | Obfuscate a "mailto:" link. -obfuscateLink :: WriterOptions -> Html -> String -> Html -obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation = - H.a ! A.href (toValue s) $ txt -obfuscateLink opts (renderHtml -> txt) s = +obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html +obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation = + addAttrs opts attr $ H.a ! A.href (toValue s) $ txt +obfuscateLink opts attr (renderHtml -> txt) s = let meth = writerEmailObfuscation opts s' = map toLower (take 7 s) ++ drop 7 s in case parseMailto s' of @@ -389,7 +386,7 @@ obfuscateLink opts (renderHtml -> txt) s = linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) _ -> error $ "Unknown obfuscation method: " ++ show meth - _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email + _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String @@ -405,11 +402,33 @@ obfuscateString = concatMap obfuscateChar . fromEntities addAttrs :: WriterOptions -> Attr -> Html -> Html addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr) +toAttrs :: [(String, String)] -> [Attribute] +toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs + attrsToHtml :: WriterOptions -> Attr -> [Attribute] attrsToHtml opts (id',classes',keyvals) = [prefixedId opts id' | not (null id')] ++ - [A.class_ (toValue $ unwords classes') | not (null classes')] ++ - map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals + [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals + +imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute] +imgAttrsToHtml opts attr = + attrsToHtml opts (ident,cls,kvs') ++ + toAttrs (dimensionsToAttrList opts attr) + where + (ident,cls,kvs) = attr + kvs' = filter isNotDim kvs + isNotDim ("width", _) = False + isNotDim ("height", _) = False + isNotDim _ = True + +dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] +dimensionsToAttrList opts attr = (go Width) ++ (go Height) + where + go dir = case (dimension dir attr) of + (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] + (Just dim) -> [(show dir, showInPixel opts dim)] + _ -> [] + imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", @@ -430,8 +449,8 @@ blockToHtml :: WriterOptions -> Block -> State WriterState Html blockToHtml _ Null = return mempty blockToHtml opts (Plain lst) = inlineListToHtml opts lst -- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image txt (s,'f':'i':'g':':':tit)]) = do - img <- inlineToHtml opts (Image txt (s,tit)) +blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do + img <- inlineToHtml opts (Image attr txt (s,tit)) let tocapt = if writerHtml5 opts then H5.figcaption else H.p ! A.class_ "caption" @@ -543,6 +562,9 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let attribs = (if startnum /= 1 then [A.start $ toValue startnum] else []) ++ + (if numstyle == Example + then [A.class_ "example"] + else []) ++ (if numstyle /= DefaultStyle then if writerHtml5 opts then [A.type_ $ @@ -593,8 +615,15 @@ blockToHtml opts (Table capt aligns widths headers rows') = do return $ H.thead (nl opts >> contents) >> nl opts body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $ zipWithM (tableRowToHtml opts aligns) [1..] rows' - return $ H.table $ nl opts >> captionDoc >> coltags >> head' >> - body' >> nl opts + let tbl = H.table $ + nl opts >> captionDoc >> coltags >> head' >> body' >> nl opts + let totalWidth = sum widths + -- When widths of columns are < 100%, we need to set width for the whole + -- table, or some browsers give us skinny columns with lots of space between: + return $ if totalWidth == 0 || totalWidth == 1 + then tbl + else tbl ! A.style (toValue $ "width:" ++ + show (round (totalWidth * 100) :: Int) ++ "%;") tableRowToHtml :: WriterOptions -> [Alignment] @@ -668,6 +697,10 @@ inlineToHtml opts inline = case inline of (Str str) -> return $ strToHtml str (Space) -> return $ strToHtml " " + (SoftBreak) -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" (LineBreak) -> return $ (if writerHtml5 opts then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) @@ -786,10 +819,10 @@ inlineToHtml opts inline = _ -> return mempty | f == Format "html" -> return $ preEscapedString str | otherwise -> return mempty - (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do + (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts linkText s - (Link txt (s,tit)) -> do + return $ obfuscateLink opts attr linkText s + (Link attr txt (s,tit)) -> do linkText <- inlineListToHtml opts txt let s' = case s of '#':xs | writerSlideVariant opts == @@ -799,19 +832,23 @@ inlineToHtml opts inline = let link' = if txt == [Str (unEscapeString s)] then link ! A.class_ "uri" else link + let link'' = addAttrs opts attr link' return $ if null tit - then link' - else link' ! A.title (toValue tit) - (Image txt (s,tit)) | treatAsImage s -> do + then link'' + else link'' ! A.title (toValue tit) + (Image attr txt (s,tit)) | treatAsImage s -> do + let alternate' = stringify txt let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] ++ - [A.alt $ toValue $ stringify txt] + [A.title $ toValue tit | not (null tit)] ++ + [A.alt $ toValue alternate' | not (null txt)] ++ + imgAttrsToHtml opts attr let tag = if writerHtml5 opts then H5.img else H.img return $ foldl (!) tag attributes -- note: null title included, as in Markdown.pl - (Image _ (s,tit)) -> do + (Image attr _ (s,tit)) -> do let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] + [A.title $ toValue tit | not (null tit)] ++ + imgAttrsToHtml opts attr return $ foldl (!) H5.embed attributes -- note: null title included, as in Markdown.pl (Note contents) @@ -849,7 +886,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [Link [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link nullAttr [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 14f398da9..2e5f2dd08 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -57,7 +57,7 @@ writeHaddock opts document = -- | Return haddock representation of document. pandocToHaddock :: WriterOptions -> Pandoc -> State WriterState String pandocToHaddock opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing body <- blockListToHaddock opts blocks @@ -103,8 +103,8 @@ blockToHaddock opts (Plain inlines) = do contents <- inlineListToHaddock opts inlines return $ contents <> cr -- title beginning with fig: indicates figure -blockToHaddock opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToHaddock opts (Para [Image alt (src,tit)]) +blockToHaddock opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = + blockToHaddock opts (Para [Image attr alt (src,tit)]) blockToHaddock opts (Para inlines) = -- TODO: if it contains linebreaks, we need to use a @...@ block (<> blankline) `fmap` blockToHaddock opts (Plain inlines) @@ -325,18 +325,23 @@ inlineToHaddock _ (RawInline f str) | otherwise = return empty -- no line break in haddock (see above on CodeBlock) inlineToHaddock _ (LineBreak) = return cr +inlineToHaddock opts SoftBreak = + case writerWrapText opts of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToHaddock _ Space = return space inlineToHaddock opts (Cite _ lst) = inlineListToHaddock opts lst -inlineToHaddock opts (Link txt (src, _)) = do - linktext <- inlineListToHaddock opts txt +inlineToHaddock _ (Link _ txt (src, _)) = do + let linktext = text $ escapeString $ stringify txt let useAuto = isURI src && case txt of [Str s] | escapeURI s == src -> True _ -> False return $ nowrap $ "<" <> text src <> (if useAuto then empty else space <> linktext) <> ">" -inlineToHaddock opts (Image alternate (source, tit)) = do - linkhaddock <- inlineToHaddock opts (Link alternate (source, tit)) +inlineToHaddock opts (Image attr alternate (source, tit)) = do + linkhaddock <- inlineToHaddock opts (Link attr alternate (source, tit)) return $ "<" <> linkhaddock <> ">" -- haddock doesn't have notes, but we can fake it: inlineToHaddock opts (Note contents) = do diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index ae068a94f..57a61178e 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -16,12 +16,14 @@ into InDesign with File -> Place. module Text.Pandoc.Writers.ICML (writeICML) where import Text.Pandoc.Definition import Text.Pandoc.XML +import Text.Pandoc.Readers.TeXMath (texMathToInlines) import Text.Pandoc.Writers.Shared -import Text.Pandoc.Shared (splitBy) +import Text.Pandoc.Shared (splitBy, fetchItem, warn) import Text.Pandoc.Options import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Pretty -import Data.List (isPrefixOf, isInfixOf, stripPrefix) +import Text.Pandoc.ImageSize +import Data.List (isPrefixOf, isInfixOf, stripPrefix, intersperse) import Data.Text as Text (breakOnAll, pack) import Control.Monad.State import Network.URI (isURI) @@ -38,7 +40,7 @@ data WriterState = WriterState{ , maxListDepth :: Int } -type WS a = State WriterState a +type WS a = StateT WriterState IO a defaultWriterState :: WriterState defaultWriterState = WriterState{ @@ -69,6 +71,8 @@ linkName = "Link" -- block element names (appear in InDesign's paragraph styles pane) paragraphName :: String +figureName :: String +imgCaptionName :: String codeBlockName :: String blockQuoteName :: String orderedListName :: String @@ -90,7 +94,10 @@ lowerAlphaName :: String upperAlphaName :: String subListParName :: String footnoteName :: String +citeName :: String paragraphName = "Paragraph" +figureName = "Figure" +imgCaptionName = "Caption" codeBlockName = "CodeBlock" blockQuoteName = "Blockquote" orderedListName = "NumList" @@ -112,30 +119,31 @@ lowerAlphaName = "lowerAlpha" upperAlphaName = "upperAlpha" subListParName = "subParagraph" footnoteName = "Footnote" +citeName = "Cite" -- | Convert Pandoc document to string in ICML format. -writeICML :: WriterOptions -> Pandoc -> String -writeICML opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts +writeICML :: WriterOptions -> Pandoc -> IO String +writeICML opts (Pandoc meta blocks) = do + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth - renderMeta f s = Just $ render' $ fst $ runState (f opts [] s) defaultWriterState - Just metadata = metaToJSON opts - (renderMeta blocksToICML) - (renderMeta inlinesToICML) - meta - (doc, st) = runState (blocksToICML opts [] blocks) defaultWriterState - main = render' doc + renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState + metadata <- metaToJSON opts + (renderMeta blocksToICML) + (renderMeta inlinesToICML) + meta + (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState + let main = render' doc context = defField "body" main $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + return $ if writerStandalone opts + then renderTemplate' (writerTemplate opts) context + else main -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] @@ -276,11 +284,18 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs -- | Convert a list of Pandoc blocks to ICML. blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc -blocksToICML opts style lst = vcat `fmap` mapM (blockToICML opts style) lst +blocksToICML opts style lst = do + docs <- mapM (blockToICML opts style) lst + return $ intersperseBrs docs -- | Convert a Pandoc block element to ICML. blockToICML :: WriterOptions -> Style -> Block -> WS Doc blockToICML opts style (Plain lst) = parStyle opts style lst +-- title beginning with fig: indicates that the image is a figure +blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do + figure <- parStyle opts (figureName:style) img + caption <- parStyle opts (imgCaptionName:style) txt + return $ intersperseBrs [figure, caption] blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) $ [Str str] blockToICML _ _ (RawBlock f str) @@ -289,7 +304,7 @@ blockToICML _ _ (RawBlock f str) blockToICML opts style (BlockQuote blocks) = blocksToICML opts (blockQuoteName:style) blocks blockToICML opts style (OrderedList attribs lst) = listItemsToICML opts orderedListName style (Just attribs) lst blockToICML opts style (BulletList lst) = listItemsToICML opts bulletListName style Nothing lst -blockToICML opts style (DefinitionList lst) = vcat `fmap` mapM (definitionListItemToICML opts style) lst +blockToICML opts style (DefinitionList lst) = intersperseBrs `fmap` mapM (definitionListItemToICML opts style) lst blockToICML opts style (Header lvl _ lst) = let stl = (headerName ++ show lvl):style in parStyle opts stl lst @@ -354,7 +369,7 @@ listItemsToICML opts listType style attribs (first:rest) = do s <- get let maxD = max (maxListDepth s) (listDepth s) put s{ listDepth = 1, maxListDepth = maxD } - return $ vcat docs + return $ intersperseBrs docs -- | Convert a list of blocks to ICML list items. listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc @@ -380,15 +395,15 @@ listItemToICML opts style isFirst attribs item = let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ (Str "\t"):lst insertTab block = blockToICML opts style block f <- blockToICML opts stl' $ head item - r <- fmap vcat $ mapM insertTab $ tail item - return $ f $$ r + r <- mapM insertTab $ tail item + return $ intersperseBrs (f : r) else blocksToICML opts stl' item definitionListItemToICML :: WriterOptions -> Style -> ([Inline],[[Block]]) -> WS Doc definitionListItemToICML opts style (term,defs) = do term' <- parStyle opts (defListTermName:style) term - defs' <- vcat `fmap` mapM (blocksToICML opts (defListDefName:style)) defs - return $ term' $$ defs' + defs' <- mapM (blocksToICML opts (defListDefName:style)) defs + return $ intersperseBrs $ (term' : defs') -- | Convert a list of inline elements to ICML. @@ -406,15 +421,21 @@ inlineToICML opts style (Subscript lst) = inlinesToICML opts (subscriptName:styl inlineToICML opts style (SmallCaps lst) = inlinesToICML opts (smallCapsName:style) lst inlineToICML opts style (Quoted SingleQuote lst) = inlinesToICML opts style $ [Str "‘"] ++ lst ++ [Str "’"] inlineToICML opts style (Quoted DoubleQuote lst) = inlinesToICML opts style $ [Str "“"] ++ lst ++ [Str "”"] -inlineToICML opts style (Cite _ lst) = inlinesToICML opts style lst +inlineToICML opts style (Cite _ lst) = inlinesToICML opts (citeName:style) lst inlineToICML _ style (Code _ str) = charStyle (codeName:style) $ text $ escapeStringForXML str inlineToICML _ style Space = charStyle style space +inlineToICML opts style SoftBreak = + case writerWrapText opts of + WrapAuto -> charStyle style space + WrapNone -> charStyle style space + WrapPreserve -> charStyle style cr inlineToICML _ style LineBreak = charStyle style $ text lineSeparator -inlineToICML _ style (Math _ str) = charStyle style $ text $ escapeStringForXML str --InDesign doesn't really do math +inlineToICML opts style (Math mt str) = + cat <$> mapM (inlineToICML opts style) (texMathToInlines mt str) inlineToICML _ _ (RawInline f str) | f == Format "icml" = return $ text str | otherwise = return empty -inlineToICML opts style (Link lst (url, title)) = do +inlineToICML opts style (Link _ lst (url, title)) = do content <- inlinesToICML opts (linkName:style) lst state $ \st -> let ident = if null $ links st @@ -424,7 +445,7 @@ inlineToICML opts style (Link lst (url, title)) = do cont = inTags True "HyperlinkTextSource" [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content in (cont, newst) -inlineToICML opts style (Image alt target) = imageICML opts style alt target +inlineToICML opts style (Image attr _ target) = imageICML opts style attr target inlineToICML opts style (Note lst) = footnoteToICML opts style lst inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst @@ -439,16 +460,26 @@ footnoteToICML opts style lst = inTags True "CharacterStyleRange" [] $ inTagsSimple "Content" "<?ACE 4?>" return $ inTags True "CharacterStyleRange" [("AppliedCharacterStyle","$ID/NormalCharacterStyle"), ("Position","Superscript")] - $ inTags True "Footnote" [] $ number $$ vcat contents + $ inTags True "Footnote" [] $ number $$ intersperseBrs contents -- | Auxiliary function to merge Space elements into the adjacent Strs. mergeSpaces :: [Inline] -> [Inline] -mergeSpaces ((Str s):(Space:((Str s'):xs))) = mergeSpaces $ Str(s++" "++s') : xs -mergeSpaces (Space:((Str s):xs)) = mergeSpaces $ Str (" "++s) : xs -mergeSpaces ((Str s):(Space:xs)) = mergeSpaces $ Str (s++" ") : xs +mergeSpaces ((Str s):(x:((Str s'):xs))) | isSp x = + mergeSpaces $ Str(s++" "++s') : xs +mergeSpaces (x:((Str s):xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs +mergeSpaces ((Str s):(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs mergeSpaces (x:xs) = x : (mergeSpaces xs) mergeSpaces [] = [] +isSp :: Inline -> Bool +isSp Space = True +isSp SoftBreak = True +isSp _ = False + +-- | Intersperse line breaks +intersperseBrs :: [Doc] -> Doc +intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty) + -- | Wrap a list of inline elements in an ICML Paragraph Style parStyle :: WriterOptions -> Style -> [Inline] -> WS Doc parStyle opts style lst = @@ -470,8 +501,7 @@ parStyle opts style lst = else [attrs] in do content <- inlinesToICML opts [] lst - let cont = inTags True "ParagraphStyleRange" attrs' - $ mappend content $ selfClosingTag "Br" [] + let cont = inTags True "ParagraphStyleRange" attrs' content state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st }) -- | Wrap a Doc in an ICML Character Style. @@ -497,39 +527,48 @@ styleToStrAttr style = in (stlStr, attrs) -- | Assemble an ICML Image. -imageICML :: WriterOptions -> Style -> [Inline] -> Target -> WS Doc -imageICML _ style _ (linkURI, _) = - let imgWidth = 300::Int --TODO: set width, height dynamically as in Docx.hs - imgHeight = 200::Int - scaleFact = show (1::Double) --TODO: set scaling factor so image is scaled exactly to imgWidth x imgHeight - hw = show $ imgWidth `div` 2 - hh = show $ imgHeight `div` 2 - qw = show $ imgWidth `div` 4 - qh = show $ imgHeight `div` 4 - uriPrefix = if isURI linkURI then "" else "file:" +imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc +imageICML opts style attr (src, _) = do + res <- liftIO $ fetchItem (writerSourceURL opts) src + imgS <- case res of + Left (_) -> do + liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." + return def + Right (img, _) -> do + case imageSize img of + Right size -> return size + Left msg -> do + return $ warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return def + let (ow, oh) = sizeInPoints imgS + (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS + hw = showFl $ ow / 2 + hh = showFl $ oh / 2 + scale = showFl (imgWidth / ow) ++ " 0 0 " ++ showFl (imgHeight / oh) + src' = if isURI src then src else "file:" ++ src (stlStr, attrs) = styleToStrAttr style props = inTags True "Properties" [] $ inTags True "PathGeometry" [] $ inTags True "GeometryPathType" [("PathOpen","false")] $ inTags True "PathPointArray" [] $ vcat [ - selfClosingTag "PathPointType" [("Anchor", "-"++qw++" -"++qh), - ("LeftDirection", "-"++qw++" -"++qh), ("RightDirection", "-"++qw++" -"++qh)] - , selfClosingTag "PathPointType" [("Anchor", "-"++qw++" "++qh), - ("LeftDirection", "-"++qw++" "++qh), ("RightDirection", "-"++qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" "++qh), - ("LeftDirection", qw++" "++qh), ("RightDirection", qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" -"++qh), - ("LeftDirection", qw++" -"++qh), ("RightDirection", qw++" -"++qh)] + selfClosingTag "PathPointType" [("Anchor", "-"++hw++" -"++hh), + ("LeftDirection", "-"++hw++" -"++hh), ("RightDirection", "-"++hw++" -"++hh)] + , selfClosingTag "PathPointType" [("Anchor", "-"++hw++" "++hh), + ("LeftDirection", "-"++hw++" "++hh), ("RightDirection", "-"++hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" "++hh), + ("LeftDirection", hw++" "++hh), ("RightDirection", hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" -"++hh), + ("LeftDirection", hw++" -"++hh), ("RightDirection", hw++" -"++hh)] ] image = inTags True "Image" - [("Self","ue6"), ("ItemTransform", scaleFact++" 0 0 "++scaleFact++" -"++qw++" -"++qh)] + [("Self","ue6"), ("ItemTransform", scale++" -"++hw++" -"++hh)] $ vcat [ inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded" - $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)] - , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)] + , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')] ] doc = inTags True "CharacterStyleRange" attrs - $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)] + $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"), + ("ItemTransform", scale++" "++hw++" -"++hh)] $ (props $$ image) - in do - state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) + state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 15982736c..648b09c2c 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -38,15 +38,16 @@ import Text.Pandoc.Options import Text.Pandoc.Templates import Text.Printf ( printf ) import Network.URI ( isURI, unEscapeString ) -import Data.Aeson ( object, (.=), FromJSON ) -import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse ) +import Data.Aeson (object, (.=)) +import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse, nub, nubBy ) import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord ) -import Data.Maybe ( fromMaybe ) +import Data.Maybe ( fromMaybe, isJust ) import qualified Data.Text as T import Control.Applicative ((<|>)) import Control.Monad.State import qualified Text.Parsec as P import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Slides import Text.Pandoc.Highlighting (highlight, styleToLaTeX, formatLaTeXInline, formatLaTeXBlock, @@ -99,12 +100,12 @@ pandocToLaTeX options (Pandoc meta blocks) = do _ -> blocks else blocks -- see if there are internal links - let isInternalLink (Link _ ('#':xs,_)) = [xs] - isInternalLink _ = [] + let isInternalLink (Link _ _ ('#':xs,_)) = [xs] + isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } let template = writerTemplate options -- set stBook depending on documentclass - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -150,6 +151,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta + let docLangs = nub $ query (extract "lang") blocks + let hasStringValue x = isJust (getField x metadata :: Maybe String) let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (show (writerTOCDepth options - if stBook st @@ -184,18 +187,50 @@ pandocToLaTeX options (Pandoc meta blocks) = do Biblatex -> defField "biblio-title" biblioTitle . defField "biblatex" True _ -> id) $ + -- set lang to something so polyglossia/babel is included + defField "lang" (if null docLangs then ""::String else "en") $ + defField "otherlangs" docLangs $ + defField "colorlinks" (any hasStringValue + ["citecolor", "urlcolor", "linkcolor", "toccolor"]) $ + defField "dir" (if (null $ query (extract "dir") blocks) + then ""::String + else "ltr") $ metadata let toPolyObj lang = object [ "name" .= T.pack name , "options" .= T.pack opts ] where (name, opts) = toPolyglossia lang let lang = maybe [] (splitBy (=='-')) $ getField "lang" context + otherlangs = maybe [] (map $ splitBy (=='-')) $ getField "otherlangs" context let context' = defField "babel-lang" (toBabel lang) + $ defField "babel-otherlangs" (map toBabel otherlangs) + $ defField "babel-newcommands" (concatMap (\(poly, babel) -> + -- \textspanish and \textgalician are already used by babel + -- save them as \oritext... and let babel use that + if poly `elem` ["spanish", "galician"] + then "\\let\\oritext" ++ poly ++ "\\text" ++ poly ++ "\n" ++ + "\\AddBabelHook{" ++ poly ++ "}{beforeextras}" ++ + "{\\renewcommand{\\text" ++ poly ++ "}{\\oritext" + ++ poly ++ "}}\n" ++ + "\\AddBabelHook{" ++ poly ++ "}{afterextras}" ++ + "{\\renewcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" + ++ poly ++ "}{##2}}}\n" + else "\\newcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" + ++ babel ++ "}{#2}}\n" ++ + "\\newenvironment{" ++ poly ++ "}[1]{\\begin{otherlanguage}{" + ++ babel ++ "}}{\\end{otherlanguage}}\n" + ) + -- eliminate duplicates that have same polyglossia name + $ nubBy (\a b -> fst a == fst b) + -- find polyglossia and babel names of languages used in the document + $ map (\l -> + let lng = splitBy (=='-') l + in (fst $ toPolyglossia lng, toBabel lng) + ) + docLangs ) $ defField "polyglossia-lang" (toPolyObj lang) - $ defField "polyglossia-otherlangs" - (maybe [] (map $ toPolyObj . splitBy (=='-')) $ - getField "otherlangs" context) + $ defField "polyglossia-otherlangs" (map toPolyObj otherlangs) $ defField "latex-dir-rtl" (case (getField "dir" context)::Maybe String of Just "rtl" -> True _ -> False) @@ -299,12 +334,8 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) hasCodeBlock _ = [] let hasCode (Code _ _) = [True] hasCode _ = [] - opts <- gets stOptions let fragile = "fragile" `elem` classes || - not (null $ query hasCodeBlock elts ++ - if writerListings opts - then query hasCode elts - else []) + not (null $ query hasCodeBlock elts ++ query hasCode elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "b", "c", "t", "environment", "label", "plain", "shrink"] @@ -331,6 +362,7 @@ isListBlock _ = False isLineBreakOrSpace :: Inline -> Bool isLineBreakOrSpace LineBreak = True +isLineBreakOrSpace SoftBreak = True isLineBreakOrSpace Space = True isLineBreakOrSpace _ = False @@ -343,29 +375,48 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do ref <- toLabel identifier let linkAnchor = if null identifier then empty - else "\\hyperdef{}" <> braces (text ref) <> - braces ("\\label" <> braces (text ref)) - contents' <- blockListToLaTeX bs - let align dir = inCmd "begin" dir $$ contents' $$ inCmd "end" dir - let contents = case lookup "dir" kvs of - Just "rtl" -> align "RTL" - Just "ltr" -> align "LTR" - _ -> contents' - if beamer && "notes" `elem` classes -- speaker notes - then return $ "\\note" <> braces contents - else return (linkAnchor $$ contents) + else "\\hypertarget" <> braces (text ref) <> + braces empty + let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir + let wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "RTL" + Just "ltr" -> align "LTR" + _ -> id + wrapLang txt = case lookup "lang" kvs of + Just lng -> let (l, o) = toPolyglossiaEnv lng + ops = if null o + then "" + else brackets $ text o + in inCmd "begin" (text l) <> ops + $$ blankline <> txt <> blankline + $$ inCmd "end" (text l) + Nothing -> txt + wrapNotes txt = if beamer && "notes" `elem` classes + then "\\note" <> braces txt -- speaker notes + else linkAnchor $$ txt + fmap (wrapDir . wrapLang . wrapNotes) $ blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure -blockToLaTeX (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToLaTeX (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do inNote <- gets stInNote + modify $ \st -> st{ stInMinipage = True, stNotes = [] } capt <- inlineListToLaTeX txt - img <- inlineToLaTeX (Image txt (src,tit)) + notes <- gets stNotes + modify $ \st -> st{ stInMinipage = False, stNotes = [] } + -- We can't have footnotes in the list of figures, so remove them: + captForLof <- if null notes + then return empty + else brackets <$> inlineListToLaTeX (walk deNote txt) + img <- inlineToLaTeX (Image attr txt (src,tit)) + let footnotes = notesToLaTeX notes return $ if inNote -- can't have figures in notes then "\\begin{center}" $$ img $+$ capt $$ "\\end{center}" else "\\begin{figure}[htbp]" $$ "\\centering" $$ img $$ - ("\\caption" <> braces capt) $$ "\\end{figure}" + ("\\caption" <> captForLof <> braces capt) $$ + "\\end{figure}" $$ + footnotes -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do beamer <- writerBeamer `fmap` gets stOptions @@ -394,7 +445,7 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do ref <- toLabel identifier let linkAnchor = if null identifier then empty - else "\\hyperdef{}" <> braces (text ref) <> + else "\\hypertarget" <> braces (text ref) <> braces ("\\label" <> braces (text ref)) let lhsCodeBlock = do modify $ \s -> s{ stLHS = True } @@ -607,19 +658,21 @@ tableCellToLaTeX header (width, align, blocks) = do return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> (halign <> "\\strut" <> cr <> cellContents <> cr) <> - "\\strut\\end{minipage}") - $$ case notes of - [] -> empty - ns -> (case length ns of + "\\strut\\end{minipage}") $$ + notesToLaTeX notes + +notesToLaTeX :: [Doc] -> Doc +notesToLaTeX [] = empty +notesToLaTeX ns = (case length ns of n | n > 1 -> "\\addtocounter" <> braces "footnote" <> braces (text $ show $ 1 - n) | otherwise -> empty) - $$ - vcat (intersperse - ("\\addtocounter" <> braces "footnote" <> braces "1") - $ map (\x -> "\\footnotetext" <> braces x) - $ reverse ns) + $$ + vcat (intersperse + ("\\addtocounter" <> braces "footnote" <> braces "1") + $ map (\x -> "\\footnotetext" <> braces x) + $ reverse ns) listItemToLaTeX :: [Block] -> State WriterState Doc listItemToLaTeX lst @@ -636,8 +689,8 @@ defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX term -- put braces around term if it contains an internal link, -- since otherwise we get bad bracket interactions: \item[\hyperref[..] - let isInternalLink (Link _ ('#':_,_)) = True - isInternalLink _ = False + let isInternalLink (Link _ _ ('#':_,_)) = True + isInternalLink _ = False let term'' = if any isInternalLink term then braces term' else term' @@ -681,8 +734,7 @@ sectionHeader unnumbered ref level lst = do let level' = if book || writerChapters opts then level - 1 else level internalLinks <- gets stInternalLinks let refLabel x = (if ref `elem` internalLinks - then text "\\hyperdef" - <> braces empty + then text "\\hypertarget" <> braces lab <> braces x else x) @@ -756,17 +808,20 @@ inlineToLaTeX (Span (id',classes,kvs) ils) = do ref <- toLabel id' let linkAnchor = if null id' then empty - else "\\protect\\hyperdef{}" <> braces (text ref) <> - braces ("\\label" <> braces (text ref)) + else "\\protect\\hypertarget" <> braces (text ref) <> + braces empty fmap (linkAnchor <>) ((if noEmph then inCmd "textup" else id) . (if noStrong then inCmd "textnormal" else id) . (if noSmallCaps then inCmd "textnormal" else id) . (if rtl then inCmd "RL" else id) . (if ltr then inCmd "LR" else id) . - (if not (noEmph || noStrong || noSmallCaps || rtl || ltr) - then braces - else id)) `fmap` inlineListToLaTeX ils + (case lookup "lang" kvs of + Just lng -> let (l, o) = toPolyglossia $ splitBy (=='-') lng + ops = if null o then "" else brackets (text o) + in \c -> char '\\' <> "text" <> text l <> ops <> braces c + Nothing -> id) + ) `fmap` inlineListToLaTeX ils inlineToLaTeX (Emph lst) = inlineListToLaTeX lst >>= return . inCmd "emph" inlineToLaTeX (Strong lst) = @@ -847,12 +902,18 @@ inlineToLaTeX (RawInline f str) = return $ text str | otherwise = return empty inlineToLaTeX (LineBreak) = return $ "\\\\" <> cr +inlineToLaTeX SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToLaTeX Space = return space -inlineToLaTeX (Link txt ('#':ident, _)) = do +inlineToLaTeX (Link _ txt ('#':ident, _)) = do contents <- inlineListToLaTeX txt lab <- toLabel ident - return $ text "\\hyperref" <> brackets (text lab) <> braces contents -inlineToLaTeX (Link txt (src, _)) = + return $ text "\\protect\\hyperlink" <> braces (text lab) <> braces contents +inlineToLaTeX (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stUrl = True } @@ -869,16 +930,31 @@ inlineToLaTeX (Link txt (src, _)) = src' <- stringToLaTeX URLString (escapeURI src) return $ text ("\\href{" ++ src' ++ "}{") <> contents <> char '}' -inlineToLaTeX (Image _ (source, _)) = do +inlineToLaTeX (Image attr _ (source, _)) = do modify $ \s -> s{ stGraphics = True } - let source' = if isURI source + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + source' = if isURI source then source else unEscapeString source source'' <- stringToLaTeX URLString (escapeURI source') inHeading <- gets stInHeading return $ - (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") - <> braces (text source'') + (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> + dims <> braces (text source'') inlineToLaTeX (Note contents) = do inMinipage <- gets stInMinipage modify (\s -> s{stInNote = True}) @@ -1007,6 +1083,30 @@ getListingsLanguage :: [String] -> Maybe String getListingsLanguage [] = Nothing getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs +-- Extract a key from divs and spans +extract :: String -> Block -> [String] +extract key (Div attr _) = lookKey key attr +extract key (Plain ils) = concatMap (extractInline key) ils +extract key (Para ils) = concatMap (extractInline key) ils +extract key (Header _ _ ils) = concatMap (extractInline key) ils +extract _ _ = [] + +-- Extract a key from spans +extractInline :: String -> Inline -> [String] +extractInline key (Span attr _) = lookKey key attr +extractInline _ _ = [] + +-- Look up a key in an attribute and give a list of its values +lookKey :: String -> Attr -> [String] +lookKey key (_,_,kvs) = maybe [] words $ lookup key kvs + +-- In environments \Arabic instead of \arabic is used +toPolyglossiaEnv :: String -> (String, String) +toPolyglossiaEnv l = + case toPolyglossia $ (splitBy (=='-')) l of + ("arabic", o) -> ("Arabic", o) + x -> x + -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Polyglossia (language, options) tuple -- http://mirrors.concertpass.com/tex-archive/macros/latex/contrib/polyglossia/polyglossia.pdf @@ -1024,10 +1124,11 @@ toPolyglossia ("ar":"TN":_) = ("arabic", "locale=tunisia") toPolyglossia ("de":"1901":_) = ("german", "spelling=old") toPolyglossia ("de":"AT":"1901":_) = ("german", "variant=austrian, spelling=old") toPolyglossia ("de":"AT":_) = ("german", "variant=austrian") +toPolyglossia ("de":"CH":"1901":_) = ("german", "variant=swiss, spelling=old") toPolyglossia ("de":"CH":_) = ("german", "variant=swiss") toPolyglossia ("de":_) = ("german", "") toPolyglossia ("dsb":_) = ("lsorbian", "") -toPolyglossia ("el":"poly":_) = ("greek", "variant=poly") +toPolyglossia ("el":"polyton":_) = ("greek", "variant=poly") toPolyglossia ("en":"AU":_) = ("english", "variant=australian") toPolyglossia ("en":"CA":_) = ("english", "variant=canadian") toPolyglossia ("en":"GB":_) = ("english", "variant=british") @@ -1049,7 +1150,7 @@ toBabel ("de":"AT":"1901":_) = "austrian" toBabel ("de":"AT":_) = "naustrian" toBabel ("de":_) = "ngerman" toBabel ("dsb":_) = "lowersorbian" -toBabel ("el":"poly":_) = "polutonikogreek" +toBabel ("el":"polyton":_) = "polutonikogreek" toBabel ("en":"AU":_) = "australian" toBabel ("en":"CA":_) = "canadian" toBabel ("en":"GB":_) = "british" @@ -1147,3 +1248,7 @@ commonFromBcp47 x = fromIso $ head x fromIso "ur" = "urdu" fromIso "vi" = "vietnamese" fromIso _ = "" + +deNote :: Inline -> Inline +deNote (Note _) = RawInline (Format "latex") "" +deNote x = x diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 6b1e42394..5c7d760ac 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -54,7 +54,7 @@ writeMan opts document = evalState (pandocToMan opts document) (WriterState [] F -- | Return groff man representation of document. pandocToMan :: WriterOptions -> Pandoc -> State WriterState String pandocToMan opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let render' = render colwidth @@ -146,6 +146,7 @@ breakSentence xs = [] -> (as, []) [c] -> (as ++ [c], []) (c:Space:cs) -> (as ++ [c], cs) + (c:SoftBreak:cs) -> (as ++ [c], cs) (Str ".":Str (')':ys):cs) -> (as ++ [Str ".", Str (')':ys)], cs) (x@(Str ('.':')':_)):cs) -> (as ++ [x], cs) (LineBreak:x@(Str ('.':_)):cs) -> (as ++[LineBreak], x:cs) @@ -343,8 +344,9 @@ inlineToMan _ (RawInline f str) | otherwise = return empty inlineToMan _ (LineBreak) = return $ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr +inlineToMan _ SoftBreak = return space inlineToMan _ Space = return space -inlineToMan opts (Link txt (src, _)) = do +inlineToMan opts (Link _ txt (src, _)) = do linktext <- inlineListToMan opts txt let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ case txt of @@ -352,12 +354,12 @@ inlineToMan opts (Link txt (src, _)) = do | escapeURI s == srcSuffix -> char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' -inlineToMan opts (Image alternate (source, tit)) = do +inlineToMan opts (Image attr alternate (source, tit)) = do let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate - linkPart <- inlineToMan opts (Link txt (source, tit)) + linkPart <- inlineToMan opts (Link attr txt (source, tit)) return $ char '[' <> text "IMAGE: " <> linkPart <> char ']' inlineToMan _ (Note contents) = do -- add to notes in state diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index cd9c26289..79a2dddf9 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -55,7 +55,8 @@ import qualified Data.Vector as V import qualified Data.Text as T type Notes = [[Block]] -type Refs = [([Inline], Target)] +type Ref = ([Inline], Target, Attr) +type Refs = [Ref] data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stRefShortcutable :: Bool @@ -70,8 +71,9 @@ instance Default WriterState writeMarkdown :: WriterOptions -> Pandoc -> String writeMarkdown opts document = evalState (pandocToMarkdown opts{ - writerWrapText = writerWrapText opts && - not (isEnabled Ext_hard_line_breaks opts) } + writerWrapText = if isEnabled Ext_hard_line_breaks opts + then WrapNone + else writerWrapText opts } document) def -- | Convert Pandoc to plain text (like markdown, but without links, @@ -125,7 +127,8 @@ jsonToYaml (Object hashmap) = | otherwise -> (k' <> ":") $$ x (k', Object _, x) -> (k' <> ":") $$ nest 2 x (_, String "", _) -> empty - (k', _, x) -> k' <> ":" <> space <> hang 2 "" x) + (k', _, x) | k == "meta-json" -> empty + | otherwise -> k' <> ":" <> space <> hang 2 "" x) $ sortBy (comparing fst) $ H.toList hashmap jsonToYaml (Array vec) = vcat $ map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec @@ -142,7 +145,7 @@ jsonToYaml _ = empty -- | Return markdown representation of document. pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String pandocToMarkdown opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing isPlain <- gets stPlain @@ -200,15 +203,16 @@ refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat -- | Return markdown representation of a reference key. keyToMarkdown :: WriterOptions - -> ([Inline], (String, String)) + -> Ref -> State WriterState Doc -keyToMarkdown opts (label, (src, tit)) = do +keyToMarkdown opts (label, (src, tit), attr) = do label' <- inlineListToMarkdown opts label let tit' = if null tit then empty else space <> "\"" <> text tit <> "\"" return $ nest 2 $ hang 2 ("[" <> label' <> "]:" <> space) (text src <> tit') + <> linkAttributes opts attr -- | Return markdown representation of notes. notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc @@ -264,7 +268,7 @@ elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs) not (null subsecs) && lev < writerTOCDepth opts ] where headerLink = if null ident then headerText - else [Link headerText ('#':ident, "")] + else [Link nullAttr headerText ('#':ident, "")] elementToListItem _ (Blk _) = [] attrsToMarkdown :: Attr -> Doc @@ -283,6 +287,12 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] map (\(k,v) -> text k <> "=\"" <> text v <> "\"") ks +linkAttributes :: WriterOptions -> Attr -> Doc +linkAttributes opts attr = + if isEnabled Ext_link_attributes opts && attr /= nullAttr + then attrsToMarkdown attr + else empty + -- | Ordered list start parser for use in Para below. olMarker :: Parser [Char] ParserState Char olMarker = do (start, style', delim) <- anyOrderedListMarker @@ -315,7 +325,7 @@ blockToMarkdown opts (Plain inlines) = do contents <- inlineListToMarkdown opts inlines -- escape if para starts with ordered list marker st <- get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let rendered = render colwidth contents @@ -328,8 +338,8 @@ blockToMarkdown opts (Plain inlines) = do else contents return $ contents' <> cr -- title beginning with fig: indicates figure -blockToMarkdown opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToMarkdown opts (Para [Image alt (src,tit)]) +blockToMarkdown opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = + blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown opts (RawBlock f str) @@ -668,21 +678,21 @@ blockListToMarkdown opts blocks = -- | Get reference for target; if none exists, create unique one and return. -- Prefer label if possible; otherwise, generate a unique key. -getReference :: [Inline] -> Target -> State WriterState [Inline] -getReference label (src, tit) = do +getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline] +getReference attr label target = do st <- get - case find ((== (src, tit)) . snd) (stRefs st) of - Just (ref, _) -> return ref + case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of + Just (ref, _, _) -> return ref Nothing -> do - let label' = case find ((== label) . fst) (stRefs st) of + let label' = case find (\(l,_,_) -> l == label) (stRefs st) of Just _ -> -- label is used; generate numerical label case find (\n -> notElem [Str (show n)] - (map fst (stRefs st))) + (map (\(l,_,_) -> l) (stRefs st))) [1..(10000 :: Integer)] of Just x -> [Str (show x)] Nothing -> error "no unique label" Nothing -> label - modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st }) + modify (\s -> s{ stRefs = (label', target, attr) : stRefs st }) return label' -- | Convert list of Pandoc inline elements to markdown. @@ -692,13 +702,17 @@ inlineListToMarkdown opts lst = do go (if inlist then avoidBadWrapsInList lst else lst) where go [] = return empty go (i:is) = case i of - (Link _ _) -> case is of + (Link _ _ _) -> case is of -- If a link is followed by another link or '[' we don't shortcut - (Link _ _):_ -> unshortcutable - Space:(Link _ _):_ -> unshortcutable + (Link _ _ _):_ -> unshortcutable + Space:(Link _ _ _):_ -> unshortcutable Space:(Str('[':_)):_ -> unshortcutable Space:(RawInline _ ('[':_)):_ -> unshortcutable Space:(Cite _ _):_ -> unshortcutable + SoftBreak:(Link _ _ _):_ -> unshortcutable + SoftBreak:(Str('[':_)):_ -> unshortcutable + SoftBreak:(RawInline _ ('[':_)):_ -> unshortcutable + SoftBreak:(Cite _ _):_ -> unshortcutable (Cite _ _):_ -> unshortcutable Str ('[':_):_ -> unshortcutable (RawInline _ ('[':_)):_ -> unshortcutable @@ -712,18 +726,25 @@ inlineListToMarkdown opts lst = do modify (\s -> s {stRefShortcutable = True }) fmap (iMark <>) (go is) +isSp :: Inline -> Bool +isSp Space = True +isSp SoftBreak = True +isSp _ = False + avoidBadWrapsInList :: [Inline] -> [Inline] avoidBadWrapsInList [] = [] -avoidBadWrapsInList (Space:Str ('>':cs):xs) = +avoidBadWrapsInList (s:Str ('>':cs):xs) | isSp s = Str (' ':'>':cs) : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str [c]:[]) - | c `elem` ['-','*','+'] = Str [' ', c] : [] -avoidBadWrapsInList (Space:Str [c]:Space:xs) - | c `elem` ['-','*','+'] = Str [' ', c] : Space : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str cs:Space:xs) - | isOrderedListMarker cs = Str (' ':cs) : Space : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str cs:[]) - | isOrderedListMarker cs = Str (' ':cs) : [] +avoidBadWrapsInList (s:Str [c]:[]) + | isSp s && c `elem` ['-','*','+'] = Str [' ', c] : [] +avoidBadWrapsInList (s:Str [c]:Space:xs) + | isSp s && c `elem` ['-','*','+'] = + Str [' ', c] : Space : avoidBadWrapsInList xs +avoidBadWrapsInList (s:Str cs:Space:xs) + | isSp s && isOrderedListMarker cs = + Str (' ':cs) : Space : avoidBadWrapsInList xs +avoidBadWrapsInList (s:Str cs:[]) + | isSp s && isOrderedListMarker cs = Str (' ':cs) : [] avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs isOrderedListMarker :: String -> Bool @@ -738,6 +759,7 @@ isRight (Left _) = False escapeSpaces :: Inline -> Inline escapeSpaces (Str s) = Str $ substitute " " "\\ " s escapeSpaces Space = Str "\\ " +escapeSpaces SoftBreak = Str "\\ " escapeSpaces x = x -- | Convert Pandoc inline element to markdown. @@ -867,6 +889,11 @@ inlineToMarkdown opts (LineBreak) = do then "\\" <> cr else " " <> cr inlineToMarkdown _ Space = return space +inlineToMarkdown opts SoftBreak = return $ + case writerWrapText opts of + WrapNone -> space + WrapAuto -> space + WrapPreserve -> cr inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst inlineToMarkdown opts (Cite (c:cs) lst) | not (isEnabled Ext_citations opts) = inlineListToMarkdown opts lst @@ -897,7 +924,12 @@ inlineToMarkdown opts (Cite (c:cs) lst) return $ pdoc <+> r modekey SuppressAuthor = "-" modekey _ = "" -inlineToMarkdown opts (Link txt (src, tit)) = do +inlineToMarkdown opts lnk@(Link attr txt (src, tit)) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]] + | otherwise = do plain <- gets stPlain linktext <- inlineListToMarkdown opts txt let linktitle = if null tit @@ -912,7 +944,7 @@ inlineToMarkdown opts (Link txt (src, tit)) = do shortcutable <- gets stRefShortcutable let useShortcutRefLinks = shortcutable && isEnabled Ext_shortcut_reference_links opts - ref <- if useRefLinks then getReference txt (src, tit) else return [] + ref <- if useRefLinks then getReference attr txt (src, tit) else return [] reftext <- inlineListToMarkdown opts ref return $ if useAuto then if plain @@ -929,14 +961,20 @@ inlineToMarkdown opts (Link txt (src, tit)) = do else if plain then linktext else "[" <> linktext <> "](" <> - text src <> linktitle <> ")" -inlineToMarkdown opts (Image alternate (source, tit)) = do + text src <> linktitle <> ")" <> + linkAttributes opts attr +inlineToMarkdown opts img@(Image attr alternate (source, tit)) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]] + | otherwise = do plain <- gets stPlain let txt = if null alternate || alternate == [Str source] -- to prevent autolinks then [Str ""] else alternate - linkPart <- inlineToMarkdown opts (Link txt (source, tit)) + linkPart <- inlineToMarkdown opts (Link attr txt (source, tit)) return $ if plain then "[" <> linkPart <> "]" else "!" <> linkPart diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 2b7c47e24..d14865612 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate ) @@ -44,6 +45,7 @@ import Control.Monad.State data WriterState = WriterState { stNotes :: Bool -- True if there are notes + , stOptions :: WriterOptions -- writer options } data WriterReader = WriterReader { @@ -57,7 +59,7 @@ type MediaWikiWriter = ReaderT WriterReader (State WriterState) -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String writeMediaWiki opts document = - let initialState = WriterState { stNotes = False } + let initialState = WriterState { stNotes = False, stOptions = opts } env = WriterReader { options = opts, listLevel = [], useTags = False } in evalState (runReaderT (pandocToMediaWiki document) env) initialState @@ -100,14 +102,15 @@ blockToMediaWiki (Plain inlines) = inlineListToMediaWiki inlines -- title beginning with fig: indicates that the image is a figure -blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToMediaWiki (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else ("|caption " ++) `fmap` inlineListToMediaWiki txt + img <- imageToMediaWiki attr let opt = if null txt then "" else "|alt=" ++ if null tit then capt else tit ++ capt - return $ "[[File:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" + return $ "[[File:" ++ src ++ "|frame|none" ++ img ++ opt ++ "]]\n" blockToMediaWiki (Para inlines) = do tags <- asks useTags @@ -312,6 +315,23 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" +imageToMediaWiki :: Attr -> MediaWikiWriter String +imageToMediaWiki attr = do + opts <- gets stOptions + let (_, cls, _) = attr + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = '|':w ++ "px" + go (Just w) (Just h) = '|':w ++ "x" ++ h ++ "px" + go Nothing (Just h) = "|x" ++ h ++ "px" + go Nothing Nothing = "" + dims = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + classes = if null cls + then "" + else "|class=" ++ unwords cls + return $ dims ++ classes + -- | Convert list of Pandoc block elements to MediaWiki. blockListToMediaWiki :: [Block] -- ^ List of block elements -> MediaWikiWriter String @@ -377,9 +397,16 @@ inlineToMediaWiki (RawInline f str) inlineToMediaWiki (LineBreak) = return "<br />\n" +inlineToMediaWiki SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return " " + WrapNone -> return " " + WrapPreserve -> return "\n" + inlineToMediaWiki Space = return " " -inlineToMediaWiki (Link txt (src, _)) = do +inlineToMediaWiki (Link _ txt (src, _)) = do label <- inlineListToMediaWiki txt case txt of [Str s] | isURI src && escapeURI s == src -> return src @@ -390,14 +417,15 @@ inlineToMediaWiki (Link txt (src, _)) = do '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToMediaWiki (Image alt (source, tit)) = do +inlineToMediaWiki (Image attr alt (source, tit)) = do + img <- imageToMediaWiki attr alt' <- inlineListToMediaWiki alt let txt = if null tit then if null alt then "" else '|' : alt' else '|' : tit - return $ "[[File:" ++ source ++ txt ++ "]]" + return $ "[[File:" ++ source ++ img ++ txt ++ "]]" inlineToMediaWiki (Note contents) = do contents' <- blockListToMediaWiki contents diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 2343ff1a8..fc96e3e3c 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -34,7 +34,7 @@ metadata. -} module Text.Pandoc.Writers.Native ( writeNative ) where -import Text.Pandoc.Options ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) ) import Data.List ( intersperse ) import Text.Pandoc.Definition import Text.Pandoc.Pretty @@ -70,7 +70,7 @@ prettyBlock block = text $ show block -- | Prettyprint Pandoc document. writeNative :: WriterOptions -> Pandoc -> String writeNative opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing withHead = if writerStandalone opts diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 922a3a785..ce4d456a3 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -37,10 +37,10 @@ import Text.TeXMath import qualified Data.ByteString.Lazy as B import Text.Pandoc.UTF8 ( fromStringLazy ) import Codec.Archive.Zip -import Text.Pandoc.Options ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) ) import Text.Pandoc.Shared ( stringify, fetchItem', warn, getDefaultReferenceODT ) -import Text.Pandoc.ImageSize ( imageSize, sizeInPoints ) +import Text.Pandoc.ImageSize import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType ) import Text.Pandoc.Definition import Text.Pandoc.Walk @@ -67,7 +67,7 @@ writeODT opts doc@(Pandoc meta _) = do -- handle formulas and pictures picEntriesRef <- newIORef ([] :: [Entry]) doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc - let newContents = writeOpenDocument opts{writerWrapText = False} doc' + let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc' epochtime <- floor `fmap` getPOSIXTime let contentEntry = toEntry "content.xml" epochtime $ fromStringLazy newContents @@ -125,21 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do $ addEntryToArchive metaEntry archive' return $ fromArchive archive'' +-- | transform both Image and Math elements transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline -transformPicMath opts entriesRef (Image lab (src,t)) = do +transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of Left (_ :: E.SomeException) -> do warn $ "Could not find image `" ++ src ++ "', skipping..." return $ Emph lab Right (img, mbMimeType) -> do - (w,h) <- case imageSize img of - Right size -> return $ sizeInPoints size - Left msg -> do - warn $ "Could not determine image size in `" ++ - src ++ "': " ++ msg - return (0,0) - let tit' = show w ++ "x" ++ show h + (ptX, ptY) <- case imageSize img of + Right s -> return $ sizeInPoints s + Left msg -> do + warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return (100, 100) + let dims = + case (getDim Width, getDim Height) of + (Just w, Just h) -> [("width", show w), ("height", show h)] + (Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")] + (Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)] + (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")] + (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)] + _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] + where + ratio = ptX / ptY + getDim dir = case (dimension dir attr) of + Just (Percent i) -> Just $ Percent i + Just dim -> Just $ Inch $ inInch opts dim + Nothing -> Nothing + let newattr = (id', cls, dims) entries <- readIORef entriesRef let extension = fromMaybe (takeExtension $ takeWhile (/='?') src) (mbMimeType >>= extensionFromMimeType) @@ -148,9 +163,7 @@ transformPicMath opts entriesRef (Image lab (src,t)) = do epochtime <- floor `fmap` getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img modifyIORef entriesRef (entry:) - let fig | "fig:" `isPrefixOf` t = "fig:" - | otherwise = "" - return $ Image lab (newsrc, fig++tit') + return $ Image newattr lab (newsrc, t) transformPicMath _ entriesRef (Math t math) = do entries <- readIORef entriesRef let dt = if t == InlineMath then DisplayInline else DisplayBlock diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 519136861..5770c3c6f 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -45,7 +45,7 @@ import qualified Text.Pandoc.Builder as B writeOPML :: WriterOptions -> Pandoc -> String writeOPML opts (Pandoc meta blocks) = let elements = hierarchicalize blocks - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index ebe678dc0..e0434c630 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -39,7 +39,7 @@ import Text.Pandoc.Pretty import Text.Printf ( printf ) import Control.Arrow ( (***), (>>>) ) import Control.Monad.State hiding ( when ) -import Data.Char (chr, isDigit) +import Data.Char (chr) import qualified Data.Map as Map import Text.Pandoc.Writers.Shared @@ -175,7 +175,7 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: WriterOptions -> Pandoc -> String writeOpenDocument opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth @@ -191,8 +191,7 @@ writeOpenDocument opts (Pandoc meta blocks) = listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) listStyles = map listStyle (stListStyles s) - automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $ - reverse $ styles ++ listStyles + automaticStyles = vcat $ reverse $ styles ++ listStyles context = defField "body" body $ defField "automatic-styles" (render' automaticStyles) $ metadata @@ -287,8 +286,8 @@ blockToOpenDocument o bs | Plain b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b - | Para [Image c (s,'f':'i':'g':':':t)] <- bs - = figure c s t + | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs + = figure attr c s t | Para b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b @@ -343,10 +342,10 @@ blockToOpenDocument o bs return $ inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) $$ captionDoc - figure caption source title | null caption = - withParagraphStyle o "Figure" [Para [Image caption (source,title)]] + figure attr caption source title | null caption = + withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] | otherwise = do - imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image caption (source,title)]] + imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] captionDoc <- withParagraphStyle o "FigureCaption" [Para caption] return $ imageDoc $$ captionDoc @@ -375,38 +374,48 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l -- | Convert an inline element to OpenDocument. inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc inlineToOpenDocument o ils - | Space <- ils = inTextStyle space - | Span _ xs <- ils = inlinesToOpenDocument o xs - | LineBreak <- ils = return $ selfClosingTag "text:line-break" [] - | Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s - | Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l - | Strong l <- ils = withTextStyle Bold $ inlinesToOpenDocument o l - | Strikeout l <- ils = withTextStyle Strike $ inlinesToOpenDocument o l - | Superscript l <- ils = withTextStyle Sup $ inlinesToOpenDocument o l - | Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l - | SmallCaps l <- ils = withTextStyle SmallC $ inlinesToOpenDocument o l - | Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l - | Code _ s <- ils = withTextStyle Pre $ inTextStyle $ preformatted s - | Math t s <- ils = inlinesToOpenDocument o (texMathToInlines t s) - | Cite _ l <- ils = inlinesToOpenDocument o l - | RawInline f s <- ils = if f == Format "opendocument" - then return $ text s - else return empty - | Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l - | Image _ (s,t) <- ils = mkImg s t - | Note l <- ils = mkNote l - | otherwise = return empty + = case ils of + Space -> inTextStyle space + SoftBreak + | writerWrapText o == WrapPreserve + -> inTextStyle (preformatted "\n") + | otherwise -> inTextStyle space + Span _ xs -> inlinesToOpenDocument o xs + LineBreak -> return $ selfClosingTag "text:line-break" [] + Str s -> inTextStyle $ handleSpaces $ escapeStringForXML s + Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l + Strong l -> withTextStyle Bold $ inlinesToOpenDocument o l + Strikeout l -> withTextStyle Strike $ inlinesToOpenDocument o l + Superscript l -> withTextStyle Sup $ inlinesToOpenDocument o l + Subscript l -> withTextStyle Sub $ inlinesToOpenDocument o l + SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l + Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l + Code _ s -> withTextStyle Pre $ inTextStyle $ preformatted s + Math t s -> inlinesToOpenDocument o (texMathToInlines t s) + Cite _ l -> inlinesToOpenDocument o l + RawInline f s -> if f == Format "opendocument" + then return $ text s + else return empty + Link _ l (s,t) -> mkLink s t <$> inlinesToOpenDocument o l + Image attr _ (s,t) -> mkImg attr s t + Note l -> mkNote l where preformatted s = handleSpaces $ escapeStringForXML s mkLink s t = inTags False "text:a" [ ("xlink:type" , "simple") , ("xlink:href" , s ) , ("office:name", t ) ] . inSpanTags "Definition" - mkImg s t = do + mkImg (_, _, kvs) s _ = do id' <- gets stImageId modify (\st -> st{ stImageId = id' + 1 }) + let getDims [] = [] + getDims (("width", w) :xs) = ("svg:width", w) : getDims xs + getDims (("height", h):xs) = ("svg:height", h) : getDims xs + getDims (x@("style:rel-width", _) :xs) = x : getDims xs + getDims (x@("style:rel-height", _):xs) = x : getDims xs + getDims (_:xs) = getDims xs return $ inTags False "draw:frame" - (("draw:name", "img" ++ show id'):attrsFromTitle t) $ + (("draw:name", "img" ++ show id') : getDims kvs) $ selfClosingTag "draw:image" [ ("xlink:href" , s ) , ("xlink:type" , "simple") , ("xlink:show" , "embed" ) @@ -422,17 +431,6 @@ inlineToOpenDocument o ils addNote nn return nn --- a title of the form "120x140" will be interpreted as image --- size in points. -attrsFromTitle :: String -> [(String,String)] -attrsFromTitle s = if null xs || null ys - then [] - else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")] - where (xs,rest) = span isDigit s - ys = case rest of - ('x':zs) | all isDigit zs -> zs - _ -> "" - bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc])) bulletListStyle l = let doStyles i = inTags True "text:list-level-style-bullet" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 1b0ab387f..d843d2efd 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -61,7 +61,7 @@ writeOrg opts document = pandocToOrg :: Pandoc -> State WriterState String pandocToOrg (Pandoc meta blocks) = do opts <- liftM stOptions get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing metadata <- metaToJSON opts @@ -116,12 +116,12 @@ blockToOrg (Div attrs bs) = do nest 2 endTag $$ "#+END_HTML" $$ blankline blockToOrg (Plain inlines) = inlineListToOrg inlines -- title beginning with fig: indicates that the image is a figure -blockToOrg (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +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 - img <- inlineToOrg (Image txt (src,tit)) + img <- inlineToOrg (Image attr txt (src,tit)) return $ capt <> img blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines @@ -275,7 +275,13 @@ inlineToOrg (RawInline f str) | f == "tex" || f == "latex" = return $ text str inlineToOrg (RawInline _ _) = return empty inlineToOrg (LineBreak) = return (text "\\\\" <> cr) inlineToOrg Space = return space -inlineToOrg (Link txt (src, _)) = do +inlineToOrg SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapPreserve -> return cr + WrapAuto -> return space + WrapNone -> return space +inlineToOrg (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stLinks = True } @@ -283,7 +289,7 @@ inlineToOrg (Link txt (src, _)) = do _ -> do contents <- inlineListToOrg txt modify $ \s -> s{ stLinks = True } return $ "[[" <> text src <> "][" <> contents <> "]]" -inlineToOrg (Image _ (source, _)) = do +inlineToOrg (Image _ _ (source, _)) = do modify $ \s -> s{ stImages = True } return $ "[[" <> text source <> "]]" inlineToOrg (Note contents) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 334619880..3b44a6cb0 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Builder (deleteMeta) import Data.Maybe (fromMaybe) @@ -49,7 +50,7 @@ type Refs = [([Inline], Target)] data WriterState = WriterState { stNotes :: [[Block]] , stLinks :: Refs - , stImages :: [([Inline], (String, String, Maybe String))] + , stImages :: [([Inline], (Attr, String, String, Maybe String))] , stHasMath :: Bool , stHasRawTeX :: Bool , stOptions :: WriterOptions @@ -69,7 +70,7 @@ writeRST opts document = pandocToRST :: Pandoc -> State WriterState String pandocToRST (Pandoc meta blocks) = do opts <- liftM stOptions get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let subtit = case lookupMeta "subtitle" meta of @@ -138,17 +139,22 @@ noteToRST num note = do return $ nowrap $ marker $$ nest 3 contents -- | Return RST representation of picture reference table. -pictRefsToRST :: [([Inline], (String, String, Maybe String))] +pictRefsToRST :: [([Inline], (Attr, String, String, Maybe String))] -> State WriterState Doc pictRefsToRST refs = mapM pictToRST refs >>= return . vcat -- | Return RST representation of a picture substitution reference. -pictToRST :: ([Inline], (String, String,Maybe String)) +pictToRST :: ([Inline], (Attr, String, String, Maybe String)) -> State WriterState Doc -pictToRST (label, (src, _, mbtarget)) = do +pictToRST (label, (attr, src, _, mbtarget)) = do label' <- inlineListToRST label + dims <- imageDimsToRST attr + let (_, cls, _) = attr + classes = if null cls + then empty + else ":class: " <> text (unwords cls) return $ nowrap - $ ".. |" <> label' <> "| image:: " <> text src + $ ".. |" <> label' <> "| image:: " <> text src $$ hang 3 empty (classes $$ dims) $$ case mbtarget of Nothing -> empty Just t -> " :target: " <> text t @@ -183,11 +189,16 @@ blockToRST (Div attr bs) = do return $ blankline <> startTag $+$ contents $+$ endTag $$ blankline blockToRST (Plain inlines) = inlineListToRST inlines -- title beginning with fig: indicates that the image is a figure -blockToRST (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- inlineListToRST txt + dims <- imageDimsToRST attr let fig = "figure:: " <> text src - let alt = ":alt: " <> if null tit then capt else text tit - return $ hang 3 ".. " (fig $$ alt $+$ capt) $$ blankline + alt = ":alt: " <> if null tit then capt else text tit + (_,cls,_) = attr + classes = if null cls + then empty + else ":figclass: " <> text (unwords cls) + return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para inlines) | LineBreak `elem` inlines = do -- use line block if LineBreaks lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines @@ -367,11 +378,13 @@ inlineListToRST lst = surroundComplex _ _ = False okAfterComplex :: Inline -> Bool okAfterComplex Space = True + okAfterComplex SoftBreak = True okAfterComplex LineBreak = True okAfterComplex (Str (c:_)) = isSpace c || c `elem` ("-.,:;!?\\/'\")]}>–—" :: String) okAfterComplex _ = False okBeforeComplex :: Inline -> Bool okBeforeComplex Space = True + okBeforeComplex SoftBreak = True okBeforeComplex LineBreak = True okBeforeComplex (Str (c:_)) = isSpace c || c `elem` ("-:/'\"<([{–—" :: String) okBeforeComplex _ = False @@ -382,8 +395,8 @@ inlineListToRST lst = isComplex (Strikeout _) = True isComplex (Superscript _) = True isComplex (Subscript _) = True - isComplex (Link _ _) = True - isComplex (Image _ _) = True + isComplex (Link _ _ _) = True + isComplex (Image _ _ _) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex (Cite _ (x:_)) = isComplex x @@ -435,18 +448,24 @@ inlineToRST (RawInline f x) | otherwise = return empty inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space +inlineToRST SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapPreserve -> return cr + WrapAuto -> return space + WrapNone -> return space -- autolink -inlineToRST (Link [Str str] (src, _)) +inlineToRST (Link _ [Str str] (src, _)) | isURI src && if "mailto:" `isPrefixOf` src then src == escapeURI ("mailto:" ++ str) else src == escapeURI str = do let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ text srcSuffix -inlineToRST (Link [Image alt (imgsrc,imgtit)] (src, _tit)) = do - label <- registerImage alt (imgsrc,imgtit) (Just src) +inlineToRST (Link _ [Image attr alt (imgsrc,imgtit)] (src, _tit)) = do + label <- registerImage attr alt (imgsrc,imgtit) (Just src) return $ "|" <> label <> "|" -inlineToRST (Link txt (src, tit)) = do +inlineToRST (Link _ txt (src, tit)) = do useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions linktext <- inlineListToRST $ normalizeSpaces txt if useReferenceLinks @@ -461,8 +480,8 @@ inlineToRST (Link txt (src, tit)) = do modify $ \st -> st { stLinks = (txt,(src,tit)):refs } return $ "`" <> linktext <> "`_" else return $ "`" <> linktext <> " <" <> text src <> ">`__" -inlineToRST (Image alternate (source, tit)) = do - label <- registerImage alternate (source,tit) Nothing +inlineToRST (Image attr alternate (source, tit)) = do + label <- registerImage attr alternate (source,tit) Nothing return $ "|" <> label <> "|" inlineToRST (Note contents) = do -- add to notes in state @@ -471,16 +490,33 @@ inlineToRST (Note contents) = do let ref = show $ (length notes) + 1 return $ " [" <> text ref <> "]_" -registerImage :: [Inline] -> Target -> Maybe String -> State WriterState Doc -registerImage alt (src,tit) mbtarget = do +registerImage :: Attr -> [Inline] -> Target -> Maybe String -> State WriterState Doc +registerImage attr alt (src,tit) mbtarget = do pics <- get >>= return . stImages txt <- case lookup alt pics of - Just (s,t,mbt) | (s,t,mbt) == (src,tit,mbtarget) -> return alt + Just (a,s,t,mbt) | (a,s,t,mbt) == (attr,src,tit,mbtarget) + -> return alt _ -> do let alt' = if null alt || alt == [Str ""] then [Str $ "image" ++ show (length pics)] else alt modify $ \st -> st { stImages = - (alt', (src,tit, mbtarget)):stImages st } + (alt', (attr,src,tit, mbtarget)):stImages st } return alt' inlineListToRST txt + +imageDimsToRST :: Attr -> State WriterState Doc +imageDimsToRST attr = do + let (ident, _, _) = attr + name = if null ident + then empty + else ":name: " <> text ident + showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d) + in case (dimension dir attr) of + Just (Percent a) -> + case dir of + Height -> empty + Width -> cols (Percent a) + Just dim -> cols dim + Nothing -> empty + return $ cr <> name $$ showDim Width $$ showDim Height diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 9eb02ad02..79a28c880 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -46,7 +46,7 @@ import Text.Pandoc.ImageSize -- or a MediaBag, or the internet. -- If file not found or filetype not jpeg or png, leave the inline unchanged. rtfEmbedImage :: WriterOptions -> Inline -> IO Inline -rtfEmbedImage opts x@(Image _ (src,_)) = do +rtfEmbedImage opts x@(Image attr _ (src,_)) = do result <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case result of Right (imgdata, Just mime) @@ -63,12 +63,12 @@ rtfEmbedImage opts x@(Image _ (src,_)) = do return "" Right sz -> return $ "\\picw" ++ show xpx ++ "\\pich" ++ show ypx ++ - "\\picwgoal" ++ show (xpt * 20) - ++ "\\pichgoal" ++ show (ypt * 20) + "\\picwgoal" ++ show (floor (xpt * 20) :: Integer) + ++ "\\pichgoal" ++ show (floor (ypt * 20) :: Integer) -- twip = 1/1440in = 1/20pt where (xpx, ypx) = sizeInPixels sz - (xpt, ypt) = sizeInPoints sz - let raw = "{\\pict" ++ filetype ++ sizeSpec ++ " " ++ + (xpt, ypt) = desiredSizeInPoints opts attr sz + let raw = "{\\pict" ++ filetype ++ sizeSpec ++ "\\bin " ++ concat bytes ++ "}" return $ if B.null imgdata then x @@ -349,11 +349,12 @@ inlineToRTF (RawInline f str) | f == Format "rtf" = str | otherwise = "" inlineToRTF (LineBreak) = "\\line " +inlineToRTF SoftBreak = " " inlineToRTF Space = " " -inlineToRTF (Link text (src, _)) = +inlineToRTF (Link _ text (src, _)) = "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n" -inlineToRTF (Image _ (source, _)) = +inlineToRTF (Image _ _ (source, _)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" inlineToRTF (Note contents) = "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index d94dbac46..865d10123 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -45,7 +45,8 @@ import Text.Pandoc.Options (WriterOptions(..)) import qualified Data.HashMap.Strict as H import qualified Data.Map as M import qualified Data.Text as T -import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..)) +import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..), encode) +import Text.Pandoc.UTF8 (toStringLazy) import qualified Data.Traversable as Traversable import Data.List ( groupBy ) @@ -67,7 +68,8 @@ metaToJSON opts blockWriter inlineWriter (Meta metamap) renderedMap <- Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap - return $ M.foldWithKey defField baseContext renderedMap + let metadata = M.foldWithKey defField baseContext renderedMap + return $ defField "meta-json" (toStringLazy $ encode metadata) metadata | otherwise = return (Object H.empty) metaValueToJSON :: Monad m diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 2325d1425..1aefaa678 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -40,6 +40,7 @@ import Data.Ord ( comparing ) import Data.Char ( chr, ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Network.URI ( isURI, unEscapeString ) import System.FilePath @@ -49,6 +50,7 @@ data WriterState = , stSubscript :: Bool -- document contains subscript , stEscapeComma :: Bool -- in a context where we need @comma , stIdentifiers :: [String] -- header ids used already + , stOptions :: WriterOptions -- writer options } {- TODO: @@ -61,7 +63,8 @@ writeTexinfo :: WriterOptions -> Pandoc -> String writeTexinfo options document = evalState (pandocToTexinfo options $ wrapTop document) $ WriterState { stStrikeout = False, stSuperscript = False, - stEscapeComma = False, stSubscript = False, stIdentifiers = [] } + stEscapeComma = False, stSubscript = False, + stIdentifiers = [], stOptions = options} -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc @@ -72,7 +75,7 @@ pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String pandocToTexinfo options (Pandoc meta blocks) = do let titlePage = not $ all null $ docTitle meta : docDate meta : docAuthors meta - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -130,12 +133,12 @@ blockToTexinfo (Plain lst) = inlineListToTexinfo lst -- title beginning with fig: indicates that the image is a figure -blockToTexinfo (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTexinfo (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty else (\c -> text "@caption" <> braces c) `fmap` inlineListToTexinfo txt - img <- inlineToTexinfo (Image txt (src,tit)) + img <- inlineToTexinfo (Image attr txt (src,tit)) return $ text "@float" $$ img $$ capt $$ text "@end float" blockToTexinfo (Para lst) = @@ -422,13 +425,19 @@ inlineToTexinfo (RawInline f str) | f == "texinfo" = return $ text str | otherwise = return empty inlineToTexinfo (LineBreak) = return $ text "@*" <> cr +inlineToTexinfo SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToTexinfo Space = return space -inlineToTexinfo (Link txt (src@('#':_), _)) = do +inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do return $ text $ "@url{" ++ x ++ "}" @@ -437,10 +446,16 @@ inlineToTexinfo (Link txt (src, _)) = do return $ text ("@uref{" ++ src1 ++ ",") <> contents <> char '}' -inlineToTexinfo (Image alternate (source, _)) = do +inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate - return $ text ("@image{" ++ base ++ ",,,") <> content <> text "," <> - text (ext ++ "}") + opts <- gets stOptions + let showDim dim = case (dimension dim attr) of + (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" + (Just (Percent _)) -> "" + (Just d) -> show d + Nothing -> "" + return $ text ("@image{" ++ base ++ ',':(showDim Width) ++ ',':(showDim Height) ++ ",") + <> content <> text "," <> text (ext ++ "}") where ext = drop 1 $ takeExtension source' base = dropExtension source' diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index df632adc6..98f9157fb 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Writers.Shared import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) @@ -44,6 +45,7 @@ import Data.Char ( isSpace ) data WriterState = WriterState { stNotes :: [String] -- Footnotes , stListLevel :: [Char] -- String at beginning of list items, e.g. "**" + , stStartNum :: Maybe Int -- Start number if first list item , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } @@ -51,7 +53,8 @@ data WriterState = WriterState { writeTextile :: WriterOptions -> Pandoc -> String writeTextile opts document = evalState (pandocToTextile opts document) - WriterState { stNotes = [], stListLevel = [], stUseTags = False } + WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing, + stUseTags = False } -- | Return Textile representation of document. pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String @@ -114,9 +117,9 @@ blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines -- title beginning with fig: indicates that the image is a figure -blockToTextile opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- blockToTextile opts (Para txt) - im <- inlineToTextile opts (Image txt (src,tit)) + im <- inlineToTextile opts (Image attr txt (src,tit)) return $ im ++ "\n" ++ capt blockToTextile opts (Para inlines) = do @@ -218,7 +221,7 @@ blockToTextile opts x@(BulletList items) = do modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ (if level > 1 then "" else "\n") -blockToTextile opts x@(OrderedList attribs items) = do +blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do oldUseTags <- liftM stUseTags get let useTags = oldUseTags || not (isSimpleList x) if useTags @@ -227,10 +230,14 @@ blockToTextile opts x@(OrderedList attribs items) = do return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ "\n</ol>\n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "#" } + modify $ \s -> s { stListLevel = stListLevel s ++ "#" + , stStartNum = if start > 1 + then Just start + else Nothing } level <- get >>= return . length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s) } + modify $ \s -> s { stListLevel = init (stListLevel s), + stStartNum = Nothing } return $ vcat contents ++ (if level > 1 then "" else "\n") blockToTextile opts (DefinitionList items) = do @@ -258,8 +265,13 @@ listItemToTextile opts items = do if useTags then return $ "<li>" ++ contents ++ "</li>" else do - marker <- get >>= return . stListLevel - return $ marker ++ " " ++ contents + marker <- gets stListLevel + mbstart <- gets stStartNum + case mbstart of + Just n -> do + modify $ \s -> s{ stStartNum = Nothing } + return $ marker ++ show n ++ " " ++ contents + Nothing -> return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to Textile. definitionListItemToTextile :: WriterOptions @@ -276,8 +288,8 @@ isSimpleList :: Block -> Bool isSimpleList x = case x of BulletList items -> all isSimpleListItem items - OrderedList (num, sty, _) items -> all isSimpleListItem items && - num == 1 && sty `elem` [DefaultStyle, Decimal] + OrderedList (_, sty, _) items -> all isSimpleListItem items && + sty `elem` [DefaultStyle, Decimal] _ -> False -- | True if list item can be handled with the simple wiki syntax. False if @@ -422,25 +434,43 @@ inlineToTextile opts (RawInline f str) inlineToTextile _ (LineBreak) = return "\n" +inlineToTextile _ SoftBreak = return " " + inlineToTextile _ Space = return " " -inlineToTextile opts (Link txt (src, _)) = do +inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do + let classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" label <- case txt of [Code _ s] | s == src -> return "$" [Str s] | s == src -> return "$" _ -> inlineListToTextile opts txt - return $ "\"" ++ label ++ "\":" ++ src + return $ "\"" ++ classes ++ label ++ "\":" ++ src -inlineToTextile opts (Image alt (source, tit)) = do +inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do alt' <- inlineListToTextile opts alt let txt = if null tit then if null alt' then "" else "(" ++ alt' ++ ")" else "(" ++ tit ++ ")" - return $ "!" ++ source ++ txt ++ "!" + classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" + showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" + in case (dimension dir attr) of + Just (Percent a) -> toCss $ show (Percent a) + Just dim -> toCss $ showInPixel opts dim ++ "px" + Nothing -> Nothing + styles = case (showDim Width, showDim Height) of + (Just w, Just h) -> "{" ++ w ++ h ++ "}" + (Just w, Nothing) -> "{" ++ w ++ "height:auto;}" + (Nothing, Just h) -> "{" ++ "width:auto;" ++ h ++ "}" + (Nothing, Nothing) -> "" + return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!" inlineToTextile opts (Note contents) = do curNotes <- liftM stNotes get |