@@ -98,6 +98,66 @@ local({
9898 unloadNamespace(" renv" )
9999
100100 # load bootstrap tools
101+ ansify <- function (text ) {
102+ if (renv_ansify_enabled())
103+ renv_ansify_enhanced(text )
104+ else
105+ renv_ansify_default(text )
106+ }
107+
108+ renv_ansify_enabled <- function () {
109+
110+ override <- Sys.getenv(" RENV_ANSIFY_ENABLED" , unset = NA )
111+ if (! is.na(override ))
112+ return (as.logical(override ))
113+
114+ pane <- Sys.getenv(" RSTUDIO_CHILD_PROCESS_PANE" , unset = NA )
115+ if (identical(pane , " build" ))
116+ return (FALSE )
117+
118+ testthat <- Sys.getenv(" TESTTHAT" , unset = " false" )
119+ if (tolower(testthat ) %in% " true" )
120+ return (FALSE )
121+
122+ iderun <- Sys.getenv(" R_CLI_HAS_HYPERLINK_IDE_RUN" , unset = " false" )
123+ if (tolower(iderun ) %in% " false" )
124+ return (FALSE )
125+
126+ TRUE
127+
128+ }
129+
130+ renv_ansify_default <- function (text ) {
131+ text
132+ }
133+
134+ renv_ansify_enhanced <- function (text ) {
135+
136+ # R help links
137+ pattern <- " `\\ ?(renv::(?:[^`])+)`"
138+ replacement <- " `\0 33]8;;ide:help:\\ 1\a ?\\ 1\0 33]8;;\a `"
139+ text <- gsub(pattern , replacement , text , perl = TRUE )
140+
141+ # runnable code
142+ pattern <- " `(renv::(?:[^`])+)`"
143+ replacement <- " `\0 33]8;;ide:run:\\ 1\a\\ 1\0 33]8;;\a `"
144+ text <- gsub(pattern , replacement , text , perl = TRUE )
145+
146+ # return ansified text
147+ text
148+
149+ }
150+
151+ renv_ansify_init <- function () {
152+
153+ envir <- renv_envir_self()
154+ if (renv_ansify_enabled())
155+ assign(" ansify" , renv_ansify_enhanced , envir = envir )
156+ else
157+ assign(" ansify" , renv_ansify_default , envir = envir )
158+
159+ }
160+
101161 `%||%` <- function (x , y ) {
102162 if (is.null(x )) y else x
103163 }
@@ -142,7 +202,10 @@ local({
142202 # compute common indent
143203 indent <- regexpr(" [^[:space:]]" , lines )
144204 common <- min(setdiff(indent , - 1L )) - leave
145- paste(substring(lines , common ), collapse = " \n " )
205+ text <- paste(substring(lines , common ), collapse = " \n " )
206+
207+ # substitute in ANSI links for executable renv code
208+ ansify(text )
146209
147210 }
148211
@@ -305,8 +368,11 @@ local({
305368 quiet = TRUE
306369 )
307370
308- if (" headers" %in% names(formals(utils :: download.file )))
309- args $ headers <- renv_bootstrap_download_custom_headers(url )
371+ if (" headers" %in% names(formals(utils :: download.file ))) {
372+ headers <- renv_bootstrap_download_custom_headers(url )
373+ if (length(headers ) && is.character(headers ))
374+ args $ headers <- headers
375+ }
310376
311377 do.call(utils :: download.file , args )
312378
@@ -385,10 +451,21 @@ local({
385451 for (type in types ) {
386452 for (repos in renv_bootstrap_repos()) {
387453
454+ # build arguments for utils::available.packages() call
455+ args <- list (type = type , repos = repos )
456+
457+ # add custom headers if available -- note that
458+ # utils::available.packages() will pass this to download.file()
459+ if (" headers" %in% names(formals(utils :: download.file ))) {
460+ headers <- renv_bootstrap_download_custom_headers(repos )
461+ if (length(headers ) && is.character(headers ))
462+ args $ headers <- headers
463+ }
464+
388465 # retrieve package database
389466 db <- tryCatch(
390467 as.data.frame(
391- utils :: available.packages( type = type , repos = repos ),
468+ do.call( utils :: available.packages , args ),
392469 stringsAsFactors = FALSE
393470 ),
394471 error = identity
@@ -470,23 +547,31 @@ local({
470547
471548 }
472549
550+ renv_bootstrap_github_token <- function () {
551+ for (envvar in c(" GITHUB_TOKEN" , " GITHUB_PAT" , " GH_TOKEN" )) {
552+ envval <- Sys.getenv(envvar , unset = NA )
553+ if (! is.na(envval ))
554+ return (envval )
555+ }
556+ }
557+
473558 renv_bootstrap_download_github <- function (version ) {
474559
475560 enabled <- Sys.getenv(" RENV_BOOTSTRAP_FROM_GITHUB" , unset = " TRUE" )
476561 if (! identical(enabled , " TRUE" ))
477562 return (FALSE )
478563
479564 # prepare download options
480- pat <- Sys.getenv( " GITHUB_PAT " )
481- if (nzchar(Sys.which(" curl" )) && nzchar(pat )) {
565+ token <- renv_bootstrap_github_token( )
566+ if (nzchar(Sys.which(" curl" )) && nzchar(token )) {
482567 fmt <- " --location --fail --header \" Authorization: token %s\" "
483- extra <- sprintf(fmt , pat )
568+ extra <- sprintf(fmt , token )
484569 saved <- options(" download.file.method" , " download.file.extra" )
485570 options(download.file.method = " curl" , download.file.extra = extra )
486571 on.exit(do.call(base :: options , saved ), add = TRUE )
487- } else if (nzchar(Sys.which(" wget" )) && nzchar(pat )) {
572+ } else if (nzchar(Sys.which(" wget" )) && nzchar(token )) {
488573 fmt <- " --header=\" Authorization: token %s\" "
489- extra <- sprintf(fmt , pat )
574+ extra <- sprintf(fmt , token )
490575 saved <- options(" download.file.method" , " download.file.extra" )
491576 options(download.file.method = " wget" , download.file.extra = extra )
492577 on.exit(do.call(base :: options , saved ), add = TRUE )
0 commit comments