Implemented \graphicspath in LaTeX reader.

Closes #736.
This commit is contained in:
John MacFarlane 2017-02-24 15:34:41 +01:00
parent b8674519d5
commit 0448b7d1fc
2 changed files with 86 additions and 69 deletions

View file

@ -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 }

View file

@ -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"