From 757bbeba0fc6fed73f64821f4473c2adf1b398bb Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Thu, 29 Feb 2024 09:20:43 -0800
Subject: SelfContained: Add title element to embedded inline svgs...

from the alt attribute. This works around the fact that present-day
screen readers ignore the alt attribute on an svg element.

Suggestion is from
https://stackoverflow.com/questions/4697100/accessibility-recommended-alt-text-convention-for-svg-and-mathml

Addresses #9525.

Potential drawbacks:

- Should we use the title attribute instead if there is one on the
  image?  Otherwise the results may be unexpected.
- Is it a drawback that this alt text will display as popup text when
  you hover over the image? Can this be suppressed?  What about using
  desc instead of title?
---
 src/Text/Pandoc/SelfContained.hs | 33 +++++++++++++++++++++++++--------
 test/command/8948.md             |  4 ++--
 test/command/9420.md             |  2 +-
 test/command/9467.md             |  2 +-
 4 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs
index fdec874ff..a05ff15eb 100644
--- a/src/Text/Pandoc/SelfContained.hs
+++ b/src/Text/Pandoc/SelfContained.hs
@@ -146,7 +146,10 @@ convertTags (t@(TagOpen tagname as):ts)
   | any (isSourceAttribute tagname) as
      = do
        as' <- mapM processAttribute as
-       let attrs = rights as'
+       let rawattrs = rights as'
+       let attrs = case lookup "role" rawattrs of
+                      Nothing -> ("role", "img") : rawattrs -- see #9525
+                      Just _ -> rawattrs
        let svgContents = lefts as'
        rest <- convertTags ts
        case svgContents of
@@ -162,12 +165,13 @@ convertTags (t@(TagOpen tagname as):ts)
                  let attrs' = [(k,v) | (k,v) <- combineSvgAttrs svgattrs attrs
                                      , k /= "id"]
                  return $ TagOpen "svg" attrs' :
-                          TagOpen "use" [("href", "#" <> svgid),
-                                         ("width", "100%"),
-                                         ("height", "100%")] :
-                          TagClose "use" :
-                          TagClose "svg" :
-                          rest'
+                          addTitle attrs'
+                          [ TagOpen "use" [("href", "#" <> svgid),
+                                           ("width", "100%"),
+                                           ("height", "100%")]
+                          , TagClose "use"
+                          , TagClose "svg"
+                          ] ++ rest'
                Nothing ->
                   case dropWhile (not . isTagOpenName "svg") tags of
                     TagOpen "svg" svgattrs : tags' -> do
@@ -198,7 +202,8 @@ convertTags (t@(TagOpen tagname as):ts)
                             TagOpen tname (map addIdPrefix ats)
                           ensureUniqueId x = x
                       return $ TagOpen "svg" attrs'' :
-                                 map ensureUniqueId tags' ++ rest'
+                                 addTitle attrs'' (map ensureUniqueId tags') ++
+                                 rest'
                     _ -> return $ TagOpen tagname attrs : rest
   where processAttribute (x,y) =
            if isSourceAttribute tagname (x,y)
@@ -219,6 +224,18 @@ convertTags (t@(TagOpen tagname as):ts)
 
 convertTags (t:ts) = (t:) <$> convertTags ts
 
+-- add a title element to the svg if attributes include 'alt' and
+-- the svg doesn't already have a title element. Motivation: see #9525,
+-- as of 2024 screen readers don't notice the alt text on the svg element.
+addTitle :: [(T.Text, T.Text)] -> [Tag T.Text] -> [Tag T.Text]
+addTitle attrs tags =
+  case lookup "alt" attrs of
+    Nothing -> tags
+    Just alt
+      | any (~== (TagOpen "title" [] :: Tag T.Text)) tags -> tags
+      | otherwise ->
+          TagOpen "title" [] : TagText alt : TagClose "title" : tags
+
 -- we want to drop spaces, <?xml>, and comments before <svg>
 -- and anything after </svg>:
 getSvgTags :: T.Text -> [Tag T.Text]
diff --git a/test/command/8948.md b/test/command/8948.md
index ecb0f2a43..cb1b502b4 100644
--- a/test/command/8948.md
+++ b/test/command/8948.md
@@ -3,7 +3,7 @@
 ![minimal](command/minimal.svg)
 ![minimal](command/minimal.svg)
 ^D
-<p><svg alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><use href="#svg_7868854ffb8f30209cd0" width="100%" height="100%" /></svg> <svg id="svg_7868854ffb8f30209cd0" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150">
+<p><svg role="img" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><title>minimal</title><use href="#svg_7868854ffb8f30209cd0" width="100%" height="100%" /></svg> <svg id="svg_7868854ffb8f30209cd0" role="img" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><title>minimal</title>
     <path d="M 0 35.5 L 6.5 22.5 L 16 37 L 23 24 L 34.8 43.7 L 42.5 30 L 50.3 47 L 59.7 27.7 L 69 47 L 85 17.7 L 98.3 39 L 113 9.7 L 127.7 42.3 L 136.3 23.7 L 147 44.3 L 158.3 20.3 L 170.3 40.3 L 177.7 25.7 L 189.7 43 L 199.7 21 L 207.7 35 L 219 11 L 233 37 L 240.3 23.7 L 251 43 L 263 18.3 L 272.7 33.3 L 283 10 L 295 32.3 L 301.3 23 L 311.7 37 L 323.7 7.7 L 339.3 39 L 346.3 25.7 L 356.3 42.3 L 369.7 15 L 376.3 25.7 L 384 9 L 393 28.3 L 400.3 19 L 411.7 38.3 L 421 21 L 434.3 43 L 445 25 L 453 36.3 L 464.3 18.3 L 476.2 40.3 L 480 33.5 L 480 215 L 0 215 L 0 35.5 Z" fill="#175720" />
 </svg></p>
 ```
@@ -13,7 +13,7 @@
 ![minimal](command/minimal.svg)
 ![minimal](command/minimal.svg){#foo}
 ^D
-<p><svg alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><use href="#foo" width="100%" height="100%" /></svg> <svg id="foo" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150">
+<p><svg role="img" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><title>minimal</title><use href="#foo" width="100%" height="100%" /></svg> <svg id="foo" role="img" alt="minimal" viewBox="-.333 -.333 480 150" style="background-color:#ffffff00" xml:space="preserve" width="480" height="150"><title>minimal</title>
     <path d="M 0 35.5 L 6.5 22.5 L 16 37 L 23 24 L 34.8 43.7 L 42.5 30 L 50.3 47 L 59.7 27.7 L 69 47 L 85 17.7 L 98.3 39 L 113 9.7 L 127.7 42.3 L 136.3 23.7 L 147 44.3 L 158.3 20.3 L 170.3 40.3 L 177.7 25.7 L 189.7 43 L 199.7 21 L 207.7 35 L 219 11 L 233 37 L 240.3 23.7 L 251 43 L 263 18.3 L 272.7 33.3 L 283 10 L 295 32.3 L 301.3 23 L 311.7 37 L 323.7 7.7 L 339.3 39 L 346.3 25.7 L 356.3 42.3 L 369.7 15 L 376.3 25.7 L 384 9 L 393 28.3 L 400.3 19 L 411.7 38.3 L 421 21 L 434.3 43 L 445 25 L 453 36.3 L 464.3 18.3 L 476.2 40.3 L 480 33.5 L 480 215 L 0 215 L 0 35.5 Z" fill="#175720" />
 </svg></p>
 ```
diff --git a/test/command/9420.md b/test/command/9420.md
index 89f666964..ce92c4c58 100644
--- a/test/command/9420.md
+++ b/test/command/9420.md
@@ -2,7 +2,7 @@
 % pandoc --embed-resources
 ![](command/9420.svg)
 ^D
-<p><svg id="svg_e1815ef374a63cf552e4" width="504pt" height="360pt" viewBox="0 0 504 360">
+<p><svg id="svg_e1815ef374a63cf552e4" role="img" width="504pt" height="360pt" viewBox="0 0 504 360">
 <defs>
 <clipPath id="svg_e1815ef374a63cf552e4_clip1-c3ce354c">
   <path />
diff --git a/test/command/9467.md b/test/command/9467.md
index 3b6a411e8..6b37d195d 100644
--- a/test/command/9467.md
+++ b/test/command/9467.md
@@ -2,7 +2,7 @@
 % pandoc --embed-resources
 ![](command/9467.svg)
 ^D
-<p><svg id="svg2" width="191.56267" height="151.71201" viewBox="0 0 191.56267 151.71201" xmlns:svg="http://www.w3.org/2000/svg">
+<p><svg id="svg2" role="img" width="191.56267" height="151.71201" viewBox="0 0 191.56267 151.71201" xmlns:svg="http://www.w3.org/2000/svg">
   <defs id="svg2_defs6">
     <clipPath clipPathUnits="userSpaceOnUse" id="svg2_clipPath24">
       <path d="M 56.69362,0 113.38724,113.38724 170.08086,0 Z" id="svg2_path22" />
-- 
cgit v1.2.3