2013-01-11 15:45:19 -08:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2010-07-02 20:12:14 -07:00
|
|
|
{-
|
|
|
|
Copyright (C) 2008-2010 John MacFarlane <jgm@berkeley.edu>
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
along with this program; if not, write to the Free Software
|
|
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
-}
|
|
|
|
|
|
|
|
{- |
|
|
|
|
Module : Text.Pandoc.Writers.ODT
|
|
|
|
Copyright : Copyright (C) 2008-2010 John MacFarlane
|
|
|
|
License : GNU GPL, version 2 or above
|
|
|
|
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
|
|
Stability : alpha
|
|
|
|
Portability : portable
|
|
|
|
|
|
|
|
Conversion of 'Pandoc' documents to ODT.
|
|
|
|
-}
|
|
|
|
module Text.Pandoc.Writers.ODT ( writeODT ) where
|
|
|
|
import Data.IORef
|
2011-07-17 23:21:59 -07:00
|
|
|
import Data.List ( isPrefixOf )
|
2010-07-02 20:12:14 -07:00
|
|
|
import qualified Data.ByteString.Lazy as B
|
2012-09-25 19:54:21 -07:00
|
|
|
import Text.Pandoc.UTF8 ( fromStringLazy )
|
2010-07-02 20:12:14 -07:00
|
|
|
import Codec.Archive.Zip
|
2012-07-26 22:59:56 -07:00
|
|
|
import Text.Pandoc.Options ( WriterOptions(..) )
|
2013-01-11 16:19:06 -08:00
|
|
|
import Text.Pandoc.Shared ( stringify, readDataFile, fetchItem, warn )
|
2013-01-11 15:45:19 -08:00
|
|
|
import Text.Pandoc.ImageSize ( imageSize, sizeInPoints )
|
2011-07-19 12:01:01 -07:00
|
|
|
import Text.Pandoc.MIME ( getMimeType )
|
2010-07-02 20:12:14 -07:00
|
|
|
import Text.Pandoc.Definition
|
2013-08-10 18:45:00 -07:00
|
|
|
import Text.Pandoc.Walk
|
2010-07-02 20:12:14 -07:00
|
|
|
import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
|
|
|
|
import Control.Monad (liftM)
|
2011-07-17 23:21:59 -07:00
|
|
|
import Text.Pandoc.XML
|
|
|
|
import Text.Pandoc.Pretty
|
2012-07-24 19:28:51 -07:00
|
|
|
import qualified Control.Exception as E
|
2013-01-11 15:45:19 -08:00
|
|
|
import Data.Time.Clock.POSIX ( getPOSIXTime )
|
2013-01-11 16:19:06 -08:00
|
|
|
import System.FilePath ( takeExtension )
|
2010-07-02 20:12:14 -07:00
|
|
|
|
|
|
|
-- | Produce an ODT file from a Pandoc document.
|
2012-07-24 09:56:00 -07:00
|
|
|
writeODT :: WriterOptions -- ^ Writer options
|
2010-07-02 20:12:14 -07:00
|
|
|
-> Pandoc -- ^ Document to convert
|
|
|
|
-> IO B.ByteString
|
2013-05-10 22:53:35 -07:00
|
|
|
writeODT opts doc@(Pandoc meta _) = do
|
2010-07-08 17:31:55 -07:00
|
|
|
let datadir = writerUserDataDir opts
|
2013-05-10 22:53:35 -07:00
|
|
|
let title = docTitle meta
|
2010-07-02 20:12:14 -07:00
|
|
|
refArchive <- liftM toArchive $
|
2012-07-24 09:56:00 -07:00
|
|
|
case writerReferenceODT opts of
|
2010-07-02 20:12:14 -07:00
|
|
|
Just f -> B.readFile f
|
2012-12-29 17:44:02 -08:00
|
|
|
Nothing -> (B.fromChunks . (:[])) `fmap`
|
|
|
|
readDataFile datadir "reference.odt"
|
2010-07-02 20:12:14 -07:00
|
|
|
-- handle pictures
|
|
|
|
picEntriesRef <- newIORef ([] :: [Entry])
|
Options: Changed `writerSourceDir` to `writerSourceURL` (now a Maybe).
Previously we used to store the directory of the first input file,
even if it was local, and used this as a base directory for
finding images in ODT, EPUB, Docx, and PDF.
This has been confusing to many users. It seems better to look for
images relative to the current working directory, even if the first
file argument is in another directory.
writerSourceURL is set to 'Just url' when the first command-line
argument is an absolute URL. (So, relative links will be resolved
in relation to the first page.) Otherwise, 'Nothing'.
The ODT, EPUB, Docx, and PDF writers have been modified accordingly.
Note that this change may break some existing workflows. If you
have been assuming that relative links will be interpreted relative
to the directory of the first file argument, you'll need to
make that the current directory before running pandoc.
Closes #942.
2013-08-11 15:58:09 -07:00
|
|
|
doc' <- walkM (transformPic opts picEntriesRef) doc
|
2010-12-22 14:55:59 -08:00
|
|
|
let newContents = writeOpenDocument opts{writerWrapText = False} doc'
|
2012-01-28 16:04:35 -08:00
|
|
|
epochtime <- floor `fmap` getPOSIXTime
|
2013-08-11 17:13:46 -07:00
|
|
|
let contentEntry = toEntry "content.xml" epochtime
|
|
|
|
$ fromStringLazy newContents
|
2010-07-02 20:12:14 -07:00
|
|
|
picEntries <- readIORef picEntriesRef
|
2013-08-11 17:13:46 -07:00
|
|
|
let archive = foldr addEntryToArchive refArchive
|
|
|
|
$ contentEntry : picEntries
|
2011-07-17 23:21:59 -07:00
|
|
|
-- construct META-INF/manifest.xml based on archive
|
|
|
|
let toFileEntry fp = case getMimeType fp of
|
|
|
|
Nothing -> empty
|
|
|
|
Just m -> selfClosingTag "manifest:file-entry"
|
|
|
|
[("manifest:media-type", m)
|
|
|
|
,("manifest:full-path", fp)
|
2013-08-11 17:13:46 -07:00
|
|
|
,("manifest:version", "1.2")
|
2011-07-17 23:21:59 -07:00
|
|
|
]
|
2013-08-11 17:13:46 -07:00
|
|
|
let files = [ ent | ent <- filesInArchive archive,
|
|
|
|
not ("META-INF" `isPrefixOf` ent) ]
|
2011-07-17 23:21:59 -07:00
|
|
|
let manifestEntry = toEntry "META-INF/manifest.xml" epochtime
|
2013-03-15 15:20:52 -07:00
|
|
|
$ fromStringLazy $ render Nothing
|
2011-07-17 23:21:59 -07:00
|
|
|
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
|
|
|
|
$$
|
|
|
|
( inTags True "manifest:manifest"
|
2013-08-11 17:13:46 -07:00
|
|
|
[("xmlns:manifest","urn:oasis:names:tc:opendocument:xmlns:manifest:1.0")
|
|
|
|
,("manifest:version","1.2")]
|
2011-07-17 23:21:59 -07:00
|
|
|
$ ( selfClosingTag "manifest:file-entry"
|
|
|
|
[("manifest:media-type","application/vnd.oasis.opendocument.text")
|
|
|
|
,("manifest:full-path","/")]
|
|
|
|
$$ vcat ( map toFileEntry $ files )
|
|
|
|
)
|
|
|
|
)
|
|
|
|
let archive' = addEntryToArchive manifestEntry archive
|
2012-07-13 15:19:39 -06:00
|
|
|
let metaEntry = toEntry "meta.xml" epochtime
|
2013-03-15 15:20:52 -07:00
|
|
|
$ fromStringLazy $ render Nothing
|
2012-07-13 15:19:39 -06:00
|
|
|
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
|
|
|
|
$$
|
|
|
|
( inTags True "office:document-meta"
|
|
|
|
[("xmlns:office","urn:oasis:names:tc:opendocument:xmlns:office:1.0")
|
|
|
|
,("xmlns:xlink","http://www.w3.org/1999/xlink")
|
|
|
|
,("xmlns:dc","http://purl.org/dc/elements/1.1/")
|
|
|
|
,("xmlns:meta","urn:oasis:names:tc:opendocument:xmlns:meta:1.0")
|
|
|
|
,("xmlns:ooo","http://openoffice.org/2004/office")
|
|
|
|
,("xmlns:grddl","http://www.w3.org/2003/g/data-view#")
|
|
|
|
,("office:version","1.2")]
|
|
|
|
$ ( inTagsSimple "office:meta"
|
|
|
|
$ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
2013-08-11 17:13:46 -07:00
|
|
|
-- make sure mimetype is first
|
|
|
|
let mimetypeEntry = toEntry "mimetype" epochtime
|
|
|
|
$ fromStringLazy "application/vnd.oasis.opendocument.text"
|
|
|
|
let archive'' = addEntryToArchive mimetypeEntry
|
|
|
|
$ addEntryToArchive metaEntry archive'
|
2012-07-13 15:19:39 -06:00
|
|
|
return $ fromArchive archive''
|
2010-07-02 20:12:14 -07:00
|
|
|
|
Options: Changed `writerSourceDir` to `writerSourceURL` (now a Maybe).
Previously we used to store the directory of the first input file,
even if it was local, and used this as a base directory for
finding images in ODT, EPUB, Docx, and PDF.
This has been confusing to many users. It seems better to look for
images relative to the current working directory, even if the first
file argument is in another directory.
writerSourceURL is set to 'Just url' when the first command-line
argument is an absolute URL. (So, relative links will be resolved
in relation to the first page.) Otherwise, 'Nothing'.
The ODT, EPUB, Docx, and PDF writers have been modified accordingly.
Note that this change may break some existing workflows. If you
have been assuming that relative links will be interpreted relative
to the directory of the first file argument, you'll need to
make that the current directory before running pandoc.
Closes #942.
2013-08-11 15:58:09 -07:00
|
|
|
transformPic :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline
|
|
|
|
transformPic opts entriesRef (Image lab (src,_)) = do
|
|
|
|
res <- fetchItem (writerSourceURL opts) src
|
2013-01-11 15:45:19 -08:00
|
|
|
case res of
|
|
|
|
Left (_ :: E.SomeException) -> do
|
2013-07-18 20:58:14 -07:00
|
|
|
warn $ "Could not find image `" ++ src ++ "', skipping..."
|
2013-01-11 15:45:19 -08:00
|
|
|
return $ Emph lab
|
|
|
|
Right (img, _) -> do
|
|
|
|
let size = imageSize img
|
|
|
|
let (w,h) = maybe (0,0) id $ sizeInPoints `fmap` size
|
|
|
|
let tit' = show w ++ "x" ++ show h
|
|
|
|
entries <- readIORef entriesRef
|
2013-01-11 16:19:06 -08:00
|
|
|
let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src
|
2013-01-11 15:45:19 -08:00
|
|
|
let toLazy = B.fromChunks . (:[])
|
|
|
|
epochtime <- floor `fmap` getPOSIXTime
|
|
|
|
let entry = toEntry newsrc epochtime $ toLazy img
|
|
|
|
modifyIORef entriesRef (entry:)
|
|
|
|
return $ Image lab (newsrc, tit')
|
2010-07-02 20:12:14 -07:00
|
|
|
transformPic _ _ x = return x
|
|
|
|
|