Skip to content

Commit

Permalink
Add r.session.levelOfObjectDetail=Normal for max.level=1 (#815)
Browse files Browse the repository at this point in the history
* Add r.session.levelOfObjectDetail=Normal for max.level=1

* Add object timeout

* Update capture_str
  • Loading branch information
renkun-ken committed Oct 12, 2021
1 parent a1f155f commit 0e01652
Show file tree
Hide file tree
Showing 2 changed files with 55 additions and 33 deletions.
79 changes: 47 additions & 32 deletions R/session/vsc.R
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand All @@ -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)
}
Expand Down Expand Up @@ -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 = ", ")
}
Expand Down Expand Up @@ -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]]) {
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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
)
Expand Down
9 changes: 8 additions & 1 deletion package.json
Original file line number Diff line number Diff line change
Expand Up @@ -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": {
Expand Down

0 comments on commit 0e01652

Please sign in to comment.