From 7a3ee9d3d83b73cb53de80e01a9968ebf8f7cf12 Mon Sep 17 00:00:00 2001
From: Jan Tojnar <jtojnar@gmail.com>
Date: Sat, 5 Jun 2021 15:53:24 +0200
Subject: CommonMark writer: do not throw away attributes when Ext_attributes
 is enabled

Ext_attributes covers at least the following:

- Ext_fenced_code_attributes
- Ext_header_attributes
- Ext_inline_code_attributes
- Ext_link_attributes
---
 src/Text/Pandoc/Writers/Markdown.hs        |  8 +++++---
 src/Text/Pandoc/Writers/Markdown/Inline.hs | 22 ++++++++++++----------
 2 files changed, 17 insertions(+), 13 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 38227dfa8..6316d9419 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -366,7 +366,7 @@ blockToMarkdown' opts (Plain inlines) = do
 -- title beginning with fig: indicates figure
 blockToMarkdown' opts (Para [Image attr alt (src,tgt@(T.stripPrefix "fig:" -> Just tit))])
   | isEnabled Ext_raw_html opts &&
-    not (isEnabled Ext_link_attributes opts) &&
+    not (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts) &&
     attr /= nullAttr = -- use raw HTML
     (<> blankline) . literal . T.strip <$>
       writeHtml5String opts{ writerTemplate = Nothing }
@@ -431,7 +431,8 @@ blockToMarkdown' opts (Header level attr inlines) = do
                                  && id' == autoId -> empty
                    (id',_,_)   | isEnabled Ext_mmd_header_identifiers opts ->
                                     space <> brackets (literal id')
-                   _ | isEnabled Ext_header_attributes opts ->
+                   _ | isEnabled Ext_header_attributes opts ||
+                       isEnabled Ext_attributes opts ->
                                     space <> attrsToMarkdown attr
                      | otherwise -> empty
   contents <- inlineListToMarkdown opts $
@@ -490,7 +491,8 @@ blockToMarkdown' opts (CodeBlock attribs str) = do
      endline c = literal $ T.replicate (endlineLen c) $ T.singleton c
      backticks = endline '`'
      tildes = endline '~'
-     attrs  = if isEnabled Ext_fenced_code_attributes opts
+     attrs  = if isEnabled Ext_fenced_code_attributes opts ||
+                 isEnabled Ext_attributes opts
                  then nowrap $ " " <> classOrAttrsToMarkdown attribs
                  else case attribs of
                             (_,cls:_,_) -> " " <> literal cls
diff --git a/src/Text/Pandoc/Writers/Markdown/Inline.hs b/src/Text/Pandoc/Writers/Markdown/Inline.hs
index e66258220..cd5f5b896 100644
--- a/src/Text/Pandoc/Writers/Markdown/Inline.hs
+++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs
@@ -117,7 +117,7 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
 
 linkAttributes :: WriterOptions -> Attr -> Doc Text
 linkAttributes opts attr =
-  if isEnabled Ext_link_attributes opts && attr /= nullAttr
+  if (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts) && attr /= nullAttr
      then attrsToMarkdown attr
      else empty
 
@@ -394,13 +394,15 @@ inlineToMarkdown opts (Quoted DoubleQuote lst) = do
                    then "&ldquo;" <> contents <> "&rdquo;"
                    else "“" <> contents <> "”"
 inlineToMarkdown opts (Code attr str) = do
-  let tickGroups = filter (T.any (== '`')) $ T.group str
-  let longest    = maybe 0 maximum $ nonEmpty $ map T.length tickGroups
-  let marker     = T.replicate (longest + 1) "`"
-  let spacer     = if longest == 0 then "" else " "
-  let attrs      = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr
-                      then attrsToMarkdown attr
-                      else empty
+  let tickGroups   = filter (T.any (== '`')) $ T.group str
+  let longest      = maybe 0 maximum $ nonEmpty $ map T.length tickGroups
+  let marker       = T.replicate (longest + 1) "`"
+  let spacer       = if longest == 0 then "" else " "
+  let attrsEnabled = isEnabled Ext_inline_code_attributes opts ||
+                     isEnabled Ext_attributes opts
+  let attrs        = if attrsEnabled && attr /= nullAttr
+                        then attrsToMarkdown attr
+                        else empty
   variant <- asks envVariant
   case variant of
      PlainText -> return $ literal str
@@ -559,7 +561,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit)) = do
                            else "[" <> reftext <> "]"
            in  return $ first <> second
       | isEnabled Ext_raw_html opts
-      , not (isEnabled Ext_link_attributes opts)
+      , not (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts)
       , attr /= nullAttr -> -- use raw HTML to render attributes
           literal . T.strip <$>
             writeHtml5String opts{ writerTemplate = Nothing }
@@ -569,7 +571,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit)) = do
          linkAttributes opts attr
 inlineToMarkdown opts img@(Image attr alternate (source, tit))
   | isEnabled Ext_raw_html opts &&
-    not (isEnabled Ext_link_attributes opts) &&
+    not (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts) &&
     attr /= nullAttr = -- use raw HTML
     literal . T.strip <$>
       writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]])
-- 
cgit v1.2.3