Merge pull request #848 from posit-dev/feature/view-function

Support functions in `View()`

Author: lionel-

crates/amalthea/src/comm/variables_comm.rs

@@ -295,7 +295,7 @@ pub enum VariablesBackendReply {
 	ClipboardFormatReply(FormattedVariable),
 
 	/// The ID of the viewer that was opened.
-	ViewReply(String),
+	ViewReply(Option<String>),
 
 }
 

crates/ark/src/interface.rs

@@ -2004,7 +2004,12 @@ impl RMain {
         }
     }
 
-    pub fn did_open_virtual_document(&mut self, uri: String, contents: String) {
+    pub fn insert_virtual_document(&mut self, uri: String, contents: String) {
+        log::trace!("Inserting vdoc for `{uri}`");
+
+        // Strip scheme if any. We're only storing the path.
+        let uri = uri.strip_prefix("ark:").unwrap_or(&uri).to_string();
+
         // Save our own copy of the virtual document. If the LSP is currently closed
         // or restarts, we can notify it of all virtual documents it should know about
         // in the LSP channel setup step. It is common for the kernel to create the
@@ -2017,6 +2022,11 @@ impl RMain {
         ))
     }
 
+    pub fn has_virtual_document(&self, uri: &String) -> bool {
+        let uri = uri.strip_prefix("ark:").unwrap_or(&uri).to_string();
+        self.lsp_virtual_documents.contains_key(&uri)
+    }
+
     pub fn call_frontend_method(&self, request: UiFrontendRequest) -> anyhow::Result<RObject> {
         log::trace!("Calling frontend method {request:?}");
 
@@ -2310,3 +2320,17 @@ fn is_auto_printing() -> bool {
         car == show_fun.sexp
     }
 }
+
+#[harp::register]
+unsafe extern "C-unwind" fn ps_insert_virtual_document(
+    uri: SEXP,
+    contents: SEXP,
+) -> anyhow::Result<SEXP> {
+    let uri: String = RObject::view(uri).try_into()?;
+    let contents: String = RObject::view(contents).try_into()?;
+
+    let main = RMain::get_mut();
+    main.insert_virtual_document(uri, contents);
+
+    Ok(RObject::null().sexp)
+}

crates/ark/src/lib.rs

@@ -43,6 +43,7 @@ pub mod treesitter;
 pub mod ui;
 pub mod variables;
 pub mod version;
+pub mod view;
 pub mod viewer;
 
 pub(crate) use r_task::r_task;

crates/ark/src/modules/positron/debug.R

@@ -247,41 +247,21 @@ frame_info_from_srcref <- function(
     srcref,
     environment
 ) {
-    srcfile <- attr(srcref, "srcfile")
-    if (is.null(srcfile)) {
+    info <- srcref_info(srcref)
+    if (is.null(info)) {
         return(NULL)
     }
 
-    # If the file name is missing but there is a `srcref`, then we can try to use
-    # the `lines` to reconstruct a fake source file that `srcref` can point into.
-    # This is used when debugging user functions that are entered directly into the console,
-    # and for functions parsed with `parse(text = <text>, keep.source = TRUE)`.
-    file <- srcfile$filename
-    lines <- srcfile$lines
-
-    if (!identical(file, "") && !identical(file, "<text>")) {
-        # TODO: Handle absolute paths by using `wd`
-        file <- normalizePath(file, mustWork = FALSE)
-        content <- NULL
-    } else if (!is.null(lines)) {
-        file <- NULL
-        content <- paste0(lines, collapse = "\n")
-    } else {
-        return(NULL)
-    }
-
-    range <- srcref_to_range(srcref)
-
     new_frame_info(
         source_name = source_name,
         frame_name = frame_name,
-        file = file,
-        contents = content,
+        file = info$file,
+        contents = info$content,
         environment = environment,
-        start_line = range$start_line,
-        start_column = range$start_column,
-        end_line = range$end_line,
-        end_column = range$end_column
+        start_line = info$range$start_line,
+        start_column = info$range$start_column,
+        end_line = info$range$end_line,
+        end_column = info$range$end_column
     )
 }
 
@@ -364,35 +344,6 @@ frame_info_unknown_range <- function(
     )
 }
 
-srcref_to_range <- function(x) {
-    n <- length(x)
-
-    # The first and third fields are sensitive to #line directives if they exist,
-    # which we want to honour in order to jump to original files
-    # rather than generated files.
-    loc_start_line <- 1L
-    loc_end_line <- 3L
-
-    # We need the `column` value rather than the `byte` value, so we
-    # can index into a character. However the srcref documentation
-    # allows a 4 elements vector when the bytes and column values are
-    # the same. We account for this here.
-    if (n >= 6) {
-        loc_start_column <- 5L
-        loc_end_column <- 6L
-    } else {
-        loc_start_column <- 2L
-        loc_end_column <- 4L
-    }
-
-    list(
-        start_line = x[[loc_start_line]],
-        start_column = x[[loc_start_column]],
-        end_line = x[[loc_end_line]],
-        end_column = x[[loc_end_column]]
-    )
-}
-
 new_frame_info <- function(
     source_name,
     frame_name,

crates/ark/src/modules/positron/frontend-methods.R

@@ -35,10 +35,22 @@
 #' @export
 .ps.ui.navigateToFile <- function(
     file = character(0),
-    line = -1L,
-    column = -1L
+    line = 0L,
+    column = 0L
 ) {
-    file <- normalizePath(file)
+    # Don't normalize if there's a scheme, e.g. an `ark:` URI
+    if (!grepl("^[a-zA-Z][a-zA-Z0-9+.-]*:", file)) {
+        file <- normalizePath(file)
+    }
+
+    # Convert `-1L` for compatibility with RStudioAPI
+    if (line < 0L) {
+        line <- 0L
+    }
+    if (column < 0L) {
+        column <- 0L
+    }
+
     .ps.Call("ps_ui_navigate_to_file", file, line, column)
 }
 

crates/ark/src/modules/positron/hooks.R

@@ -6,7 +6,7 @@
 #
 
 register_hooks <- function() {
-    rebind("utils", "View", .ps.view_data_frame, namespace = TRUE)
+    rebind("utils", "View", view, namespace = TRUE)
     rebind("base", "debug", new_ark_debug(base::debug), namespace = TRUE)
     rebind(
         "base",

crates/ark/src/modules/positron/r_data_explorer.R

@@ -5,37 +5,15 @@
 #
 #
 
-#' @export
-.ps.view_data_frame <- function(x, title) {
-    # Derive the name of the object from the expression passed to View()
-    object_name <- .ps.as_label(substitute(x))
-
-    # Create a title from the name of the object if one is not provided
-    if (missing(title)) {
-        title <- object_name
-    }
-
-    stopifnot(
-        is.data.frame(x) || is.matrix(x),
-        is.character(title) && length(title) == 1L && !is.na(title)
-    )
-
-    # If the variable is defined in the parent frame using the same name as was
-    # passed to View(), we can watch it for updates.
-    #
-    # Note that this means that (for example) View(foo) will watch the variable
-    # foo in the parent frame, but Viewing temporary variables like
-    # View(cbind(foo, bar)) does not create something that can be watched.
-    var <- ""
-    env <- NULL
-    if (isTRUE(exists(object_name, envir = parent.frame(), inherits = FALSE))) {
-        var <- object_name
-        env <- parent.frame()
-    }
-
+view_data_frame <- function(x, title, var, env) {
+    stopifnot(is_viewable_data_frame(x))
     invisible(.ps.Call("ps_view_data_frame", x, title, var, env))
 }
 
+is_viewable_data_frame <- function(x) {
+    is.data.frame(x) || is.matrix(x)
+}
+
 .ps.null_count <- function(column) {
     sum(is.na(column))
 }

crates/ark/src/modules/positron/srcref.R

@@ -1,9 +1,29 @@
-# For debugging from R
+# Populate source references right there and then instead of at idle time. Used
+# for `View()` when called from top-level. Also useful for debugging from R. Be
+# careful with this one because it produces session-wide side effects that
+# mutate source references for all functions in the given namespace. This could
+# invalidate reasonable assumptions made by currently running code.
 ns_populate_srcref <- function(ns_name) {
     loadNamespace(ns_name)
     .ps.Call("ps_ns_populate_srcref", ns_name)
 }
 
+ns_populate_srcref_without_vdoc_insertion <- function(ns_name) {
+    loadNamespace(ns_name)
+    .ps.Call("ps_ns_populate_srcref_without_vdoc_insertion", ns_name)
+}
+
+fn_populate_srcref_without_vdoc_insertion <- function(fn) {
+    fn_env <- topenv(environment(fn))
+    if (!isNamespace(fn_env)) {
+        return(NULL)
+    }
+
+    pkg <- getNamespaceName(fn_env)
+    ns_populate_srcref_without_vdoc_insertion(pkg)
+}
+
+
 # Called from Rust
 reparse_with_srcref <- function(x, name, uri, line) {
     if (!is.function(x)) {
@@ -83,3 +103,65 @@ do_resource_namespaces <- function(default) {
 resource_namespaces <- function(pkgs) {
     .ps.Call("ps_resource_namespaces", pkgs)
 }
+
+srcref_info <- function(srcref) {
+    srcfile <- attr(srcref, "srcfile")
+    if (is.null(srcfile)) {
+        return(NULL)
+    }
+
+    # If the file name is missing but there is a `srcref`, then we can try to use
+    # the `lines` to reconstruct a fake source file that `srcref` can point into.
+    # This is used when debugging user functions that are entered directly into the console,
+    # and for functions parsed with `parse(text = <text>, keep.source = TRUE)`.
+    file <- srcfile$filename
+    lines <- srcfile$lines
+
+    if (!identical(file, "") && !identical(file, "<text>")) {
+        # TODO: Handle absolute paths by using `wd`
+        file <- normalizePath(file, mustWork = FALSE)
+        content <- NULL
+    } else if (!is.null(lines)) {
+        file <- NULL
+        content <- paste0(lines, collapse = "\n")
+    } else {
+        return(NULL)
+    }
+
+    range <- srcref_to_range(srcref)
+
+    list(
+        file = file,
+        content = content,
+        range = range
+    )
+}
+
+srcref_to_range <- function(x) {
+    n <- length(x)
+
+    # The first and third fields are sensitive to #line directives if they exist,
+    # which we want to honour in order to jump to original files
+    # rather than generated files.
+    loc_start_line <- 1L
+    loc_end_line <- 3L
+
+    # We need the `column` value rather than the `byte` value, so we
+    # can index into a character. However the srcref documentation
+    # allows a 4 elements vector when the bytes and column values are
+    # the same. We account for this here.
+    if (n >= 6) {
+        loc_start_column <- 5L
+        loc_end_column <- 6L
+    } else {
+        loc_start_column <- 2L
+        loc_end_column <- 4L
+    }
+
+    list(
+        start_line = x[[loc_start_line]],
+        start_column = x[[loc_start_column]],
+        end_line = x[[loc_end_line]],
+        end_column = x[[loc_end_column]]
+    )
+}

crates/ark/src/modules/positron/tools.R

@@ -127,10 +127,6 @@ push_rds <- function(x, path = NULL, context = "") {
     xs
 }
 
-is_string <- function(x) {
-    is.character(x) && length(x) == 1 && !is.na(x)
-}
-
 local_options <- function(..., .frame = parent.frame()) {
     options <- list(...)
     old <- options(options)

crates/ark/src/modules/positron/utils.R

@@ -63,8 +63,7 @@
 }
 
 # Extracts a character label from a syntactically valid quoted R expression
-#' @export
-.ps.as_label <- function(expr) {
+as_label <- function(expr) {
     paste(deparse(expr, backtick = TRUE), collapse = "")
 }
 
@@ -145,3 +144,11 @@ is_string <- function(x) {
 is_http_url <- function(x) {
     is_string(x) && grepl("^https?://", x)
 }
+
+obj_address <- function(x) {
+    .ps.Call("ps_obj_address", x)
+}
+
+paste_line <- function(x) {
+    paste(x, collapse = "\n")
+}