aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniele D'Orazio <d.dorazio96@gmail.com>2019-10-09 10:10:08 +0200
committerJohn MacFarlane <jgm@berkeley.edu>2019-10-15 09:49:09 -0700
commit1425bf9a6549da00ca87832dc6f19d59269a6a83 (patch)
tree5afee855bf9c867ed2fce0edfd6ecf14fb04c02a
parenta1977dd2d67e6ccbafaf7ac25f941bdd399469fa (diff)
downloadpandoc-1425bf9a6549da00ca87832dc6f19d59269a6a83.tar.gz
Add support for reading and writing <kbd> elements
* Text.Pandoc.Shared: export `htmlSpanLikeElements` [API change] This commit also introduces a mapping of HTML span like elements that are internally represented as a Span with a single class, but that are converted back to the original element by the html writer. As of now, only the kbd element is handled this way. Ideally these elements should be handled as plain AST values, but since that would be a breaking change with a large impact, we revert to this stop-gap solution. Fixes https://github.com/jgm/pandoc/issues/5796.
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 2025-04-05 18:02:35 +0000