如何修改R Shiny中的tabindex？

Question

我正在尝试修复我的一款闪亮应用程序上的一些辅助功能问题。问题在于，Shiny 的

tabPanel

默认行为是，一旦访问了某个选项卡，其

tabindex

就会变为 -1，这使得通过键盘导航访问的用户无法访问它（在单击选项卡之前，选项卡的 tabindex = 0）。

下面的示例显示了键盘导航如何不适用于选项卡。我正在使用 Shiny 1.7.2 和 R 4.0.3。

我尝试使用库

bslib

及其

page_navbar

/

nav_panel

函数，但没有成功。我还尝试将

HTML

添加到

tabPanel

调用中，并探索是否可以通过

CSS

做任何事情，但没有运气。我研究了这些函数的代码，看看是否可以修改它们，但我不确定如何修改。也许可以用

JS

来完成，但我只知道它的基础知识。我还尝试按照

此响应

中的建议使用htmltools::tagAppendatrribute，但它不会修改单击后的行为。

任何指示或解决方案都会很棒。

library(shiny)

# Define UI 
ui <- navbarPage(
    title = "Test accessibility issue",
    tabPanel(title = "Home", icon = icon("house"), value = "home",
             p("Test")),
    tabPanel(title = "Trends", icon = icon("list-ul"), value = "trends",
             p("Test")),
    tabPanel(title = "Geography", icon = icon("globe"), value = "geo",
             p("Test"))
)

# Define server logic 
server <- function(input, output) {

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

你可以做的是使用

MutationObserver

并监听属性

tabindex

的变化。如果该属性设置为“-1”，您可以将其编辑为例如“0”。在以下示例中，这适用于所有元素，但您当然可以更改它。

var observer = new MutationObserver(function(mutations) {
    mutations.forEach(function(mutation) {
        var attributeValue = $(mutation.target).prop(mutation.attributeName);
        if (mutation.attributeName === "tabindex" && attributeValue == "-1") {
            $(mutation.target).prop(mutation.attributeName, "0");
        }
    });
});

$("*").each(function() {
    observer.observe(this, {
        attributes: true
    });
});

library(shiny)

js <- "
var observer = new MutationObserver(function(mutations) {
    mutations.forEach(function(mutation) {
        var attributeValue = $(mutation.target).prop(mutation.attributeName);
        if (mutation.attributeName === 'tabindex' && attributeValue == '-1') {
            $(mutation.target).prop(mutation.attributeName, '0');
        }
    });
});

$('*').each(function() {
    observer.observe(this, {
        attributes: true
    });
});
"

# Define UI
ui <- shinyUI(
    navbarPage(
        header = tags$script(HTML(js)),
        title = "Test accessibility issue",
        tabPanel(
            title = "Home",
            icon = icon("house"),
            value = "home",
            p("Test")
        ),
        tabPanel(
            title = "Trends",
            icon = icon("list-ul"),
            value = "trends",
            p("Test")
        ),
        tabPanel(
            title = "Geography",
            icon = icon("globe"),
            value = "geo",
            p("Test")
        )
    )
)

# Define server logic
server <- function(input, output) {
    
}

# Run the application
shinyApp(ui = ui, server = server)