aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs10
-rw-r--r--src/Text/Pandoc/Shared.hs6
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs64
-rw-r--r--test/command/5805.md20
4 files changed, 74 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
diff --git a/test/command/5805.md b/test/command/5805.md
new file mode 100644
index 000000000..8bfc75f2d
--- /dev/null
+++ b/test/command/5805.md
@@ -0,0 +1,20 @@
+```
+% pandoc -f html -t html
+<kbd>Ctrl-C</kbd>
+^D
+<kbd>Ctrl-C</kbd>
+```
+
+```
+% pandoc -f html -t native
+<kbd>Ctrl-C</kbd>
+^D
+[Plain [Span ("",["kbd"],[]) [Str "Ctrl-C"]]]
+```
+
+```
+% pandoc -f native -t html
+[Plain [Span ("",["kbd"],[]) [Str "Ctrl-C"]]]
+^D
+<kbd>Ctrl-C</kbd>
+```
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-03 00:27:58 +0000