From ca97f1482d391220e8a711b4b6552d2f885dbd53 Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Thu, 31 Dec 2009 01:09:20 +0000 Subject: Renamed headers -> templates. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1677 788f1e2b-df1e-0410-8736-df70ead52e1b --- src/Text/Pandoc.hs | 4 +-- src/Text/Pandoc/DefaultHeaders.hs | 70 ------------------------------------- src/Text/Pandoc/DefaultTemplates.hs | 69 ++++++++++++++++++++++++++++++++++++ src/pandoc.hs | 16 ++++----- 4 files changed, 79 insertions(+), 80 deletions(-) delete mode 100644 src/Text/Pandoc/DefaultHeaders.hs create mode 100644 src/Text/Pandoc/DefaultTemplates.hs (limited to 'src') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 390c27765..fedb4102a 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -89,7 +89,7 @@ module Text.Pandoc , HTMLMathMethod (..) , defaultWriterOptions -- * Default headers for various output formats - , module Text.Pandoc.DefaultHeaders + , module Text.Pandoc.DefaultTemplates -- * Version , pandocVersion ) where @@ -111,7 +111,7 @@ import Text.Pandoc.Writers.OpenDocument import Text.Pandoc.Writers.Man import Text.Pandoc.Writers.RTF import Text.Pandoc.Writers.MediaWiki -import Text.Pandoc.DefaultHeaders +import Text.Pandoc.DefaultTemplates import Text.Pandoc.Shared import Data.Version (showVersion) import Paths_pandoc (version) diff --git a/src/Text/Pandoc/DefaultHeaders.hs b/src/Text/Pandoc/DefaultHeaders.hs deleted file mode 100644 index 27fb237c5..000000000 --- a/src/Text/Pandoc/DefaultHeaders.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE CPP, TemplateHaskell #-} -{- -Copyright (C) 2006-7 John MacFarlane - -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.DefaultHeaders - Copyright : Copyright (C) 2006-7 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane - Stability : alpha - Portability : portable - -Default headers for Pandoc writers. --} -module Text.Pandoc.DefaultHeaders ( - defaultLaTeXHeader, - defaultConTeXtHeader, - defaultDocbookHeader, - defaultOpenDocumentHeader, - defaultS5Header, - defaultRTFHeader - ) where -import Text.Pandoc.Writers.S5 -import Text.Pandoc.Shared -import System.FilePath ( () ) -import Text.Pandoc.TH ( contentsOf ) - -defaultLaTeXHeader :: String -#ifndef __HADDOCK__ -defaultLaTeXHeader = $(contentsOf $ "data" "headers" "LaTeX.header") -#endif - -defaultConTeXtHeader :: String -#ifndef __HADDOCK__ -defaultConTeXtHeader = $(contentsOf $ "data" "headers" "ConTeXt.header") -#endif - -defaultDocbookHeader :: String -#ifndef __HADDOCK__ -defaultDocbookHeader = $(contentsOf $ "data" "headers" "Docbook.header") -#endif - -defaultOpenDocumentHeader :: String -#ifndef __HADDOCK__ -defaultOpenDocumentHeader = $(contentsOf $ "data" "headers" "OpenDocument.header") -#endif - -defaultS5Header :: String -defaultS5Header = substitute "$" "$$" $ s5Meta ++ s5CSS ++ s5Javascript - -defaultRTFHeader :: String -#ifndef __HADDOCK__ -defaultRTFHeader = $(contentsOf $ "data" "headers" "RTF.header") -#endif diff --git a/src/Text/Pandoc/DefaultTemplates.hs b/src/Text/Pandoc/DefaultTemplates.hs new file mode 100644 index 000000000..533fb10a6 --- /dev/null +++ b/src/Text/Pandoc/DefaultTemplates.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE CPP, TemplateHaskell #-} +{- +Copyright (C) 2006-7 John MacFarlane + +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.DefaultTemplates + Copyright : Copyright (C) 2006-7 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +Default templates for Pandoc writers. +-} +module Text.Pandoc.DefaultTemplates ( defaultLaTeXTemplate, + defaultConTeXtTemplate, + defaultDocbookTemplate, + defaultOpenDocumentTemplate, + defaultS5Template, + defaultRTFTemplate + ) where +import Text.Pandoc.Writers.S5 +import Text.Pandoc.Shared +import System.FilePath ( () ) +import Text.Pandoc.TH ( contentsOf ) + +defaultLaTeXTemplate :: String +#ifndef __HADDOCK__ +defaultLaTeXTemplate = $(contentsOf $ "data" "templates" "LaTeX.template") +#endif + +defaultConTeXtTemplate :: String +#ifndef __HADDOCK__ +defaultConTeXtTemplate = $(contentsOf $ "data" "templates" "ConTeXt.template") +#endif + +defaultDocbookTemplate :: String +#ifndef __HADDOCK__ +defaultDocbookTemplate = $(contentsOf $ "data" "templates" "Docbook.template") +#endif + +defaultOpenDocumentTemplate :: String +#ifndef __HADDOCK__ +defaultOpenDocumentTemplate = $(contentsOf $ "data" "templates" "OpenDocument.template") +#endif + +defaultS5Template :: String +defaultS5Template = substitute "$" "$$" $ s5Meta ++ s5CSS ++ s5Javascript + +defaultRTFTemplate :: String +#ifndef __HADDOCK__ +defaultRTFTemplate = $(contentsOf $ "data" "templates" "RTF.template") +#endif diff --git a/src/pandoc.hs b/src/pandoc.hs index c2cc9b75e..4e3cad5b2 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -101,13 +101,13 @@ writers :: [ ( String, ( WriterOptions -> Pandoc -> String, String ) ) ] writers = [("native" , (writeDoc, "")) ,("html" , (writeHtmlString, "")) ,("html+lhs" , (writeHtmlString, "")) - ,("s5" , (writeS5String, defaultS5Header)) - ,("docbook" , (writeDocbook, defaultDocbookHeader)) - ,("opendocument" , (writeOpenDocument, defaultOpenDocumentHeader)) - ,("odt" , (writeOpenDocument, defaultOpenDocumentHeader)) - ,("latex" , (writeLaTeX, defaultLaTeXHeader)) - ,("latex+lhs" , (writeLaTeX, defaultLaTeXHeader)) - ,("context" , (writeConTeXt, defaultConTeXtHeader)) + ,("s5" , (writeS5String, defaultS5Template)) + ,("docbook" , (writeDocbook, defaultDocbookTemplate)) + ,("opendocument" , (writeOpenDocument, defaultOpenDocumentTemplate)) + ,("odt" , (writeOpenDocument, defaultOpenDocumentTemplate)) + ,("latex" , (writeLaTeX, defaultLaTeXTemplate)) + ,("latex+lhs" , (writeLaTeX, defaultLaTeXTemplate)) + ,("context" , (writeConTeXt, defaultConTeXtTemplate)) ,("texinfo" , (writeTexinfo, "")) ,("man" , (writeMan, "")) ,("markdown" , (writeMarkdown, "")) @@ -115,7 +115,7 @@ writers = [("native" , (writeDoc, "")) ,("rst" , (writeRST, "")) ,("rst+lhs" , (writeRST, "")) ,("mediawiki" , (writeMediaWiki, "")) - ,("rtf" , (writeRTF, defaultRTFHeader)) + ,("rtf" , (writeRTF, defaultRTFTemplate)) ] isNonTextOutput :: String -> Bool -- cgit v1.2.3