diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 103 |
1 files changed, 70 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index d06bec89f..73a8906c3 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -31,9 +31,11 @@ Conversion of 'Pandoc' documents to HTML. -} module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Options +import Text.Pandoc.ImageSize import Text.Pandoc.Templates import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Slides @@ -93,9 +95,9 @@ strToHtml [] = "" -- | Hard linebreak. nl :: WriterOptions -> Html -nl opts = if writerWrapText opts - then preEscapedString "\n" - else mempty +nl opts = if writerWrapText opts == WrapNone + then mempty + else preEscapedString "\n" -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String @@ -192,9 +194,6 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ defField "html5" (writerHtml5 opts) $ - defField "center" (case lookupMeta "center" meta of - Just (MetaBool False) -> False - _ -> True) $ metadata return (thebody, context) @@ -307,11 +306,9 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen $ if titleSlide -- title slides have no content of their own then filter isSec elements - else if slide - then case splitBy isPause elements of - [] -> [] - (x:xs) -> x ++ concatMap inDiv xs - else elements + else case splitBy isPause elements of + [] -> [] + (x:xs) -> x ++ concatMap inDiv xs let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] let classes' = ["titleslide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && @@ -360,10 +357,10 @@ parseMailto s = do _ -> fail "not a mailto: URL" -- | Obfuscate a "mailto:" link. -obfuscateLink :: WriterOptions -> Html -> String -> Html -obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation = - H.a ! A.href (toValue s) $ txt -obfuscateLink opts (renderHtml -> txt) s = +obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html +obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation = + addAttrs opts attr $ H.a ! A.href (toValue s) $ txt +obfuscateLink opts attr (renderHtml -> txt) s = let meth = writerEmailObfuscation opts s' = map toLower (take 7 s) ++ drop 7 s in case parseMailto s' of @@ -389,7 +386,7 @@ obfuscateLink opts (renderHtml -> txt) s = linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) _ -> error $ "Unknown obfuscation method: " ++ show meth - _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email + _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String @@ -405,11 +402,33 @@ obfuscateString = concatMap obfuscateChar . fromEntities addAttrs :: WriterOptions -> Attr -> Html -> Html addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr) +toAttrs :: [(String, String)] -> [Attribute] +toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs + attrsToHtml :: WriterOptions -> Attr -> [Attribute] attrsToHtml opts (id',classes',keyvals) = [prefixedId opts id' | not (null id')] ++ - [A.class_ (toValue $ unwords classes') | not (null classes')] ++ - map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals + [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals + +imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute] +imgAttrsToHtml opts attr = + attrsToHtml opts (ident,cls,kvs') ++ + toAttrs (dimensionsToAttrList opts attr) + where + (ident,cls,kvs) = attr + kvs' = filter isNotDim kvs + isNotDim ("width", _) = False + isNotDim ("height", _) = False + isNotDim _ = True + +dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] +dimensionsToAttrList opts attr = (go Width) ++ (go Height) + where + go dir = case (dimension dir attr) of + (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] + (Just dim) -> [(show dir, showInPixel opts dim)] + _ -> [] + imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", @@ -430,8 +449,8 @@ blockToHtml :: WriterOptions -> Block -> State WriterState Html blockToHtml _ Null = return mempty blockToHtml opts (Plain lst) = inlineListToHtml opts lst -- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image txt (s,'f':'i':'g':':':tit)]) = do - img <- inlineToHtml opts (Image txt (s,tit)) +blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do + img <- inlineToHtml opts (Image attr txt (s,tit)) let tocapt = if writerHtml5 opts then H5.figcaption else H.p ! A.class_ "caption" @@ -543,6 +562,9 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let attribs = (if startnum /= 1 then [A.start $ toValue startnum] else []) ++ + (if numstyle == Example + then [A.class_ "example"] + else []) ++ (if numstyle /= DefaultStyle then if writerHtml5 opts then [A.type_ $ @@ -593,8 +615,15 @@ blockToHtml opts (Table capt aligns widths headers rows') = do return $ H.thead (nl opts >> contents) >> nl opts body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $ zipWithM (tableRowToHtml opts aligns) [1..] rows' - return $ H.table $ nl opts >> captionDoc >> coltags >> head' >> - body' >> nl opts + let tbl = H.table $ + nl opts >> captionDoc >> coltags >> head' >> body' >> nl opts + let totalWidth = sum widths + -- When widths of columns are < 100%, we need to set width for the whole + -- table, or some browsers give us skinny columns with lots of space between: + return $ if totalWidth == 0 || totalWidth == 1 + then tbl + else tbl ! A.style (toValue $ "width:" ++ + show (round (totalWidth * 100) :: Int) ++ "%;") tableRowToHtml :: WriterOptions -> [Alignment] @@ -668,6 +697,10 @@ inlineToHtml opts inline = case inline of (Str str) -> return $ strToHtml str (Space) -> return $ strToHtml " " + (SoftBreak) -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" (LineBreak) -> return $ (if writerHtml5 opts then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) @@ -786,10 +819,10 @@ inlineToHtml opts inline = _ -> return mempty | f == Format "html" -> return $ preEscapedString str | otherwise -> return mempty - (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do + (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts linkText s - (Link txt (s,tit)) -> do + return $ obfuscateLink opts attr linkText s + (Link attr txt (s,tit)) -> do linkText <- inlineListToHtml opts txt let s' = case s of '#':xs | writerSlideVariant opts == @@ -799,19 +832,23 @@ inlineToHtml opts inline = let link' = if txt == [Str (unEscapeString s)] then link ! A.class_ "uri" else link + let link'' = addAttrs opts attr link' return $ if null tit - then link' - else link' ! A.title (toValue tit) - (Image txt (s,tit)) | treatAsImage s -> do + then link'' + else link'' ! A.title (toValue tit) + (Image attr txt (s,tit)) | treatAsImage s -> do + let alternate' = stringify txt let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] ++ - [A.alt $ toValue $ stringify txt] + [A.title $ toValue tit | not (null tit)] ++ + [A.alt $ toValue alternate' | not (null txt)] ++ + imgAttrsToHtml opts attr let tag = if writerHtml5 opts then H5.img else H.img return $ foldl (!) tag attributes -- note: null title included, as in Markdown.pl - (Image _ (s,tit)) -> do + (Image attr _ (s,tit)) -> do let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] + [A.title $ toValue tit | not (null tit)] ++ + imgAttrsToHtml opts attr return $ foldl (!) H5.embed attributes -- note: null title included, as in Markdown.pl (Note contents) @@ -849,7 +886,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [Link [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link nullAttr [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks |