From be6b06a1a96bc85baec8037aa956f703a3ad1198 Mon Sep 17 00:00:00 2001
From: Duncan Murdoch <murdoch.duncan@gmail.com>
Date: Sun, 19 Mar 2023 18:06:39 -0400
Subject: [PATCH 1/5] Support aria-labelledby in htmlwidgets.

---
 NEWS.md    |  2 ++
 R/output.R | 30 +++++++++++++++++++++++-------
 2 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index cf82f0b1a3..41512546c6 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1089,6 +1089,8 @@
 
 - added three global R options `knitr.sanitize.errors`, `knitr.sanitize.warnings`, and `knitr.sanitize.messages` to mask or change the messages, e.g. if `options(knitr.sanitize.errors = TRUE)` and the chunk option `error = TRUE`, the actual error message will be replaced by a character string like `"An error occurred"`; these options can also accept character values so you can customize the messages to be displayed, e.g. `options(knitr.sanitize.warnings = 'You had a warning from the code')`; see https://github.com/rstudio/shiny/issues/1123 for the motivation of these options
 
+- htmlwidgets can now support alt text by specifying an attribute `aria-labelledby="<label>"` in their first HTML tag. The text will be obtained from the `fig.alt` or `fig.cap` chunk option in the usual way.
+
 ## BUG FIXES
 
 - when the chunk option `cache.rebuild = TRUE`, the cache database should be rewritten (thanks, Oleg Mayba)
diff --git a/R/output.R b/R/output.R
index 6d13d3366f..f2df177c82 100644
--- a/R/output.R
+++ b/R/output.R
@@ -478,6 +478,17 @@ wrap_asis = function(x, options) {
   x
 }
 
+# This looks for attribute 'aria-labelledby = "label"' in the first
+# HTML tag in the string, and returns the label, or NULL if
+# none is found.
+
+get_alt_id <- function(s) {
+  repr = '^[^<]*<[^>]+aria-labelledby[ ]*=[ ]*"([^"]+)".*$'
+  id = sub(repr, "\\1", s)
+  if (id == s) id = NULL
+  id
+}
+
 # If you provide a custom print function that returns a character object of
 # class 'knit_asis', it will be written as is.
 #' @export
@@ -495,7 +506,9 @@ sew.knit_asis = function(x, options, inline = FALSE, ...) {
     if (inherits(x, 'knit_asis_htmlwidget')) {
       options$fig.cur = plot_counter()
       options = reduce_plot_opts(options)
-      return(add_html_caption(options, wrap_asis(x, options)))
+      return(add_html_caption(options,
+                              wrap_asis(x, options),
+                              id = get_alt_id(x)))
     }
   }
   x = wrap_asis(x, options)
@@ -638,13 +651,16 @@ sew.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE, ...
   ))
 }
 
-add_html_caption = function(options, code) {
+add_html_caption = function(options, code, id = NULL) {
   cap = .img.cap(options)
-  if (cap == '') return(code)
-  sprintf(
-    '<div class="figure"%s>\n%s\n<p class="caption">%s</p>\n</div>',
-    css_text_align(options$fig.align), code, cap
-  )
+  if (cap == '' && is.null(id)) return(code)
+  if (!is.null(id))
+    alt = .img.cap(options, alt = TRUE)
+  paste0(sprintf(
+    '<div class="figure"%s>\n%s\n', css_text_align(options$fig.align), code),
+    if (cap != '') sprintf('<p class="caption">%s</p>\n', cap),
+    if (!is.null(id)) sprintf('<p id="%s" hidden>%s</p>\n', id, alt),
+    '</div>')
 }
 
 #' A custom printing function

From 92e47e876573badddbef80ebce8bec8b98822f39 Mon Sep 17 00:00:00 2001
From: Duncan Murdoch <murdoch.duncan@gmail.com>
Date: Mon, 20 Mar 2023 06:29:09 -0400
Subject: [PATCH 2/5] Slightly cleaner code, only inserts one caption if the
 alternate matches it.

---
 R/output.R | 27 +++++++++++++++++++++------
 1 file changed, 21 insertions(+), 6 deletions(-)

diff --git a/R/output.R b/R/output.R
index f2df177c82..d4adb65803 100644
--- a/R/output.R
+++ b/R/output.R
@@ -653,14 +653,29 @@ sew.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE, ...
 
 add_html_caption = function(options, code, id = NULL) {
   cap = .img.cap(options)
+
   if (cap == '' && is.null(id)) return(code)
-  if (!is.null(id))
+
+  if (!is.null(id)) {
     alt = .img.cap(options, alt = TRUE)
-  paste0(sprintf(
-    '<div class="figure"%s>\n%s\n', css_text_align(options$fig.align), code),
-    if (cap != '') sprintf('<p class="caption">%s</p>\n', cap),
-    if (!is.null(id)) sprintf('<p id="%s" hidden>%s</p>\n', id, alt),
-    '</div>')
+    if (cap == alt) {
+      # Both are the same, so insert cap with id
+      alttext <- sprintf('<p class="caption" id="%s">%s</p>\n', id, cap)
+      # Prevent a second insertion
+      cap = ''
+    } else
+      alttext = sprintf('<p id="%s" hidden>%s</p>\n', id, alt)
+  } else
+    alttext = ''
+
+  if (cap != '')
+    captext = sprintf('<p class="caption">%s</p>\n', cap)
+  else
+    captext = ''
+
+  sprintf('<div class="figure"%s>\n%s\n%s%s</div>',
+          css_text_align(options$fig.align), code,
+          captext, alttext)
 }
 
 #' A custom printing function

From dc5c0b9cddd112634691944e7c9bf0f1fd281f42 Mon Sep 17 00:00:00 2001
From: Duncan Murdoch <murdoch.duncan@gmail.com>
Date: Mon, 20 Mar 2023 08:28:13 -0400
Subject: [PATCH 3/5] Don't insert blank caption. Blank alt should be inserted
 to satisfy the search for the id.

---
 R/output.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/output.R b/R/output.R
index d4adb65803..4492543f4c 100644
--- a/R/output.R
+++ b/R/output.R
@@ -658,7 +658,7 @@ add_html_caption = function(options, code, id = NULL) {
 
   if (!is.null(id)) {
     alt = .img.cap(options, alt = TRUE)
-    if (cap == alt) {
+    if (cap == alt && cap != '') {
       # Both are the same, so insert cap with id
       alttext <- sprintf('<p class="caption" id="%s">%s</p>\n', id, cap)
       # Prevent a second insertion

From 016b46c3d147f16e6be2588086a3b6b1423a3f45 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Mon, 22 May 2023 17:20:35 -0500
Subject: [PATCH 4/5] cosmetic changes

---
 R/output.R | 49 +++++++++++++++++++------------------------------
 1 file changed, 19 insertions(+), 30 deletions(-)

diff --git a/R/output.R b/R/output.R
index 4492543f4c..d1fe3e1492 100644
--- a/R/output.R
+++ b/R/output.R
@@ -478,17 +478,6 @@ wrap_asis = function(x, options) {
   x
 }
 
-# This looks for attribute 'aria-labelledby = "label"' in the first
-# HTML tag in the string, and returns the label, or NULL if
-# none is found.
-
-get_alt_id <- function(s) {
-  repr = '^[^<]*<[^>]+aria-labelledby[ ]*=[ ]*"([^"]+)".*$'
-  id = sub(repr, "\\1", s)
-  if (id == s) id = NULL
-  id
-}
-
 # If you provide a custom print function that returns a character object of
 # class 'knit_asis', it will be written as is.
 #' @export
@@ -506,9 +495,12 @@ sew.knit_asis = function(x, options, inline = FALSE, ...) {
     if (inherits(x, 'knit_asis_htmlwidget')) {
       options$fig.cur = plot_counter()
       options = reduce_plot_opts(options)
-      return(add_html_caption(options,
-                              wrap_asis(x, options),
-                              id = get_alt_id(x)))
+      # look for attribute 'aria-labelledby="label"' in the first HTML tag and
+      # use the label to provide alt text if found
+      return(add_html_caption(
+        options, wrap_asis(x, options),
+        xfun::grep_sub('^[^<]*<[^>]+aria-labelledby[ ]*=[ ]*"([^"]+)".*$', '\\1', x)
+      ))
     }
   }
   x = wrap_asis(x, options)
@@ -653,29 +645,26 @@ sew.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE, ...
 
 add_html_caption = function(options, code, id = NULL) {
   cap = .img.cap(options)
+  if (cap == '' && !length(id)) return(code)
 
-  if (cap == '' && is.null(id)) return(code)
-
-  if (!is.null(id)) {
+  if (length(id)) {
     alt = .img.cap(options, alt = TRUE)
     if (cap == alt && cap != '') {
-      # Both are the same, so insert cap with id
-      alttext <- sprintf('<p class="caption" id="%s">%s</p>\n', id, cap)
-      # Prevent a second insertion
+      # both are the same, so insert cap with id
+      alttext = sprintf('<p class="caption" id="%s">%s</p>\n', id, cap)
+      # prevent a second insertion
       cap = ''
-    } else
+    } else {
       alttext = sprintf('<p id="%s" hidden>%s</p>\n', id, alt)
-  } else
-    alttext = ''
+    }
+  } else alttext = ''
 
-  if (cap != '')
-    captext = sprintf('<p class="caption">%s</p>\n', cap)
-  else
-    captext = ''
+  captext = if (cap == '') '' else sprintf('<p class="caption">%s</p>\n', cap)
 
-  sprintf('<div class="figure"%s>\n%s\n%s%s</div>',
-          css_text_align(options$fig.align), code,
-          captext, alttext)
+  sprintf(
+    '<div class="figure"%s>\n%s\n%s%s</div>',
+    css_text_align(options$fig.align), code, captext, alttext
+  )
 }
 
 #' A custom printing function

From f76a7fc8916ab790e52dcf3d2dbeba0e71167361 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Mon, 22 May 2023 17:22:37 -0500
Subject: [PATCH 5/5] move news up

---
 NEWS.md | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 41512546c6..3b6a0f06ea 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
 # CHANGES IN knitr VERSION 1.43
 
+## NEW FEATURES
+
+- HTML Widgets can now support alt text by specifying an attribute `aria-labelledby="<label>"` in their first HTML tag. The text will be obtained from the `fig.alt` or `fig.cap` chunk option in the usual way (thanks, @dmurdoch, #2243).
+
 ## BUG FIXES
 
 - The chunk option `collapse = TRUE` works with HTML widgets now (thanks, @dmurdoch, #2212).
@@ -1089,8 +1093,6 @@
 
 - added three global R options `knitr.sanitize.errors`, `knitr.sanitize.warnings`, and `knitr.sanitize.messages` to mask or change the messages, e.g. if `options(knitr.sanitize.errors = TRUE)` and the chunk option `error = TRUE`, the actual error message will be replaced by a character string like `"An error occurred"`; these options can also accept character values so you can customize the messages to be displayed, e.g. `options(knitr.sanitize.warnings = 'You had a warning from the code')`; see https://github.com/rstudio/shiny/issues/1123 for the motivation of these options
 
-- htmlwidgets can now support alt text by specifying an attribute `aria-labelledby="<label>"` in their first HTML tag. The text will be obtained from the `fig.alt` or `fig.cap` chunk option in the usual way.
-
 ## BUG FIXES
 
 - when the chunk option `cache.rebuild = TRUE`, the cache database should be rewritten (thanks, Oleg Mayba)