Add r.session.levelOfObjectDetail=Normal for max.level=1 (REditorSupport#815)

* Add r.session.levelOfObjectDetail=Normal for max.level=1

* Add object timeout

* Update capture_str

Author: renkun-ken

R/session/vsc.R

@@ -15,19 +15,24 @@ load_settings <- function() {
     return(FALSE)
   }
 
+  setting <- function(x, ...) {
+    switch(EXPR = x, ..., x)
+  }
+
   mapping <- quote(list(
     vsc.use_httpgd = plot$useHttpgd,
     vsc.show_object_size = workspaceViewer$showObjectSize,
     vsc.rstudioapi = session$emulateRStudioAPI,
-    vsc.str.max.level = session$levelOfObjectDetail,
+    vsc.str.max.level = setting(session$levelOfObjectDetail, Minimal = 0, Normal = 1, Detailed = 2),
     vsc.object_length_limit = session$objectLengthLimit,
+    vsc.object_timeout = session$objectTimeout,
     vsc.globalenv = session$watchGlobalEnvironment,
-    vsc.plot = session$viewers$viewColumn$plot,
-    vsc.browser = session$viewers$viewColumn$browser,
-    vsc.viewer = session$viewers$viewColumn$viewer,
-    vsc.page_viewer = session$viewers$viewColumn$pageViewer,
-    vsc.view = session$viewers$viewColumn$view,
-    vsc.helpPanel = session$viewers$viewColumn$helpPanel
+    vsc.plot = setting(session$viewers$viewColumn$plot, Disable = FALSE),
+    vsc.browser = setting(session$viewers$viewColumn$browser, Disable = FALSE),
+    vsc.viewer = setting(session$viewers$viewColumn$viewer, Disable = FALSE),
+    vsc.page_viewer = setting(session$viewers$viewColumn$pageViewer, Disable = FALSE),
+    vsc.view = setting(session$viewers$viewColumn$view, Disable = FALSE),
+    vsc.helpPanel = setting(session$viewers$viewColumn$helpPanel, Disable = FALSE)
   ))
 
   vsc_settings <- tryCatch(jsonlite::read_json(settings_file), error = function(e) {
@@ -41,21 +46,7 @@ load_settings <- function() {
   ops <- eval(mapping, vsc_settings)
 
   # exclude options set by user on startup
-  ops <- ops[!(names(ops) %in% user_options)]
-
-  # translate VS Code setting values to R option values
-  r_options <- lapply(ops, function(x) {
-    if (is.character(x) && length(x) == 1) {
-      switch(EXPR = x,
-        "Disable" = FALSE,
-        "Minimal" = 0,
-        "Detailed" = 2,
-        x
-      )
-    } else {
-      x
-    }
-  })
+  r_options <- ops[!(names(ops) %in% user_options)]
 
   options(r_options)
 }
@@ -88,15 +79,27 @@ request <- function(command, ...) {
   cat(get_timestamp(), file = request_lock_file)
 }
 
+try_catch_timeout <- function(expr, timeout = Inf, ...) {
+  expr <- substitute(expr)
+  envir <- parent.frame()
+  setTimeLimit(timeout, transient = TRUE)
+  on.exit(setTimeLimit())
+  tryCatch(eval(expr, envir), ...)
+}
+
 capture_str <- function(object, max.level = getOption("vsc.str.max.level", 0)) {
+  paste0(utils::capture.output(
+    utils::str(object,
+      max.level = max.level,
+      give.attr = FALSE,
+      vec.len = 1
+    )
+  ), collapse = "\n")
+}
+
+try_capture_str <- function(object, max.level = getOption("vsc.str.max.level", 0)) {
   tryCatch(
-    paste0(utils::capture.output(
-      utils::str(object,
-        max.level = max.level,
-        give.attr = FALSE,
-        vec.len = 1
-      )
-    ), collapse = "\n"),
+    capture_str(object, max.level = max.level),
     error = function(e) {
       paste0(class(object), collapse = ", ")
     }
@@ -135,6 +138,7 @@ inspect_env <- function(env, cache) {
   is_active <- rlang::env_binding_are_active(env, all_names)
   show_object_size <- getOption("vsc.show_object_size", FALSE)
   object_length_limit <- getOption("vsc.object_length_limit", 2000)
+  object_timeout <- getOption("vsc.object_timeout", 50) / 1000
   str_max_level <- getOption("vsc.str.max.level", 0)
   objs <- lapply(all_names, function(name) {
     if (is_promise[[name]]) {
@@ -174,9 +178,20 @@ inspect_env <- function(env, cache) {
       }
 
       if (length(obj) > object_length_limit) {
-        info$str <- scalar(trimws(capture_str(obj, 0)))
+        info$str <- scalar(trimws(try_capture_str(obj, 0)))
       } else {
-        info$str <- scalar(trimws(capture_str(obj, str_max_level)))
+        info_str <- NULL
+        if (str_max_level > 0) {
+          info_str <- try_catch_timeout(
+            capture_str(obj, str_max_level),
+            timeout = object_timeout,
+            error = function(e) NULL
+          )
+        }
+        if (is.null(info_str)) {
+          info_str <- try_capture_str(obj, 0)
+        }
+        info$str <- scalar(trimws(info_str))
         obj_names <- if (is.object(obj)) {
           .DollarNames(obj, pattern = "")
         } else if (is.recursive(obj)) {
@@ -401,7 +416,7 @@ if (show_view) {
             type = typeof(obj),
             length = length(obj),
             size = as.integer(object.size(obj)),
-            value = trimws(capture_str(obj, 0)),
+            value = trimws(try_capture_str(obj, 0)),
             stringsAsFactors = FALSE,
             check.names = FALSE
           )

package.json

@@ -1403,17 +1403,24 @@
           "default": 2000,
           "markdownDescription": "The upper limit of object length to show object details in workspace viewer and provide session symbol completion. Decrease this value if you experience significant delay after executing R commands caused by large global objects with many elements. Changes the option `vsc.object_length_limit` in R. Requires `#r.sessionWatcher#` to be set to `true`."
         },
+        "r.session.objectTimeout": {
+          "type": "integer",
+          "default": 50,
+          "markdownDescription": "The maximum number of milliseconds to get information of a single object in the global environment. Decrease this value if you experience significant delay after executing R commands caused by large global objects with many elements. Changes the option `vsc.object_timeout` in R. Requires `#r.sessionWatcher#` to be set to `true`."
+        },
         "r.session.levelOfObjectDetail": {
           "type": "string",
           "markdownDescription": "How much of the object to show on hover, autocompletion, and in the workspace viewer? Changes the option `vsc.str.max.level` in R. Requires `#r.sessionWatcher#` to be set to `true`.",
           "default": "Minimal",
           "enum": [
             "Minimal",
+            "Normal",
             "Detailed"
           ],
           "enumDescriptions": [
             "Display literal values and object types only.",
-            "Display list content, data frame column values, and example values."
+            "Display the top level of list content, data frame column values, and example values.",
+            "Display the top two levels of list content, data frame column values, and example values. This option may cause notable delay after each user input in the terminal."
           ]
         },
         "r.session.emulateRStudioAPI": {