diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 64 |
3 files changed, 54 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index bb4e3a913..a9a04c962 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -62,7 +62,8 @@ import Text.Pandoc.Options ( extensionEnabled) import Text.Pandoc.Parsing hiding ((<|>)) import Text.Pandoc.Shared (addMetaField, blocksToInlines', crFilter, escapeURI, - extractSpaces, onlySimpleTableCells, safeRead, underlineSpan) + extractSpaces, htmlSpanLikeElements, + onlySimpleTableCells, safeRead, underlineSpan) import Text.Pandoc.Walk import Text.Parsec.Error import Text.TeXMath (readMathML, writeTeX) @@ -643,6 +644,7 @@ inline = choice , pStrong , pSuperscript , pSubscript + , pSpanLike , pSmall , pStrikeout , pUnderline @@ -707,6 +709,12 @@ pSuperscript = pInlinesInTags "sup" B.superscript pSubscript :: PandocMonad m => TagParser m Inlines pSubscript = pInlinesInTags "sub" B.subscript +pSpanLike :: PandocMonad m => TagParser m Inlines +pSpanLike = Set.foldr + (\tag acc -> acc <|> pInlinesInTags tag (B.spanWith ("",[T.unpack tag],[]))) + mzero + htmlSpanLikeElements + pSmall :: PandocMonad m => TagParser m Inlines pSmall = pInlinesInTags "small" (B.spanWith ("",["small"],[])) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index bcaa48ea1..765bc0826 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -67,6 +67,7 @@ module Text.Pandoc.Shared ( makeMeta, eastAsianLineBreakFilter, underlineSpan, + htmlSpanLikeElements, splitSentences, filterIpynbOutput, -- * TagSoup HTML handling @@ -694,6 +695,11 @@ eastAsianLineBreakFilter = bottomUp go underlineSpan :: Inlines -> Inlines underlineSpan = B.spanWith ("", ["underline"], []) +-- | Set of HTML elements that are represented as Span with a class equal as +-- the element tag itself. +htmlSpanLikeElements :: Set.Set T.Text +htmlSpanLikeElements = Set.fromList [T.pack "kbd"] + -- | Returns the first sentence in a list of inlines, and the rest. breakSentence :: [Inline] -> ([Inline], [Inline]) breakSentence [] = ([],[]) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index f573753b0..a1a617829 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE MultiWayIf #-} {- | Module : Text.Pandoc.Writers.HTML Copyright : Copyright (C) 2006-2019 John MacFarlane @@ -28,27 +28,28 @@ module Text.Pandoc.Writers.HTML ( writeRevealJs, tagWithAttributes ) where -import Prelude import Control.Monad.State.Strict import Data.Char (ord, toLower) import Data.List (intercalate, intersperse, isPrefixOf, partition) +import Data.List.Split (splitWhen) import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) import qualified Data.Set as Set import Data.String (fromString) -import Data.List.Split (splitWhen) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Text.DocTemplates (FromContext(lookupContext)) import Network.HTTP (urlEncode) import Network.URI (URI (..), parseURIReference) import Numeric (showHex) -import Text.Blaze.Internal (customLeaf, customParent, MarkupM(Empty)) +import Prelude +import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent) +import Text.DocTemplates (FromContext (lookupContext)) #if MIN_VERSION_blaze_markup(0,6,3) #else import Text.Blaze.Internal (preEscapedString, preEscapedText) #endif import Text.Blaze.Html hiding (contents) +import Text.DocTemplates (Context (..)) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, styleToCss) @@ -57,7 +58,6 @@ import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Slides import Text.Pandoc.Templates (renderTemplate) -import Text.DocTemplates (Context(..)) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared @@ -412,7 +412,7 @@ tableOfContents opts sects = do _ -> opts case toTableOfContents opts sects of bl@(BulletList (_:_)) -> Just <$> blockToHtml opts' bl - _ -> return Nothing + _ -> return Nothing -- | Convert list of Note blocks to a footnote <div>. -- Assumes notes are sorted. @@ -650,7 +650,7 @@ blockToHtml opts (Div (ident, "section":dclasses, dkvs) isSec (Div _ zs) = any isSec zs isSec _ = False let isPause (Para [Str ".",Space,Str ".",Space,Str "."]) = True - isPause _ = False + isPause _ = False let fragmentClass = case slideVariant of RevealJsSlides -> "fragment" _ -> "incremental" @@ -907,9 +907,9 @@ tableRowToHtml :: PandocMonad m tableRowToHtml opts aligns rownum cols' = do let mkcell = if rownum == 0 then H.th else H.td let rowclass = case rownum of - 0 -> "header" + 0 -> "header" x | x `rem` 2 == 1 -> "odd" - _ -> "even" + _ -> "even" cols'' <- zipWithM (\alignment item -> tableItemToHtml opts mkcell alignment item) aligns cols' @@ -980,7 +980,7 @@ inlineToHtml :: PandocMonad m inlineToHtml opts inline = do html5 <- gets stHtml5 case inline of - (Str str) -> return $ strToHtml str + (Str str) -> return $ strToHtml str Space -> return $ strToHtml " " SoftBreak -> return $ case writerWrapText opts of WrapNone -> preEscapedString " " @@ -989,22 +989,36 @@ inlineToHtml opts inline = do LineBreak -> return $ do if html5 then H5.br else H.br strToHtml "\n" - (Span (id',classes,kvs) ils) - -> inlineListToHtml opts ils >>= - addAttrs opts attr' . H.span - where attr' = (id',classes',kvs') - classes' = filter (`notElem` ["csl-no-emph", - "csl-no-strong", - "csl-no-smallcaps"]) classes - kvs' = if null styles - then kvs - else ("style", concat styles) : kvs + + (Span (id',classes,kvs) ils) -> + let spanLikeTag = case classes of + [c] -> do + let c' = T.pack c + guard (c' `Set.member` htmlSpanLikeElements) + pure $ customParent (textTag c') + _ -> Nothing + in case spanLikeTag of + Just tag -> tag <$> inlineListToHtml opts ils + Nothing -> do + h <- inlineListToHtml opts ils + addAttrs opts (id',classes',kvs') (H.span h) + where styles = ["font-style:normal;" - | "csl-no-emph" `elem` classes] + | "csl-no-emph" `elem` classes] ++ ["font-weight:normal;" - | "csl-no-strong" `elem` classes] + | "csl-no-strong" `elem` classes] ++ ["font-variant:normal;" - | "csl-no-smallcaps" `elem` classes] + | "csl-no-smallcaps" `elem` classes] + kvs' = if null styles + then kvs + else ("style", concat styles) : kvs + classes' = [ c | c <- classes + , c `notElem` [ "csl-no-emph" + , "csl-no-strong" + , "csl-no-smallcaps" + ] + ] + (Emph lst) -> inlineListToHtml opts lst >>= return . H.em (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong (Code attr str) -> case hlCode of |