parent
b8674519d5
commit
0448b7d1fc
2 changed files with 86 additions and 69 deletions
|
@ -53,7 +53,7 @@ import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
|
||||||
import Text.Pandoc.ImageSize (numUnit, showFl)
|
import Text.Pandoc.ImageSize (numUnit, showFl)
|
||||||
import Control.Monad.Except (throwError)
|
import Control.Monad.Except (throwError)
|
||||||
import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, report,
|
import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, report,
|
||||||
readFileFromDirs)
|
readFileFromDirs, setResourcePath)
|
||||||
|
|
||||||
-- | Parse LaTeX from string and return 'Pandoc' document.
|
-- | Parse LaTeX from string and return 'Pandoc' document.
|
||||||
readLaTeX :: PandocMonad m
|
readLaTeX :: PandocMonad m
|
||||||
|
@ -372,6 +372,7 @@ blockCommands = M.fromList $
|
||||||
addMeta "bibliography" . splitBibs))
|
addMeta "bibliography" . splitBibs))
|
||||||
-- includes
|
-- includes
|
||||||
, ("lstinputlisting", inputListing)
|
, ("lstinputlisting", inputListing)
|
||||||
|
, ("graphicspath", graphicsPath)
|
||||||
] ++ map ignoreBlocks
|
] ++ map ignoreBlocks
|
||||||
-- these commands will be ignored unless --parse-raw is specified,
|
-- these commands will be ignored unless --parse-raw is specified,
|
||||||
-- in which case they will appear as raw latex blocks
|
-- in which case they will appear as raw latex blocks
|
||||||
|
@ -390,6 +391,12 @@ blockCommands = M.fromList $
|
||||||
, "newpage"
|
, "newpage"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
graphicsPath :: PandocMonad m => LP m Blocks
|
||||||
|
graphicsPath = do
|
||||||
|
ps <- bgroup *> (manyTill braced egroup)
|
||||||
|
setResourcePath (".":ps)
|
||||||
|
return mempty
|
||||||
|
|
||||||
addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
|
addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
|
||||||
addMeta field val = updateState $ \st ->
|
addMeta field val = updateState $ \st ->
|
||||||
st{ stateMeta = addMetaField field val $ stateMeta st }
|
st{ stateMeta = addMetaField field val $ stateMeta st }
|
||||||
|
|
|
@ -48,14 +48,13 @@ import Text.Pandoc.Options
|
||||||
import Text.Pandoc.Writers.Math
|
import Text.Pandoc.Writers.Math
|
||||||
import Text.Pandoc.Highlighting ( highlight )
|
import Text.Pandoc.Highlighting ( highlight )
|
||||||
import Text.Pandoc.Walk
|
import Text.Pandoc.Walk
|
||||||
import Text.Pandoc.Error (PandocError)
|
|
||||||
import Text.XML.Light as XML
|
import Text.XML.Light as XML
|
||||||
import Text.TeXMath
|
import Text.TeXMath
|
||||||
import Text.Pandoc.Readers.Docx.StyleMap
|
import Text.Pandoc.Readers.Docx.StyleMap
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Skylighting
|
import Skylighting
|
||||||
import Control.Monad.Except (runExceptT)
|
import Control.Monad.Except (catchError)
|
||||||
import System.Random (randomR)
|
import System.Random (randomR)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
|
@ -68,6 +67,7 @@ import Data.Char (ord, isSpace, toLower)
|
||||||
import Text.Pandoc.Class (PandocMonad, report)
|
import Text.Pandoc.Class (PandocMonad, report)
|
||||||
import qualified Text.Pandoc.Class as P
|
import qualified Text.Pandoc.Class as P
|
||||||
import Text.Pandoc.Logging
|
import Text.Pandoc.Logging
|
||||||
|
import Text.Pandoc.Error
|
||||||
|
|
||||||
data ListMarker = NoMarker
|
data ListMarker = NoMarker
|
||||||
| BulletMarker
|
| BulletMarker
|
||||||
|
@ -1175,72 +1175,82 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
|
||||||
case M.lookup src imgs of
|
case M.lookup src imgs of
|
||||||
Just (_,_,_,elt,_) -> return [elt]
|
Just (_,_,_,elt,_) -> return [elt]
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
res <- runExceptT $ lift (P.fetchItem (writerSourceURL opts) src)
|
catchError
|
||||||
case res of
|
(do (img, mt) <- P.fetchItem (writerSourceURL opts) src
|
||||||
Left (_ :: PandocError) -> do
|
ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId)
|
||||||
report $ CouldNotFetchResource src ""
|
let (xpt,ypt) = desiredSizeInPoints opts attr
|
||||||
-- emit alt text
|
(either (const def) id (imageSize opts img))
|
||||||
inlinesToOpenXML opts alt
|
-- 12700 emu = 1 pt
|
||||||
Right (img, mt) -> do
|
let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700)
|
||||||
ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId)
|
(pageWidth * 12700)
|
||||||
let (xpt,ypt) = desiredSizeInPoints opts attr
|
let cNvPicPr = mknode "pic:cNvPicPr" [] $
|
||||||
(either (const def) id (imageSize opts img))
|
mknode "a:picLocks" [("noChangeArrowheads","1")
|
||||||
-- 12700 emu = 1 pt
|
,("noChangeAspect","1")] ()
|
||||||
let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) (pageWidth * 12700)
|
let nvPicPr = mknode "pic:nvPicPr" []
|
||||||
let cNvPicPr = mknode "pic:cNvPicPr" [] $
|
[ mknode "pic:cNvPr"
|
||||||
mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
|
[("descr",src),("id","0"),("name","Picture")] ()
|
||||||
let nvPicPr = mknode "pic:nvPicPr" []
|
, cNvPicPr ]
|
||||||
[ mknode "pic:cNvPr"
|
let blipFill = mknode "pic:blipFill" []
|
||||||
[("descr",src),("id","0"),("name","Picture")] ()
|
[ mknode "a:blip" [("r:embed",ident)] ()
|
||||||
, cNvPicPr ]
|
, mknode "a:stretch" [] $
|
||||||
let blipFill = mknode "pic:blipFill" []
|
mknode "a:fillRect" [] () ]
|
||||||
[ mknode "a:blip" [("r:embed",ident)] ()
|
let xfrm = mknode "a:xfrm" []
|
||||||
, mknode "a:stretch" [] $ mknode "a:fillRect" [] () ]
|
[ mknode "a:off" [("x","0"),("y","0")] ()
|
||||||
let xfrm = mknode "a:xfrm" []
|
, mknode "a:ext" [("cx",show xemu)
|
||||||
[ mknode "a:off" [("x","0"),("y","0")] ()
|
,("cy",show yemu)] () ]
|
||||||
, mknode "a:ext" [("cx",show xemu),("cy",show yemu)] () ]
|
let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
|
||||||
let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
|
mknode "a:avLst" [] ()
|
||||||
mknode "a:avLst" [] ()
|
let ln = mknode "a:ln" [("w","9525")]
|
||||||
let ln = mknode "a:ln" [("w","9525")]
|
[ mknode "a:noFill" [] ()
|
||||||
[ mknode "a:noFill" [] ()
|
, mknode "a:headEnd" [] ()
|
||||||
, mknode "a:headEnd" [] ()
|
, mknode "a:tailEnd" [] () ]
|
||||||
, mknode "a:tailEnd" [] () ]
|
let spPr = mknode "pic:spPr" [("bwMode","auto")]
|
||||||
let spPr = mknode "pic:spPr" [("bwMode","auto")]
|
[xfrm, prstGeom, mknode "a:noFill" [] (), ln]
|
||||||
[xfrm, prstGeom, mknode "a:noFill" [] (), ln]
|
let graphic = mknode "a:graphic" [] $
|
||||||
let graphic = mknode "a:graphic" [] $
|
mknode "a:graphicData"
|
||||||
mknode "a:graphicData" [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
|
[("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
|
||||||
[ mknode "pic:pic" []
|
[ mknode "pic:pic" []
|
||||||
[ nvPicPr
|
[ nvPicPr
|
||||||
, blipFill
|
, blipFill
|
||||||
, spPr ] ]
|
, spPr ] ]
|
||||||
let imgElt = mknode "w:r" [] $
|
let imgElt = mknode "w:r" [] $
|
||||||
mknode "w:drawing" [] $
|
mknode "w:drawing" [] $
|
||||||
mknode "wp:inline" []
|
mknode "wp:inline" []
|
||||||
[ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
|
[ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
|
||||||
, mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
|
, mknode "wp:effectExtent"
|
||||||
, mknode "wp:docPr" [("descr",stringify alt), ("title", title), ("id","1"),("name","Picture")] ()
|
[("b","0"),("l","0"),("r","0"),("t","0")] ()
|
||||||
, graphic ]
|
, mknode "wp:docPr" [("descr",stringify alt)
|
||||||
let imgext = case mt >>= extensionFromMimeType of
|
,("title", title)
|
||||||
Just x -> '.':x
|
,("id","1")
|
||||||
Nothing -> case imageType img of
|
,("name","Picture")] ()
|
||||||
Just Png -> ".png"
|
, graphic ]
|
||||||
Just Jpeg -> ".jpeg"
|
let imgext = case mt >>= extensionFromMimeType of
|
||||||
Just Gif -> ".gif"
|
Just x -> '.':x
|
||||||
Just Pdf -> ".pdf"
|
Nothing -> case imageType img of
|
||||||
Just Eps -> ".eps"
|
Just Png -> ".png"
|
||||||
Just Svg -> ".svg"
|
Just Jpeg -> ".jpeg"
|
||||||
Nothing -> ""
|
Just Gif -> ".gif"
|
||||||
if null imgext
|
Just Pdf -> ".pdf"
|
||||||
then -- without an extension there is no rule for content type
|
Just Eps -> ".eps"
|
||||||
inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
|
Just Svg -> ".svg"
|
||||||
else do
|
Nothing -> ""
|
||||||
let imgpath = "media/" ++ ident ++ imgext
|
if null imgext
|
||||||
let mbMimeType = mt <|> getMimeType imgpath
|
then -- without an extension there is no rule for content type
|
||||||
-- insert mime type to use in constructing [Content_Types].xml
|
inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
|
||||||
modify $ \st -> st{ stImages =
|
else do
|
||||||
M.insert src (ident, imgpath, mbMimeType, imgElt, img)
|
let imgpath = "media/" ++ ident ++ imgext
|
||||||
$ stImages st }
|
let mbMimeType = mt <|> getMimeType imgpath
|
||||||
return [imgElt]
|
-- insert mime type to use in constructing [Content_Types].xml
|
||||||
|
modify $ \st -> st{ stImages =
|
||||||
|
M.insert src (ident, imgpath, mbMimeType, imgElt, img)
|
||||||
|
$ stImages st }
|
||||||
|
return [imgElt])
|
||||||
|
(\e -> do case e of
|
||||||
|
PandocIOError _ e' ->
|
||||||
|
report $ CouldNotFetchResource src (show e')
|
||||||
|
e' -> report $ CouldNotFetchResource src (show e')
|
||||||
|
-- emit alt text
|
||||||
|
inlinesToOpenXML opts alt)
|
||||||
|
|
||||||
br :: Element
|
br :: Element
|
||||||
br = breakElement "textWrapping"
|
br = breakElement "textWrapping"
|
||||||
|
|
Loading…
Add table
Reference in a new issue