1425bf9 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Add support for reading and writing <kbd> elements

1425bf9Daniele D'Orazio7 years ago

src/Text/Pandoc/Readers/HTML.hs+9−1

compare with master

unifiedsplit

@@ -62,7 +62,8 @@ import Text.Pandoc.Options (

62 extensionEnabled)

63import Text.Pandoc.Parsing hiding ((<|>))

64import Text.Pandoc.Shared (addMetaField, blocksToInlines', crFilter, escapeURI,

65+ extractSpaces, htmlSpanLikeElements,

65− extractSpaces, onlySimpleTableCells, safeRead, underlineSpan)

66+ onlySimpleTableCells, safeRead, underlineSpan)

66import Text.Pandoc.Walk

67import Text.Pandoc.Walk

67import Text.Parsec.Error

68import Text.Parsec.Error

68import Text.TeXMath (readMathML, writeTeX)

69import Text.TeXMath (readMathML, writeTeX)

@@ -643,6 +644,7 @@ inline = choice

643 , pStrong

644 , pStrong

644 , pSuperscript

645 , pSuperscript

645 , pSubscript

646 , pSubscript

647+ , pSpanLike

646 , pSmall

648 , pSmall

647 , pStrikeout

649 , pStrikeout

648 , pUnderline

650 , pUnderline

@@ -707,6 +709,12 @@ pSuperscript = pInlinesInTags "sup" B.superscript

707pSubscript :: PandocMonad m => TagParser m Inlines

709pSubscript :: PandocMonad m => TagParser m Inlines

708pSubscript = pInlinesInTags "sub" B.subscript

710pSubscript = pInlinesInTags "sub" B.subscript

709

711

712+pSpanLike :: PandocMonad m => TagParser m Inlines

713+pSpanLike = Set.foldr

714+ (\tag acc -> acc <|> pInlinesInTags tag (B.spanWith ("",[T.unpack tag],[])))

715+ mzero

716+ htmlSpanLikeElements

717+

710pSmall :: PandocMonad m => TagParser m Inlines

718pSmall :: PandocMonad m => TagParser m Inlines

711pSmall = pInlinesInTags "small" (B.spanWith ("",["small"],[]))

719pSmall = pInlinesInTags "small" (B.spanWith ("",["small"],[]))

712

720

src/Text/Pandoc/Shared.hs+6

@@ -67,6 +67,7 @@ module Text.Pandoc.Shared (

67 makeMeta,

68 eastAsianLineBreakFilter,

69 underlineSpan,

70+ htmlSpanLikeElements,

70 splitSentences,

71 splitSentences,

71 filterIpynbOutput,

72 filterIpynbOutput,

72 -- * TagSoup HTML handling

73 -- * TagSoup HTML handling

@@ -694,6 +695,11 @@ eastAsianLineBreakFilter = bottomUp go

694underlineSpan :: Inlines -> Inlines

695underlineSpan :: Inlines -> Inlines

695underlineSpan = B.spanWith ("", ["underline"], [])

696underlineSpan = B.spanWith ("", ["underline"], [])

696

697

698+-- | Set of HTML elements that are represented as Span with a class equal as

699+-- the element tag itself.

700+htmlSpanLikeElements :: Set.Set T.Text

701+htmlSpanLikeElements = Set.fromList [T.pack "kbd"]

702+

697-- | Returns the first sentence in a list of inlines, and the rest.

703-- | Returns the first sentence in a list of inlines, and the rest.

698breakSentence :: [Inline] -> ([Inline], [Inline])

704breakSentence :: [Inline] -> ([Inline], [Inline])

699breakSentence [] = ([],[])

705breakSentence [] = ([],[])

src/Text/Pandoc/Writers/HTML.hs+39−25

@@ -1,9 +1,9 @@

1−{-# LANGUAGE NoImplicitPrelude #-}

2{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

2+{-# LANGUAGE MultiWayIf #-}

3+{-# LANGUAGE NoImplicitPrelude #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ViewPatterns #-}

6{-# LANGUAGE ViewPatterns #-}

6−{-# LANGUAGE MultiWayIf #-}

7{- |

8 Module : Text.Pandoc.Writers.HTML

@@ -28,27 +28,28 @@ module Text.Pandoc.Writers.HTML (

28 writeRevealJs,

29 tagWithAttributes

30 ) where

31−import Prelude

32import Control.Monad.State.Strict

31import Control.Monad.State.Strict

33import Data.Char (ord, toLower)

32import Data.Char (ord, toLower)

34import Data.List (intercalate, intersperse, isPrefixOf, partition)

33import Data.List (intercalate, intersperse, isPrefixOf, partition)

34+import Data.List.Split (splitWhen)

35import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)

36import qualified Data.Set as Set

37import Data.String (fromString)

38−import Data.List.Split (splitWhen)

39import Data.Text (Text)

38import Data.Text (Text)

40import qualified Data.Text as T

39import qualified Data.Text as T

41import qualified Data.Text.Lazy as TL

40import qualified Data.Text.Lazy as TL

42−import Text.DocTemplates (FromContext(lookupContext))

43import Network.HTTP (urlEncode)

41import Network.HTTP (urlEncode)

44import Network.URI (URI (..), parseURIReference)

42import Network.URI (URI (..), parseURIReference)

45import Numeric (showHex)

43import Numeric (showHex)

44+import Prelude

46−import Text.Blaze.Internal (customLeaf, customParent, MarkupM(Empty))

45+import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent)

46+import Text.DocTemplates (FromContext (lookupContext))

47#if MIN_VERSION_blaze_markup(0,6,3)

48#else

49import Text.Blaze.Internal (preEscapedString, preEscapedText)

50#endif

51import Text.Blaze.Html hiding (contents)

52+import Text.DocTemplates (Context (..))

52import Text.Pandoc.Definition

53import Text.Pandoc.Definition

53import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,

54import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,

54 styleToCss)

55 styleToCss)

@@ -57,7 +58,6 @@ import Text.Pandoc.Options

57import Text.Pandoc.Shared

58import Text.Pandoc.Shared

58import Text.Pandoc.Slides

59import Text.Pandoc.Slides

59import Text.Pandoc.Templates (renderTemplate)

60import Text.Pandoc.Templates (renderTemplate)

60−import Text.DocTemplates (Context(..))

61import Text.Pandoc.Walk

62import Text.Pandoc.Writers.Math

63import Text.Pandoc.Writers.Shared

@@ -412,7 +412,7 @@ tableOfContents opts sects = do

412 _ -> opts

413 case toTableOfContents opts sects of

414 bl@(BulletList (_:_)) -> Just <$> blockToHtml opts' bl

415− _ -> return Nothing

415+ _ -> return Nothing

416

417-- | Convert list of Note blocks to a footnote <div>.

418-- Assumes notes are sorted.

@@ -650,7 +650,7 @@ blockToHtml opts (Div (ident, "section":dclasses, dkvs)

650 isSec (Div _ zs) = any isSec zs

651 isSec _ = False

652 let isPause (Para [Str ".",Space,Str ".",Space,Str "."]) = True

653− isPause _ = False

653+ isPause _ = False

654 let fragmentClass = case slideVariant of

655 RevealJsSlides -> "fragment"

656 _ -> "incremental"

@@ -907,9 +907,9 @@ tableRowToHtml :: PandocMonad m

907tableRowToHtml opts aligns rownum cols' = do

908 let mkcell = if rownum == 0 then H.th else H.td

909 let rowclass = case rownum of

910− 0 -> "header"

910+ 0 -> "header"

911 x | x `rem` 2 == 1 -> "odd"

912− _ -> "even"

912+ _ -> "even"

913 cols'' <- zipWithM

914 (\alignment item -> tableItemToHtml opts mkcell alignment item)

915 aligns cols'

@@ -980,7 +980,7 @@ inlineToHtml :: PandocMonad m

980inlineToHtml opts inline = do

981 html5 <- gets stHtml5

982 case inline of

983− (Str str) -> return $ strToHtml str

983+ (Str str) -> return $ strToHtml str

984 Space -> return $ strToHtml " "

985 SoftBreak -> return $ case writerWrapText opts of

986 WrapNone -> preEscapedString " "

@@ -989,22 +989,36 @@ inlineToHtml opts inline = do

989 LineBreak -> return $ do

990 if html5 then H5.br else H.br

991 strToHtml "\n"

992+

992− (Span (id',classes,kvs) ils)

993+ (Span (id',classes,kvs) ils) ->

994+ let spanLikeTag = case classes of

995+ [c] -> do

996+ let c' = T.pack c

997+ guard (c' `Set.member` htmlSpanLikeElements)

998+ pure $ customParent (textTag c')

999+ _ -> Nothing

1000+ in case spanLikeTag of

993− -> inlineListToHtml opts ils >>=

1001+ Just tag -> tag <$> inlineListToHtml opts ils

1002+ Nothing -> do

1003+ h <- inlineListToHtml opts ils

994− addAttrs opts attr' . H.span

1004+ addAttrs opts (id',classes',kvs') (H.span h)

995− where attr' = (id',classes',kvs')

1005+ where

996− classes' = filter (`notElem` ["csl-no-emph",

997− "csl-no-strong",

998− "csl-no-smallcaps"]) classes

999− kvs' = if null styles

1000− then kvs

1001− else ("style", concat styles) : kvs

1002 styles = ["font-style:normal;"

1006 styles = ["font-style:normal;"

1003− | "csl-no-emph" `elem` classes]

1007+ | "csl-no-emph" `elem` classes]

1004 ++ ["font-weight:normal;"

1008 ++ ["font-weight:normal;"

1005− | "csl-no-strong" `elem` classes]

1009+ | "csl-no-strong" `elem` classes]

1006 ++ ["font-variant:normal;"

1010 ++ ["font-variant:normal;"

1007− | "csl-no-smallcaps" `elem` classes]

1011+ | "csl-no-smallcaps" `elem` classes]

1012+ kvs' = if null styles

1013+ then kvs

1014+ else ("style", concat styles) : kvs

1015+ classes' = [ c | c <- classes

1016+ , c `notElem` [ "csl-no-emph"

1017+ , "csl-no-strong"

1018+ , "csl-no-smallcaps"

1019+ ]

1020+ ]

1021+

1008 (Emph lst) -> inlineListToHtml opts lst >>= return . H.em

1022 (Emph lst) -> inlineListToHtml opts lst >>= return . H.em

1009 (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong

1023 (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong

1010 (Code attr str) -> case hlCode of

1024 (Code attr str) -> case hlCode of

test/command/5805.mdnew file+20

@@ -0,0 +1,20 @@

1+```

2+% pandoc -f html -t html

3+<kbd>Ctrl-C</kbd>

4+^D

5+<kbd>Ctrl-C</kbd>

6+```

8+```

9+% pandoc -f html -t native

10+<kbd>Ctrl-C</kbd>

11+^D

12+[Plain [Span ("",["kbd"],[]) [Str "Ctrl-C"]]]

13+```

14+

15+```

16+% pandoc -f native -t html

17+[Plain [Span ("",["kbd"],[]) [Str "Ctrl-C"]]]

18+^D

19+<kbd>Ctrl-C</kbd>

20+```