Merge pull request #1644 from mpickering/master

Fixes and Enhancements from the tracker

6 files changed, 61 insertions, 18 deletions

diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index 5921b56cf..a55d5417e 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -51,7 +51,7 @@ import System.IO (stderr)
 -- mime types.  Note that a 'MediaBag' is a Monoid, so 'mempty'
 -- can be used for an empty 'MediaBag', and '<>' can be used to append
 -- two 'MediaBag's.
-newtype MediaBag = MediaBag (M.Map String (MimeType, BL.ByteString))
+newtype MediaBag = MediaBag (M.Map [String] (MimeType, BL.ByteString))
         deriving (Monoid)
 
 instance Show MediaBag where
@@ -65,7 +65,7 @@ insertMedia :: FilePath       -- ^ relative path and canonical name of resource
             -> MediaBag
             -> MediaBag
 insertMedia fp mbMime contents (MediaBag mediamap) =
-  MediaBag (M.insert fp (mime, contents) mediamap)
+  MediaBag (M.insert (splitPath fp) (mime, contents) mediamap)
   where mime = fromMaybe fallback mbMime
         fallback = case takeExtension fp of
                         ".gz"   -> getMimeTypeDef $ dropExtension fp
@@ -75,14 +75,14 @@ insertMedia fp mbMime contents (MediaBag mediamap) =
 lookupMedia :: FilePath
             -> MediaBag
             -> Maybe (MimeType, BL.ByteString)
-lookupMedia fp (MediaBag mediamap) = M.lookup fp mediamap
+lookupMedia fp (MediaBag mediamap) = M.lookup (splitPath fp) mediamap
 
 -- | Get a list of the file paths stored in a 'MediaBag', with
 -- their corresponding mime types and the lengths in bytes of the contents.
 mediaDirectory :: MediaBag -> [(String, MimeType, Int)]
 mediaDirectory (MediaBag mediamap) =
   M.foldWithKey (\fp (mime,contents) ->
-      ((fp, mime, fromIntegral $ BL.length contents):)) [] mediamap
+      (((joinPath fp), mime, fromIntegral $ BL.length contents):)) [] mediamap
 
 -- | Extract contents of MediaBag to a given directory.  Print informational
 -- messages if 'verbose' is true.
@@ -93,7 +93,7 @@ extractMediaBag :: Bool
 extractMediaBag verbose dir (MediaBag mediamap) = do
   sequence_ $ M.foldWithKey
      (\fp (_ ,contents) ->
-        ((writeMedia verbose dir (fp, contents)):)) [] mediamap
+        ((writeMedia verbose dir (joinPath fp, contents)):)) [] mediamap
 
 writeMedia :: Bool -> FilePath -> (FilePath, BL.ByteString) -> IO ()
 writeMedia verbose dir (subpath, bs) = do
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 84ccbbdc9..ebfd8f8a9 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -251,6 +251,7 @@ data HTMLMathMethod = PlainMath
                     | WebTeX String               -- url of TeX->image script.
                     | MathML (Maybe String)       -- url of MathMLinHTML.js
                     | MathJax String              -- url of MathJax.js
+                    | KaTeX String String -- url of stylesheet and katex.js
                     deriving (Show, Read, Eq)
 
 data CiteMethod = Citeproc                        -- use citeproc to render them
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 4ea5f41d5..4e0bb375a 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -440,7 +440,7 @@ pCodeBlock :: TagParser Blocks
 pCodeBlock = try $ do
   TagOpen _ attr <- pSatisfy (~== TagOpen "pre" [])
   contents <- manyTill pAnyTag (pCloses "pre" <|> eof)
-  let rawText = concatMap fromTagText $ filter isTagText contents
+  let rawText = concatMap tagToString contents
   -- drop leading newline if any
   let result' = case rawText of
                      '\n':xs  -> xs
@@ -451,6 +451,11 @@ pCodeBlock = try $ do
                     _        -> result'
   return $ B.codeBlockWith (mkAttr attr) result
 
+tagToString :: Tag String -> String
+tagToString (TagText s) = s
+tagToString (TagOpen "br" _) = "\n"
+tagToString _ = ""
+
 inline :: TagParser Inlines
 inline = choice
            [ eNoteref
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index b07f96846..5c00a1b27 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -863,7 +863,7 @@ definitionListItem parseMarkerGetLength = try $ do
   line1 <- anyLineNewline
   blank <- option "" ("\n" <$ blankline)
   cont <- concat <$> many (listContinuation markerLength)
-  term' <- parseFromString inline term
+  term' <- parseFromString parseInlines term
   contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont
   return $ (,) <$> term' <*> fmap (:[]) contents'
 
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 2d7c08718..6e1f84335 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable, CPP, MultiParamTypeClasses,
-    FlexibleContexts, ScopedTypeVariables, PatternGuards #-}
+    FlexibleContexts, ScopedTypeVariables, PatternGuards,
+    ViewPatterns #-}
 {-
 Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
 
@@ -106,7 +107,7 @@ import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo,
                      unEscapeString, parseURIReference, isAllowedInURI )
 import qualified Data.Set as Set
 import System.Directory
-import System.FilePath (joinPath, splitDirectories)
+import System.FilePath (joinPath, splitDirectories, pathSeparator, isPathSeparator)
 import Text.Pandoc.MIME (MimeType, getMimeType)
 import System.FilePath ( (</>), takeExtension, dropExtension)
 import Data.Generics (Typeable, Data)
@@ -871,11 +872,14 @@ collapseFilePath = joinPath . reverse . foldl go [] . splitDirectories
     go rs "." = rs
     go r@(p:rs) ".." = case p of
                             ".." -> ("..":r)
-                            "/" -> ("..":r)
+                            (checkPathSeperator -> Just True) -> ("..":r)
                             _ -> rs
-    go _ "/" = ["/"]
+    go _ (checkPathSeperator -> Just True) = [[pathSeparator]]
     go rs x = x:rs
-
+    isSingleton [] = Nothing
+    isSingleton [x] = Just x
+    isSingleton _ = Nothing
+    checkPathSeperator = fmap isPathSeparator . isSingleton
 
 --
 -- Safe read
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 9ead604d7..1a00c7660 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
+{-# LANGUAGE OverloadedStrings, CPP, ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-
 Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
@@ -60,6 +60,8 @@ import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
 import Text.Blaze.Renderer.String (renderHtml)
 import Text.TeXMath
 import Text.XML.Light.Output
+import Text.XML.Light (unode, elChildren, add_attr, unqual)
+import qualified Text.XML.Light as XML
 import System.FilePath (takeExtension)
 import Data.Monoid
 import Data.Aeson (Value)
@@ -155,6 +157,10 @@ pandocToHtml opts (Pandoc meta blocks) = do
                               H.script ! A.src (toValue url)
                                        ! A.type_ "text/javascript"
                                        $ mempty
+                           KaTeX js css ->
+                              (H.script ! A.src (toValue js) $ mempty) <>
+                              (H.link ! A.rel "stylesheet" ! A.href (toValue css)) <>
+                              (H.script ! A.type_ "text/javascript" $ toHtml renderKaTeX)
                            _ -> case lookup "mathml-script" (writerVariables opts) of
                                       Just s | not (writerHtml5 opts) ->
                                         H.script ! A.type_ "text/javascript"
@@ -342,10 +348,10 @@ parseMailto s = do
        _ -> fail "not a mailto: URL"
 
 -- | Obfuscate a "mailto:" link.
-obfuscateLink :: WriterOptions -> String -> String -> Html
+obfuscateLink :: WriterOptions -> Html -> String -> Html
 obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation =
-  H.a ! A.href (toValue s) $ toHtml txt
-obfuscateLink opts txt s =
+  H.a ! A.href (toValue s) $ txt
+obfuscateLink opts (renderHtml -> txt) s =
   let meth = writerEmailObfuscation opts
       s' = map toLower (take 7 s) ++ drop 7 s
   in  case parseMailto s' of
@@ -615,6 +621,18 @@ inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
 inlineListToHtml opts lst =
   mapM (inlineToHtml opts) lst >>= return . mconcat
 
+-- | Annotates a MathML expression with the tex source
+annotateMML :: XML.Element -> String -> XML.Element
+annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs, tex)])
+  where
+    cs = case elChildren e of
+          [] -> unode "mrow" ()
+          [x] -> x
+          xs -> unode "mrow" xs
+    math = add_attr (XML.Attr (unqual "xmlns") "http://www.w3.org/1998/Math/MathML") . unode "math"
+    annotAttrs = [XML.Attr (unqual "encoding") "application/x-tex"]
+
+
 -- | Convert Pandoc inline element to HTML.
 inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
 inlineToHtml opts inline =
@@ -706,7 +724,7 @@ inlineToHtml opts inline =
                                                defaultConfigPP
                                   case writeMathML dt <$> readTeX str of
                                         Right r  -> return $ preEscapedString $
-                                            ppcElement conf r
+                                            ppcElement conf (annotateMML r str)
                                         Left _   -> inlineListToHtml opts
                                             (texMathToInlines t str) >>=
                                             return .  (H.span ! A.class_ "math")
@@ -714,6 +732,10 @@ inlineToHtml opts inline =
                                   case t of
                                     InlineMath  -> "\\(" ++ str ++ "\\)"
                                     DisplayMath -> "\\[" ++ str ++ "\\]"
+                               KaTeX _ _ -> return $ H.span ! A.class_ "math" $
+                                  toHtml (case t of
+                                            InlineMath -> str
+                                            DisplayMath -> "\\displaystyle " ++ str)
                                PlainMath -> do
                                   x <- inlineListToHtml opts (texMathToInlines t str)
                                   let m = H.span ! A.class_ "math" $ x
@@ -731,7 +753,7 @@ inlineToHtml opts inline =
       | otherwise          -> return mempty
     (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
                         linkText <- inlineListToHtml opts txt
-                        return $ obfuscateLink opts (renderHtml linkText) s
+                        return $ obfuscateLink opts linkText s
     (Link txt (s,tit)) -> do
                         linkText <- inlineListToHtml opts txt
                         let s' = case s of
@@ -815,3 +837,14 @@ blockListToNote opts ref blocks =
                               Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote"
                               _          -> noteItem
          return $ nl opts >> noteItem'
+
+-- Javascript snippet to render all KaTeX elements
+renderKaTeX :: String
+renderKaTeX = unlines [
+    "window.onload = function(){var mathElements = document.getElementsByClassName(\"math\");"
+  , "for (var i=0; i < mathElements.length; i++)"
+  , "{"
+  , " var texText = mathElements[i].firstChild"
+  , " katex.render(texText.data, mathElements[i])"
+  , "}}"
+  ]