Merge pull request #23 from atusy/fuzzyhelp-less-bg

fix(fuzzyhelp): not working on RStudio Server

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: felp
 Type: Package
 Title: Functional Help for Functions, Objects, and Packages
-Version: 0.5.0
+Version: 0.5.0.9999
 Author: Atsushi Yasumoto [aut, cph, cre] (<https://orcid.org/0000-0002-8335-495X>)
 Authors@R: c(
         person(

NEWS.md

@@ -1,3 +1,7 @@
+# felp 0.5.1
+
+- Fixed `fuzzyhelp()` not showing preview on RStudio Server.
+
 # felp 0.5.0
 
 - On `fuzzyhelp()`, help/vignette contents gain syntax highlights and links. It formerly used `Rd2HTML()` to generate HTML contents. Now the contents inherit from a help server with `startDynamicHelp()`, which means they are exactly same as the contents of `help()` or `vignette()`.

R/fuzzyhelp.R

@@ -3,10 +3,16 @@
 NULL
 
 #' Get preview content for Shiny UI
+#'
+#' @value `list(src?: character, srcdoc?: character)`
+#'  `src` and `srcdoc` are exclusive. If dynamic help server is available,
+#'  `src` returns address to the help page. Otherwise, `srcdoc` returns
+#'  HTML content of the help page.
+#'
 #' @noRd
-get_content <- function(x, i) {
+get_content <- function(x, i, helpPort, rstudioServer) {
   if (NROW(x) == 0L || length(i) == 0L) {
-    return("")
+    return(list(srcdoc = ""))
   }
   if (length(i) > 1L) {
     warning("i should be an integer vector of the length equal to 1.")
@@ -15,33 +21,41 @@ get_content <- function(x, i) {
   type <- x$Type[i]
   topic <- x$Topic[i]
   package <- x$Package[i]
-  helpPort <- startDynamicHelp()
-  helpUrl <- "http://127.0.0.1:%d/%s/%s/%s/%s%s"
+  helpUrl <- if (rstudioServer) {
+    "/help/%s/%s/%s/%s%s"
+  } else {
+    paste0("http://127.0.0.1:", helpPort, "/%s/%s/%s/%s%s")
+  }
 
   if (type == "help") {
     if (is.null(helpPort)) {
-      return(get_help(topic, package))
+      return(list(srcdoc = if (is.null(helpPort)) get_help(topic, package)))
+    } else {
+      h <- help((topic), (package), help_type = "html")
+      return(
+        list(src = sprintf(helpUrl, "library", package, "html", basename(h), ".html"))
+      )
     }
-    h <- help((topic), (package), help_type = "html")
-    return(sprintf(helpUrl, helpPort, "library", package, "html", basename(h), ".html"))
   }
 
   if (type == "vignette") {
     if (is.null(helpPort)) {
-      return(get_vignette(topic, package))
+      return(list(srcdoc = if (is.null(helpPort)) get_vignette(topic, package)))
+    } else {
+      v <- utils::vignette(topic, package)
+      return(list(src = sprintf(helpUrl, "library", basename(v$Dir), "doc", v$PDF, "")))
     }
-    v <- utils::vignette(topic, package)
-    return(sprintf(helpUrl, helpPort, "library", basename(v$Dir), "doc", v$PDF, ""))
   }
 
   if (type == "demo") {
     if (is.null(helpPort)) {
-      return(sprintf('Call <code>demo("%s", "%s")</code> to see demo', topic, package))
+      return(list(srcdoc = sprintf('Call <code>demo("%s", "%s")</code> to see demo', topic, package)))
+    } else {
+      return(list(src = sprintf(helpUrl, "library", package, "Demo", topic, "")))
     }
-    return(sprintf(helpUrl, helpPort, "library", package, "Demo", topic, ""))
   }
 
-  paste("Viewer not available for the type:", type)
+  return(list(srcdoc = paste("Viewer not available for the type:", type)))
 }
 
 #' Create ToC of help
@@ -309,7 +323,11 @@ parse_query <- function(string) {
   queries[queries != ""]
 }
 
-create_server <- function(method = c("fzf", "lv"), background = FALSE) {
+create_server <- function(
+    method = c("fzf", "lv"),
+    background = FALSE,
+    helpPort = NULL,
+    rstudioServer = FALSE) {
   method <- match.arg(method)
   function(input, output) {
     toc <- create_toc()
@@ -341,11 +359,11 @@ create_server <- function(method = c("fzf", "lv"), background = FALSE) {
     })
     reactiveHelp <- shiny::reactive({
       arguments <- list(style = "width: 100%; height: 100%;", id = "helpViewer")
-      content <- get_content(reactiveToc(), reactiveSelection())
-      if (grepl("^http://", content)) {
-        arguments$src <- content
+      content <- get_content(reactiveToc(), reactiveSelection(), helpPort, rstudioServer)
+      if (is.null(content$srcdoc)) {
+        arguments$src <- content$src
       } else {
-        arguments$srcdoc <- content
+        arguments$srcdoc <- content$srcdoc
         arguments$onload <- "(function(){
           // replace anchors to avoid nesting shiny widgets
           const pattern = document.baseURI + '#';
@@ -389,8 +407,13 @@ create_server <- function(method = c("fzf", "lv"), background = FALSE) {
 }
 
 .env <- new.env()
+# 31537
+
+startDynamicHelp <- function(background) {
+  if (background) {
+    return(tools::startDynamicHelp(NA))
+  }
 
-startDynamicHelp <- function() {
   if (
     !is.null(.env$helpProcess) &&
       is.null(.env$helpProcess$get_exit_status()) &&
@@ -468,7 +491,9 @@ fuzzyhelp <- function(
     background = getOption("fuzzyhelp.background", TRUE),
     viewer = shiny::paneViewer()) {
   app <- create_ui(query, background)
-  server <- create_server(method, background)
+  helpPort <- startDynamicHelp(background) # NOTE: eager evaluate
+  rstudioServer <- rstudioapi::isAvailable() && rstudioapi::versionInfo()$mode == "server"
+  server <- create_server(method, background, helpPort, rstudioServer)
 
   # Create new gadget on foreground
   if (!background) {

docs/pkgdown.yml

@@ -3,5 +3,5 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   felp: felp.html
-last_built: 2024-04-18T14:16Z
+last_built: 2024-04-22T14:20Z