diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 10 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Muse.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Org.hs | 19 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint.hs | 80 |
5 files changed, 101 insertions, 18 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 94529dad4..e4240ca4f 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -213,8 +213,12 @@ writeDocx opts doc@(Pandoc meta _) = do let doc' = walk fixDisplayMath doc username <- P.lookupEnv "USERNAME" utctime <- P.getCurrentTime - distArchive <- (toArchive . BL.fromStrict) <$> - P.readDefaultDataFile "reference.docx" + distArchive <- (toArchive . BL.fromStrict) <$> do + oldUserDataDir <- P.getUserDataDir + P.setUserDataDir Nothing + res <- P.readDefaultDataFile "reference.docx" + P.setUserDataDir oldUserDataDir + return res refArchive <- case writerReferenceDoc opts of Just f -> toArchive <$> P.readFileLazy f Nothing -> (toArchive . BL.fromStrict) <$> diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 8dda969d9..e9e380a6c 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -325,6 +325,9 @@ tableItemToJATS :: PandocMonad m -> Bool -> [Block] -> JATS m Doc +tableItemToJATS opts isHeader [Plain item] = + inTags True (if isHeader then "th" else "td") [] <$> + inlinesToJATS opts item tableItemToJATS opts isHeader item = (inTags True (if isHeader then "th" else "td") [] . vcat) <$> mapM (blockToJATS opts) item @@ -416,8 +419,11 @@ inlineToJATS opts (Link (ident,_,kvs) txt ('#':src, _)) = do [("alt", stringify txt) | not (null txt)] ++ [("rid", src)] ++ [(k,v) | (k,v) <- kvs, k `elem` ["ref-type", "specific-use"]] - contents <- inlinesToJATS opts txt - return $ inTags False "xref" attr contents + if null txt + then return $ selfClosingTag "xref" attr + else do + contents <- inlinesToJATS opts txt + return $ inTags False "xref" attr contents inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do let attr = [("id", ident) | not (null ident)] ++ [("ext-link-type", "uri"), diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 545891d97..34936504e 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -229,7 +229,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do else "#" <> text ident <> cr let header' = text $ replicate level '*' return $ blankline <> nowrap (header' <> space <> contents) - <> blankline <> attr' + $$ attr' <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline blockToMuse (Table caption _ _ headers rows) = do diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index e10fcd5ce..43b5b59ee 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -308,13 +308,18 @@ blockListToOrg blocks = vcat <$> mapM blockToOrg blocks inlineListToOrg :: PandocMonad m => [Inline] -> Org m Doc -inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixNotes lst) - where fixNotes [] = [] -- prevent note ref from wrapping, see #4171 - fixNotes (Space : n@Note{} : rest) = - Str " " : n : fixNotes rest - fixNotes (SoftBreak : n@Note{} : rest) = - Str " " : n : fixNotes rest - fixNotes (x : rest) = x : fixNotes rest +inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst) + where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171 + fixMarkers (Space : x : rest) | shouldFix x = + Str " " : x : fixMarkers rest + fixMarkers (SoftBreak : x : rest) | shouldFix x = + Str " " : x : fixMarkers rest + fixMarkers (x : rest) = x : fixMarkers rest + + shouldFix Note{} = True -- Prevent footnotes + shouldFix (Str "-") = True -- Prevent bullet list items + -- TODO: prevent ordered list items + shouldFix _ = False -- | Convert Pandoc inline element to Org. inlineToOrg :: PandocMonad m => Inline -> Org m Doc diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs index b5f06c581..7a453ef1f 100644 --- a/src/Text/Pandoc/Writers/Powerpoint.hs +++ b/src/Text/Pandoc/Writers/Powerpoint.hs @@ -105,6 +105,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta , envPresentationSize :: PresentationSize , envSlideHasHeader :: Bool , envInList :: Bool + , envInNoteSlide :: Bool } deriving (Show) @@ -120,6 +121,7 @@ instance Default WriterEnv where , envPresentationSize = def , envSlideHasHeader = False , envInList = False + , envInNoteSlide = False } data MediaInfo = MediaInfo { mInfoFilePath :: FilePath @@ -139,6 +141,7 @@ data WriterState = WriterState { stCurSlideId :: Int -- (FP, Local ID, Global ID, Maybe Mime) , stMediaIds :: M.Map Int [MediaInfo] , stMediaGlobalIds :: M.Map FilePath Int + , stNoteIds :: M.Map Int [Block] } deriving (Show, Eq) instance Default WriterState where @@ -147,6 +150,7 @@ instance Default WriterState where , stLinkIds = mempty , stMediaIds = mempty , stMediaGlobalIds = mempty + , stNoteIds = mempty } type P m = ReaderT WriterEnv (StateT WriterState m) @@ -300,6 +304,7 @@ data RunProps = RunProps { rPropBold :: Bool , rLink :: Maybe (URL, String) , rPropCode :: Bool , rPropBlockQuote :: Bool + , rPropForceSize :: Maybe Pixels } deriving (Show, Eq) instance Default RunProps where @@ -311,6 +316,7 @@ instance Default RunProps where , rLink = Nothing , rPropCode = False , rPropBlockQuote = False + , rPropForceSize = Nothing } -------------------------------------------------- @@ -351,6 +357,14 @@ inlineToParElems (Code _ str) = do inlineToParElems $ Str str inlineToParElems (Math mathtype str) = return [MathElem mathtype (TeXString str)] +inlineToParElems (Note blks) = do + notes <- gets stNoteIds + let maxNoteId = case M.keys notes of + [] -> 0 + lst -> maximum lst + curNoteId = maxNoteId + 1 + modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes } + inlineToParElems $ Superscript [Str $ show curNoteId] inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils inlineToParElems (RawInline _ _) = return [] inlineToParElems _ = return [] @@ -375,7 +389,7 @@ blockToParagraphs (CodeBlock attr str) = -- TODO: work out the format blockToParagraphs (BlockQuote blks) = local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100} - , envRunProps = (envRunProps r){rPropBlockQuote = True}})$ + , envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$ concatMapM blockToParagraphs blks -- TODO: work out the format blockToParagraphs (RawBlock _ _) = return [] @@ -411,6 +425,15 @@ blockToParagraphs (OrderedList listAttr blksLst) = do , pPropMarginLeft = Nothing }}) $ concatMapM multiParBullet blksLst +blockToParagraphs (DefinitionList entries) = do + let go :: PandocMonad m => ([Inline], [[Block]]) -> P m [Paragraph] + go (ils, blksLst) = do + term <-blockToParagraphs $ Para [Strong ils] + -- For now, we'll treat each definition term as a + -- blockquote. We can extend this further later. + definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst + return $ term ++ definition + concatMapM go entries blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks -- TODO blockToParagraphs blk = do @@ -527,12 +550,18 @@ blocksToSlide' lvl ((Header n _ ils) : blks) return $ TitleSlide {titleSlideHeader = hdr} | n == lvl = do hdr <- inlinesToParElems ils - shapes <- blocksToShapes blks + inNoteSlide <- asks envInNoteSlide + shapes <- if inNoteSlide + then forceFontSize noteSize $ blocksToShapes blks + else blocksToShapes blks return $ ContentSlide { contentSlideHeader = hdr , contentSlideContent = shapes } blocksToSlide' _ (blk : blks) = do - shapes <- blocksToShapes (blk : blks) + inNoteSlide <- asks envInNoteSlide + shapes <- if inNoteSlide + then forceFontSize noteSize $ blocksToShapes (blk : blks) + else blocksToShapes (blk : blks) return $ ContentSlide { contentSlideHeader = [] , contentSlideContent = shapes } @@ -545,6 +574,38 @@ blocksToSlide blks = do slideLevel <- asks envSlideLevel blocksToSlide' slideLevel blks +makeNoteEntry :: Int -> [Block] -> [Block] +makeNoteEntry n blks = + let enum = Str (show n ++ ".") + in + case blks of + (Para ils : blks') -> (Para $ enum : Space : ils) : blks' + _ -> (Para [enum]) : blks + +forceFontSize :: PandocMonad m => Pixels -> P m a -> P m a +forceFontSize px x = do + rpr <- asks envRunProps + local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x + +-- Right now, there's no logic for making more than one slide, but I +-- want to leave the option open to make multiple slides if we figure +-- out how to guess at how much space the text of the notes will take +-- up (or if we allow a way for it to be manually controlled). Plus a +-- list will make it easier to put together in the final +-- `blocksToPresentation` function (since we can just add an empty +-- list without checking the state). +makeNotesSlides :: PandocMonad m => P m [Slide] +makeNotesSlides = local (\env -> env{envInNoteSlide=True}) $ do + noteIds <- gets stNoteIds + if M.null noteIds + then return [] + else do let hdr = Header 2 nullAttr [Str "Notes"] + blks <- return $ + concatMap (\(n, bs) -> makeNoteEntry n bs) $ + M.toList noteIds + sld <- blocksToSlide $ hdr : blks + return [sld] + getMetaSlide :: PandocMonad m => P m (Maybe Slide) getMetaSlide = do meta <- asks envMetadata @@ -570,11 +631,13 @@ blocksToPresentation :: PandocMonad m => [Block] -> P m Presentation blocksToPresentation blks = do blksLst <- splitBlocks blks slides <- mapM blocksToSlide blksLst + noteSlides <- makeNotesSlides + let slides' = slides ++ noteSlides metadataslide <- getMetaSlide presSize <- asks envPresentationSize return $ case metadataslide of - Just metadataslide' -> Presentation presSize $ metadataslide' : slides - Nothing -> Presentation presSize slides + Just metadataslide' -> Presentation presSize $ metadataslide' : slides' + Nothing -> Presentation presSize slides' -------------------------------------------------------------------- @@ -1045,13 +1108,18 @@ makePicElement mInfo attr = do blockQuoteSize :: Pixels blockQuoteSize = 20 +noteSize :: Pixels +noteSize = 18 + paraElemToElement :: PandocMonad m => ParaElem -> P m Element paraElemToElement Break = return $ mknode "a:br" [] () paraElemToElement (Run rpr s) = do let attrs = if rPropCode rpr then [] - else (if rPropBlockQuote rpr then [("sz", (show $ blockQuoteSize * 100))] else []) ++ + else (case rPropForceSize rpr of + Just n -> [("sz", (show $ n * 100))] + Nothing -> []) ++ (if rPropBold rpr then [("b", "1")] else []) ++ (if rPropItalics rpr then [("i", "1")] else []) ++ (case rStrikethrough rpr of |