Set options lazily and conditionally (#1123)

Author: lionel-

crates/ark/src/console/console_repl.rs

@@ -518,6 +518,12 @@ impl Console {
             startup::source_user_r_profile();
         }
 
+        // Apply Positron's default options after profiles so that user-defined
+        // options take precedence over our defaults
+        if let Some(ref ns) = console.positron_ns {
+            modules::initialize_options(ns.sexp).log_err();
+        }
+
         // Start the REPL. Does not return!
         crate::sys::console::run_r();
     }

crates/ark/src/fixtures/utils.rs

@@ -18,7 +18,8 @@ pub fn r_test_init() {
     harp::fixtures::r_test_init();
     INIT.call_once(|| {
         // Initialize the positron module so tests can use them.
-        modules::initialize().unwrap();
+        let ns = modules::initialize().unwrap();
+        modules::initialize_options(ns.sexp).unwrap();
     });
 }
 

crates/ark/src/modules.rs

@@ -162,6 +162,11 @@ pub fn initialize() -> anyhow::Result<RObject> {
     Ok(namespace)
 }
 
+pub fn initialize_options(ns: libr::SEXP) -> anyhow::Result<()> {
+    RFunction::from("initialize_options").call_in(ns)?;
+    Ok(())
+}
+
 #[cfg(debug_assertions)]
 mod debug {
     use std::collections::HashMap;

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

@@ -107,8 +107,6 @@ connection_focus <- function(id) {
     )
 }
 
-options("connectionObserver" = .ps.connection_observer())
-
 connection_flatten_object_types <- function(object_tree) {
     # RStudio actually flattens the objectTree to make it easier to find metadata for an object type.
     # See link below for the original implementation

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

@@ -8,11 +8,6 @@
 # The Ark graphics device name
 ARK_GRAPHICS_DEVICE_NAME <- ".ark.graphics.device"
 
-# Declare the function name that `dev.new()` and `GECurrentDevice()`
-# go looking for to create a new graphics device when the current one
-# is `"null device"` and a new plot is requested
-options(device = ARK_GRAPHICS_DEVICE_NAME)
-
 # Set up "before plot new" hooks. This is our cue for
 # saving up the state of a plot before it gets wiped out.
 setHook("before.plot.new", action = "replace", function(...) {

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

@@ -5,8 +5,6 @@
 #
 #
 
-options(help_type = "html")
-
 # A wrapper around `help()` that works for our specific use cases:
 # - Picks up devtools `help()` if the shim is on the search path.
 # - Expects that `topic` and `package` don't require NSE and are just strings or `NULL`.

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

@@ -5,47 +5,110 @@
 #
 #
 
-# Avoid overwhelming the console
-options(max.print = 1000)
-
-# Enable HTML help
-options(help_type = "html")
-
-# Use internal editor
-options(editor = function(file, title, ..., name = NULL) {
-    handler_editor(file = file, title = title, ..., name = name)
-})
-
-# Use custom browser implementation
-options(browser = function(url) {
-    .ps.Call("ps_browse_url", as.character(url))
-})
-
-# Register our password handler as the generic `askpass` option.
-# Same as RStudio, see `?rstudioapi::askForPassword` for rationale.
-options(askpass = function(prompt) {
-    .ps.ui.askForPassword(prompt)
-})
-
-# Show Plumber apps in the viewer
-options(plumber.docs.callback = function(url) {
-    .ps.ui.showUrl(url)
-})
-
-# Show Shiny applications in the viewer
-options(shiny.launch.browser = function(url) {
-    .ps.ui.showUrl(url)
-})
-
-# Show Profvis output in the viewer
-options(profvis.print = function(x) {
-    # Render the widget to a tag list to create standalone HTML output.
-    # (htmltools is a Profvis dependency so it's guaranteed to be available)
-    rendered <- htmltools::as.tags(x, standalone = TRUE)
-
-    # Render the HTML content to a temporary file
-    tmp_file <- htmltools::html_print(rendered, viewer = NULL)
-
-    # Pass the file to the viewer
-    .ps.Call("ps_html_viewer", tmp_file, "R Profile", -1L, "editor")
-})
+# Called from Rust after sourcing the user's Rprofile so that user-defined
+# options take precedence over our defaults.
+initialize_options <- function() {
+    # These options have non-NULL defaults in R, so we can't detect user
+    # overrides by checking for NULL. They are always set unless the user
+    # has listed the option name in `positron.protected_options`.
+
+    # Use Positron editor
+    set_override(
+        "editor",
+        function(file, title, ..., name = NULL) {
+            handler_editor(file = file, title = title, ..., name = name)
+        }
+    )
+
+    # Use Positron viewer to browse URLs
+    set_override(
+        "browser",
+        function(url) {
+            .ps.Call("ps_browse_url", as.character(url))
+        }
+    )
+
+    # Register our password handler as the generic `askpass` option.
+    # Same as RStudio, see `?rstudioapi::askForPassword` for rationale.
+    set_override(
+        "askpass",
+        function(prompt) {
+            .ps.ui.askForPassword(prompt)
+        }
+    )
+
+    set_override("connectionObserver", .ps.connection_observer())
+
+    # Declare the function name that `dev.new()` and `GECurrentDevice()`
+    # go looking for to create a new graphics device when the current one
+    # is `"null device"` and a new plot is requested
+    set_override("device", ARK_GRAPHICS_DEVICE_NAME)
+
+    # Avoid overwhelming the console
+    set_override("max.print", 1000)
+
+    # These options default to NULL in R, so a non-NULL value means the
+    # user has set them. They are only set when the current value is NULL,
+    # unless the user has also listed them in `positron.protected_options`,
+    # which allows the user to preserve the default `NULL` value.
+
+    # Enable HTML help
+    set_default("help_type", "html")
+
+    set_default("viewer", viewer_option_handler)
+
+    # Show Shiny applications in the viewer
+    set_default(
+        "shiny.launch.browser",
+        function(url) {
+            .ps.ui.showUrl(url)
+        }
+    )
+
+    # Show Plumber apps in the viewer
+    set_default(
+        "plumber.docs.callback",
+        function(url) {
+            .ps.ui.showUrl(url)
+        }
+    )
+
+    # Show Profvis output in the viewer
+    set_default(
+        "profvis.print",
+        function(x) {
+            # Render the widget to a tag list to create standalone HTML output.
+            # (htmltools is a Profvis dependency so it's guaranteed to be available)
+            rendered <- htmltools::as.tags(x, standalone = TRUE)
+
+            # Render the HTML content to a temporary file
+            tmp_file <- htmltools::html_print(rendered, viewer = NULL)
+
+            # Pass the file to the viewer
+            .ps.Call("ps_html_viewer", tmp_file, "R Profile", -1L, "editor")
+        }
+    )
+}
+
+is_protected <- function(name) {
+    name %in% getOption("positron.protected_options", default = character())
+}
+
+# Set an option unconditionally, unless listed in `positron.protected_options`
+set_override <- function(name, value) {
+    if (is_protected(name)) {
+        return(invisible())
+    }
+    do.call(options, set_names(list(value), name))
+}
+
+# Set an option only when currently `NULL`, unless listed in `positron.protected_options`
+set_default <- function(name, value) {
+    if (is_protected(name)) {
+        return(invisible())
+    }
+    if (!is.null(getOption(name))) {
+        return(invisible())
+    }
+    do.call(options, set_names(list(value), name))
+}

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

@@ -171,7 +171,7 @@ paste_line <- function(x) {
 }
 
 set_names <- function(x, names = x) {
-    names(x) <- x
+    names(x) <- names
     x
 }
 

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

@@ -5,7 +5,7 @@
 #
 #
 
-options("viewer" = function(url, height = NULL, ...) {
+viewer_option_handler <- function(url, height = NULL, ...) {
     # Validate the URL argument.
     if (!is_string(url)) {
         stop("`url` must be a string.")
@@ -37,4 +37,4 @@ options("viewer" = function(url, height = NULL, ...) {
         # If not, fall back to opening it in the system browser.
         utils::browseURL(normalizedPath, ...)
     }
-})
+}

crates/ark/tests/options.rs

@@ -0,0 +1,77 @@
+use std::io::Write;
+
+use ark_test::DummyArkFrontendRprofile;
+
+// These tests verify that options set in `.Rprofile` interact correctly with
+// `initialize_options()` during startup. Each test needs its own process
+// because `DummyArkFrontendRprofile` can only be locked once, which is
+// handled by nextest.
+
+#[test]
+fn test_override_option_replaces_user_value() {
+    let mut file = tempfile::NamedTempFile::new().unwrap();
+    writeln!(file, "options(max.print = 500)").unwrap();
+    unsafe { std::env::set_var("R_PROFILE_USER", file.path()) };
+
+    let frontend = DummyArkFrontendRprofile::lock();
+
+    frontend.execute_request("getOption('max.print')", |result| {
+        assert_eq!(result, "[1] 1000");
+    });
+}
+
+#[test]
+fn test_protected_override_option_keeps_user_value() {
+    let mut file = tempfile::NamedTempFile::new().unwrap();
+    writeln!(
+        file,
+        "options(max.print = 500, positron.protected_options = 'max.print')"
+    )
+    .unwrap();
+    unsafe { std::env::set_var("R_PROFILE_USER", file.path()) };
+
+    let frontend = DummyArkFrontendRprofile::lock();
+
+    frontend.execute_request("getOption('max.print')", |result| {
+        assert_eq!(result, "[1] 500");
+    });
+}
+
+#[test]
+fn test_default_option_keeps_user_value() {
+    let mut file = tempfile::NamedTempFile::new().unwrap();
+    writeln!(file, "options(help_type = 'text')").unwrap();
+    unsafe { std::env::set_var("R_PROFILE_USER", file.path()) };
+
+    let frontend = DummyArkFrontendRprofile::lock();
+
+    frontend.execute_request("getOption('help_type')", |result| {
+        assert_eq!(result, "[1] \"text\"");
+    });
+}
+
+#[test]
+fn test_default_option_sets_when_null() {
+    let mut file = tempfile::NamedTempFile::new().unwrap();
+    writeln!(file).unwrap();
+    unsafe { std::env::set_var("R_PROFILE_USER", file.path()) };
+
+    let frontend = DummyArkFrontendRprofile::lock();
+
+    frontend.execute_request("getOption('help_type')", |result| {
+        assert_eq!(result, "[1] \"html\"");
+    });
+}
+
+#[test]
+fn test_protected_default_option_stays_null() {
+    let mut file = tempfile::NamedTempFile::new().unwrap();
+    writeln!(file, "options(positron.protected_options = 'help_type')").unwrap();
+    unsafe { std::env::set_var("R_PROFILE_USER", file.path()) };
+
+    let frontend = DummyArkFrontendRprofile::lock();
+
+    frontend.execute_request("is.null(getOption('help_type'))", |result| {
+        assert_eq!(result, "[1] TRUE");
+    });
+}