get browsing state in a function

Question

I have a function such as this one :

fun <- function() {
  browser()
  is_browsing()
} 

I would like to know what the code of is_browsin

Answer 1

This is not 100% what you are looking for, but perhaps you get an idea how to solve your problem? I am not familiar with C / C++ R-basics, but perhaps you can kind of overload base::browser()?

I hope this helps:

list.parent_env <- function() {
  ll <- list()
  n <- 1
  while (!environmentName(.GlobalEnv) %in% 
         environmentName(parent.frame(n))) {
    ll <- c(ll, parent.frame(n))
    n <- n + 1
  }
  return(ll)
}

listofenv2names <- function(env_list) {
  names <- unlist(lapply(c(1:length(env_list)), function(i) {
    attributes(env_list[[i]])$name
  }))
  return(names)
}

# https://stackoverflow.com/a/23891089/5784831
mybrowser <- function() {
  e <- parent.frame()
  attr(e, "name") <- "mybrowser_env"
  assign("mybrowser_env", 1,
         envir = parent.frame(),
         inherits = FALSE, immediate = TRUE)
  return(eval(quote(browser()), parent.frame()))
}

is_browsing <- function() {
  env_list <- list.parent_env()
  r <- "mybrowser_env" %in% listofenv2names(env_list)
  print(r)
  return(r)
}

subsubfun <- function() {
  print("subsubfun")
  b <- 2
  is_browsing()
  return(NULL)
}

subfun <- function() {
  print("subfun")
  a <- 1
  is_browsing()
  subsubfun()
  return(NULL)
}

fun1 <- function() {
  print("fun1")
  is_browsing()
  mybrowser()
  for (i in 1:10) {
    is_browsing()
  }
  is_browsing()
  subfun()
  
  return(NULL)
} 

fun2 <- function() {
  print("fun2")
  is_browsing()
  return(NULL)
}

fun1()
fun2()

Output looks good:

[1] "fun1"
[1] FALSE
Called from: eval(quote(browser()), parent.frame())
Browse[1]> c
[1] TRUE
[1] "subfun"
[1] TRUE
[1] "subsubfun"
[1] TRUE
[1] "fun2"
[1] FALSE

Answer 2

Starting with the ideas in Romain's code, then copying across the RCNTXT struct (plus a couple of other structs it uses internally), I managed to get the C++ code to return the contents of R_GlobalContext.

The C++ code looks like this:

#include <Rcpp.h>
#include <Rinternals.h>
#include <setjmp.h>

extern void* R_GlobalContext ;

typedef struct {int tag, flags; union {int ival; double dval; SEXP sxpval;} u;
} R_bcstack_t;

typedef struct{jmp_buf jmpbuf; int mask_was_saved, saved_mask;} sigjmp_buf[1];

typedef struct RCNTXT {
    struct RCNTXT *nextcontext;
    int callflag;
    sigjmp_buf cjmpbuf;
    int cstacktop, evaldepth;
    SEXP promargs, callfun, sysparent, call, cloenv, conexit;
    void (*cend)(void *);
    void *cenddata;
    void *vmax;
    int intsusp, gcenabled, bcintactive;
    SEXP bcbody;
    void* bcpc;
    SEXP handlerstack, restartstack;
    struct RPRSTACK *prstack;
    R_bcstack_t *nodestack;
    R_bcstack_t *bcprottop;
    SEXP srcref;
    int browserfinish;
    SEXP returnValue;
    struct RCNTXT *jumptarget;
    int jumpmask;
} RCNTXT, *context;

// [[Rcpp::export]]
Rcpp::List get_RCNTXT(int level){
  RCNTXT* res = (RCNTXT*)R_GlobalContext;
  if (level > 1) res = res->nextcontext;
  return Rcpp::List::create(Rcpp::Named("call_flag") = res->callflag,
                            Rcpp::Named("c_stack_top") = res->cstacktop,
                            Rcpp::Named("call_depth") = res->evaldepth,
                            Rcpp::Named("call_fun") = res->callfun,
                            Rcpp::Named("sys_parent") = res->sysparent,
                            Rcpp::Named("call") = res->call,
                            Rcpp::Named("cloenv") = res->cloenv,
                            Rcpp::Named("conexit") = res->conexit,
                            Rcpp::Named("promargs") = res->promargs,
                            Rcpp::Named("intsusp") = res->intsusp,
                            Rcpp::Named("gcenabled") = res->gcenabled,
                            Rcpp::Named("bcintactive") = res->bcintactive,
                            Rcpp::Named("handlerstack") = res->handlerstack,
                            Rcpp::Named("restartstack") = res->restartstack,
                            Rcpp::Named("srcref") = res->srcref,
                            Rcpp::Named("browserfinish") = res->browserfinish);
}

That allows us to review the contents of R_Globalcontext:

get_RCNTXT(1)
#> $call_flag
#> [1] 12
#> 
#> $c_stack_top
#> [1] 4
#> 
#> $call_depth
#> [1] 1
#> 
#> $call_fun
#> function (level) 
#> .Call(<pointer: 0x0000000071282ff0>, level)
#> <bytecode: 0x00000174169448d0>
#> 
#> $sys_parent
#> <environment: R_GlobalEnv>
#> 
#> $call
#> get_RCNTXT(1)
#> 
#> $cloenv
#> <environment: 0x0000017416c52a08>
#> 
#> $conexit
#> NULL
#> 
#> $promargs
#> $promargs[[1]]
#> NULL
#> 
#> 
#> $intsusp
#> [1] 0
#> 
#> $gcenabled
#> [1] 1
#> 
#> $bcintactive
#> [1] 0
#> 
#> $handlerstack
#> NULL
#> 
#> $restartstack
#> NULL
#> 
#> $srcref
#> NULL
#> 
#> $browserfinish
#> [1] 0

Unfortunately, the browserfinish field just returns a 0 whether called from browser or not. However, if the get_RCNTXT function is called from the browser prompt, the restartstack shows that it has been called from browser. This allows the following R function to be defined once the C++ code has been sourced:

is_browser <- function()
{
  R <- get_RCNTXT(1)$restartstack
  if(is.null(R)) return(FALSE)
  class(R[[1]]) == "restart"
}

This allows the browser state to be queried from the command prompt:

is_browser()
#> [1] FALSE

> browser()
#> Called from: top level 
Browse[1]> is_browser()
#> [1] TRUE

However, this is not as useful as it seems. Firstly, it has the same effect as the following code in base R:

is_browser <- function() {
  !is.null(findRestart("browser"))
}

Secondly, when browser is called from inside a function, the code it runs is evaluated in its own context rather than the browser context, meaning is_browser will return FALSE. The C code for browser, (the actual function is called do_browser in main.c) writes a new context which is removed after the function exits, and this context is apparently not pointed at by any other structure for the duration of the function, so it is difficult to see how is_browser could be written to allow access to this context.

It therefore seems you would need to write a new implementation of browser to allow the browsed context to know that it was being browsed, and we really don't want to go there.

On the other hand, the browser context has full access to the browsed context, and since your end goal is to allow conditional code like plots to run only when in browser mode, I think the best solution is to use the browser itself to tell the browsed context that it is being browsed.

So for example, if you do:

browser_on <- function() {
  options(I_am_browsing = TRUE)
}

browser_off <- function() {
  options(I_am_browsing = FALSE)
}

is_browser <- function() {
  b <- getOption("I_am_browsing")
  if(is.null(b)) FALSE else b
}

You now have the option while browsing to conditionally run code that is protected by if(is_browser()).

Then if you have fun like this (with browser() commented out):

fun <- function() {
  #browser()
  if(is_browser()) plot(1:10)
  if(!is_browser()) "I didn't plot anything"
}

You will get:

fun()
#> [1] "I didn't plot anything"

But, if you run fun() from inside a browser, you get:

browser()
Called from: top level 
Browse[1]> browser_on()
Browse[1]> fun()

And it still works if browser is called inside fun:

fun <- function() {
  browser()
  if(is_browser()) plot(1:10)
  if(!is_browser()) "I didn't plot anything"
}

fun()
#> Called from: fun()
Browse[1]> browser_on()
Browse[1]> 
#> debug at #3: if (is_browser()) plot(1:10)
Browse[2]> 
#> debug at #3: plot(1:10)
Browse[2]> 
#> debug at #4: if (!is_browser()) "I didn't plot anything"
Browse[2]>

It's not a perfect solution because it requires an extra command while running in the browser, and it saves state via options. You will need to keep track of this if you call browser multiple times from the same scope. In particular, you shoud be careful to call browser_off() before exiting the browser if you are calling browser from the global environment.

Answer 3

It is described in the documentation for browser, browseText and browseCondition:

Instead of just calling browser(), call it and set the argument for browseText or browseCondition.

browser(text="foo")

Then you can check for the condition to determine if browser is running:

is_browsing<-function(n)
{
    result = FALSE
 result = tryCatch({
    browserText(n=1)
     result = TRUE
}, warning = function(w) {
    #warning-handler-code
}, error = function(e) {
   # error-handler-code
}, finally = {

    #code you always want to execute
 })
   return (result)
}

The n=1 in browseText refers to which context to retrieve the value from.

If you are not browsing, then the call to browseText() throws an error - > This is why we wrapped it in a try catch. So if an error is thrown we know that browser is not running. If no error is thrown, result is set to true, and you can run your own custom logic.

To test, try:

browser(text="foo")
if(isTRUE(is_browsing())){
    print("is browsing!!!")
}else{
    print("is not browsing!!!");
}

Then comment out the call to browser(text="foo"), and see the difference.

EDIT: If you cannot pass an argument to browser() for any reason, you can use debug instead:

https://www.rdocumentation.org/packages/base/versions/3.6.2/topics/debug

Or you can set the value using some other external debugger.

Answer 4

When you use the browser, the prompt shows you the browse level :
Browse[1], Browse[2],...

> browser()
Called from: top level 
Browse[1]> browser()
Called from: top level 
Browse[2]> 

This browse level is calculated in main.C by :

browselevel = countContexts(CTXT_BROWSER, 1);

Where CTXT_BROWSER is a constant defined in defn.h:

CTXT_BROWSER  = 16

You could use this internal countContexts function to get the is_browsing information you're looking for :

is_browsing.cpp

#include <Rcpp.h>
#include <R.h>
#include <Rinternals.h>
using namespace Rcpp;


// [[Rcpp::export]]
int is_browsing() {
  return Rf_countContexts(16,1);
}

Test :

library(Rcpp)
sourceCpp('is_browsing.cpp')
test <- function() {
  is_browsing()
}

test()
#> [1] 0

browser()
#> Called from: eval(expr, envir, enclos)

test()
#> [1] 1

^{Created on 2020-08-29 by the reprex package (v0.3.0)}

Also working if browser is called within function :

test2 <- function() {
  browser()
   is_browsing()
 }
test2()
Called from: test2()
Browse[1]> n
debug à #3 :is_browsing()
Browse[2]> n
[1] 1

If you wanted a TRUE / FALSE return, the Rcpp code would be:

#include <Rcpp.h>
#include <R.h>
#include <Rinternals.h>

// [[Rcpp::export]]
Rcpp::LogicalVector is_browsing() { 
  return Rf_countContexts(16,1) > 0;
}