diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 37 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 6 |
5 files changed, 45 insertions, 15 deletions
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 82b6e8221..0f4e338e6 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -41,6 +41,7 @@ import qualified Text.Pandoc.Class as P import Data.Time import Text.Pandoc.Definition import Text.Pandoc.Error +import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType) import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..), @@ -67,6 +68,7 @@ data Chapter = Chapter (Maybe [Int]) [Block] data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))] + , stMediaNextId :: Int , stEpubSubdir :: String } @@ -390,7 +392,7 @@ writeEPUB epubVersion opts doc = do -- sanity check on epubSubdir unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $ throwError $ PandocEpubSubdirectoryError epubSubdir - let initState = EPUBState { stMediaPaths = [], stEpubSubdir = epubSubdir } + let initState = EPUBState { stMediaPaths = [], stMediaNextId = 0, stEpubSubdir = epubSubdir } evalStateT (pandocToEPUB epubVersion opts doc) initState pandocToEPUB :: PandocMonad m @@ -450,14 +452,23 @@ pandocToEPUB version opts doc = do Nothing -> return ([],[]) Just img -> do let coverImage = takeFileName img + imgContent <- lift $ P.readFileLazy img + (coverImageWidth, coverImageHeight) <- + case imageSize opts' (B.toStrict imgContent) of + Right sz -> return $ sizeInPixels sz + Left err' -> (0, 0) <$ report + (CouldNotDetermineImageSize img err') cpContent <- lift $ writeHtml opts'{ writerVariables = ("coverpage","true"): ("pagetitle", escapeStringForXML plainTitle): + ("cover-image", coverImage): + ("cover-image-width", show coverImageWidth): + ("cover-image-height", + show coverImageHeight): cssvars True ++ vars } - (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"../media/" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"]) - imgContent <- lift $ P.readFileLazy img + (Pandoc meta []) coverEntry <- mkEntry "text/cover.xhtml" cpContent coverImageEntry <- mkEntry ("media/" ++ coverImage) imgContent @@ -994,17 +1005,25 @@ modifyMediaRef oldsrc = do Just (n,_) -> return n Nothing -> catchError (do (img, mbMime) <- P.fetchItem oldsrc - let new = "media/file" ++ show (length media) ++ - fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) - (('.':) <$> (mbMime >>= extensionFromMimeType)) - entry <- mkEntry new (B.fromChunks . (:[]) $ img) + let ext = fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) + (('.':) <$> (mbMime >>= extensionFromMimeType)) + newName <- getMediaNextNewName ext + let newPath = "media/" ++ newName + entry <- mkEntry newPath (B.fromChunks . (:[]) $ img) modify $ \st -> st{ stMediaPaths = - (oldsrc, (new, Just entry)):media} - return new) + (oldsrc, (newPath, Just entry)):media} + return newPath) (\e -> do report $ CouldNotFetchResource oldsrc (show e) return oldsrc) +getMediaNextNewName :: PandocMonad m => String -> E m String +getMediaNextNewName ext = do + nextId <- gets stMediaNextId + modify $ \st -> st { stMediaNextId = nextId + 1 } + let nextName = "file" ++ show nextId ++ ext + (P.fetchItem nextName >> getMediaNextNewName ext) `catchError` const (return nextName) + transformBlock :: PandocMonad m => Block -> E m Block diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index ca44583ab..241479157 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -621,6 +621,7 @@ toAttrs kvs = do if x `Set.member` (html5Attributes <> rdfaAttributes) || ':' `elem` x -- e.g. epub: namespace || "data-" `isPrefixOf` x + || "aria-" `isPrefixOf` x then Just $ customAttribute (fromString x) (toValue y) else Just $ customAttribute (fromString ("data-" ++ x)) (toValue y) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 145d37bee..61a68d543 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -88,7 +88,9 @@ docToJATS opts (Pandoc meta blocks) = do mapM (elementToJATS opts' startLvl) elements notes <- reverse . map snd <$> gets jatsNotes backs <- mapM (elementToJATS opts' startLvl) backElements - let fns = inTagsIndented "fn-group" $ vcat notes + let fns = if null notes + then mempty + else inTagsIndented "fn-group" $ vcat notes let back = render' $ vcat backs $$ fns let date = case getField "date" metadata -- an object `mplus` diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index ed8682a84..506461fac 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -26,6 +26,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared +import Text.Pandoc.Walk (walk) import Text.Pandoc.Templates import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared @@ -228,7 +229,9 @@ definitionListItemToMan :: PandocMonad m -> ([Inline],[[Block]]) -> StateT WriterState m Doc definitionListItemToMan opts (label, defs) = do - labelText <- inlineListToMan opts label + -- in most man pages, option and other code in option lists is boldface, + -- but not other things, so we try to reproduce this style: + labelText <- inlineListToMan opts $ makeCodeBold label contents <- if null defs then return empty else liftM vcat $ forM defs $ \blocks -> @@ -245,7 +248,12 @@ definitionListItemToMan opts (label, defs) = do then empty else text ".RS" $$ rest' $$ text ".RE" [] -> return empty - return $ text ".TP" $$ nowrap (text ".B " <> labelText) $$ contents + return $ text ".TP" $$ nowrap labelText $$ contents + +makeCodeBold :: [Inline] -> [Inline] +makeCodeBold = walk go + where go x@(Code{}) = Strong [x] + go x = x -- | Convert list of Pandoc block elements to man. blockListToMan :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 1f55be797..a9163b3b9 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -63,7 +63,7 @@ import Text.Pandoc.XML (escapeStringForXML) -- Variables overwrite metadata fields with the same names. -- If multiple variables are set with the same name, a list is -- assigned. Does nothing if 'writerTemplate' is Nothing. -metaToJSON :: (Functor m, Monad m, ToJSON a) +metaToJSON :: (Monad m, ToJSON a) => WriterOptions -> ([Block] -> m a) -> ([Inline] -> m a) @@ -76,7 +76,7 @@ metaToJSON opts blockWriter inlineWriter meta -- | Like 'metaToJSON', but does not include variables and is -- not sensitive to 'writerTemplate'. -metaToJSON' :: (Functor m, Monad m, ToJSON a) +metaToJSON' :: (Monad m, ToJSON a) => ([Block] -> m a) -> ([Inline] -> m a) -> Meta @@ -99,7 +99,7 @@ addVariablesToJSON opts metadata = where combineMetadata (Object o1) (Object o2) = Object $ H.union o1 o2 combineMetadata x _ = x -metaValueToJSON :: (Functor m, Monad m, ToJSON a) +metaValueToJSON :: (Monad m, ToJSON a) => ([Block] -> m a) -> ([Inline] -> m a) -> MetaValue |