rshinyquarto

How can a Shiny input button control a display button on a Quarto website nested within an iframe?


I am building a Shiny app that has a tab for documentation, and I plan to use tags$iframe to include a rendered Quarto website for it.

In Quarto, it is possible to set a switch for display. This will also show a switch button to control the theme of the website.

The sample App is shown below:

enter image description here

While both support switching from light to dark mode, users need to click different switches twice, which is not ideal for the best experience:

Only the Shiny input switched to dark: enter image description here

Both the Shiny input and Quarto input switched to dark: enter image description here

My question is: Is it possible to use a Shiny input button to control both the theme in the Shiny app and the theme in the Quarto website?

The code of the sample Shiny app is:

library(shiny)
library(bslib)
library(htmltools)

ui <- page_fillable(

    input_dark_mode(id = "shiny_control", mode = "light"),

    tags$iframe(
      src = "_site/index.html",

      style = "height:86vh"
    )
)

server <- function(input, output, session) {

}

shinyApp(ui, server)

And the full app structure is available in github:

├── app.R                                       <- Shiny app
├── control_quarto_theme_from_Shiny.Rproj
└── www               
    └── _site                                   <- Rendered Quarto Website files
        ├── about.html
        ├── index.html
        ├── search.json
        ├── site_libs
        │   ├── bootstrap
        │   │   ├── bootstrap-dark.min.css
        │   │   ├── bootstrap-icons.css
        │   │   ├── bootstrap-icons.woff
        │   │   ├── bootstrap.min.css
        │   │   └── bootstrap.min.js
        │   ├── clipboard
        │   │   └── clipboard.min.js
        │   ├── quarto-html
        │   │   ├── anchor.min.js
        │   │   ├── popper.min.js
        │   │   ├── quarto-syntax-highlighting-dark.css
        │   │   ├── quarto-syntax-highlighting.css
        │   │   ├── quarto.js
        │   │   ├── tippy.css
        │   │   └── tippy.umd.min.js
        │   ├── quarto-nav
        │   │   ├── headroom.min.js
        │   │   └── quarto-nav.js
        │   └── quarto-search
        │       ├── autocomplete.umd.js
        │       ├── fuse.min.js
        │       └── quarto-search.js
        └── styles.css

Solution

  • You can set up click event handler which trigger a button click in Quarto (or Shiny), if the Shiny (or Quarto) control was clicked:

    library(shiny)
    library(bslib)
    library(htmltools)
    
    ui <- page_fillable(
      tags$head(
        tags$script('
        $(document).on("shiny:connected", function () {
          
          var iframe = document.getElementById("QuartoWebsite");
          var innerDoc = iframe.contentDocument || iframe.contentWindow.document;
          var ShinyDarkMode = document.getElementById("shiny_control").shadowRoot.querySelector("button");
          var QuartoDarkMode = innerDoc.querySelector(".quarto-color-scheme-toggle");
          
          QuartoDarkMode.addEventListener("click",
              function(event) {
                if (!event.isTrusted) {
                  return; // to avoid an infinite loop because of the other event listener, only trigger if the user clicked
                }
                ShinyDarkMode.click();
            });
          
          ShinyDarkMode.addEventListener("click",
              function(event) {
                if (!event.isTrusted) {
                  return; // to avoid an infinite loop because of the other event listener, only trigger if the user clicked
                }
                QuartoDarkMode.click();
              }
          );
                    
       });')),
      
      input_dark_mode(id = "shiny_control", mode = "light"),
      
      tags$iframe(
        id = "QuartoWebsite",
        src = "_site/about.html",
        style = "height:86vh"
      )
    )
    
    shinyApp(ui, \(...){})
    

    enter image description here