R session watcher

.github/ISSUE_TEMPLATE/bug_report.md

@@ -49,6 +49,9 @@ Yes / No
 
 // Use bracketed paste mode
 "r.bracketedPaste": false,
+
+// Enable R session watcher (experimental)
+"r.sessionWatcher": false,
 ```
 
 **Expected behavior**

ISSUE_TEMPLATE.md

@@ -42,4 +42,7 @@ Yes / No
 
 // Use bracketed paste mode
 "r.bracketedPaste": false,
+
+// Enable R session watcher (experimental)
+"r.sessionWatcher": false,
 ```

R/init.R

@@ -0,0 +1,184 @@
+if (interactive() && 
+  is.null(getOption("vscodeR")) && 
+  !identical(Sys.getenv("RSTUDIO"), "1")) {
+  local({
+    pid <- Sys.getpid()
+    tempdir <- tempdir()
+    dir <- normalizePath(file.path(".vscode", "vscode-R"), mustWork = FALSE)
+    dir_session <- file.path(dir, pid)
+    if (dir.create(dir_session, showWarnings = FALSE, recursive = TRUE) || dir.exists(dir_session)) {
+      reg.finalizer(.GlobalEnv, function(e) {
+        unlink(dir_session, recursive = TRUE, force = TRUE)
+      }, onexit = TRUE)
+
+      response_file <- file.path(dir, "response.log")
+      globalenv_file <- file.path(dir_session, "globalenv.json")
+      plot_file <- file.path(dir_session, "plot.png")
+      plot_updated <- FALSE
+
+      options(vscodeR = environment())
+      options(device = function(...) {
+        pdf(NULL, bg = "white")
+        dev.control(displaylist = "enable")
+      })
+      setHook("plot.new", function(...) {
+        plot_updated <<- TRUE
+      })
+      setHook("grid.newpage", function(...) {
+        plot_updated <<- TRUE
+      })
+
+      options(browser = function(url, ...) {
+        respond("browser", url = url)
+      })
+      options(viewer = function(url, ...) {
+        respond("webview", file = url)
+      })
+      options(page_viewer = function(url, ...) {
+        respond("webview", file = url)
+      })
+
+      respond <- function(command, ...) {
+        json <- jsonlite::toJSON(list(
+          time = Sys.time(),
+          pid = pid,
+          command = command,
+          ...
+        ), auto_unbox = TRUE)
+        cat(json, "\n", file = response_file, append = TRUE)
+      }
+
+      update <- function(...) {
+        objs <- eapply(.GlobalEnv, function(obj) {
+          list(
+            class = class(obj),
+            type = typeof(obj),
+            length = length(obj),
+            str = trimws(utils::capture.output(str(obj, max.level = 0, give.attr = FALSE)))
+          )
+        }, all.names = FALSE, USE.NAMES = TRUE)
+        jsonlite::write_json(objs, globalenv_file, auto_unbox = TRUE, pretty = TRUE)
+        if (plot_updated && dev.cur() == 2L) {
+          plot_updated <<- FALSE
+          record <- recordPlot()
+          if (length(record[[1]])) {
+            png(plot_file)
+            on.exit(dev.off())
+            replayPlot(record)
+          }
+        }
+        TRUE
+      }
+
+      attach <- function() {
+        respond("attach")
+      }
+
+      dataview_data_type <- function(x) {
+        if (is.numeric(x)) {
+          if (is.null(attr(x, "class"))) {
+            "num"
+          } else {
+            "num-fmt"
+          }
+        } else if (inherits(x, "Date")) {
+          "date"
+        } else {
+          "string"
+        }
+      }
+
+      dataview_table <- function(data) {
+        if (is.data.frame(data)) {
+          colnames <- colnames(data)
+          if (is.null(colnames)) {
+            colnames <- sprintf("(X%d)", seq_len(ncol(data)))
+          } else {
+            colnames <- trimws(colnames)
+          }
+          if (.row_names_info(data) > 0L) {
+            rownames <- rownames(data)
+            rownames(data) <- NULL
+            data <- cbind(rownames, data, stringsAsFactors = FALSE)
+            colnames <- c(" ", colnames)
+          }
+          types <- vapply(data, dataview_data_type,
+            character(1L), USE.NAMES = FALSE)
+          data <- vapply(data, function(x) {
+            trimws(format(x))
+          }, character(nrow(data)), USE.NAMES = FALSE)
+        } else if (is.matrix(data)) {
+          if (is.factor(data)) {
+            data <- format(data)
+          }
+          types <- rep(dataview_data_type(data), ncol(data))
+          colnames <- colnames(data)
+          colnames(data) <- NULL
+          if (is.null(colnames)) {
+            colnames <- sprintf("(X%d)", seq_len(ncol(data)))
+          } else {
+            colnames <- trimws(colnames)
+          }
+          rownames <- rownames(data)
+          rownames(data) <- NULL
+          data <- trimws(format(data))
+          if (!is.null(rownames)) {
+            types <- c("string", types)
+            colnames <- c(" ", colnames)
+            data <- cbind(` ` = trimws(rownames), data)
+          }
+        } else {
+          stop("data must be data.frame or matrix")
+        }
+        columns <- .mapply(function(title, type) {
+          class <- if (type == "string") "text-left" else "text-right"
+          list(title = jsonlite::unbox(title),
+            className = jsonlite::unbox(class),
+            type = jsonlite::unbox(type))
+        }, list(colnames, types), NULL)
+        list(columns = columns, data = data)
+      }
+
+      dataview <- function(x, title) {
+        if (missing(title)) {
+          title <- deparse(substitute(x))[[1]]
+        }
+        if (is.data.frame(x) || is.matrix(x)) {
+          data <- dataview_table(x)
+          file <- tempfile(tmpdir = tempdir, fileext = ".json")
+          jsonlite::write_json(data, file, matrix = "rowmajor")
+          respond("dataview", source = "table", type = "json",
+            title = title, file = file)
+        } else if (is.list(x)) {
+          file <- tempfile(tmpdir = tempdir, fileext = ".json")
+          jsonlite::write_json(x, file, auto_unbox = TRUE)
+          respond("dataview", source = "list", type = "json",
+            title = title, file = file)
+        } else {
+          stop("Unsupported object class")
+        }
+      }
+
+      rebind <- function(sym, value, ns) {
+        ns <- getNamespace(ns)
+        unlockBinding(sym, ns)
+        on.exit(lockBinding(sym, ns))
+        assign(sym, value, envir = ns)
+      }
+
+      rebind(".External.graphics", function(...) {
+        plot_updated <<- TRUE
+        .prim <- .Primitive(".External.graphics")
+        .prim(...)
+      }, "base")
+      rebind("View", dataview, "utils")
+
+      update()
+      addTaskCallback(update, name = "vscode-R")
+      lockEnvironment(environment(), bindings = TRUE)
+      unlockBinding("plot_updated", environment())
+      attach()
+    }
+    invisible()
+  })
+}

README.md

@@ -57,12 +57,50 @@ This extension contributes the following settings:
 * `r.source.focus`: Keeping focus when running (editor or terminal)
 * `r.alwaysUseActiveTerminal`: Use active terminal for all commands, rather than creating a new R terminal
 * `r.bracketedPaste`: For consoles supporting bracketed paste mode (such as Radian)
+* `r.sessionWatcher`: Enable R session watcher (experimental)
 
 * Language server(developing [here](https://github.com/REditorSupport/languageserver))
 
+## R Session Watcher (Experimental)
+
+*This experimental feature is still under development and the behavior
+**may change without notice**. Please file an issue [here](https://github.com/Ikuyadeu/vscode-R/issues) if you experience problems or have any suggestions.*
+
+An opt-in experimental R session watcher is implemented to support the following features:
+
+* Watch any R session
+* Show symbol value in hover
+* `View()` data frames and list objects
+* Show plot output on update
+* Show htmlwidgets and shiny apps
+
+To enable this feature, turn on `r.sessionWatcher` and append the following code to your `.Rprofile` (in your home directory):
+
+```r
+source(file.path(Sys.getenv(if (.Platform$OS.type == "windows") "HOMEPATH" else "HOME"), ".vscode-R", "init.R"))
+```
+
+This script writes the metadata of symbols in the global environment and plot file to `${workspaceFolder}/.vscode/vscode-R/PID` where `PID` is the R process ID. It also captures user input and append command lines to `${workspaceFolder}/.vscode/vscode-R/response.log`, which enables the communication between vscode-R and a live R sesson.
+
+Each time the extension is activated, the latest session watcher script (`init.R`) will be deployed to `~/.vscode-R/init.R`.
+
+R sessions started from the workspace root folder will be automatically attached. The session watcher is designed to work in a wide range of scenarios:
+
+* Official R terminal or `radian` console
+* R session started by vscode-R or user
+* R session in a `tmux` or `screen` window
+* Switch between multiple running R sessions
+* [Remote Development](https://code.visualstudio.com/docs/remote/remote-overview)
+
+The status bar item shows the process id of the attached R session. Click the status bar item and it will
+attach to currently active session.
+
+![Attached R process](./images/RStatusBarItem.png)
+
+![R session watcher](https://user-images.githubusercontent.com/4662568/70815935-65391480-1e09-11ea-9ad6-7ebbebf9a9c8.gif)
+
 ## TODO
 
-* Output Plot
 * Debug
 
 ## CONTRIBUTING