From 4ec02053bba3f280b63267c90f2faeafe74d5c64 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 17 Aug 2018 21:25:14 -0700 Subject: Docx writer: properly handle display math in spans. Closes #4826. This isn't a complete solution, since other nestings of display math may still cause problems, but it should work for what is by far the most common case. Note that this also involves an API change: `isDisplayMath` is now exported from Text.Pandoc.Writers.Shared. --- src/Text/Pandoc/Writers/Shared.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 2edce7deb..438a35ca4 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -38,6 +38,7 @@ module Text.Pandoc.Writers.Shared ( , resetField , defField , tagWithAttrs + , isDisplayMath , fixDisplayMath , unsmartify , gridTable @@ -187,8 +188,9 @@ tagWithAttrs tag (ident,classes,kvs) = hsep ] <> ">" isDisplayMath :: Inline -> Bool -isDisplayMath (Math DisplayMath _) = True -isDisplayMath _ = False +isDisplayMath (Math DisplayMath _) = True +isDisplayMath (Span _ [Math DisplayMath _]) = True +isDisplayMath _ = False stripLeadingTrailingSpace :: [Inline] -> [Inline] stripLeadingTrailingSpace = go . reverse . go . reverse -- cgit v1.2.3 From d975917509061e4dfbeb4d2444f5ef7ccbe1887b Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 2 Oct 2018 18:16:43 -0700 Subject: Removed Text.Pandoc.Groff. Moved groffEscape function to Text.Pandoc.Writers.Shared. [API change, since T.P.W.S is exported.] --- pandoc.cabal | 1 - src/Text/Pandoc/Groff.hs | 43 --------------------------------------- src/Text/Pandoc/Writers/Man.hs | 1 - src/Text/Pandoc/Writers/Ms.hs | 1 - src/Text/Pandoc/Writers/Shared.hs | 11 ++++++++++ 5 files changed, 11 insertions(+), 46 deletions(-) delete mode 100644 src/Text/Pandoc/Groff.hs (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/pandoc.cabal b/pandoc.cabal index 4f7794dc4..58e8d6348 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -541,7 +541,6 @@ library Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.StackInstances, Text.Pandoc.Lua.Util, - Text.Pandoc.Groff Text.Pandoc.CSS, Text.Pandoc.CSV, Text.Pandoc.UUID, diff --git a/src/Text/Pandoc/Groff.hs b/src/Text/Pandoc/Groff.hs deleted file mode 100644 index 46acc8fa8..000000000 --- a/src/Text/Pandoc/Groff.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{- -Copyright (C) 2018 John MacFarlane - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{- | - Module : Text.Pandoc.Groff - Copyright : Copyright (C) 2018 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane - Stability : alpha - Portability : portable - -Shared functions for escaping and formatting groff. --} -module Text.Pandoc.Groff ( groffEscape ) -where - -import Prelude -import Data.Char (isAscii, ord) -import qualified Data.Text as T -import Text.Printf (printf) - -groffEscape :: T.Text -> T.Text -groffEscape = T.concatMap toUchar - where toUchar c - | isAscii c = T.singleton c - | otherwise = T.pack $ printf "\\[u%04X]" (ord c) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index c37d13841..81fa38bd7 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -45,7 +45,6 @@ import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared -import Text.Pandoc.Groff (groffEscape) import Text.Pandoc.Templates import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 5eda77233..9a35a9693 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -60,7 +60,6 @@ import Text.Pandoc.Shared import Text.Pandoc.Templates import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared -import Text.Pandoc.Groff (groffEscape) import Text.Printf (printf) import Text.TeXMath (writeEqn) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 438a35ca4..ccf39c3c8 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -44,6 +44,7 @@ module Text.Pandoc.Writers.Shared ( , gridTable , metaValueToInlines , stripLeadingTrailingSpace + , groffEscape ) where import Prelude @@ -63,6 +64,8 @@ import Text.Pandoc.Pretty import Text.Pandoc.Walk (query) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) +import Text.Printf (printf) +import Data.Char (isAscii, ord) -- | Create JSON value for template from a 'Meta' and an association list -- of variables, specified at the command line or in the writer. @@ -340,3 +343,11 @@ metaValueToInlines (MetaInlines ils) = ils metaValueToInlines (MetaBlocks bs) = query return bs metaValueToInlines (MetaBool b) = [Str $ show b] metaValueToInlines _ = [] + +-- | Escape non-ASCII characters using groff \u[..] sequences. +groffEscape :: T.Text -> T.Text +groffEscape = T.concatMap toUchar + where toUchar c + | isAscii c = T.singleton c + | otherwise = T.pack $ printf "\\[u%04X]" (ord c) + -- cgit v1.2.3 From d7263a7e5fb1ba53465099c6f1be7a85e05564f8 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 3 Oct 2018 17:36:32 -0700 Subject: Text.Pandoc.Writers.Shared: added `metaValueToString`. [API change] --- src/Text/Pandoc/Writers/Shared.hs | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index ccf39c3c8..6113b0a66 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -43,6 +43,7 @@ module Text.Pandoc.Writers.Shared ( , unsmartify , gridTable , metaValueToInlines + , metaValueToString , stripLeadingTrailingSpace , groffEscape ) @@ -61,6 +62,7 @@ import qualified Text.Pandoc.Builder as Builder import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Pretty +import Text.Pandoc.Shared (stringify) import Text.Pandoc.Walk (query) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) @@ -344,6 +346,13 @@ metaValueToInlines (MetaBlocks bs) = query return bs metaValueToInlines (MetaBool b) = [Str $ show b] metaValueToInlines _ = [] +metaValueToString :: MetaValue -> String +metaValueToString (MetaString s) = s +metaValueToString (MetaInlines ils) = stringify ils +metaValueToString (MetaBlocks bs) = stringify bs +metaValueToString (MetaBool b) = show b +metaValueToString _ = "" + -- | Escape non-ASCII characters using groff \u[..] sequences. groffEscape :: T.Text -> T.Text groffEscape = T.concatMap toUchar -- cgit v1.2.3 From 600034d7ff83b7ece292016a1e9c232fd7ac66f7 Mon Sep 17 00:00:00 2001 From: Mauro Bieg Date: Thu, 4 Oct 2018 18:45:59 +0200 Subject: Add lookupMeta* functions to Text.Pandoc.Writers.Shared (#4907) Remove exported functions `metaValueToInlines`, `metaValueToString`. Add new exported functions `lookupMetaBool`, `lookupMetaBlocks`, `lookupMetaInlines`, `lookupMetaString`. Use these whenever possible for uniformity in writers. API change (major, because of removed function `metaValueToInlines`. `metaValueToString` wasn't in any released version.) --- src/Text/Pandoc/Readers/Org/DocumentTree.hs | 9 +--- src/Text/Pandoc/Writers/Docx.hs | 29 +++------- src/Text/Pandoc/Writers/OpenDocument.hs | 6 ++- src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 22 +++----- src/Text/Pandoc/Writers/RST.hs | 5 +- src/Text/Pandoc/Writers/Shared.hs | 62 ++++++++++++++++------ 6 files changed, 68 insertions(+), 65 deletions(-) (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index c7a5f22c4..a9df3b437 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -43,7 +43,6 @@ import Text.Pandoc.Readers.Org.BlockStarts import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing -import qualified Data.Map as Map import qualified Text.Pandoc.Builder as B -- @@ -58,7 +57,7 @@ documentTree :: PandocMonad m documentTree blocks inline = do initialBlocks <- blocks headlines <- sequence <$> manyTill (headline blocks inline 1) eof - title <- fmap (getTitle . unMeta) . orgStateMeta <$> getState + title <- fmap docTitle . orgStateMeta <$> getState return $ do headlines' <- headlines initialBlocks' <- initialBlocks @@ -73,12 +72,6 @@ documentTree blocks inline = do , headlineContents = initialBlocks' , headlineChildren = headlines' } - where - getTitle :: Map.Map String MetaValue -> [Inline] - getTitle metamap = - case Map.lookup "title" metamap of - Just (MetaInlines inlns) -> inlns - _ -> [] newtype Tag = Tag { fromTag :: String } deriving (Show, Eq) diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 5bd7e809b..524d20fd1 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -66,8 +66,7 @@ import Text.Pandoc.Readers.Docx.StyleMap import Text.Pandoc.Shared hiding (Element) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math -import Text.Pandoc.Writers.Shared (isDisplayMath, fixDisplayMath, - metaValueToInlines) +import Text.Pandoc.Writers.Shared import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -267,8 +266,9 @@ writeDocx opts doc@(Pandoc meta _) = do -- parse styledoc for heading styles let styleMaps = getStyleMaps styledoc - let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ - metaValueToInlines <$> lookupMeta "toc-title" meta + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> stTocTitle defaultWriterState + ls -> ls let initialSt = defaultWriterState { stStyleMaps = styleMaps @@ -760,24 +760,9 @@ writeOpenXML opts (Pandoc meta blocks) = do let tit = docTitle meta let auths = docAuthors meta let dat = docDate meta - let abstract' = case lookupMeta "abstract" meta of - Just (MetaBlocks bs) -> bs - Just (MetaInlines ils) -> [Plain ils] - Just (MetaString s) -> [Plain [Str s]] - _ -> [] - let subtitle' = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - Just (MetaBlocks [Para xs]) -> xs - Just (MetaInlines xs) -> xs - Just (MetaString s) -> [Str s] - _ -> [] - let includeTOC = writerTableOfContents opts || - case lookupMeta "toc" meta of - Just (MetaBlocks _) -> True - Just (MetaInlines _) -> True - Just (MetaString (_:_)) -> True - Just (MetaBool True) -> True - _ -> False + let abstract' = lookupMetaBlocks "abstract" meta + let subtitle' = lookupMetaInlines "subtitle" meta + let includeTOC = writerTableOfContents opts || lookupMetaBool "toc" meta title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')] authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $ diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index e3d7f2e5c..676a1acb0 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -226,8 +226,10 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeOpenDocument opts (Pandoc meta blocks) = do - lang <- fromMaybe (Lang "en" "US" "" []) <$> - toLang (metaValueToString <$> lookupMeta "lang" meta) + let defLang = Lang "en" "US" "" [] + lang <- case lookupMetaString "lang" meta of + "" -> pure defLang + s -> fromMaybe defLang <$> toLang (Just s) setTranslations lang let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index e14476b16..c97d8d770 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -72,7 +72,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Walk import Data.Time (UTCTime) import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" -import Text.Pandoc.Writers.Shared (metaValueToInlines) +import Text.Pandoc.Writers.Shared (lookupMetaInlines) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList, fromMaybe) @@ -731,9 +731,9 @@ makeEndNotesSlideBlocks = do anchorSet <- M.keysSet <$> gets stAnchorMap if M.null noteIds then return [] - else let title = case lookupMeta "notes-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Notes"] + else let title = case lookupMetaInlines "notes-title" meta of + [] -> [Str "Notes"] + ls -> ls ident = Shared.uniqueIdent title anchorSet hdr = Header slideLevel (ident, [], []) title blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $ @@ -744,13 +744,7 @@ getMetaSlide :: Pres (Maybe Slide) getMetaSlide = do meta <- asks envMetadata title <- inlinesToParElems $ docTitle meta - subtitle <- inlinesToParElems $ - case lookupMeta "subtitle" meta of - Just (MetaString s) -> [Str s] - Just (MetaInlines ils) -> ils - Just (MetaBlocks [Plain ils]) -> ils - Just (MetaBlocks [Para ils]) -> ils - _ -> [] + subtitle <- inlinesToParElems $ lookupMetaInlines "subtitle" meta authors <- mapM inlinesToParElems $ docAuthors meta date <- inlinesToParElems $ docDate meta if null title && null subtitle && null authors && null date @@ -785,9 +779,9 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks) meta <- asks envMetadata slideLevel <- asks envSlideLevel - let tocTitle = case lookupMeta "toc-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Table of Contents"] + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> [Str "Table of Contents"] + ls -> ls hdr = Header slideLevel nullAttr tocTitle blocksToSlide [hdr, contents] diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index b416eca59..34d5cce04 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -82,10 +82,7 @@ pandocToRST (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let subtit = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - Just (MetaInlines xs) -> xs - _ -> [] + let subtit = lookupMetaInlines "subtitle" meta title <- titleToRST (docTitle meta) subtit metadata <- metaToJSON opts (fmap render' . blockListToRST) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 6113b0a66..323748aad 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -42,8 +42,10 @@ module Text.Pandoc.Writers.Shared ( , fixDisplayMath , unsmartify , gridTable - , metaValueToInlines - , metaValueToString + , lookupMetaBool + , lookupMetaBlocks + , lookupMetaInlines + , lookupMetaString , stripLeadingTrailingSpace , groffEscape ) @@ -63,7 +65,6 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared (stringify) -import Text.Pandoc.Walk (query) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) import Text.Printf (printf) @@ -339,19 +340,50 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do body $$ border '-' (repeat AlignDefault) widthsInChars -metaValueToInlines :: MetaValue -> [Inline] -metaValueToInlines (MetaString s) = [Str s] -metaValueToInlines (MetaInlines ils) = ils -metaValueToInlines (MetaBlocks bs) = query return bs -metaValueToInlines (MetaBool b) = [Str $ show b] -metaValueToInlines _ = [] -metaValueToString :: MetaValue -> String -metaValueToString (MetaString s) = s -metaValueToString (MetaInlines ils) = stringify ils -metaValueToString (MetaBlocks bs) = stringify bs -metaValueToString (MetaBool b) = show b -metaValueToString _ = "" + +-- | Retrieve the metadata value for a given @key@ +-- and convert to Bool. +lookupMetaBool :: String -> Meta -> Bool +lookupMetaBool key meta = + case lookupMeta key meta of + Just (MetaBlocks _) -> True + Just (MetaInlines _) -> True + Just (MetaString (_:_)) -> True + Just (MetaBool True) -> True + _ -> False + +-- | Retrieve the metadata value for a given @key@ +-- and extract blocks. +lookupMetaBlocks :: String -> Meta -> [Block] +lookupMetaBlocks key meta = + case lookupMeta key meta of + Just (MetaBlocks bs) -> bs + Just (MetaInlines ils) -> [Plain ils] + Just (MetaString s) -> [Plain [Str s]] + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and extract inlines. +lookupMetaInlines :: String -> Meta -> [Inline] +lookupMetaInlines key meta = + case lookupMeta key meta of + Just (MetaString s) -> [Str s] + Just (MetaInlines ils) -> ils + Just (MetaBlocks [Plain ils]) -> ils + Just (MetaBlocks [Para ils]) -> ils + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and convert to String. +lookupMetaString :: String -> Meta -> String +lookupMetaString key meta = + case lookupMeta key meta of + Just (MetaString s) -> s + Just (MetaInlines ils) -> stringify ils + Just (MetaBlocks bs) -> stringify bs + Just (MetaBool b) -> show b + _ -> "" -- | Escape non-ASCII characters using groff \u[..] sequences. groffEscape :: T.Text -> T.Text -- cgit v1.2.3 From 6207bdeb681142e9fa3731e6e0ee7fa8e6c120f5 Mon Sep 17 00:00:00 2001 From: quasicomputational Date: Sat, 6 Oct 2018 05:33:14 +0100 Subject: CommonMark writer: add plain text fallbacks. (#4531) Previously, the writer would unconditionally emit HTMLish output for subscripts, superscripts, strikeouts (if the strikeout extension is disabled) and small caps, even with raw_html disabled. Now there are plain-text (and, where possible, fancy Unicode) fallbacks for all of these corresponding (mostly) to the Markdown fallbacks, and the HTMLish output is only used when raw_html is enabled. This commit adds exported functions `toSuperscript` and `toSubscript` to `Text.Pandoc.Writers.Shared`. [API change] Closes #4528. --- MANUAL.txt | 10 ++- src/Text/Pandoc/Writers/CommonMark.hs | 52 +++++++++--- src/Text/Pandoc/Writers/Markdown.hs | 29 +------ src/Text/Pandoc/Writers/Shared.hs | 31 ++++++- test/command/4528.md | 156 ++++++++++++++++++++++++++++++++++ 5 files changed, 237 insertions(+), 41 deletions(-) create mode 100644 test/command/4528.md (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/MANUAL.txt b/MANUAL.txt index 802ce556e..bf47184ce 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -3381,8 +3381,14 @@ Markdown allows it, but it has been made an extension so that it can be disabled if desired.) The raw HTML is passed through unchanged in HTML, S5, Slidy, Slideous, -DZSlides, EPUB, Markdown, Emacs Org mode, and Textile output, and suppressed -in other formats. +DZSlides, EPUB, Markdown, CommonMark, Emacs Org mode, and Textile +output, and suppressed in other formats. + +In the CommonMark format, if `raw_html` is enabled, superscripts, +subscripts, strikeouts and small capitals will be represented as HTML. +Otherwise, plain-text fallbacks will be used. Note that even if +`raw_html` is disabled, tables will be rendered with HTML syntax if +they cannot use pipe syntax. #### Extension: `markdown_in_html_blocks` #### diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index 27179496c..84ea37f38 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -45,7 +45,7 @@ import Network.HTTP (urlEncode) import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Shared (isTightList, linesToPara, substitute) +import Text.Pandoc.Shared (isTightList, linesToPara, substitute, capitalize) import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Walk (query, walk, walkM) import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes) @@ -253,18 +253,34 @@ inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :) inlineToNodes opts (Strikeout xs) = if isEnabled Ext_strikeout opts then (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :) - else ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "")) []]) ++ ) + else if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "")) []]) ++ ) + else (inlinesToNodes opts xs ++) inlineToNodes opts (Superscript xs) = - ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "")) []]) ++ ) + else case traverse toSuperscriptInline xs of + Nothing -> + ((node (TEXT (T.pack "^(")) [] : inlinesToNodes opts xs ++ + [node (TEXT (T.pack ")")) []]) ++ ) + Just xs' -> (inlinesToNodes opts xs' ++) inlineToNodes opts (Subscript xs) = - ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "")) []]) ++ ) + else case traverse toSubscriptInline xs of + Nothing -> + ((node (TEXT (T.pack "_(")) [] : inlinesToNodes opts xs ++ + [node (TEXT (T.pack ")")) []]) ++ ) + Just xs' -> (inlinesToNodes opts xs' ++) inlineToNodes opts (SmallCaps xs) = - ((node (HTML_INLINE (T.pack "")) [] - : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "")) [] + : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "")) []]) ++ ) + else (inlinesToNodes opts (capitalize xs) ++) inlineToNodes opts (Link _ ils (url,tit)) = (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :) -- title beginning with fig: indicates implicit figure @@ -319,3 +335,19 @@ inlineToNodes opts (Span attr ils) = inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++) inlineToNodes _ (Note _) = id -- should not occur -- we remove Note elements in preprocessing + +toSubscriptInline :: Inline -> Maybe Inline +toSubscriptInline Space = Just Space +toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils +toSubscriptInline (Str s) = Str <$> traverse toSubscript s +toSubscriptInline LineBreak = Just LineBreak +toSubscriptInline SoftBreak = Just SoftBreak +toSubscriptInline _ = Nothing + +toSuperscriptInline :: Inline -> Maybe Inline +toSuperscriptInline Space = Just Space +toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils +toSuperscriptInline (Str s) = Str <$> traverse toSuperscript s +toSuperscriptInline LineBreak = Just LineBreak +toSuperscriptInline SoftBreak = Just SoftBreak +toSuperscriptInline _ = Nothing diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 741d11580..9a4acb59d 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -38,7 +38,7 @@ module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where import Prelude import Control.Monad.Reader import Control.Monad.State.Strict -import Data.Char (chr, isPunctuation, isSpace, ord, isAlphaNum) +import Data.Char (isPunctuation, isSpace, isAlphaNum) import Data.Default import qualified Data.HashMap.Strict as H import Data.List (find, group, intersperse, sortBy, stripPrefix, transpose) @@ -1249,33 +1249,6 @@ makeMathPlainer = walk go go (Emph xs) = Span nullAttr xs go x = x -toSuperscript :: Char -> Maybe Char -toSuperscript '1' = Just '\x00B9' -toSuperscript '2' = Just '\x00B2' -toSuperscript '3' = Just '\x00B3' -toSuperscript '+' = Just '\x207A' -toSuperscript '-' = Just '\x207B' -toSuperscript '=' = Just '\x207C' -toSuperscript '(' = Just '\x207D' -toSuperscript ')' = Just '\x207E' -toSuperscript c - | c >= '0' && c <= '9' = - Just $ chr (0x2070 + (ord c - 48)) - | isSpace c = Just c - | otherwise = Nothing - -toSubscript :: Char -> Maybe Char -toSubscript '+' = Just '\x208A' -toSubscript '-' = Just '\x208B' -toSubscript '=' = Just '\x208C' -toSubscript '(' = Just '\x208D' -toSubscript ')' = Just '\x208E' -toSubscript c - | c >= '0' && c <= '9' = - Just $ chr (0x2080 + (ord c - 48)) - | isSpace c = Just c - | otherwise = Nothing - lineBreakToSpace :: Inline -> Inline lineBreakToSpace LineBreak = Space lineBreakToSpace SoftBreak = Space diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 323748aad..a7bf30aaa 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -48,12 +48,15 @@ module Text.Pandoc.Writers.Shared ( , lookupMetaString , stripLeadingTrailingSpace , groffEscape + , toSubscript + , toSuperscript ) where import Prelude import Control.Monad (zipWithM) import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object), encode, fromJSON) +import Data.Char (chr, ord, isAscii, isSpace) import qualified Data.HashMap.Strict as H import Data.List (groupBy, intersperse, transpose) import qualified Data.Map as M @@ -68,7 +71,6 @@ import Text.Pandoc.Shared (stringify) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) import Text.Printf (printf) -import Data.Char (isAscii, ord) -- | Create JSON value for template from a 'Meta' and an association list -- of variables, specified at the command line or in the writer. @@ -392,3 +394,30 @@ groffEscape = T.concatMap toUchar | isAscii c = T.singleton c | otherwise = T.pack $ printf "\\[u%04X]" (ord c) + +toSuperscript :: Char -> Maybe Char +toSuperscript '1' = Just '\x00B9' +toSuperscript '2' = Just '\x00B2' +toSuperscript '3' = Just '\x00B3' +toSuperscript '+' = Just '\x207A' +toSuperscript '-' = Just '\x207B' +toSuperscript '=' = Just '\x207C' +toSuperscript '(' = Just '\x207D' +toSuperscript ')' = Just '\x207E' +toSuperscript c + | c >= '0' && c <= '9' = + Just $ chr (0x2070 + (ord c - 48)) + | isSpace c = Just c + | otherwise = Nothing + +toSubscript :: Char -> Maybe Char +toSubscript '+' = Just '\x208A' +toSubscript '-' = Just '\x208B' +toSubscript '=' = Just '\x208C' +toSubscript '(' = Just '\x208D' +toSubscript ')' = Just '\x208E' +toSubscript c + | c >= '0' && c <= '9' = + Just $ chr (0x2080 + (ord c - 48)) + | isSpace c = Just c + | otherwise = Nothing diff --git a/test/command/4528.md b/test/command/4528.md new file mode 100644 index 000000000..a60f6decf --- /dev/null +++ b/test/command/4528.md @@ -0,0 +1,156 @@ +# Rendering small caps, superscripts and subscripts with and without `raw_html` + +## Small caps + +``` +% pandoc --wrap=none -f latex -t commonmark-raw_html +This has \textsc{small caps} in it. +^D +This has SMALL CAPS in it. +``` + +``` +% pandoc --wrap=none -f latex -t commonmark+raw_html +This has \textsc{small caps} in it. +^D +This has small caps in it. +``` +``` + +``` +% pandoc --wrap=none -f latex -t markdown_strict+raw_html +This has \textsc{small caps} in it. +^D +This has small caps in it. +``` + +## Strikeout + +``` +% pandoc --wrap=none -f html -t commonmark-raw_html-strikeout +This has strikeout in it. +^D +This has strikeout in it. + +``` +% pandoc --wrap=none -f html -t commonmark+raw_html-strikeout +This has strikeout in it. +^D +This has strikeout in it. +``` + +``` +% pandoc --wrap=none -f html -t commonmark-raw_html+strikeout +This has strikeout in it. +^D +This has ~~strikeout~~ in it. +``` + +``` +% pandoc --wrap=none -f html -t commonmark+raw_html+strikeout +This has strikeout in it. +^D +This has ~~strikeout~~ in it. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict-raw_html-strikeout +This has strikeout in it. +^D +This has strikeout in it. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html-strikeout +This has strikeout in it. +^D +This has strikeout in it. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict-raw_html+strikeout +This has strikeout in it. +^D +This has ~~strikeout~~ in it. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html+strikeout +This has strikeout in it. +^D +This has ~~strikeout~~ in it. +``` + +## Superscript + +``` +% pandoc --wrap=none -f html -t commonmark-raw_html +This has superscript in it and 2 3 again. With emphasis: 2 3. With letters: foo. With a span: 2. +^D +This has ^(superscript) in it and ² ³ again. With emphasis: ^(*2* 3). With letters: ^(foo). With a span: ². +``` + +``` +% pandoc --wrap=none -f html -t commonmark+raw_html +This has superscript in it and 2 again. +^D +This has superscript in it and 2 again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict-raw_html-superscript +This has superscript in it and 2 again. +^D +This has ^(superscript) in it and ² again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html-superscript +This has superscript in it and 2 again. +^D +This has superscript in it and 2 again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html+superscript +This has superscript in it and 2 again. +^D +This has ^superscript^ in it and ^2^ again. +``` + +## Subscript + +``` +% pandoc --wrap=none -f html -t commonmark-raw_html +This has subscript in it and 2 3 again. With emphasis: 2 3. With letters: foo. With a span: 2. +^D +This has \_(subscript) in it and ₂ ₃ again. With emphasis: \_(*2* 3). With letters: \_(foo). With a span: ₂. +``` + +``` +% pandoc --wrap=none -f html -t commonmark+raw_html +This has subscript in it and 2 again. +^D +This has subscript in it and 2 again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict-raw_html-subscript +This has subscript in it and 2 again. +^D +This has _(subscript) in it and ₂ again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html-subscript +This has subscript in it and 2 again. +^D +This has subscript in it and 2 again. +``` + +``` +% pandoc --wrap=none -f html -t markdown_strict+raw_html+subscript +This has subscript in it and 2 again. +^D +This has ~subscript~ in it and ~2~ again. +``` -- cgit v1.2.3 From bd8a66394bc25b52dca9ffd963a560a4ca492f9c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 6 Oct 2018 22:33:24 -0700 Subject: RST writer: use simple tables when possible. Closes #4750. Text.Pandoc.Writers.Shared now exports hasSimpleCells [API change]. --- src/Text/Pandoc/Writers/RST.hs | 38 ++++++++++++++++++++++--- src/Text/Pandoc/Writers/Shared.hs | 18 ++++++++++++ test/tables-rstsubset.native | 8 +++--- test/tables.rst | 60 +++++++++++++++++---------------------- 4 files changed, 82 insertions(+), 42 deletions(-) (limited to 'src/Text/Pandoc/Writers/Shared.hs') diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 34d5cce04..d64529c21 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -35,7 +35,7 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where import Prelude import Control.Monad.State.Strict import Data.Char (isSpace, toLower) -import Data.List (isPrefixOf, stripPrefix) +import Data.List (isPrefixOf, stripPrefix, transpose) import Data.Maybe (fromMaybe) import Data.Text (Text, stripEnd) import qualified Text.Pandoc.Builder as B @@ -304,9 +304,12 @@ blockToRST (Table caption aligns widths headers rows) = do modify $ \st -> st{ stOptions = oldOpts } return result opts <- gets stOptions - tbl <- gridTable opts blocksToDoc (all null headers) - (map (const AlignDefault) aligns) widths - headers rows + let isSimple = all (== 0) widths + tbl <- if isSimple + then simpleTable opts blocksToDoc headers rows + else gridTable opts blocksToDoc (all null headers) + (map (const AlignDefault) aligns) widths + headers rows return $ if null caption then tbl $$ blankline else (".. table:: " <> caption') $$ blankline $$ nest 3 tbl $$ @@ -693,3 +696,30 @@ imageDimsToRST attr = do Just dim -> cols dim Nothing -> empty return $ cr <> name $$ showDim Width $$ showDim Height + +simpleTable :: PandocMonad m + => WriterOptions + -> (WriterOptions -> [Block] -> m Doc) + -> [[Block]] + -> [[[Block]]] + -> m Doc +simpleTable opts blocksToDoc headers rows = do + -- can't have empty cells in first column: + let fixEmpties (d:ds) = if isEmpty d + then text "\\ " : ds + else d : ds + fixEmpties [] = [] + headerDocs <- if all null headers + then return [] + else fixEmpties <$> mapM (blocksToDoc opts) headers + rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows + let numChars [] = 0 + numChars xs = maximum . map offset $ xs + let colWidths = map numChars $ transpose (headerDocs : rowDocs) + let toRow = hsep . zipWith lblock colWidths + let hline = hsep (map (\n -> text (replicate n '=')) colWidths) + let hdr = if all null headers + then mempty + else hline $$ toRow headerDocs + let bdy = vcat $ map toRow rowDocs + return $ hdr $$ hline $$ bdy $$ hline diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index a7bf30aaa..ed2c46d7b 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -41,6 +41,7 @@ module Text.Pandoc.Writers.Shared ( , isDisplayMath , fixDisplayMath , unsmartify + , hasSimpleCells , gridTable , lookupMetaBool , lookupMetaBlocks @@ -54,6 +55,7 @@ module Text.Pandoc.Writers.Shared ( where import Prelude import Control.Monad (zipWithM) +import Data.Monoid (Any (..)) import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object), encode, fromJSON) import Data.Char (chr, ord, isAscii, isSpace) @@ -70,6 +72,7 @@ import Text.Pandoc.Pretty import Text.Pandoc.Shared (stringify) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) +import Text.Pandoc.Walk (query) import Text.Printf (printf) -- | Create JSON value for template from a 'Meta' and an association list @@ -243,6 +246,21 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs unsmartify opts (x:xs) = x : unsmartify opts xs unsmartify _ [] = [] +-- | True if block is a table that can be represented with +-- one line per row. +hasSimpleCells :: Block -> Bool +hasSimpleCells (Table _caption _aligns _widths headers rows) = + all isSimpleCell (concat (headers:rows)) + where + isLineBreak LineBreak = Any True + isLineBreak _ = Any False + hasLineBreak = getAny . query isLineBreak + isSimpleCell [Plain ils] = not (hasLineBreak ils) + isSimpleCell [Para ils ] = not (hasLineBreak ils) + isSimpleCell [] = True + isSimpleCell _ = False +hasSimpleCells _ = False + gridTable :: Monad m => WriterOptions -> (WriterOptions -> [Block] -> m Doc) diff --git a/test/tables-rstsubset.native b/test/tables-rstsubset.native index 5ea520d7c..a4f801b1c 100644 --- a/test/tables-rstsubset.native +++ b/test/tables-rstsubset.native @@ -1,5 +1,5 @@ [Para [Str "Simple",Space,Str "table",Space,Str "with",Space,Str "caption:"] -,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -17,7 +17,7 @@ ,[Plain [Str "1"]] ,[Plain [Str "1"]]]] ,Para [Str "Simple",Space,Str "table",Space,Str "without",Space,Str "caption:"] -,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -35,7 +35,7 @@ ,[Plain [Str "1"]] ,[Plain [Str "1"]]]] ,Para [Str "Simple",Space,Str "table",Space,Str "indented",Space,Str "two",Space,Str "spaces:"] -,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -81,7 +81,7 @@ ,[Plain [Str "5.0"]] ,[Plain [Str "Here\8217s",Space,Str "another",Space,Str "one.",Space,Str "Note",SoftBreak,Str "the",Space,Str "blank",Space,Str "line",Space,Str "between",SoftBreak,Str "rows."]]]] ,Para [Str "Table",Space,Str "without",Space,Str "column",Space,Str "headers:"] -,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [7.5e-2,7.5e-2,7.5e-2,7.5e-2] +,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[] ,[] ,[] diff --git a/test/tables.rst b/test/tables.rst index 4559883cd..660df61d4 100644 --- a/test/tables.rst +++ b/test/tables.rst @@ -2,41 +2,35 @@ Simple table with caption: .. table:: Demonstration of simple table syntax. - +-------+------+--------+---------+ - | Right | Left | Center | Default | - +=======+======+========+=========+ - | 12 | 12 | 12 | 12 | - +-------+------+--------+---------+ - | 123 | 123 | 123 | 123 | - +-------+------+--------+---------+ - | 1 | 1 | 1 | 1 | - +-------+------+--------+---------+ + ===== ==== ====== ======= + Right Left Center Default + ===== ==== ====== ======= + 12 12 12 12 + 123 123 123 123 + 1 1 1 1 + ===== ==== ====== ======= Simple table without caption: -+-------+------+--------+---------+ -| Right | Left | Center | Default | -+=======+======+========+=========+ -| 12 | 12 | 12 | 12 | -+-------+------+--------+---------+ -| 123 | 123 | 123 | 123 | -+-------+------+--------+---------+ -| 1 | 1 | 1 | 1 | -+-------+------+--------+---------+ +===== ==== ====== ======= +Right Left Center Default +===== ==== ====== ======= +12 12 12 12 +123 123 123 123 +1 1 1 1 +===== ==== ====== ======= Simple table indented two spaces: .. table:: Demonstration of simple table syntax. - +-------+------+--------+---------+ - | Right | Left | Center | Default | - +=======+======+========+=========+ - | 12 | 12 | 12 | 12 | - +-------+------+--------+---------+ - | 123 | 123 | 123 | 123 | - +-------+------+--------+---------+ - | 1 | 1 | 1 | 1 | - +-------+------+--------+---------+ + ===== ==== ====== ======= + Right Left Center Default + ===== ==== ====== ======= + 12 12 12 12 + 123 123 123 123 + 1 1 1 1 + ===== ==== ====== ======= Multiline table with caption: @@ -70,13 +64,11 @@ Multiline table without caption: Table without column headers: -+-----+-----+-----+-----+ -| 12 | 12 | 12 | 12 | -+-----+-----+-----+-----+ -| 123 | 123 | 123 | 123 | -+-----+-----+-----+-----+ -| 1 | 1 | 1 | 1 | -+-----+-----+-----+-----+ +=== === === === +12 12 12 12 +123 123 123 123 +1 1 1 1 +=== === === === Multiline table without column headers: -- cgit v1.2.3