HTML writer changes for templates.

Note:  now a single meta tag is used for multiple authors.
Previously one tag per author was used.

Fixed title in HTML template to avoid excess blank space.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1703 788f1e2b-df1e-0410-8736-df70ead52e1b

src/Text/Pandoc/Templates.hs

@@ -66,7 +66,7 @@ renderTemplate :: [(String,String)]  -- ^ Assoc. list of values for variables
                -> String
 renderTemplate vals templ =
   case runParser (do x <- parseTemplate; eof; return x) vals "template" templ of
-       Left e        -> show e
+       Left e        -> error $ show e
        Right r       -> concat r
 
 reservedWords :: [String]

src/Text/Pandoc/Writers/HTML.hs

@@ -30,36 +30,31 @@ Conversion of 'Pandoc' documents to HTML.
 -}
 module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where
 import Text.Pandoc.Definition
-import Text.Pandoc.LaTeXMathML
 import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
 import Text.Pandoc.Shared
 import Text.Pandoc.Templates
 import Text.Pandoc.Readers.TeXMath
-import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
+import Text.Pandoc.Highlighting ( highlightHtml )
 import Text.Pandoc.XML (stripTags)
 import Numeric ( showHex )
 import Data.Char ( ord, toLower )
-import Data.List ( isPrefixOf, intersperse )
+import Data.List ( isPrefixOf, intersperse, intercalate )
 import Data.Maybe ( catMaybes )
-import qualified Data.Set as S
 import Control.Monad.State
 import Text.XHtml.Transitional hiding ( stringToHtml )
 
 data WriterState = WriterState
-    { stNotes            :: [Html]       -- ^ List of notes
-    , stMath             :: Bool         -- ^ Math is used in document
-    , stCSS              :: S.Set String -- ^ CSS to include in header
-    , stSecNum           :: [Int]        -- ^ Number of current section
+    { stNotes            :: [Html]  -- ^ List of notes
+    , stMath             :: Bool    -- ^ Math is used in document
+    , stHighlighting     :: Bool    -- ^ Syntax highlighting is used
+    , stSecNum           :: [Int]   -- ^ Number of current section
     } deriving Show
 
 defaultWriterState :: WriterState
-defaultWriterState = WriterState {stNotes= [], stMath = False, stCSS = S.empty, stSecNum = []}
+defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting = False, stSecNum = []}
 
 -- Helpers to render HTML with the appropriate function.
 
-render :: (HTML html) => WriterOptions -> html -> String
-render opts = if writerWrapText opts then renderHtml else showHtml
-
 renderFragment :: (HTML html) => WriterOptions -> html -> String
 renderFragment opts = if writerWrapText opts
                          then renderHtmlFragment
@@ -81,71 +76,87 @@ stringToHtml = primHtml . concatMap fixChar
 
 -- | Convert Pandoc document to Html string.
 writeHtmlString :: WriterOptions -> Pandoc -> String
-writeHtmlString opts = 
-  if writerStandalone opts
-     then render opts . writeHtml opts
-     else renderFragment opts . writeHtml opts
+writeHtmlString opts d =
+  let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)
+                                                 defaultWriterState
+  in  if writerStandalone opts
+         then inTemplate opts tit auths date toc body' newvars
+         else renderFragment opts body'
 
 -- | Convert Pandoc document to Html structure.
 writeHtml :: WriterOptions -> Pandoc -> Html
-writeHtml opts (Pandoc (Meta tit authors date) blocks) =
-  noHtml -- TODO
---  let titlePrefix = writerTitlePrefix opts
---      (topTitle,st) = runState (inlineListToHtml opts tit) defaultWriterState
---      topTitle''  = stripTags $ showHtmlFragment topTitle
---      topTitle'   = titlePrefix ++
---                    (if null topTitle'' || null titlePrefix
---                        then ""
---                        else " - ") ++ topTitle''
---      metadata    = thetitle << topTitle' +++
---                    meta ! [httpequiv "Content-Type", 
---                            content "text/html; charset=UTF-8"] +++
---                    meta ! [name "generator", content "pandoc"] +++
---                    (toHtmlFromList $ 
---                    map (\a -> meta ! [name "author", content a]) authors) +++
---                    (if null date
---                       then noHtml
---                       else meta ! [name "date", content date])
---      titleHeader = if writerStandalone opts && not (null tit) && 
---                    not (writerS5 opts)
---                        then h1 ! [theclass "title"] $ topTitle
---                        else noHtml
---      sects        = hierarchicalize blocks
---      toc          = if writerTableOfContents opts 
---                        then evalState (tableOfContents opts sects) st
---                        else noHtml
---      (blocks', st') = runState
---                       (mapM (elementToHtml opts) sects >>= return . toHtmlFromList)
---                       st
---      cssLines     = stCSS st'
---      css          = if S.null cssLines
---                        then noHtml
---                        else style ! [thetype "text/css"] $ primHtml $
---                             '\n':(unlines $ S.toList cssLines)
---      math         = if stMath st'
---                        then case writerHTMLMathMethod opts of
---                                   LaTeXMathML Nothing -> 
---                                      primHtml latexMathMLScript
---                                   LaTeXMathML (Just url) ->
---                                      script ! 
---                                      [src url, thetype "text/javascript"] $
---                                      noHtml
---                                   JsMath (Just url) ->
---                                      script !
---                                      [src url, thetype "text/javascript"] $
---                                      noHtml
---                                   _ -> noHtml
---                        else noHtml
---      head'        = header $ metadata +++ math +++ css +++ 
---                              primHtml (renderTemplate [] $ writerHeader opts)
---      notes        = reverse (stNotes st')
---      before       = primHtml $ writerIncludeBefore opts
---      after        = primHtml $ writerIncludeAfter opts
---      thebody      = before +++ titleHeader +++ toc +++ blocks' +++
---                     footnoteSection notes +++ after
---  in  if writerStandalone opts
---         then head' +++ body thebody
---         else thebody
+writeHtml opts d =
+  let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)
+                                                 defaultWriterState
+  in  if writerStandalone opts
+         then primHtml $ inTemplate opts tit auths date toc body' newvars
+         else body'
+
+-- result is (title, authors, date, toc, body, new variables)
+pandocToHtml :: WriterOptions
+             -> Pandoc
+             -> State WriterState (Html, [Html], Html, Html, Html, [(String,String)])
+pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
+  let standalone = writerStandalone opts
+  tit <- if standalone
+            then inlineListToHtml opts title'
+            else return noHtml
+  auths <- if standalone
+              then mapM (inlineListToHtml opts) authors'
+              else return [] 
+  date <- if standalone
+             then inlineListToHtml opts date'
+             else return noHtml 
+  let sects = hierarchicalize blocks
+  toc <- if writerTableOfContents opts 
+            then tableOfContents opts sects
+            else return noHtml
+  blocks' <- liftM toHtmlFromList $ mapM (elementToHtml opts) sects
+  st <- get
+  let notes = reverse (stNotes st)
+  let before = primHtml $ writerIncludeBefore opts
+  let after = primHtml $ writerIncludeAfter opts
+  let thebody = before +++ blocks' +++ footnoteSection notes +++ after
+  let  math = if stMath st
+                then case writerHTMLMathMethod opts of
+                           LaTeXMathML (Just url) ->
+                              script ! 
+                              [src url, thetype "text/javascript"] $ noHtml
+                           JsMath (Just url) ->
+                              script !
+                              [src url, thetype "text/javascript"] $ noHtml
+                           _ -> case lookup "latexmathml-script" (writerVariables opts) of
+                                      Just s -> 
+                                        script ! [thetype "text/javascript"] <<
+                                           primHtml s
+                                      Nothing -> noHtml
+                else noHtml
+  let newvars = [("highlighting","yes") | stHighlighting st] ++
+                [("math", renderHtmlFragment math) | stMath st] 
+  return (tit, auths, date, toc, thebody, newvars)
+
+inTemplate :: WriterOptions
+           -> Html
+           -> [Html]
+           -> Html
+           -> Html
+           -> Html
+           -> [(String,String)]
+           -> String
+inTemplate opts tit auths date toc body' newvars =
+  let renderedTit = showHtmlFragment tit
+      topTitle'   = stripTags renderedTit
+      authors     = map (stripTags . showHtmlFragment) auths
+      date'       = stripTags $ showHtmlFragment date
+      variables   = writerVariables opts ++ newvars
+      context     = variables ++
+                    [ ("body", renderHtmlFragment body')
+                    , ("pagetitle", topTitle')
+                    , ("toc", renderHtmlFragment toc)
+                    , ("title", renderHtmlFragment tit)
+                    , ("authors", intercalate "; " authors)
+                    , ("date", date') ]
+  in  renderTemplate context $ writerTemplate opts
 
 -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
 prefixedId :: WriterOptions -> String -> HtmlAttr
@@ -251,13 +262,6 @@ obfuscateChar char =
 obfuscateString :: String -> String
 obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
 
--- | Add CSS for document header.
-addToCSS :: String -> State WriterState ()
-addToCSS item = do
-  st <- get
-  let current = stCSS st
-  put $ st {stCSS = S.insert item current}
-
 -- | Convert Pandoc block element to HTML.
 blockToHtml :: WriterOptions -> Block -> State WriterState Html
 blockToHtml _ Null = return $ noHtml 
@@ -279,7 +283,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
                     in  return $ pre ! attrs $ thecode <<
                                  (replicate (length leadingBreaks) br +++
                                  [stringToHtml $ rawCode' ++ "\n"])
-         Right h -> addToCSS defaultHighlightingCss >> return h
+         Right h -> modify (\st -> st{ stHighlighting = True }) >> return h
 blockToHtml opts (BlockQuote blocks) =
   -- in S5, treat list in blockquote specially
   -- if default is incremental, make it nonincremental; 

src/pandoc.hs

@@ -643,7 +643,7 @@ main = do
                    else return variables
 
   variables'' <- case mathMethod of
-                      LaTeXMathML (Just _) -> do
+                      LaTeXMathML Nothing -> do
                          s <- latexMathMLScript
                          return $ ("latexmathml-script", s) : variables'
                       _ -> return variables'

templates/html.template

@@ -1,81 +1,47 @@
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml"
-><head
-  ><title
-    >title</title
-    ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
-     /><meta name="generator" content="pandoc"
-     /><meta name="author" content="$authors$"
-     /><meta name="date" content="$date$"
-     />
-     $if(latexmathml-script)$
-     $latexmathml-script$
-     $endif$
-     $if(header-includes)$
-     $header-includes$
-     $endif$
-</head
-  ><body
-  >
-<h1 class="title"
-    ><span class="math"
-      ><em
-	>title</em
-	></span
-      ></h1
-    ><div id="TOC"
-    ><ul
-      ><li
-	><a href="#section-oen"
-	  >section oen</a
-	  ></li
-	></ul
-      ></div
-    ><div id="section-oen"
-    ><h1
-      ><a href="#TOC"
-	>section oen</a
-	></h1
-      ><ol style="list-style-type: decimal;"
-      ><li
-	>one<ol style="list-style-type: lower-alpha;"
-	  ><li
-	    >two<ol start="3" style="list-style-type: lower-roman;"
-	      ><li
-		>three</li
-		></ol
-	      ></li
-	    ></ol
-	  ></li
-	></ol
-      ><pre class="haskell"
-      ><code
-	>hi
-</code
-	></pre
-      ><p
-      >footnote<a href="#fn1" class="footnoteRef" id="fnref1"
-	><sup
-	  >1</sup
-	  ></a
-	></p
-      ></div
-    ><div class="footnotes"
-    ><hr
-       /><ol
-      ><li id="fn1"
-	><p
-	  >with code</p
-	  ><pre
-	  ><code
-	    >code
-</code
-	    ></pre
-	  > <a href="#fnref1" class="footnoteBackLink" title="Jump back to footnote 1">&#8617;</a></li
-	></ol
-      ></div
-    >
-</body
-  ></html
->
-
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+  <title>$if(title-prefix)$$title-prefix$ - $endif$$if(pagetitle)$$pagetitle$$endif$</title>
+  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+  <meta name="generator" content="pandoc" />
+  <meta name="author" content="$authors$" />
+  <meta name="date" content="$date$" />
+  $if(highlighting)$
+  <style type="text/css">
+  table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode, table.sourceCode pre { margin: 0; padding: 0; border: 0; vertical-align: baseline; border: none; }
+  td.lineNumbers { border-right: 1px solid #AAAAAA; text-align: right; color: #AAAAAA; padding-right: 5px; padding-left: 5px; }
+  td.sourceCode { padding-left: 5px; }
+  pre.sourceCode { }
+  pre.sourceCode span.Normal { }
+  pre.sourceCode span.Keyword { color: #007020; font-weight: bold; } 
+  pre.sourceCode span.DataType { color: #902000; }
+  pre.sourceCode span.DecVal { color: #40a070; }
+  pre.sourceCode span.BaseN { color: #40a070; }
+  pre.sourceCode span.Float { color: #40a070; }
+  pre.sourceCode span.Char { color: #4070a0; }
+  pre.sourceCode span.String { color: #4070a0; }
+  pre.sourceCode span.Comment { color: #60a0b0; font-style: italic; }
+  pre.sourceCode span.Others { color: #007020; }
+  pre.sourceCode span.Alert { color: red; font-weight: bold; }
+  pre.sourceCode span.Function { color: #06287e; }
+  pre.sourceCode span.RegionMarker { }
+  pre.sourceCode span.Error { color: red; font-weight: bold; }
+  </style>
+  $endif$
+  $if(header-includes)$
+  $header-includes$
+  $endif$
+  $if(latexmathml-script)$
+  $latexmathml-script$
+  $endif$
+</head>
+<body>
+$if(title)$
+  <h1 class="title">$title$</h1>
+$endif$
+$if(toc)$
+$toc$
+$endif$
+$body$
+</body>
+</html>