webshot_shiny() changed to also use a separate screenshot

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: learnitdown
 Type: Package
-Version: 1.6.0
+Version: 1.7.0
 Title: R Markdown, Bookdown and Learnr Additions for Learning Material
 Description: Extension to R Markdown, Bookdown and Learnr for building better
   learning and e-learning material: H5P integration, course-contextual divs,

NEWS.md

@@ -1,8 +1,12 @@
+# learnitdown 1.7.0
+
+-   `webshot_shiny()` now also accepts the path to a PNG file (the screenshot of the app) instead of the url to the Shiny application. This allows to create the webshot image in case the app cannot be accessed directly (for instance, a login in Posit Connect is required). The corresponding RStudio addin is modified to ask fpr a PNG screenshot if no suitable code is selected.
+
 # learnitdown 1.6.0
 
--  Argument `idurl=` added in `h5p()` to allow including exercises from h5p.org or h5p.com.
+-   Argument `idurl=` added in `h5p()` to allow including exercises from h5p.org or h5p.com.
 
-- Default directory for assignments is now `docs` instead of `_book` with subdirectory being `ex` an which is now created by `clean_ex_doc()`.
+-   Default directory for assignments is now `docs` instead of `_book` with subdirectory being `ex` an which is now created by `clean_ex_doc()`.
 
 
 # learnitdown 1.5.6

R/addins.R

@@ -15,20 +15,28 @@ webshot_shiny_addin <- function() {
 
     # Check that the selection contains something like a call to a function
     if (!grepl("^[^\\(]+(\\([^\\)]+\\)).*$", sel)) {
-      message("You must select a construct like 'launch_shiny(url, ...)' first")
-      return()
+      message("You must select a construct like 'launch_shiny(url, ...)', ",
+        "or select a PNG file with the screenshot now...")
+
+      screenshot <- rstudioapi::selectFile(
+        "Select the Shiny app screenshot in PNG format",
+        filter = "PNG images (*.png)", existing = TRUE)
+      if (is.null(screenshot))
+        return()
+      # Construct the composite image
+      res <- try(img <- learnitdown::webshot_shiny(screenshot), silent = TRUE)
+    } else {# We have to launch the app and make the screenshot
+      # Get what looks like the arguments
+      args <- sub("^[^\\(]+(\\([^\\)]+\\)).*$", "\\1", sel)
+
+      # Construct the code to take screenshot of the Shiny app and run it
+      message("Launching the Shiny application and taking the screenshot,",
+        " please wait...")
+      img <- NULL
+      code <- paste0("img <- learnitdown::webshot_shiny", args)
+      res <- try(eval(parse(text = code)), silent = TRUE)
     }
 
-    # Get what looks like the arguments
-    args <- sub("^[^\\(]+(\\([^\\)]+\\)).*$", "\\1", sel)
-
-    # Construct the code to take screenshot of the Shiny app and run it
-    message("Launching the Shiny application and taking the screenshot,",
-      " please wait...")
-    img <- NULL
-    code <- paste0("img <- learnitdown::webshot_shiny", args)
-    res <- try(eval(parse(text = code)), silent = TRUE)
-
     # Is there an error?
     if (inherits(res, "try-error")) {
       message("An error occured while trying to take Shiny app screenshot")

R/learnitdown_learnr.R

@@ -98,7 +98,7 @@ record_learnr <- function(tutorial_id, tutorial_version, user_id, event, data) {
     max <- as.integer(sub("^.*/([0-9]+)$", "\\1", tutorial_version))
   } else {# No indication of the number of exercises
     version <- tutorial_version
-    max <- 1 # We indicate 1 by default and score is by exercice only
+    max <- 1 # We indicate 1 by default and score is by exercise only
   }
 
   # Extract label and correct from data
@@ -461,7 +461,7 @@ debug = Sys.getenv("LEARNITDOWN_DEBUG", 0) != 0) {
   tutorial_options(exercise.timelimit = time.limit)
   tutorial_options(exercise.cap = cap)
 
-  # Set general knitr parameters (lmore suitable ones for learnr)
+  # Set general knitr parameters (more suitable ones for learnr)
   load_lib('knitr')
   knitr::opts_chunk$set(echo = echo, comment = comment)
 }

R/run.R

@@ -47,7 +47,8 @@ ask = interactive(), upgrade = "never") {
   if (isTRUE(update) && !is.null(github_repos))
     updated <- update_pkg(package, github_repos, upgrade = upgrade)
 
-  if (missing(tutorial) || is.null(tutorial) || tutorial == "") {
+  if (missing(tutorial) || is.null(tutorial) || !length(tutorial) ||
+      tutorial[1] == "") {
     tutos <- dir(system.file("tutorials", package = package))
     if (isTRUE(ask) && interactive()) {
       # Allow selecting from the list...
@@ -84,7 +85,7 @@ ask = interactive(), upgrade = "never") {
   } else {
     # This is the classical learnr function, but the tutorial does not run in
     # the tutorial tab of RStudio in this case!
-    run_tutorial(tutorial, package = package, ...)
+    run_tutorial(tutorial[1], package = package, ...)
   }
 }
 
@@ -96,7 +97,7 @@ run_app <- function(app, package, github_repos = NULL, ..., update = ask,
   if (isTRUE(update) && !is.null(github_repos))
     updated <- update_pkg(package, github_repos, upgrade = upgrade)
 
-  if (missing(app) || is.null(app) || app == "") {
+  if (missing(app) || is.null(app) || !length(app) || app[1] == "") {
     apps <- dir(system.file("shiny", package = package))
     if (isTRUE(ask) && interactive()) {
       # Allow selecting from the list...
@@ -109,7 +110,7 @@ run_app <- function(app, package, github_repos = NULL, ..., update = ask,
       return(apps)
     }
   }
-  appDir <- system.file("shiny", app, package = package)
+  appDir <- system.file("shiny", app[1], package = package)
   port <- httpuv::randomPort()
 
   # Should we run the app in a job in RStudio?
@@ -121,7 +122,7 @@ run_app <- function(app, package, github_repos = NULL, ..., update = ask,
     cat("shiny::runApp('", appDir, "', port = ", port,
       ", launch.browser = FALSE, display.mode = 'normal')\n",
       file = script, sep = "")
-    rstudioapi::jobRunScript(script, name = paste("Shiny:", app, sep = ' '))
+    rstudioapi::jobRunScript(script, name = paste("Shiny:", app[1], sep = ' '))
     message("Waiting for the Shiny application...")
     url <- paste0("http://", getOption("shiny.host", "127.0.0.1"), ":", port)
     is_ready <- function(url) {

R/webshot_shiny.R

@@ -7,8 +7,10 @@
 #' information to the user (how the Shiny application would look like if it was
 #' started).
 #'
-#' @param url The URL to launch the Shiny app. If both `app =` and `baseurl =`
-#' @param app The name of the Shiny application.
+#' @param url The URL to launch the Shiny app, or to a screenshot of the app in
+#' PNG format.
+#' @param app The name of the Shiny application. If `NULL`, the base name of the
+#' URL without the extension is used.
 #' are provided, you don't need to specify it.
 #' @param imgdir The directory without trailing "/" where images relative
 #' to Shiny applications are stored. By default, it is relative to current
@@ -35,20 +37,28 @@
 #' (webshot_shiny("https://phgrosjean.shinyapps.io/histogram/", delay = 10))
 #'  # Now, look at this image. You can use it with launch_shiny()
 #'}
-webshot_shiny <- function(url, app = basename(url),
+webshot_shiny <- function(url, app = NULL,
 imgdir = "images/shinyapps", img = paste0(imgdir, "/", app, ".png"),
 width = 790, height = 500, offsetx = 30, offsety = 30, delay = 10, ...) {
   # Make sure imgdir directory exists
   dir.create(imgdir, showWarnings = FALSE, recursive = TRUE)
 
+  if (is.null(app))
+    app <- sub("\\.[^\\.]+$", "", basename(url))
+
   # Temporary screenshot and click icon images
   img_app_file <- paste0(imgdir, "/", app, "_temp.png")
   img_click_file <- system.file("images", "shinyapp_click.png",
     package = "learnitdown")
 
-  # Launch the Shiny app, wait delay and take screenshot
-  webshot(url, delay = delay, vwidth = width, vheight = height,
-    file = img_app_file)
+  # If url points to a .png file, just copy that file into img_app_file
+  if (endsWith(url, ".png")) {
+    file.copy(url, img_app_file)
+  } else {
+    # Launch the Shiny app, wait delay and take screenshot
+    webshot(url, delay = delay, vwidth = width, vheight = height,
+      file = img_app_file)
+  }
 
   # Combine both images
   img_app <- image_read(img_app_file)

inst/rstudio/addins.dcf

@@ -1,5 +1,5 @@
 Name: Shiny Application Webshot
 Description: Select a launch_shiny("url", ...) code then start this addin to create the required screenshot
 Binding: webshot_shiny_addin
-Interactive: false
+Interactive: true