Showing preview only (366K chars total). Download the full file or copy to clipboard to get everything.
Repository: rstudio/chromote
Branch: main
Commit: 13a789a2c2f9
Files: 84
Total size: 343.9 KB
Directory structure:
gitextract_bqyizoye/
├── .Rbuildignore
├── .github/
│ ├── .gitignore
│ └── workflows/
│ └── R-CMD-check.yaml
├── .gitignore
├── .vscode/
│ ├── extensions.json
│ └── settings.json
├── DESCRIPTION
├── LICENSE
├── LICENSE.md
├── NAMESPACE
├── NEWS.md
├── R/
│ ├── browser.R
│ ├── callbacks.R
│ ├── chrome.R
│ ├── chromote-package.R
│ ├── chromote.R
│ ├── chromote_session.R
│ ├── event_manager.R
│ ├── import-standalone-obj-type.R
│ ├── import-standalone-types-check.R
│ ├── manage.R
│ ├── promises.R
│ ├── protocol.R
│ ├── screenshot.R
│ ├── synchronize.R
│ ├── utils.R
│ └── zzz.R
├── README.Rmd
├── README.md
├── chromote.Rproj
├── cran-comments.md
├── man/
│ ├── Browser.Rd
│ ├── Chrome.Rd
│ ├── ChromeRemote.Rd
│ ├── Chromote.Rd
│ ├── ChromoteSession.Rd
│ ├── chrome_versions.Rd
│ ├── chrome_versions_list.Rd
│ ├── chromote-options.Rd
│ ├── chromote-package.Rd
│ ├── chromote_info.Rd
│ ├── default_chrome_args.Rd
│ ├── default_chromote_object.Rd
│ ├── find_chrome.Rd
│ ├── fragments/
│ │ ├── basic-usage.Rmd
│ │ ├── features.Rmd
│ │ └── install.Rmd
│ ├── reexports.Rd
│ └── with_chrome_version.Rd
├── pkgdown/
│ ├── _brand.yml
│ ├── _pkgdown.yml
│ ├── extra.scss
│ └── favicon/
│ └── site.webmanifest
├── revdep/
│ ├── .gitignore
│ ├── README.md
│ ├── cran.md
│ ├── failures.md
│ └── problems.md
├── tests/
│ ├── testthat/
│ │ ├── _snaps/
│ │ │ ├── chromote_session.md
│ │ │ ├── linux64/
│ │ │ │ └── manage.md
│ │ │ ├── mac-arm64/
│ │ │ │ └── manage.md
│ │ │ └── win64/
│ │ │ └── manage.md
│ │ ├── helper.R
│ │ ├── setup.R
│ │ ├── test-chrome.R
│ │ ├── test-chromote_session.R
│ │ ├── test-default_chromote_args.R
│ │ ├── test-manage.R
│ │ └── test-utils.R
│ └── testthat.R
└── vignettes/
├── .gitignore
├── chromote.Rmd
├── commands-and-events.Rmd
├── example-attach-existing.Rmd
├── example-authentication.Rmd
├── example-cran-tests.Rmd
├── example-custom-headers.Rmd
├── example-custom-user-agent.Rmd
├── example-extract-text.Rmd
├── example-loading-page.Rmd
├── example-remote-hosts.Rmd
├── example-screenshot.Rmd
├── sync-async.Rmd
└── which-chrome.Rmd
================================================
FILE CONTENTS
================================================
================================================
FILE: .Rbuildignore
================================================
^chromote\.Rproj$
^\.Rproj\.user$
^temp$
^chromote\.sublime-project$
^\.github$
^_pkgdown\.yml$
^docs$
^pkgdown$
^README\.Rmd$
^sidebar.png$
^revdep$
^cran-comments\.md$
^CRAN-SUBMISSION$
^_dev$
^\.vscode$
^[\.]?air\.toml$
^LICENSE\.md$
================================================
FILE: .github/.gitignore
================================================
*.html
================================================
FILE: .github/workflows/R-CMD-check.yaml
================================================
# Workflow derived from https://github.com/rstudio/shiny-workflows
#
# NOTE: This Shiny team GHA workflow is overkill for most R packages.
# For most R packages it is better to use https://github.com/r-lib/actions
on:
push:
branches: [main, rc-**]
pull_request:
branches: [main]
schedule:
- cron: '0 8 * * 1' # every monday
name: Package checks
jobs:
website:
uses: rstudio/shiny-workflows/.github/workflows/website.yaml@v1
routine:
uses: rstudio/shiny-workflows/.github/workflows/routine.yaml@v1
with:
format-r-code: true
R-CMD-check:
uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1
================================================
FILE: .gitignore
================================================
.Rhistory
.RData
.Rproj.user
temp
docs
CRAN-SUBMISSION
inst/doc
================================================
FILE: .vscode/extensions.json
================================================
{
"recommendations": [
"Posit.air-vscode"
]
}
================================================
FILE: .vscode/settings.json
================================================
{
"[r]": {
"editor.formatOnSave": true,
"editor.defaultFormatter": "Posit.air-vscode"
}
}
================================================
FILE: DESCRIPTION
================================================
Package: chromote
Title: Headless Chrome Web Browser Interface
Version: 0.5.1.9000
Authors@R: c(
person("Garrick", "Aden-Buie", , "garrick@posit.co", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7111-0077")),
person("Winston", "Chang", , "winston@posit.co", role = "aut"),
person("Barret", "Schloerke", , "barret@posit.co", role = "aut",
comment = c(ORCID = "0000-0001-9986-114X")),
person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49"))
)
Description: An implementation of the 'Chrome DevTools Protocol', for
controlling a headless Chrome web browser.
License: MIT + file LICENSE
URL: https://rstudio.github.io/chromote/,
https://github.com/rstudio/chromote
BugReports: https://github.com/rstudio/chromote/issues
Imports:
cli,
curl,
fastmap,
jsonlite,
later (>= 1.1.0),
magrittr,
processx,
promises (>= 1.1.1),
R6,
rlang (>= 1.1.0),
utils,
websocket (>= 1.2.0),
withr,
zip
Suggests:
knitr,
rmarkdown,
showimage,
testthat (>= 3.0.0)
VignetteBuilder:
knitr
Config/Needs/website: r-lib/pkgdown, rstudio/bslib
Config/testthat/edition: 3
Config/testthat/parallel: FALSE
Config/testthat/start-first: chromote_session
Encoding: UTF-8
Language: en-US
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.2
SystemRequirements: Google Chrome or other Chromium-based browser.
chromium: chromium (rpm) or chromium-browser (deb)
================================================
FILE: LICENSE
================================================
YEAR: 2025
COPYRIGHT HOLDER: chromote authors
================================================
FILE: LICENSE.md
================================================
# MIT License
Copyright (c) 2025 chromote authors
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
================================================
FILE: NAMESPACE
================================================
# Generated by roxygen2: do not edit by hand
S3method(print,chromote_info)
export("%...!%")
export("%...>%")
export("%...T!%")
export("%...T>%")
export("%>%")
export("%T>%")
export(Browser)
export(Chrome)
export(ChromeRemote)
export(Chromote)
export(ChromoteSession)
export(catch)
export(chrome_versions_add)
export(chrome_versions_list)
export(chrome_versions_path)
export(chrome_versions_path_cache)
export(chrome_versions_remove)
export(chromote_info)
export(default_chrome_args)
export(default_chromote_object)
export(finally)
export(find_chrome)
export(get_chrome_args)
export(has_default_chromote_object)
export(local_chrome_version)
export(local_chromote_chrome)
export(promise)
export(set_chrome_args)
export(set_default_chromote_object)
export(then)
export(with_chrome_version)
export(with_chromote_chrome)
import(later)
import(promises)
import(rlang)
importFrom(R6,R6Class)
importFrom(fastmap,fastmap)
importFrom(jsonlite,fromJSON)
importFrom(jsonlite,toJSON)
importFrom(magrittr,"%>%")
importFrom(magrittr,"%T>%")
importFrom(processx,process)
importFrom(promises,"%...!%")
importFrom(promises,"%...>%")
importFrom(promises,"%...T!%")
importFrom(promises,"%...T>%")
importFrom(promises,catch)
importFrom(promises,finally)
importFrom(promises,promise)
importFrom(promises,then)
importFrom(websocket,WebSocket)
================================================
FILE: NEWS.md
================================================
# chromote (development version)
# chromote 0.5.1
## New features
* `ChromoteSession` gets a new helper method, `$go_to()`. This is an easier way of reliably waiting for a page load, instead of using `Page$loadEventFired()` and `Page$navigate()` together. (#221)
* `ChromoteSession$view()` now accommodates the new DevTools Frontend URL used by Chrome v135 and later (#225, #226).
# chromote 0.5.0
## New features
* chromote now includes experimental features to download versioned binaries of Chrome and `chrome-headless-shell` for Mac (x64 or arm64), Windows (32- or 64-bit) or Linux (x86-64) from the [Chrome for Testing](https://googlechromelabs.github.io/chrome-for-testing/) service. (#198)
* Use `with_chrome_version()` or `local_chrome_version()` to temporarily switch to a specific version of Chrome. The appropriate binary will be downloaded automatically if not yet available locally.
* Use `chrome_versions_list()` to list installed or available versions of Chrome.
* Or use `chrome_versions_add()` and `chrome_versions_remove()` to manually add or remove a specific version of Chrome from chromote's cache.
* `ChromoteSession` gains two new helper methods: `$set_viewport_size()` and `$get_viewport_size()`. These methods allow you to change the viewport size – effectively the virtual window size for a page – or to get the current viewport size. If you previously relied on `$Emulation$setVisibleSize()` (now a deprecated method in the Chrome DevTools Protocol), `$set_viewport_size()` is a good replacement as it uses [Emulation.setDeviceMetricsOverride](https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setDeviceMetricsOverride) instead. (#206)
## Improvements
* `ChromoteSession$new()` gains a `mobile` argument that can be used to set the device emulation in that session to emulate a mobile browser. The default is `mobile = FALSE`, which matches previous behavior. (#205)
* `Chromote` and `ChromoteSesssion` gain an `$auto_events_enable_args()` method that sets that arguments used by chromote's auto-events feature when calling the `enable` command for a domain, e.g. `Fetch.enable`. (#208)
* The `$view()` method of a `ChromoteSession` will now detect when `chrome-headless-shell` is being used and will use the system browser (via `utils::browseURL()`) rather than the Chrome instance attached to chromote. (#214)
* chromote now has a hex sticker! Thank you to @davidrsch for the inspiration. (#216)
## Bug fixes
* `ChromoteSession$new()` now sets `width` and `height` using [Emulation.setDeviceMetricsOverride](https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setDeviceMetricsOverride), which works for all Chrome binaries and versions. This fixes an issue with `width` and `height` being ignored for Chrome versions 128-133. (#205)
* Fixed a bug in `chromote_info()` on Windows with Powershell when no version info is returned. (#207)
* `Chromote` and `ChromoteSession` once again correctly handles connections to remote Chrome browsers via `ChromeRemote`. Calling `$close()` on a `Chromote` object connected to a remote browser no longer attempts to close the browser, and will now simply close the websocket connection to the browser. For local process, the `Chromote$close()` gains a `wait` argument that sets the number of seconds to wait for Chrome to gracefully shut down before chromote closes the process. (#212)
# chromote 0.4.0
* Chrome v132 and later no longer support [old headless mode](https://developer.chrome.com/blog/removing-headless-old-from-chrome). As such, `chromote` no longer defaults to using `--headless=old` and now uses `--headless` when running Chrome. You can still use the `chromote.headless` option or `CHROMOTE_HEADLESS` environment variable to configure the `--headless` flag if you're using an older version of Chrome. (#187)
* Added `chromote_info()`, a new utility function to print out key information about chromote and Chrome. Useful when debugging chromote or reporting an issue. (#190)
* chromote now uses a consistent prefix for logs, e.g `{tempdir}/chrome-{id}-stdout.log` and `{tempdir}/chrome-{id}-stderr.log`. chromote also now uses `--crash-dumps-dir` to set a session-specific temp directory. (#194)
# chromote 0.3.1
* Fixed a typo that caused `launch_chrome()` to throw an error. (#175)
# chromote 0.3.0
* The headless mode used by Chrome can now be selected with the `chromote.headless` option or `CHROMOTE_HEADLESS` environment variable.
In Chrome v128, a [new headless mode](https://developer.chrome.com/docs/chromium/new-headless) became the default. The new mode uses the same browser engine as the regular Chrome browser, whereas the old headless mode is built on a separate architecture. The old headless mode may be faster to launch and is still well-suited to many of the tasks for which chromote is used.
For now, to avoid disruption, chromote defaults to using the old headless mode. In the future, chromote will follow Chrome and default to `"new"` headless mode. (And at some point, Chrome intends to remove the old headless mode which is now offered as [a separate binary](https://developer.chrome.com/blog/chrome-headless-shell).) To test the new headless mode, use `options(chromote.headless = "new")` or `CHROMOTE_HEADLESS="new"` (in `.Renviron` or via `Sys.setenv()`). (#172)
# chromote 0.2.0
## Breaking changes
* Breaking change: `Chromote$is_active()` method now reports if there is an active connection to the underlying chrome instance, rather than whether or not that instance is alive (#94).
## Improvements and bug fixes
* `Chromote` and `ChromoteSession` gain print methods to give you a snapshot of the most important values (#140).
* `Chromote` gains a new `is_alive()` method equivalent to the old `is_active()` method; i.e. it reports on if there is an active chrome process running in the background (#136).
* `ChromoteSession` now records the `targetId`. This eliminates one round-trip to the browser when viewing or closing a session. You can now call the `$respawn()` method if a session terminates and you want to reconnect to the same target (#94).
* `ChromoteSession$screenshot()` gains an `options` argument that accepts a list of additional options to be passed to the Chrome Devtools Protocol's [`Page.captureScreenshot` method](https://chromedevtools.github.io/devtools-protocol/tot/Page/#method-captureScreenshot) (#129).
* `ChromoteSession$screenshot()` will now infer the image format from the `filename` extension. Alternatively, you can specify the `format` in the list passed to `options` (#130).
* `--disable-gpu` is no longer included in the default Chrome arguments, except on windows where empirically it appears to be necessary (otherwise GHA check runs never terminate) (#142).
# chromote 0.1.2
* Fixed #109: An error would occur when a `Chromote` object's `$close()` method was called. (#110)
* Fixed #99: When the `$view()` method was called, recent versions of Chrome would display `"Debugging connection was closed. Reason: WebSocket disconnected"`. (#101)
* Fixed #89, #91: `find_chrome()` now checks more possible binary names for Chrome or Chromium on Linux and Mac. (thanks @brianmsm and @rossellhayes, #117)
* Fixed #22: Added a new `chromote.timeout` global option that can be used to set the timeout (in seconds) for establishing connections with the Chrome session. (#120)
# chromote 0.1.1
* Update docs for CRAN (#93)
# chromote 0.1.0
* Initial package release
================================================
FILE: R/browser.R
================================================
globals <- new.env()
#' Browser base class
#'
#' @description
#' Base class for browsers like Chrome, Chromium, etc. Defines the interface
#' used by various browser implementations. It can represent a local browser
#' process or one running remotely.
#'
#' @details
#' The `initialize()` method of an implementation should set `private$host`
#' and `private$port`. If the process is local, the `initialize()` method
#' should also set `private$process`.
#'
#' @export
Browser <- R6Class(
"Browser",
public = list(
# Returns TRUE if the browser is running locally, FALSE if it's remote.
#' @description Is local browser?
#' Returns TRUE if the browser is running locally, FALSE if it's remote.
is_local = function() !is.null(private$process),
#' @description Browser process
get_process = function() private$process,
#' @description Is the process alive?
is_alive = function() private$process$is_alive(),
#' @description Browser Host
get_host = function() private$host,
#' @description Browser port
get_port = function() private$port,
#' @description Close the browser
#' @param wait If an integer, waits a number of seconds for the process to
#' exit, killing the process if it takes longer than `wait` seconds to
#' close. Use `wait = TRUE` to wait for 10 seconds.
close = function(wait = FALSE) {
if (!self$is_local()) return(invisible())
if (!private$process$is_alive()) return(invisible())
if (!isFALSE(wait)) {
if (isTRUE(wait)) wait <- 10
check_number_whole(wait, min = 0)
}
private$process$signal(tools::SIGTERM)
if (!isFALSE(wait)) {
tryCatch(
{
private$process$wait(timeout = wait * 1000)
if (private$process$is_alive()) {
stop("shut it down") # ignored, used to escalate
}
},
error = function(err) {
# Still alive after wait...
try(private$process$kill(), silent = TRUE)
}
)
}
}
),
private = list(
process = NULL,
host = NULL,
port = NULL,
finalize = function(e) {
if (self$is_local()) {
self$close()
}
}
)
)
================================================
FILE: R/callbacks.R
================================================
# The data structure for storing callbacks is essentially a queue: items are
# added to the end, and removed from the front. Occasionally a callback will
# be manually removed from the middle of the queue. For each callback that's
# registered, we provide a function that can remove that callback from the
# queue.
Callbacks <- R6Class(
"Callbacks",
public = list(
initialize = function() {
# Use floating point because it has greater range than int while
# maintaining precision of 1.0.
private$nextId <- 1.0
private$callbacks <- fastmap()
},
add = function(callback) {
if (!is.function(callback)) {
stop("callback must be a function.")
}
# Keys are formatted like "0000000000001", "0000000000002", etc., so
# that they can be easily sorted by numerical value.
id <- sprintf("%013.f", private$nextId)
private$nextId <- private$nextId + 1.0
private$callbacks$set(id, callback)
# Return function for unregistering the callback.
invisible(function() {
if (private$callbacks$has(id)) {
private$callbacks$remove(id)
}
})
},
invoke = function(..., on_error = NULL) {
# Ensure that calls are invoked in the order that they were registered
keys <- private$callbacks$keys(sort = TRUE)
errors <- character()
if (is.null(on_error)) {
on_error <- function(e) {
errors[length(errors) + 1] <<- e$message
}
}
for (key in keys) {
callback <- private$callbacks$get(key)
tryCatch(callback(...), error = on_error)
}
if (length(errors) != 0) {
warning(
paste0(
length(errors),
" errors occurred while executing callbacks:\n ",
paste(errors, collapse = "\n ")
)
)
}
},
clear = function() {
private$callbacks <- fastmap()
},
size = function() {
private$callbacks$size()
}
),
private = list(
nextId = NULL,
callbacks = NULL
)
)
================================================
FILE: R/chrome.R
================================================
#' Local Chrome process
#'
#' @description
#' This is a subclass of [`Browser`] that represents a local browser. It extends
#' the [`Browser`] class with a [`processx::process`] object, which represents
#' the browser's system process.
#' @export
Chrome <- R6Class(
"Chrome",
inherit = Browser,
public = list(
#' @description Create a new Chrome object.
#' @param path Location of chrome installation
#' @param args A character vector of command-line arguments passed when
#' initializing Chrome. Single on-off arguments are passed as single
#' values (e.g.`"--disable-gpu"`), arguments with a value are given with a
#' nested character vector (e.g. `c("--force-color-profile", "srgb")`).
#' See
#' [here](https://peter.sh/experiments/chromium-command-line-switches/)
#' for a list of possible arguments. Defaults to [`get_chrome_args()`].
#' @return A new `Chrome` object.
#' @seealso [`get_chrome_args()`]
initialize = function(path = find_chrome(), args = get_chrome_args()) {
if (is.null(path)) {
stop("Invalid path to Chrome")
}
res <- launch_chrome(path, args)
private$host <- "127.0.0.1"
private$process <- res$process
private$port <- res$port
private$path <- path
},
#' @description Browser application path
get_path = function() private$path
),
private = list(
path = NULL
)
)
#' Remote Chrome process
#'
#' @description
#' Remote Chrome process
#'
#' @export
ChromeRemote <- R6Class(
"ChromeRemote",
inherit = Browser,
public = list(
#' @description Create a new ChromeRemote object.
#' @param host A string that is a valid IPv4 or IPv6 address. `"0.0.0.0"`
#' represents all IPv4 addresses and `"::/0"` represents all IPv6 addresses.
#' @param port A number or integer that indicates the server port.
initialize = function(host, port) {
private$host <- host
private$port <- port
},
#' @description Is the remote service alive?
is_alive = function() {
url <- sprintf("http://%s:%s/json/version", private$host, private$port)
tryCatch(
{
# If we can read info from the remote host, then it's alive
suppressWarnings(fromJSON(url))
TRUE
},
error = function(err) FALSE
)
},
#' @description chromote does not manage remote processes, so closing a
#' remote Chrome browser does nothing. You can send a `Browser$close()`
#' command if this is really something you want to do.
close = function() {
# chromote didn't start this process, so we won't kill it or close it.
invisible(TRUE)
}
)
)
#' Find path to Chrome or Chromium browser
#'
#' @description
#' \pkg{chromote} requires a Chrome- or Chromium-based browser with support for
#' the Chrome DevTools Protocol. There are many such browser variants,
#' including [Google Chrome](https://www.google.com/chrome/),
#' [Chromium](https://www.chromium.org/chromium-projects/),
#' [Microsoft Edge](https://www.microsoft.com/en-us/edge) and others.
#'
#' If you want \pkg{chromote} to use a specific browser, set the
#' `CHROMOTE_CHROME` environment variable to the full path to the browser's
#' executable. Note that when `CHROMOTE_CHROME` is set, \pkg{chromote} will use
#' the value without any additional checks. On Mac, for example, one could use
#' Microsoft Edge by setting `CHROMOTE_CHROME` with the following:
#'
#' ```r
#' Sys.setenv(
#' CHROMOTE_CHROME = "/Applications/Microsoft Edge.app/Contents/MacOS/Microsoft Edge"
#' )
#' ```
#'
#' When `CHROMOTE_CHROME` is not set, `find_chrome()` will perform a limited
#' search to find a reasonable executable. On Windows, `find_chrome()` consults
#' the registry to find `chrome.exe`. On Mac, it looks for `Google Chrome` in
#' the `/Applications` folder (or tries the same checks as on Linux). On Linux,
#' it searches for several common executable names.
#'
#' @examples
#' find_chrome()
#'
#' @returns A character vector with the value of `CHROMOTE_CHROME`, or a path to
#' the discovered Chrome executable. If no path to is found, `find_chrome()`
#' returns `NULL`.
#'
#' @export
find_chrome <- function() {
if (Sys.getenv("CHROMOTE_CHROME") != "") {
return(Sys.getenv("CHROMOTE_CHROME"))
}
path <-
if (is_mac()) {
inform_if_chrome_not_found(find_chrome_mac())
} else if (is_windows()) {
inform_if_chrome_not_found(find_chrome_windows())
} else if (is_linux() || is_openbsd()) {
inform_if_chrome_not_found(
find_chrome_linux(),
searched_for = "`google-chrome`, `chromium-browser` and `chrome` were",
extra_advice = "or adding one of these executables to your PATH"
)
} else {
message("Platform currently not supported")
NULL
}
path
}
chrome_verify <- function(path = find_chrome()) {
if (is_windows() && basename(path) != "chrome-headless-shell.exe") {
return(chrome_verify_windows())
}
processx::run(
command = path,
args = c("--headless", "--version"),
timeout = 2,
error_on_status = FALSE
)
}
chrome_verify_windows <- function(path = find_chrome()) {
# Returns something similar to chrome_verify() for Windows, without actually
# launching chrome, since `--version` doesn't work there.
status <- function(code = 0, stdout = "", stderr = "") {
list(status = code, stdout = stdout, stderr = stderr, timeout = FALSE)
}
path <- normalizePath(path)
if (!file.exists(path)) {
return(status(-1, stderr = sprintf("%s does not exist", path)))
}
has_powershell <- nzchar(Sys.which("powershell"))
has_wmic <- nzchar(Sys.which("wmic"))
status_unknown_version <- status(
stdout = "Unknown (please manually verify the Chrome version)"
)
if (!has_powershell && !has_wmic) {
return(status_unknown_version)
}
version <- ""
if (has_powershell) {
version <- chrome_windows_version_powershell(path)
}
if (!nzchar(version) && has_wmic) {
version <- chrome_windows_version_wmic(path)
}
if (identical(version, "")) {
return(status_unknown_version)
}
status(stdout = version)
}
chrome_windows_version_powershell <- function(path) {
# Uses PowerShell to get the Chrome version
command <- sprintf("(Get-Item \"%s\").VersionInfo.FileVersion", path)
output <- system2(
"powershell",
c("-Command", shQuote(command)),
stdout = TRUE
)
if (identical(output, "")) {
return("")
}
output <- trimws(output)
output <- output[nzchar(output)]
if (length(output) > 0) output[[1]] else ""
}
chrome_windows_version_wmic <- function(path) {
# Uses WMIC to get the Chrome version
wmic_cmd <- sprintf(
'wmic datafile where "name=\'%s\'" get version /value',
gsub("\\\\", "\\\\\\\\", path)
)
output <- tryCatch(
system(wmic_cmd, intern = TRUE),
error = function(err) ""
)
if (identical(output, "")) {
return("")
}
# Returns possibly several lines, one of which looks like
# "Version=128.0.6613.85\r"
output <- trimws(output)
version <- grep("^Version=", output, value = TRUE)
version <- sub("Version=", "", version)
version <- paste(version, collapse = ", ") # might have more than one line
return(version)
}
#' Show information about the chromote package and Chrome browser
#'
#' This function gathers information about the operating system, R version,
#' chromote package version, environment variables, Chrome path, and Chrome
#' arguments. It also verifies the Chrome installation and retrieves its version.
#'
#' @return A list containing the following elements:
#' \describe{
#' \item{os}{The operating system platform.}
#' \item{version_r}{The version of R.}
#' \item{version_chromote}{The version of the chromote package.}
#' \item{envvar}{The value of the `CHROMOTE_CHROME` environment variable.}
#' \item{path}{The path to the Chrome browser.}
#' \item{args}{A vector of Chrome arguments.}
#' \item{version}{The version of Chrome (if verification is successful).}
#' \item{error}{The error message (if verification fails).}
#' \item{.check}{A list with the status and output of the Chrome verification.}
#' }
#'
#' @examples
#' chromote_info()
#'
#' @export
chromote_info <- function() {
pkg_version <- as.character(utils::packageVersion("chromote"))
pkg_ref <- utils::packageDescription("chromote")$RemotePkgRef
if (!is.null(pkg_ref) && !identical("chromote", pkg_ref)) {
pkg_version <- sprintf("%s (%s)", pkg_version, pkg_ref)
}
info <- structure(
list(
os = as.character(R.version["platform"]),
version_r = R.version.string,
version_chromote = pkg_version,
envvar = Sys.getenv("CHROMOTE_CHROME", ""),
path = find_chrome(),
args = c(chrome_headless_mode(), get_chrome_args())
),
class = c("chromote_info", "list")
)
if (is.null(info$path)) {
return(info)
}
info$.check <- chrome_verify(info$path)
if (info$.check$status == 0) {
info$version <- trimws(info$.check$stdout)
} else {
info$error <- info$.check$stderr
}
info
}
#' @export
print.chromote_info <- function(x, ...) {
cat0 <- function(...) cat(..., "\n", sep = "")
wrap <- function(x, nchar = 9) {
x <- strwrap(x, width = getOption("width") - nchar, exdent = nchar)
paste(x, collapse = "\n")
}
cat0("---- {chromote} ----")
cat0(" System: ", x$os)
cat0("R version: ", x$version_r)
cat0(" chromote: ", x$version_chromote)
cat0("\n---- Chrome ----")
if (is.null(x$path)) {
cat0(
"Path: !! ",
wrap("Could not find Chrome, is it installed on this system?")
)
cat0(" !! ", wrap("If yes, see `?find_chrome()` for help."))
return(invisible(x))
}
cat0(
" Path: ",
x$path,
if (identical(x$path, x$envvar)) " (set by CHROMOTE_CHROME envvar)"
)
cat0("Version: ", x$version %||% "(unknown)")
cat0(" Args: ", wrap(paste(x$args, collapse = " ")))
if (x$.check$timeout) {
cat0(" Error: Timed out.")
cat0(" Error message:")
cat0(x$error)
} else if (!is.null(x$error)) {
cat0(" Error: ", x$error)
}
invisible(x)
}
find_chrome_windows <- function() {
tryCatch(
{
path <- utils::readRegistry(
"SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\chrome.exe\\"
)
path[["(Default)"]]
},
error = function(e) {
NULL
}
)
}
find_chrome_mac <- function() {
path_default <- "/Applications/Google\ Chrome.app/Contents/MacOS/Google\ Chrome"
if (file.exists(path_default)) {
return(path_default)
}
find_chrome_linux()
}
find_chrome_linux <- function() {
possible_names <- c(
"google-chrome",
"google-chrome-stable",
"chromium-browser",
"chromium",
"google-chrome-beta",
"google-chrome-unstable",
"chrome"
)
for (path in possible_names) {
path <- Sys.which(path)
if (nzchar(path)) {
return(path)
}
}
NULL
}
inform_if_chrome_not_found <- function(
path,
searched_for = "Google Chrome was",
extra_advice = ""
) {
if (!is.null(path)) return(invisible(path))
message(
searched_for,
" not found. ",
"Try setting the `CHROMOTE_CHROME` environment variable to the executable ",
"of a Chromium-based browser, such as Google Chrome, Chromium or Brave",
if (nzchar(extra_advice)) " ",
extra_advice,
"."
)
NULL
}
chrome_headless_mode <- function() {
opt <- getOption("chromote.headless", NULL)
env <- Sys.getenv("CHROMOTE_HEADLESS", "")
env <- if (nzchar(env)) env else NULL
# TODO Chrome v128 changed the default from --headless=old to --headless=new
# in 2024-08. Old headless mode was effectively a separate browser render,
# and while more performant did not share the same browser implementation as
# headful Chrome. New headless mode will likely be useful to some, but in most
# chromote use cases -- printing to PDF and testing -- we are not ready to
# move to the new mode. Even once removed, the option may be useful if we
# add support downloading specific versions of Chrome. (See rstudio/chromote#171)
# 2025-01-16: Chrome v132 removed headless mode (rstudio/chromote#187)
mode <- opt %||% env
if (is.null(mode)) {
return("--headless")
}
# Just pass headless along directly, Chrome will error if needed
sprintf("--headless=%s", mode)
}
launch_chrome <- function(path = find_chrome(), args = get_chrome_args()) {
if (is.null(path)) {
stop("Invalid path to Chrome")
}
res <- with_random_port(launch_chrome_impl, path = path, args = args)
res
}
launch_chrome_impl <- function(path, args, port) {
# Create temp locations for logs and crashes, grouped by chromote session
tmp_session <- tempfile("chrome-", fileext = "%s")
path_dir_crash <- sprintf(tmp_session, "-crashpad")
path_stdout <- sprintf(tmp_session, "-stdout.log")
path_stderr <- sprintf(tmp_session, "-stderr.log")
p <- process$new(
command = path,
args = c(
chrome_headless_mode(),
paste0("--remote-debugging-port=", port),
paste0("--remote-allow-origins=http://127.0.0.1:", port),
paste0("--crash-dumps-dir=", path_dir_crash),
args
),
supervise = TRUE,
stdout = path_stdout,
stderr = path_stderr,
echo_cmd = getOption("chromote.launch.echo_cmd", FALSE)
)
connected <- FALSE
timeout <- getOption("chromote.timeout", 10)
end <- Sys.time() + timeout
while (!connected && Sys.time() < end) {
if (!p$is_alive()) {
error_logs_path <- p$get_error_file()
error_logs <- paste(readLines(error_logs_path), collapse = "\n")
stdout_file <- p$get_output_file()
verify <- chrome_verify()
stop(
"Failed to start chrome. ",
if (verify$status == 0) {
"Chrome is available on your system, so this error may be a configuration issue. "
} else {
"Chrome does not appear to be runnable on your system. "
},
"Try `chromote_info()` to check and verify your settings. ",
if (nzchar(error_logs)) {
sprintf(
"\nLog file: %s\nError:\n%s",
error_logs_path,
trimws(error_logs)
)
} else {
"No error messages were logged."
},
if (file.info(stdout_file)$size > 0) {
paste0(
"\nThe following log file may contain more information:\n",
stdout_file
)
}
)
}
tryCatch(
{
# Find port number from output
output <- readLines(p$get_error_file())
output <- output[grepl("^DevTools listening on ws://", output)]
if (length(output) != 1) stop() # Just break out of the tryCatch
output_port <- sub(
"^DevTools listening on ws://[0-9\\.]+:(\\d+)/.*",
"\\1",
output
)
output_port <- as.integer(output_port)
if (is.na(output_port) || output_port != port) stop()
con <- url(paste0("http://127.0.0.1:", port, "/json/protocol"), "rb")
if (!isOpen(con)) break # Failed to connect
connected <- TRUE
close(con)
},
warning = function(e) {
},
error = function(e) {
}
)
Sys.sleep(0.1)
}
if (!connected) {
rlang::abort(
paste("Chrome debugging port not open after", timeout, "seconds."),
class = "error_stop_port_search"
)
}
list(
process = p,
port = port
)
}
================================================
FILE: R/chromote-package.R
================================================
#' @keywords internal
"_PACKAGE"
#' chromote Options
#'
#' @description
#' These options and environment variables that are used by chromote. Options
#' are lowercase and can be set with `options()`. Environment variables are
#' uppercase and can be set in an `.Renviron` file, with `Sys.setenv()`, or in
#' the shell or process running R. If both an option or environment variable are
#' supported, chromote will use the option first.
#'
#' * `CHROMOTE_CHROME` \cr
#' Path to the Chrome executable. If not set, chromote will
#' attempt to find and use the system installation of Chrome.
#' * `chromote.headless`, `CHROMOTE_HEADLESS` \cr
#' Headless mode for Chrome. Can be `"old"` or `"new"`. See
#' [Chrome Headless mode](https://developer.chrome.com/docs/chromium/new-headless)
#' for more details.
#' * `chromote.timeout` \cr
#' Timeout (in seconds) for Chrome to launch or connect. Default is `10`.
#' * `chromote.launch.echo_cmd` \cr
#' Echo the command used to launch Chrome to the console for debugging.
#' Default is `FALSE`.
#'
#' @name chromote-options
NULL
## usethis namespace: start
#' @import promises later rlang
#' @importFrom fastmap fastmap
#' @importFrom jsonlite fromJSON toJSON
#' @importFrom processx process
#' @importFrom R6 R6Class
#' @importFrom websocket WebSocket
## usethis namespace: end
NULL
# inlined from `lifecycle::badge()` and only supports the experimental badge.
# Use `usethis::use_lifecycle()` to add additional badges.
lifecycle_badge <- function(stage) {
stage <- rlang::arg_match0(
stage,
c("experimental") #, "stable", "superseded", "deprecated")
)
stage_name <- substr(stage, 1, 1) <- toupper(substr(stage, 1, 1))
url <- paste0("https://lifecycle.r-lib.org/articles/stages.html#", stage)
html <- sprintf(
"\\href{%s}{\\figure{%s}{options: alt='[%s]'}}",
url,
file.path(tolower(sprintf("lifecycle-%s.svg", stage))),
stage_name
)
text <- sprintf("\\strong{[%s]}", stage_name)
sprintf("\\ifelse{html}{%s}{%s}", html, text)
}
================================================
FILE: R/chromote.R
================================================
#' Chromote class
#'
#' @description
#' A `Chromote` object represents the browser as a whole, and it can have
#' multiple _targets_, which each represent a browser tab. In the Chrome
#' DevTools Protocol, each target can have one or more debugging _sessions_ to
#' control it. A `ChromoteSession` object represents a single _session_.
#'
#' A `Chromote` object can have any number of `ChromoteSession` objects as
#' children. It is not necessary to create a `Chromote` object manually. You can
#' simply call:
#' ```r
#' b <- ChromoteSession$new()
#' ```
#' and it will automatically create a `Chromote` object if one has not already
#' been created. The \pkg{chromote} package will then designate that `Chromote`
#' object as the _default_ `Chromote` object for the package, so that any future
#' calls to `ChromoteSession$new()` will automatically use the same `Chromote`.
#' This is so that it doesn't start a new browser for every `ChromoteSession`
#' object that is created.
#' @export
Chromote <- R6Class(
"Chromote",
lock_objects = FALSE,
cloneable = FALSE,
public = list(
#' @param browser A [`Browser`] object
#' @param multi_session Should multiple sessions be allowed?
#' @param auto_events If `TRUE`, enable automatic event enabling/disabling;
#' if `FALSE`, disable automatic event enabling/disabling.
initialize = function(
browser = Chrome$new(),
multi_session = TRUE,
auto_events = TRUE
) {
private$browser <- browser
private$auto_events <- auto_events
private$multi_session <- multi_session
private$command_callbacks <- fastmap()
# Use a private event loop to drive the websocket
private$child_loop <- create_loop(parent = current_loop())
p <- self$connect(multi_session = multi_session, wait_ = FALSE)
# Populate methods while the connection is being established.
protocol_spec <- jsonlite::fromJSON(
self$url("/json/protocol"),
simplifyVector = FALSE
)
self$protocol <- process_protocol(protocol_spec, self$.__enclos_env__)
lockBinding("protocol", self)
# self$protocol is a list of domains, each of which is a list of
# methods. Graft the entries from self$protocol onto self
list2env(self$protocol, self)
private$event_manager <- EventManager$new(self)
self$wait_for(p)
private$register_default_event_listeners()
},
#' @description Re-connect the websocket to the browser. The Chrome browser
#' automatically closes websockets when your computer goes to sleep;
#' you can use this to bring it back to life with a new connection.
#' @param multi_session Should multiple sessions be allowed?
#' @param wait_ If `FALSE`, return a promise; if `TRUE` wait until
#' connection is complete.
connect = function(multi_session = TRUE, wait_ = TRUE) {
if (multi_session) {
chrome_info <- fromJSON(self$url("/json/version"))
} else {
chrome_info <- fromJSON(self$url("/json"))
}
with_loop(private$child_loop, {
private$ws <- WebSocket$new(
chrome_info$webSocketDebuggerUrl,
autoConnect = FALSE
)
private$ws$onMessage(private$on_message)
# Allow up to 10 seconds to connect to browser.
# TODO: The extra promise_resolve()$then() wrapper is currently
# necessary because promise_timeout needs to be run _within_ a
# synchronize() call (which $wait_for(), down below, does). If we call
# promise_timeout() directly here, then it will error out because
# there isn't a current interrupt domain. Hopefully we can remove this
# delay and extra wrapper stuff.
p <- promise_resolve(TRUE)$then(function(value) {
promise_timeout(
promise(function(resolve, reject) {
private$ws$onOpen(resolve)
}),
timeout = getOption("chromote.timeout", 10),
timeout_message = paste0(
"Chromote: timed out waiting for WebSocket connection to browser. ",
"Use `options(chromote.timeout = ",
getOption("chromote.timeout", 10),
")` ",
"to increase the timeout."
)
)
})
private$ws$connect()
})
if (wait_) {
invisible(self$wait_for(p))
} else {
p
}
},
#' @description Display the current session in the `browser`
#'
#' If a [`Chrome`] browser is being used, this method will open a new tab
#' using your [`Chrome`] browser. When not using a [`Chrome`] browser, set
#' `options(browser=)` to change the default behavior of [`browseURL()`].
view = function() {
browse_url(path = NULL, self)
},
#' @description
#' `auto_events` value.
#'
#' For internal use only.
get_auto_events = function() {
private$auto_events
},
#' @description
#' Set or retrieve the `enable` command arguments for a domain. These
#' arguments are used for the `enable` command that is called for a domain,
#' e.g. `Fetch$enable()`, when accessing an event method.
#'
#' @param domain A command domain, e.g. `"Fetch"`.
#' @param ... Arguments to use for auto-events for the domain. If not
#' provided, returns the argument values currently in place for the
#' domain. Use `NULL` to clear the enable arguments for a domain.
auto_events_enable_args = function(domain, ...) {
dots <- dots_list(..., .named = TRUE)
if (length(dots) == 0) {
return(get_auto_events_enable_args(private, domain, self$parent))
}
set_auto_events_enable_args(self, private, domain, dots)
},
# =========================================================================
# Event loop, promises, and synchronization
# =========================================================================
#' @description Local \pkg{later} loop.
#'
#' For expert async usage only.
get_child_loop = function() {
private$child_loop
},
# This runs the child loop until the promise is resolved.
#' @description Wait until the promise resolves
#'
#' Blocks the R session until the promise (`p`) is resolved. The loop from
#' `$get_child_loop()` will only advance just far enough for the promise to
#' resolve.
#' @param p A promise to resolve.
wait_for = function(p) {
if (!is.promise(p)) {
stop("wait_for requires a promise object.")
}
synchronize(p, loop = private$child_loop)
},
# =========================================================================
# Session management
# =========================================================================
#' @description Create a new tab / window
#'
#' @param width,height Width and height of the new window.
#' @param targetId
#' [Target](https://chromedevtools.github.io/devtools-protocol/tot/Target/)
#' ID of an existing target to attach to. When a `targetId` is provided, the
#' `width` and `height` arguments are ignored. If NULL (the default) a new
#' target is created and attached to, and the `width` and `height`
#' arguments determine its viewport size.
#' @param wait_ If `FALSE`, return a [promises::promise()] of a new
#' `ChromoteSession` object. Otherwise, block during initialization, and
#' return a `ChromoteSession` object directly.
new_session = function(
width = 992,
height = 1323,
targetId = NULL,
wait_ = TRUE
) {
self$check_active()
create_session(
chromote = self,
width = width,
height = height,
targetId = targetId,
wait_ = wait_
)
},
#' @description Retrieve all [`ChromoteSession`] objects
#' @return A list of `ChromoteSession` objects
get_sessions = function() {
private$sessions
},
#' @description Register [`ChromoteSession`] object
#' @param session A `ChromoteSession` object
#'
#' For internal use only.
register_session = function(session) {
private$sessions[[session$get_session_id()]] <- session
},
# =========================================================================
# Commands and events
# =========================================================================
#' @description
#' Send command through Chrome DevTools Protocol.
#'
#' For expert use only.
#' @param msg A JSON-serializable list containing `method`, and `params`.
#' @param callback Method to run when the command finishes successfully.
#' @param error Method to run if an error occurs.
#' @param timeout Number of milliseconds for Chrome DevTools Protocol
#' execute a method.
#' @param sessionId Determines which [`ChromoteSession`] with the
#' corresponding to send the command to.
send_command = function(
msg,
callback = NULL,
error = NULL,
timeout = NULL,
sessionId = NULL
) {
self$check_active()
private$last_msg_id <- private$last_msg_id + 1
msg$id <- private$last_msg_id
if (!is.null(sessionId)) {
msg$sessionId <- sessionId
}
p <- promise(function(resolve, reject) {
msg_json <- toJSON(msg, auto_unbox = TRUE)
private$ws$send(msg_json)
self$debug_log("SEND ", msg_json)
# One of these callbacks will be invoked when a message arrives with a
# matching id.
private$add_command_callback(msg$id, resolve, reject)
})
p <- p$catch(function(e) {
stop(
"code: ",
e$code,
"\n message: ",
e$message,
if (!is.null(e$data)) paste0("\n data: ", e$data)
)
})
if (!is.null(timeout) && !is.infinite(timeout)) {
p <- promise_timeout(
p,
timeout,
loop = private$child_loop,
timeout_message = paste0(
"Chromote: timed out waiting for response to command ",
msg$method
)
)
}
if (!is.null(callback)) {
p <- p$then(onFulfilled = callback, onRejected = error)
}
p <- p$finally(function() private$remove_command_callback(msg$id))
p
},
#' @description
#' Immediately call all event callback methods.
#'
#' For internal use only.
#' @param event A single event string
#' @param params A list of parameters to pass to the event callback methods.
invoke_event_callbacks = function(event, params) {
private$event_manager$invoke_event_callbacks(event, params)
},
# =========================================================================
# Debugging
# =========================================================================
#' @description Enable or disable message debugging
#'
#' If enabled, R will print out the
# JSON messages that are sent and received. If called with no value, this
# method will print out the current debugging state.
#' @param value If `TRUE`, enable debugging. If `FALSE`, disable debugging.
debug_messages = function(value = NULL) {
if (is.null(value)) return(private$debug_messages_)
if (!(identical(value, TRUE) || identical(value, FALSE)))
stop("value must be TRUE or FALSE")
private$debug_messages_ <- value
},
#' @description
#' Submit debug log message
#'
#' ## Examples
#'
#' ```r
#' b <- ChromoteSession$new()
#' b$parent$debug_messages(TRUE)
#' b$Page$navigate("https://www.r-project.org/")
#' #> SEND {"method":"Page.navigate","params":{"url":"https://www.r-project.org/"}| __truncated__}
#' # Turn off debug messages
#' b$parent$debug_messages(FALSE)
#' ```
#'
#' @param ... Arguments pasted together with `paste0(..., collapse = "")`.
debug_log = function(...) {
txt <- truncate(paste0(..., collapse = ""), 1000)
if (private$debug_messages_) {
message(txt)
}
},
# =========================================================================
# Misc utility functions
# =========================================================================
#' @description Create url for a given path
#' @param path A path string to append to the host and port
url = function(path = NULL) {
if (!is.null(path) && substr(path, 1, 1) != "/") {
stop('path must be NULL or a string that starts with "/"')
}
paste0(
"http://",
private$browser$get_host(),
":",
private$browser$get_port(),
path
)
},
#' @description
#' Is there an active websocket connection to the browser process?
is_active = function() {
self$is_alive() && private$ws$readyState() %in% c(0L, 1L)
},
#' @description
#' Is the underlying browser process running?
is_alive = function() {
private$browser$is_alive()
},
#' @description Check that a chromote instance is active and alive.
#' Will automatically reconnect if browser process is alive, but
#' there's no active web socket connection.
check_active = function() {
if (!self$is_alive()) {
stop("Chromote has been closed.")
}
if (!self$is_active()) {
inform(
c(
"!" = "Reconnecting to chrome process.",
i = "All active sessions will be need to be respawned."
)
)
self$connect()
# Mark all sessions as closed
for (session in private$sessions) {
session$mark_closed(FALSE)
}
private$sessions <- list()
}
invisible(self)
},
#' @description Retrieve [`Browser`]` object
#'
get_browser = function() {
private$browser
},
#' @description Close the [`Browser`] object
#' @param wait If an integer, waits a number of seconds for the process to
#' exit, killing the process if it takes longer than `wait` seconds to
#' close. Use `wait = TRUE` to wait for 10 seconds, or `wait = FALSE` to
#' close the connection without waiting for the process to exit. Only
#' applies when Chromote is connected to a local process.
close = function(wait = TRUE) {
if (!isFALSE(wait)) {
if (isTRUE(wait)) wait <- 10
check_number_whole(wait, min = 0)
}
is_local <- private$browser$is_local()
if (!is_local || !self$is_alive()) {
# For remote connections or cases where the process is already closed,
# we just close the websocket. Note that we skip $is_active() because it
# requires $is_alive().
if (private$ws$readyState() %in% c(0L, 1L)) {
private$ws$close()
}
return(invisible())
}
# close the browser nicely, immediately close websocket
self$Browser$close(wait_ = FALSE)
try(private$ws$close(), silent = TRUE)
if (!isFALSE(wait)) {
# or close it forcefully if it takes too long
tryCatch(
{
private$browser$get_process()$wait(timeout = wait * 1000)
if (private$browser$get_process()$is_alive()) {
stop("shut it down") # ignored, used to escalate
}
},
error = function(err) {
try(private$ws$close(), silent = TRUE)
private$browser$close(wait = 1)
}
)
}
invisible()
},
#' @description Summarise the current state of the object.
#' @param verbose The print method defaults to a brief summary
#' of the most important debugging info; use `verbose = TRUE` tp
#' see the complex R6 object.
#' @param ... Passed on to `format()` when `verbose` = TRUE
print = function(..., verbose = FALSE) {
if (verbose) {
cat(format(self, ...), sep = "\n")
} else {
if (self$is_active()) {
state <- "active + alive"
} else if (self$is_alive()) {
state <- "alive"
} else {
state <- "closed"
}
ps <- self$get_browser()$get_process()
cat_line("<Chromote> (", state, ")")
if (self$is_alive()) {
cat_line(" URL: ", self$url())
cat_line(" PID: ", ps$get_pid())
cat_line(" Path: ", ps$get_cmdline()[[1]])
}
}
invisible(self)
},
#' @field default_timeout Default timeout in seconds for \pkg{chromote} to
#' wait for a Chrome DevTools Protocol response.
default_timeout = 10,
#' @field protocol Dynamic protocol implementation. For expert use only!
protocol = NULL
),
private = list(
browser = NULL,
ws = NULL,
# =========================================================================
# Browser commands
# =========================================================================
last_msg_id = 0,
command_callbacks = NULL,
add_command_callback = function(id, callback, error) {
id <- as.character(id)
private$command_callbacks$set(
id,
list(
callback = callback,
error = error
)
)
},
# Invoke the callback for a command (using id).
invoke_command_callback = function(id, value, error) {
id <- as.character(id)
if (!private$command_callbacks$has(id)) return()
handlers <- private$command_callbacks$get(id)
if (!is.null(error)) {
handlers$error(error)
} else if (!is.null(value)) {
handlers$callback(value)
}
},
remove_command_callback = function(id) {
private$command_callbacks$remove(as.character(id))
},
# =========================================================================
# Browser events
# =========================================================================
event_manager = NULL,
register_event_listener = function(event, callback = NULL, timeout = NULL) {
self$check_active()
private$event_manager$register_event_listener(event, callback, timeout)
},
register_default_event_listeners = function() {
# When a target is closed, mark the corresponding R session object as
# closed and remove it from the list of sessions.
self$protocol$Target$detachedFromTarget(function(msg) {
sid <- msg$sessionId
session <- private$sessions[[sid]]
if (is.null(session)) return()
private$sessions[[sid]] <- NULL
session$mark_closed(TRUE)
})
},
# =========================================================================
# Message handling and dispatch
# =========================================================================
debug_messages_ = FALSE,
debug_message_max_length = 1000,
on_message = function(msg) {
self$debug_log("RECV ", msg$data)
data <- fromJSON(msg$data, simplifyVector = FALSE)
if (!is.null(data$method)) {
# This is an event notification.
#
# The reason that the callback is wrapped in later() is to prevent a
# possible race when a command response and an event notification arrive
# in the same tick. See issue #1.
later(function() {
if (!is.null(data$sessionId)) {
session <- private$sessions[[data$sessionId]]
} else {
session <- self
}
session$invoke_event_callbacks(data$method, data$params)
})
} else if (!is.null(data$id)) {
# This is a response to a command.
private$invoke_command_callback(data$id, data$result, data$error)
} else {
message("Don't know how to handle message: ", msg$data)
}
},
# =========================================================================
# Sessions
# =========================================================================
multi_session = NULL,
sessions = list(),
# =========================================================================
# Private event loop for the websocket
# =========================================================================
child_loop = NULL
)
)
globals$default_chromote <- NULL
#' Default Chromote object
#'
#' Returns the Chromote package's default [Chromote] object. If
#' there is not currently a default `Chromote` object that is active, then
#' one will be created and set as the default.
#'
#' `ChromoteSession$new()` calls this function by default, if the
#' `parent` is not specified. That means that when
#' `ChromoteSession$new()` is called and there is not currently an
#' active default `Chromote` object, then a new `Chromote` object will
#' be created and set as the default.
#' @export
default_chromote_object <- function() {
if (!has_default_chromote_object()) {
set_default_chromote_object(Chromote$new())
}
globals$default_chromote
}
#' Returns TRUE if there's a default Chromote object and it is active, FALSE
#' otherwise.
#' @rdname default_chromote_object
#' @export
has_default_chromote_object <- function() {
!is.null(globals$default_chromote) && globals$default_chromote$is_alive()
}
#' @param x A [Chromote] object.
#' @rdname default_chromote_object
#' @export
set_default_chromote_object <- function(x) {
if (!inherits(x, "Chromote")) {
stop("x must be a Chromote object.")
}
globals$default_chromote <- x
}
cache_value <- function(fn) {
value <- NULL
function() {
if (is.null(value)) {
value <<- fn()
}
value
}
}
# inspired by https://www.npmjs.com/package/is-docker
# This should not change over time. Cache it
is_inside_docker <- cache_value(function() {
file.exists("/.dockerenv") ||
(is_linux() &&
file.exists("/proc/self/cgroup") &&
any(grepl("docker", readLines("/proc/self/cgroup"), fixed = TRUE)))
})
# This is a _fast_ function. Do not cache it.
is_inside_ci <- function() {
!identical(Sys.getenv("CI", unset = ""), "")
}
is_missing_linux_user <- cache_value(function() {
is_linux() &&
system("id", ignore.stdout = TRUE) != 0
})
#' Default Chrome arguments
#'
#' A character vector of command-line arguments passed when initializing any new
#' instance of [`Chrome`]. Single on-off arguments are passed as single values
#' (e.g.`"--disable-gpu"`), arguments with a value are given with a nested
#' character vector (e.g. `c("--force-color-profile", "srgb")`). See
#' [here](https://peter.sh/experiments/chromium-command-line-switches/) for a
#' list of possible arguments.
#'
#'
#' @details
#'
#' Default chromote arguments are composed of the following values (when
#' appropriate):
#'
#' * [`"--disable-gpu"`](https://peter.sh/experiments/chromium-command-line-switches/#disable-gpu)
#' * Only added on Windows, as empirically it appears to be needed
#' (if not, check runs on GHA never terminate).
#' * Disables GPU hardware acceleration. If software renderer is not in place, then the GPU process won't launch.
#' * [`"--no-sandbox"`](https://peter.sh/experiments/chromium-command-line-switches/#no-sandbox)
#' * Only added when `CI` system environment variable is set, when the
#' user on a Linux system is not set, or when executing inside a Docker container.
#' * Disables the sandbox for all process types that are normally sandboxed. Meant to be used as a browser-level switch for testing purposes only
#' * [`"--disable-dev-shm-usage"`](https://peter.sh/experiments/chromium-command-line-switches/#disable-dev-shm-usage)
#' * Only added when `CI` system environment variable is set or when inside a docker instance.
#' * The `/dev/shm` partition is too small in certain VM environments, causing Chrome to fail or crash.
#' * [`"--force-color-profile=srgb"`](https://peter.sh/experiments/chromium-command-line-switches/#force-color-profile)
#' * This means that screenshots taken on a laptop plugged into an external
#' monitor will often have subtly different colors than one taken when
#' the laptop is using its built-in monitor. This problem will be even
#' more likely across machines.
#' * Force all monitors to be treated as though they have the specified color profile.
#' * [`"--disable-extensions"`](https://peter.sh/experiments/chromium-command-line-switches/#disable-extensions)
#' * Disable extensions.
#' * [`"--mute-audio"`](https://peter.sh/experiments/chromium-command-line-switches/#mute-audio)
#' * Mutes audio sent to the audio device so it is not audible during automated testing.
#'
#' @return A character vector of default command-line arguments to be used with
#' every new [`ChromoteSession`]
#' @describeIn default_chrome_args Returns a character vector of command-line
#' arguments passed when initializing Chrome. See Details for more
#' information.
#' @export
default_chrome_args <- function() {
c(
# Empirically, appears to be needed for check runs to terminate on GHA
if (is_windows()) "--disable-gpu",
# > Note: --no-sandbox is not needed if you properly setup a user in the container.
# https://developers.google.com/web/updates/2017/04/headless-chrome
if (is_inside_ci() || is_missing_linux_user() || is_inside_docker()) {
"--no-sandbox"
},
# Until we have hundreds of concurrent usage, let's slow things down by
# using `/tmp` disk folder, rather than shared memory folder `/dev/shm`.
# This will make things more stable at the cost of accessing disk more often.
# Great discussion: https://github.com/puppeteer/puppeteer/issues/1834
if (is_inside_ci() || is_inside_docker()) {
"--disable-dev-shm-usage" # required bc the target easily crashes
},
# Consistent screenshot colors
# https://github.com/rstudio/chromote/pull/52
"--force-color-profile=srgb",
# Have also seen usage of `--ignore-certificate-errors`
# Generic options to have consistent output
c(
'--disable-extensions',
'--mute-audio'
)
)
}
#' @describeIn default_chrome_args Retrieves the default command-line arguments
#' passed to [`Chrome`] during initialization. Returns either `NULL` or a
#' character vector.
#' @export
get_chrome_args <- function() {
if (!exists("chrome_args", envir = globals)) {
set_chrome_args(default_chrome_args())
}
globals$chrome_args
}
reset_chrome_args <- function() {
rm("chrome_args", envir = globals)
}
#' @describeIn default_chrome_args Sets the default command-line arguments
#' passed when initializing. Returns the updated defaults.
#' @param args A character vector of command-line arguments (or `NULL`) to be
#' used with every new [`ChromoteSession`].
#' @export
#' @examples
#' old_chrome_args <- get_chrome_args()
#'
#' # Disable the gpu and use of `/dev/shm`
#' set_chrome_args(c("--disable-gpu", "--disable-dev-shm-usage"))
#'
#' #... Make new `Chrome` or `ChromoteSession` instance
#'
#' # Restore old defaults
#' set_chrome_args(old_chrome_args)
set_chrome_args <- function(args) {
set_args <- function(args_) {
# Using $ to set `NULL` is safe within environments
globals$chrome_args <- args_
invisible(args_)
}
# Validate
default_args <- unique(unlist(args))
if (length(default_args) == 0) {
return(set_args(NULL))
}
if (
anyNA(default_args) || !any(vapply(default_args, is.character, logical(1)))
) {
stop("`set_chrome_args()` only accepts a character vector or `NULL`")
}
# Set
return(set_args(default_args))
}
================================================
FILE: R/chromote_session.R
================================================
#' ChromoteSession class
#'
#' @description
#' This represents one _session_ in a Chromote object. Note that in the Chrome
#' DevTools Protocol a session is a debugging session connected to a _target_,
#' which is a browser window/tab or an iframe.
#'
#' A single target can potentially have more than one session connected to it,
#' but this is not currently supported by chromote.
#'
#' @export
#' @param targetId
#' [Target](https://chromedevtools.github.io/devtools-protocol/tot/Target/)
#' ID of an existing target to attach to. When a `targetId` is provided, the
#' `width` and `height` arguments are ignored. If NULL (the default) a new
#' target is created and attached to, and the `width` and `height`
#' arguments determine its viewport size.
ChromoteSession <- R6Class(
"ChromoteSession",
lock_objects = FALSE,
cloneable = FALSE,
public = list(
#' @description Create a new `ChromoteSession` object.
#'
#' ## Examples
#'
#' ```r
#' # Create a new `ChromoteSession` object.
#' b <- ChromoteSession$new()
#'
#' # Create a ChromoteSession with a specific height,width
#' b <- ChromoteSession$new(height = 1080, width = 1920)
#'
#' # Navigate to page
#' b$go_to("http://www.r-project.org/")
#'
#' # View current chromote session
#' if (interactive()) b$view()
#' ```
#'
#' @param parent [`Chromote`] object to use; defaults to
#' [default_chromote_object()]
#' @param width,height Width and height of the new window in integer pixel
#' values.
#' @param wait_ If `FALSE`, return a [promises::promise()] of a new
#' `ChromoteSession` object. Otherwise, block during initialization, and
#' return a `ChromoteSession` object directly.
#' @param mobile Whether to emulate mobile device. When `TRUE`, Chrome
#' updates settings to emulate browsing on a mobile phone; this includes
#' viewport meta tag, overlay scrollbars, text autosizing and more. The
#' default is `FALSE`.
#' @param auto_events If `NULL` (the default), use the `auto_events` setting
#' from the parent `Chromote` object. If `TRUE`, enable automatic
#' event enabling/disabling; if `FALSE`, disable automatic event
#' enabling/disabling.
#' @return A new `ChromoteSession` object.
initialize = function(
parent = default_chromote_object(),
width = 992,
height = 1323,
targetId = NULL,
wait_ = TRUE,
auto_events = NULL,
mobile = FALSE
) {
check_number_whole(width)
check_number_whole(height)
check_logical(auto_events, allow_null = TRUE)
check_logical(mobile)
check_logical(wait_)
self$parent <- parent
lockBinding("parent", self) # do not allow `$parent` to be set!
self$default_timeout <- parent$default_timeout
# Create a session from the Chromote. Basically the same code as
# new_session(), but this is synchronous.
if (is.null(targetId)) {
# In earlier versions of chromote (< 0.5.0), we set `width` and `height`
# in `Target.createTarget`. With legacy (old) headless mode, each new
# session was essentially a tab in a new window. With new headless mode,
# introduced with Chrome v128, new tabs are created in existing windows.
# For Chrome v128-v133, `width` and `height` in `Target.createTarget`
# were ignored completely, and for v134+ they only have an effect when
# creating a new window, i.e. for the first ChromoteSession. We now use
# `Emulation.setDeviceMetricsOverride` below to set the viewport
# dimensions, which works across all versions of Chrome/headless-shell
# regardless of the parent window size.
p <- parent$Target$createTarget("about:blank", wait_ = FALSE)$then(
function(value) {
private$target_id <- value$targetId
parent$Target$attachToTarget(
value$targetId,
flatten = TRUE,
wait_ = FALSE
)
}
)
} else {
private$target_id <- targetId
p <- parent$Target$attachToTarget(
targetId,
flatten = TRUE,
wait_ = FALSE
)
}
p <- p$then(function(value) {
private$session_id <- value$sessionId
self$parent$register_session(self)
})
# Whenever a command method (like x$Page$navigate()) is executed, it calls
# x$send_command(). This object's send_command() method calls the parent's
# send_command() method with a sessionId -- that is how the command is
# scoped to this session.
self$protocol <- protocol_reassign_envs(
parent$protocol,
env = self$.__enclos_env__
)
lockBinding("protocol", self)
# Graft the entries from self$protocol onto self
list2env(self$protocol, self)
private$auto_events <- auto_events
private$event_manager <- EventManager$new(self)
private$session_is_active <- TRUE
private$target_is_active <- TRUE
# Find pixelRatio for screenshots
p <- p$then(function(value) {
private$get_pixel_ratio()
})
if (is.null(targetId)) {
# `Emulation.setDeviceMetricsOverride` is equivalent to turning on
# responsive preview in developer tools and lets us adjust the size of
# the viewport for the active session. This avoids setting the size of
# the parent browser window and ensures that the viewport of the current
# tab has dimensions that exactly match the requested `width` and
# `height`.
p <- p$then(function(value) {
self$Emulation$setDeviceMetricsOverride(
width = width,
height = height,
deviceScaleFactor = private$pixel_ratio,
mobile = mobile,
wait_ = FALSE
)
})
}
# When a target crashes, raise a warning.
if (!is.null(self$Inspector$targetCrashed)) {
p <- p$then(function(value) {
self$Inspector$targetCrashed(
timeout_ = NULL,
wait_ = FALSE,
function(value) {
warning(
"Chromote has received a Inspector.targetCrashed event. This means that the ChromoteSession has probably crashed."
)
# Even if no targetId nor sessionId is returned by Inspector.targetCashed
# mark the session as closed. This will close all sessions..
self$mark_closed(TRUE)
}
)
})
}
if (wait_) {
self$wait_for(p)
} else {
# If wait_=FALSE, then we can't use the usual strategy of just
# returning p, because the call to ChromoteSession$new() always
# returns the new object. Instead, we'll store it as
# private$init_promise_, and the user can retrieve it with
# b$get_init_promise().
private$init_promise_ <- p$then(function(value) self)
}
},
#' @description Display the current session in the [`Chromote`] browser.
#'
#' If a [`Chrome`] browser is being used, this method will open a new tab
#' using your [`Chrome`] browser. When not using a [`Chrome`] browser, set
#' `options(browser=)` to change the default behavior of [`browseURL()`].
#'
#' ## Examples
#'
#' ```r
#' # Create a new `ChromoteSession` object.
#' b <- ChromoteSession$new()
#'
#' # Navigate to page
#' b$go_to("http://www.r-project.org/")
#'
#' # View current chromote session
#' if (interactive()) b$view()
#' ```
view = function() {
# A data frame of targets, one row per target.
info <- fromJSON(self$parent$url("/json"))
path <- info$devtoolsFrontendUrl[info$id == private$target_id]
if (length(path) == 0) {
stop("Target info not found.")
}
if (grepl("^https://chrome-devtools-frontend\\.appspot\\.com", path)) {
# Chrome v135+ uses a fully-qualified appspot.com URL because some
# flavors of Chrome do not ship with the devtools inspector (iOS,
# Android). Using this URL requires also setting
# `--remote-allow-origins=https://chrome-devtools-frontend.appspot.com`.
# This is cumbersome and not required for desktop Chrome, so we instead
# use the legacy path, while trying to guard against future changes.
inspector_path <- "/devtools/inspector.html"
inspector_contents <- tryCatch(
readLines(self$parent$url(inspector_path)),
error = function(err) character(0)
)
if (length(inspector_contents) > 0) {
ws_url <- info$webSocketDebuggerUrl[info$id == private$target_id]
ws_url <- sub("ws://", "ws=", ws_url)
path <- paste0(inspector_path, "?", ws_url)
}
}
browse_url(path, self$parent)
},
#' @description Close the Chromote session.
#'
#' ## Examples
#'
#' ```r
#' # Create a new `ChromoteSession` object.
#' b <- ChromoteSession$new()
#'
#' # Navigate to page
#' b$go_to("http://www.r-project.org/")
#'
#' # Close current chromote session
#' b$close()
#' ```
#'
#' @param wait_ If `FALSE`, return a [promises::promise()] that will resolve
#' when the `ChromoteSession` is closed. Otherwise, block until the
#' `ChromoteSession` has closed.
close = function(wait_ = TRUE) {
if (!private$target_is_active) {
return(invisible())
}
# Even if this session calls Target.closeTarget, the response from
# the browser is sent without a sessionId. In order to wait for the
# correct browser response, we need to invoke this from the parent's
# browser-level methods.
p <- self$parent$protocol$Target$closeTarget(
private$target_id,
wait_ = FALSE
)
p <- p$then(function(value) {
if (isTRUE(value$success)) {
self$mark_closed(TRUE)
}
invisible(value$success)
})
if (wait_) {
self$wait_for(p)
} else {
p
}
},
#' @description Get the viewport size
#'
#' @param wait_ If `FALSE`, return a [promises::promise()] of a new
#' `ChromoteSession` object. Otherwise, block during initialization, and
#' return a `ChromoteSession` object directly.
#'
#' @return Returns a list with values `width`, `height`, `zoom`
#' and `mobile`. See `$set_viewport_size()` for more details.
get_viewport_size = function(wait_ = TRUE) {
check_bool(wait_)
p <- self$Page$getLayoutMetrics(wait_ = FALSE)$then(function(value) {
list(
width = value$cssVisualViewport$clientWidth,
height = value$cssVisualViewport$clientHeight
)
})$then(function(value) {
list(
width = value$width,
height = value$height,
zoom = private$pixel_ratio %||% 0,
mobile = private$is_mobile
)
})
if (wait_) self$wait_for(p) else p
},
#' @description Set the viewport size
#'
#' Each ChromoteSession is associated with a page that may be one page open
#' in a browser window among many. Each page can have its own viewport size,
#' that can be thought of like the window size for that page.
#'
#' This function uses the
#' [Emulation.setDeviceMetricsOverride](https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setDeviceMetricsOverride)
#' command to set the viewport size. If you need more granular control or
#' access to additional settings, use
#' `$Emulation$setDeviceMetricsOverride()`.
#'
#' @param width,height Width and height of the new window in integer pixel
#' values.
#' @param zoom The zoom level of displayed content on a device, where a
#' value of 1 indicates normal size, greater than 1 indicates zoomed in,
#' and less than 1 indicates zoomed out.
#' @param mobile Whether to emulate mobile device. When `TRUE`, Chrome
#' updates settings to emulate browsing on a mobile phone; this includes
#' viewport meta tag, overlay scrollbars, text autosizing and more. The
#' default is `FALSE`.
#' @param wait_ If `FALSE`, return a [promises::promise()] of a new
#' `ChromoteSession` object. Otherwise, block during initialization, and
#' return a `ChromoteSession` object directly.
#'
#' @return Invisibly returns the previous viewport dimensions so that you
#' can restore the viewport size, if desired.
set_viewport_size = function(
width,
height,
zoom = NULL,
mobile = NULL,
wait_ = TRUE
) {
check_number_whole(width)
check_number_whole(height)
check_number_decimal(zoom, allow_null = TRUE)
check_bool(mobile, allow_null = TRUE)
check_bool(wait_)
prev_bounds <- NULL
p <- self$get_viewport_size(wait_ = FALSE)$then(function(value) {
prev_bounds <<- value
self$Emulation$setDeviceMetricsOverride(
width = width,
height = height,
deviceScaleFactor = zoom %||% private$pixel_ratio %||% 0,
mobile = mobile %||% private$is_mobile %||% FALSE,
wait_ = FALSE
)
})$then(function(value) {
prev_bounds
})
if (wait_) invisible(self$wait_for(p)) else p
},
#' @description Navigate to a URL and wait for the page to load
#'
#' This method navigates to a specified URL and waits for the page load
#' event to complete. This is a more reliable alternative to directly
#' calling `Page$navigate()`, which can return before the page is actually
#' loaded. This method also allows for an optional delay after the load
#' event has fired, in case the page needs to load additional assets after
#' that event.
#'
#' @param url The URL to navigate to.
#' @param ... Additional parameters passed to `Page$navigate()`.
#' @param delay Number of seconds to wait after the page load event fires.
#' @param callback_ Function to call when the page load event fires.
#' @param error_ Function to call if an error occurs during navigation.
#' @param timeout_ Maximum time in seconds to wait for the page load event
#' (defaults to session's `default_timeout``).
#' @param wait_ If `FALSE`, returns a promise that resolves when navigation
#' is complete. If `TRUE` (default), blocks until navigation is complete.
#'
#' @return If `wait_` is TRUE, returns invisible(NULL). If wait_ is FALSE,
#' returns a promise that resolves when navigation is complete. The
#' promise resolves with the value from the navigate command.
#'
#' @examples \dontrun{
#' # Basic navigation
#' b$go_to("https://www.r-project.org")
#'
#' # Navigation with delay
#' b$go_to("https://www.r-project.org", delay = 2)
#'
#' # Asynchronous navigation
#' p <- b$go_to("https://www.r-project.org", wait_ = FALSE)
#' p$then(function(value) print("Navigation complete!"))
#' }
go_to = function(
url,
...,
delay = 0,
callback_ = NULL,
error_ = NULL,
timeout_ = self$default_timeout,
wait_ = TRUE
) {
p <- self$Page$loadEventFired(
callback_ = callback_,
timeout_ = timeout_,
wait_ = FALSE
)
result <- self$Page$navigate(url, ..., error_ = error_, wait_ = FALSE)
if (delay > 0) {
# After loadEventFired, wait `delay` seconds.
p <- p$then(function(value) {
promise(function(resolve, reject) {
later(function() resolve(result), delay)
})
})
}
if (wait_) invisible(self$wait_for(p)) else p
},
#' @description Take a PNG screenshot
#'
#' ## Examples
#'
#' ```r
#' # Create a new `ChromoteSession` object.
#' b <- ChromoteSession$new()
#'
#' # Navigate to page
#' b$go_to("http://www.r-project.org/")
#'
#' # Take screenshot
#' tmppngfile <- tempfile(fileext = ".png")
#' is_interactive <- interactive() # Display screenshot if interactive
#' b$screenshot(tmppngfile, show = is_interactive)
#'
#' # Show screenshot file info
#' unlist(file.info(tmppngfile))
#'
#'
#' # Take screenshot using a selector
#' sidebar_file <- tempfile(fileext = ".png")
#' b$screenshot(sidebar_file, selector = ".sidebar", show = is_interactive)
#'
#' # ----------------------------
#' # Take screenshots in parallel
#'
#' urls <- c(
#' "https://www.r-project.org/",
#' "https://github.com/",
#' "https://news.ycombinator.com/"
#' )
#' # Helper method that:
#' # 1. Navigates to the given URL
#' # 2. Waits for the page loaded event to fire
#' # 3. Takes a screenshot
#' # 4. Prints a message
#' # 5. Close the ChromoteSession
#' screenshot_p <- function(url, filename = NULL) {
#' if (is.null(filename)) {
#' filename <- gsub("^.*://", "", url)
#' filename <- gsub("/", "_", filename)
#' filename <- gsub("\\.", "_", filename)
#' filename <- sub("_$", "", filename)
#' filename <- paste0(filename, ".png")
#' }
#'
#' b2 <- b$new_session()
#' b2$go_to(url, wait_ = FALSE)$
#' then(function(value) {
#' b2$screenshot(filename, wait_ = FALSE)
#' })$
#' then(function(value) {
#' message(filename)
#' })$
#' finally(function() {
#' b2$close()
#' })
#' }
#'
#' # Take multiple screenshots simultaneously
#' ps <- lapply(urls, screenshot_p)
#' pa <- promises::promise_all(.list = ps)$then(function(value) {
#' message("Done!")
#' })
#'
#' # Block the console until the screenshots finish (optional)
#' b$wait_for(pa)
#' #> www_r-project_org.png
#' #> github_com.png
#' #> news_ycombinator_com.png
#' #> Done!
#' ```
#'
#' @param filename File path of where to save the screenshot. The format of
#' the screenshot is inferred from the file extension; use
#' `options = list(format = "jpeg")` to manually choose the format. See
#' [`Page.captureScreenshot`](https://chromedevtools.github.io/devtools-protocol/tot/Page/#method-captureScreenshot)
#' for supported formats; at the time of this release the format options
#' were `"png"` (default), `"jpeg"`, or `"webp"`.
#' @param selector CSS selector to use for the screenshot.
#' @param cliprect An unnamed vector or list containing values for `top`,
#' `left`, `width`, and `height`, in that order. See
#' [`Page.Viewport`](https://chromedevtools.github.io/devtools-protocol/tot/Page/#type-Viewport)
#' for more information. If provided, `selector` and `expand` will be
#' ignored. To provide a scale, use the `scale` parameter.
#' @param region CSS region to use for the screenshot.
#' @param expand Extra pixels to expand the screenshot. May be a single
#' value or a numeric vector of top, right, bottom, left values.
#' @param scale Page scale factor
#' @param show If `TRUE`, the screenshot will be displayed in the viewer.
#' @param delay The number of seconds to wait before taking the screenshot
#' after resizing the page. For complicated pages, this may need to be
#' increased.
#' @param options Additional options passed to
#' [`Page.captureScreenshot`](https://chromedevtools.github.io/devtools-protocol/tot/Page/#method-captureScreenshot).
#' @param wait_ If `FALSE`, return a [promises::promise()] that will resolve
#' when the `ChromoteSession` has saved the screenshot. Otherwise, block
#' until the `ChromoteSession` has saved the screenshot.
screenshot = function(
filename = "screenshot.png",
selector = "html",
cliprect = NULL,
region = c("content", "padding", "border", "margin"),
expand = NULL,
scale = 1,
show = FALSE,
delay = 0.5,
options = list(),
wait_ = TRUE
) {
chromote_session_screenshot(
self,
private,
filename = filename,
selector = selector,
cliprect = cliprect,
region = region,
expand = expand,
scale = scale,
show = show,
delay = delay,
options = options,
wait_ = wait_
)
},
#' @description Take a PDF screenshot
#'
#' ## Examples
#'
#' ```r
#' # Create a new `ChromoteSession` object.
#' b <- ChromoteSession$new()
#'
#' # Navigate to page
#' b$go_to("http://www.r-project.org/")
#'
#' # Take screenshot
#' tmppdffile <- tempfile(fileext = ".pdf")
#' b$screenshot_pdf(tmppdffile)
#'
#' # Show PDF file info
#' unlist(file.info(tmppdffile))
#' ```
#'
#' @param filename File path of where to save the screenshot.
#' @param pagesize A single character value in the set `"letter"`,
#' `"legal"`, `"tabloid"`, `"ledger"` and `"a0"` through `"a1"`. Or a
#' numeric vector `c(width, height)` specifying the page size.
#' @param margins A numeric vector `c(top, right, bottom, left)` specifying
#' the page margins.
#' @param units Page and margin size units. Either `"in"` or `"cm"` for
#' inches and centimeters respectively.
#' @param landscape Paper orientation.
#' @param display_header_footer Display header and footer.
#' @param print_background Print background graphics.
#' @param scale Page scale factor.
#' @param wait_ If `FALSE`, return a [promises::promise()] that will resolve
#' when the `ChromoteSession` has saved the screenshot. Otherwise, block
#' until the `ChromoteSession` has saved the screnshot.
screenshot_pdf = function(
filename = "screenshot.pdf",
pagesize = "letter",
margins = 0.5,
units = c("in", "cm"),
landscape = FALSE,
display_header_footer = FALSE,
print_background = FALSE,
scale = 1,
wait_ = TRUE
) {
chromote_session_screenshot_pdf(
self,
private,
filename = filename,
pagesize = pagesize,
margins = margins,
units = units,
landscape = landscape,
display_header_footer = display_header_footer,
print_background = print_background,
scale = scale,
wait_ = wait_
)
},
#' @description Create a new tab / window
#'
#' ## Examples
#'
#' ```r
#' b1 <- ChromoteSession$new()
#' b1$go_to("http://www.google.com")
#' b2 <- b1$new_session()
#' b2$go_to("http://www.r-project.org/")
#' b1$Runtime$evaluate("window.location", returnByValue = TRUE)$result$value$href
#' #> [1] "https://www.google.com/"
#' b2$Runtime$evaluate("window.location", returnByValue = TRUE)$result$value$href
#' #> [1] "https://www.r-project.org/"
#' ```
#'
#' @param width,height Width and height of the new window.
#' @param wait_ If `FALSE`, return a [promises::promise()] that will resolve
#' when the `ChromoteSession` has created a new session. Otherwise, block
#' until the `ChromoteSession` has created a new session.
new_session = function(
width = 992,
height = 1323,
targetId = NULL,
wait_ = TRUE
) {
create_session(
chromote = self$parent,
width = width,
height = height,
targetId = targetId,
wait_ = wait_
)
},
#' @description
#' Retrieve the session id
get_session_id = function() {
private$session_id
},
#' @description
#' Create a new session that connects to the same target (i.e. page)
#' as this session. This is useful if the session has been closed but the target still
#' exists.
respawn = function() {
if (!private$target_is_active) {
stop("Can't respawn session; target has been closed.")
}
create_session(
chromote = self$parent,
targetId = private$target_id,
auto_events = private$auto_events
)
},
#' @description
#' Retrieve the target id
get_target_id = function() {
private$target_id
},
#' @description
#' Wait for a Chromote Session to finish. This method will block the R
#' session until the provided promise resolves. The loop from
#' `$get_child_loop()` will only advance just far enough for the promise to
#' resolve.
#'
#' ## Examples
#'
#' ```r
#' b <- ChromoteSession$new()
#'
#' # Async with promise
#' p <- b$Browser$getVersion(wait_ = FALSE)
#' p$then(str)
#'
#' # Async with callback
#' b$Browser$getVersion(wait_ = FALSE, callback_ = str)
#' ```
#'
#' @param p A promise to resolve.
wait_for = function(p) {
self$parent$wait_for(p)
},
#' @description
#' Send a debug log message to the parent [Chromote] object
#'
#' ## Examples
#'
#' ```r
#' b <- ChromoteSession$new()
#' b$parent$debug_messages(TRUE)
#' b$go_to("https://www.r-project.org/")
#' #> SEND {"method":"Page.navigate","params":{"url":"https://www.r-project.org/"}| __truncated__}
#' # Turn off debug messages
#' b$parent$debug_messages(FALSE)
#' ```
#'
#' @param ... Arguments pasted together with `paste0(..., collapse = "")`.
debug_log = function(...) {
self$parent$debug_log(...)
},
#' @description
#' \pkg{later} loop.
#'
#' For expert async usage only.
get_child_loop = function() {
self$parent$get_child_loop()
},
#' @description
#' Send command through Chrome DevTools Protocol.
#'
#' For expert use only.
#' @param msg A JSON-serializable list containing `method`, and `params`.
#' @param callback Method to run when the command finishes successfully.
#' @param error Method to run if an error occurs.
#' @param timeout Number of milliseconds for Chrome DevTools Protocol
#' execute a method.
send_command = function(
msg,
callback = NULL,
error = NULL,
timeout = NULL
) {
self$check_active()
self$parent$send_command(
msg,
callback,
error,
timeout,
sessionId = private$session_id
)
},
#' @description
#' Resolved `auto_events` value.
#'
#' For internal use only.
get_auto_events = function() {
if (!is.null(private$auto_events)) {
private$auto_events
} else {
self$parent$get_auto_events()
}
},
#' @description
#' Set or retrieve the `enable` command arguments for a domain. These
#' arguments are used for the `enable` command that is called for a domain,
#' e.g. `Fetch$enable()`, when accessing an event method.
#'
#' @examples
#' if (interactive()) {
#' b <- ChromoteSession$new(
#' auto_events_enable_args = list(
#' Fetch = list(handleAuthRequests = TRUE)
#' )
#' )
#'
#' # Get current `Fetch.enable` args
#' b$auto_events_enable_args("Fetch")
#'
#' # Update the `Fetch.enable` args
#' b$auto_events_enable_args("Fetch", handleAuthRequests = FALSE)
#'
#' # Reset `Fetch.enable` args
#' b$auto_events_enable_args("Fetch", NULL)
#' }
#'
#' @param domain A command domain, e.g. `"Fetch"`.
#' @param ... Arguments to use for auto-events for the domain. If not
#' provided, returns the argument values currently in place for the
#' domain. Use `NULL` to clear the enable arguments for a domain.
auto_events_enable_args = function(domain, ...) {
dots <- dots_list(..., .named = TRUE)
if (length(dots) == 0) {
return(get_auto_events_enable_args(private, domain, self$parent))
}
set_auto_events_enable_args(self, private, domain, dots)
},
#' @description
#' Immediately call all event callback methods.
#'
#' For internal use only.
#' @param event A single event string
#' @param params A list of parameters to pass to the event callback methods.
invoke_event_callbacks = function(event, params) {
private$event_manager$invoke_event_callbacks(event, params)
},
#' @description Mark a session, and optionally, the underlying target,
#' as closed. For internal use only.
#' @param target_closed Has the underlying target been closed as well as the
#' active debugging session?
mark_closed = function(target_closed) {
private$session_is_active <- FALSE
private$target_is_active <- !target_closed
},
#' @description Retrieve active status
#' Once initialized, the value returned is `TRUE`. If `$close()` has been
#' called, this value will be `FALSE`.
is_active = function() {
private$session_is_active &&
private$target_is_active &&
self$parent$is_active()
},
#' @description Check that a session is active, erroring if not.
check_active = function() {
if (self$is_active()) {
return()
}
if (private$target_is_active) {
abort(
c(
"Session has been closed.",
i = "Call session$respawn() to create a new session that connects to the same target."
)
)
} else {
abort("Session and underlying target have been closed.")
}
},
#' @description Initial promise
#'
#' For internal use only.
get_init_promise = function() {
private$init_promise_
},
#' @description Summarise the current state of the object.
#' @param verbose The print method defaults to a brief summary
#' of the most important debugging info; use `verbose = TRUE` tp
#' see the complex R6 object.
#' @param ... Passed on to `format()` when `verbose` = TRUE
print = function(..., verbose = FALSE) {
if (verbose) {
cat(format(self, ...), sep = "\n")
} else {
if (self$is_active()) {
state <- "session + target active"
} else if (private$target_is_active) {
state <- "target active"
} else {
state <- "closed"
}
cat_line("<ChromoteSession> (", state, ")")
if (self$is_active()) cat_line(" Session ID: ", self$get_session_id())
if (private$target_is_active)
cat_line(" Target ID: ", self$get_target_id())
browser <- self$parent$get_browser()
if (browser$is_local()) {
cat_line(
" Parent PID: ",
self$parent$get_browser()$get_process()$get_pid()
)
} else {
cat_line(
" Remote Host: ",
sprintf("http://%s:%s", browser$get_host(), browser$get_port())
)
}
}
invisible(self)
},
#' @field parent [`Chromote`] object
parent = NULL,
#' @field default_timeout Default timeout in seconds for \pkg{chromote} to
#' wait for a Chrome DevTools Protocol response.
default_timeout = NULL,
#' @field protocol Dynamic protocol implementation. For expert use only!
protocol = NULL
),
private = list(
session_id = NULL,
target_id = NULL,
session_is_active = NULL,
target_is_active = NULL,
event_manager = NULL,
auto_events = NULL,
init_promise_ = NULL,
# Updated when `Emulation.setDeviceMetricsOverride` is called
is_mobile = NULL,
pixel_ratio = NULL,
get_pixel_ratio = function() {
if (!is.null(private$pixel_ratio)) {
promise_resolve(private$pixel_ratio)
} else {
self$Runtime$evaluate("window.devicePixelRatio", wait_ = FALSE)$then(
function(value) {
(private$pixel_ratio <- value$result$value)
}
)
}
},
register_event_listener = function(event, callback = NULL, timeout = NULL) {
self$check_active()
private$event_manager$register_event_listener(event, callback, timeout)
}
)
)
# Wrapper around ChromoteSession$new() that can return a promise
create_session <- function(
chromote = default_chromote_object(),
width = 992,
height = 1323,
targetId = NULL,
wait_ = TRUE,
auto_events = NULL
) {
session <- ChromoteSession$new(
parent = chromote,
width = width,
height = height,
targetId,
auto_events = auto_events,
wait_ = wait_
)
if (wait_) {
session
} else {
# ChromoteSession$new() must return a ChromoteSession object so we need a
# side-channel to return a promise
session$get_init_promise()
}
}
================================================
FILE: R/event_manager.R
================================================
EventManager <- R6Class(
"EventManager",
public = list(
initialize = function(session) {
private$session <- session
if (length(session$protocol) == 0) {
stop("Session object must have non-empty protocol field.")
}
# Find out which domains require the <domain>.enable command to enable
# event notifications.
private$event_enable_domains <- lapply(
session$protocol,
function(domain) {
is.function(domain$enable)
}
)
private$event_callbacks <- fastmap()
},
register_event_listener = function(event, callback = NULL, timeout = NULL) {
domain <- find_domain(event)
# Note: If callback is specified, then timeout is ignored. Also, returns
# a function for deregistering the callback, instead of a promise.
if (!is.null(callback)) {
deregister_callback_fn <- private$add_event_callback(
event,
callback,
once = FALSE
)
return(invisible(deregister_callback_fn))
}
deregister_callback_fn <- NULL
p <- promise(function(resolve, reject) {
deregister_callback_fn <<- private$add_event_callback(
event,
resolve,
once = TRUE
)
})
if (!is.null(timeout) && !is.infinite(timeout)) {
# !!! TODO: Fix loop !!!
p <- promise_timeout(
p,
timeout,
loop = private$session$get_child_loop(),
timeout_message = paste0(
"Chromote: timed out waiting for event ",
event
)
)
}
p <- p$finally(function() {
deregister_callback_fn()
})
p
},
invoke_event_callbacks = function(event, params) {
callbacks <- private$event_callbacks$get(event)
if (is.null(callbacks) || callbacks$size() == 0) return()
callbacks$invoke(params)
},
remove_event_callbacks = function(event) {
# Removes ALL callbacks for a given event. In the future it might be
# useful to implement finer control.
private$event_callbacks$remove(event)
}
),
private = list(
# The ChromoteSession or Chromote object that owns this EventManager.
session = NULL,
event_callbacks = NULL,
# For keeping count of the number of callbacks for each domain; if
# auto_events is TRUE, then when the count goes from 0 to 1 or 1 to 0 for
# a given domain, it will automatically enable or disable events for that
# domain.
event_callback_counts = list(),
# Some domains require a <domain>.event command to enable event
# notifications, others do not. (Not really sure why.)
event_enable_domains = NULL,
add_event_callback = function(event, callback, once) {
if (!private$event_callbacks$has(event)) {
private$event_callbacks$set(event, Callbacks$new())
}
if (once) {
orig_callback <- callback
callback <- function(...) {
tryCatch(
orig_callback(...),
finally = deregister_and_dec()
)
}
}
deregister_callback <- private$event_callbacks$get(event)$add(callback)
domain <- find_domain(event)
private$inc_event_callback_count(domain)
# We'll wrap deregister_callback in another function which also keeps
# count to the number of callbacks for the domain.
deregister_called <- FALSE
deregister_and_dec <- function() {
# Make sure that if this is called multiple times that it doesn't keep
# having effects.
if (deregister_called) return()
deregister_called <<- TRUE
deregister_callback()
private$dec_event_callback_count(domain)
}
deregister_and_dec
},
inc_event_callback_count = function(domain) {
if (is.null(private$event_callback_counts[[domain]])) {
private$event_callback_counts[[domain]] <- 0
}
private$event_callback_counts[[domain]] <-
private$event_callback_counts[[domain]] + 1
private$session$debug_log(
"Callbacks for ",
domain,
"++: ",
private$event_callback_counts[[domain]]
)
# If we're doing auto events and we're going from 0 to 1, enable events
# for this domain. (Some domains do not require or have an .enable
# method.)
if (
private$session$get_auto_events() &&
private$event_callback_counts[[domain]] == 1 &&
isTRUE(private$event_enable_domains[[domain]])
) {
private$session$debug_log("Enabling events for ", domain)
args <- private$session$auto_events_enable_args(domain)
exec(
private$session[[domain]]$enable,
!!!args
)
}
invisible(private$event_callback_counts[[domain]])
},
dec_event_callback_count = function(domain) {
private$event_callback_counts[[domain]] <-
private$event_callback_counts[[domain]] - 1
private$session$debug_log(
"Callbacks for ",
domain,
"--: ",
private$event_callback_counts[[domain]]
)
# If we're doing auto events and we're going from 1 to 0, disable
# enable events for this domain.
if (
private$session$get_auto_events() &&
private$event_callback_counts[[domain]] == 0 &&
isTRUE(private$event_enable_domains[[domain]])
) {
private$session$debug_log("Disabling events for ", domain)
private$session[[domain]]$disable()
}
invisible(private$event_callback_counts[[domain]])
}
)
)
# These functions power `$auto_events_enable_args()` for both `Chromote` and
# `ChromoteSession`.
get_auto_events_enable_args <- function(private, domain, parent = NULL) {
session_args <- private$auto_events_enable_args[[domain]]
if (!is.null(session_args) || is.null(parent)) {
return(session_args)
}
return(parent$auto_events_enable_args(domain))
}
set_auto_events_enable_args <- function(self, private, domain, dots) {
# Set enable args for the domain ----
if (identical(dots, list("NULL" = NULL))) {
# Unset args with `$auto_events_enable_args(domain, NULL)`
dots <- NULL
}
if (!is_function(self[[domain]]$enable)) {
cli::cli_abort(
"{.field {domain}} does not have an {.field enable} method.",
call = parent.frame()
)
}
known_args <- names(fn_fmls(self[[domain]]$enable))
unknown_args <- setdiff(names(dots), known_args)
if (length(unknown_args)) {
cli::cli_abort(
c(
"{.field {domain}.enable} does not have {cli::qty(unknown_args)}argument{?s}: {.arg {unknown_args}}.",
"i" = "Available arguments: {.arg {setdiff(known_args, 'wait_')}}"
),
call = parent.frame()
)
}
if ("wait_" %in% names(dots)) {
cli::cli_warn(
"{.arg wait_} cannot be set for {.field {domain}.enable}, ignoring.",
call = parent.frame()
)
dots[["wait_"]] <- NULL
}
old <- self$auto_events_enable_args(domain)
private$auto_events_enable_args[[domain]] <- dots
invisible(old)
}
================================================
FILE: R/import-standalone-obj-type.R
================================================
# Standalone file: do not edit by hand
# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-obj-type.R>
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-obj-type.R
# last-updated: 2024-02-14
# license: https://unlicense.org
# imports: rlang (>= 1.1.0)
# ---
#
# ## Changelog
#
# 2024-02-14:
# - `obj_type_friendly()` now works for S7 objects.
#
# 2023-05-01:
# - `obj_type_friendly()` now only displays the first class of S3 objects.
#
# 2023-03-30:
# - `stop_input_type()` now handles `I()` input literally in `arg`.
#
# 2022-10-04:
# - `obj_type_friendly(value = TRUE)` now shows numeric scalars
# literally.
# - `stop_friendly_type()` now takes `show_value`, passed to
# `obj_type_friendly()` as the `value` argument.
#
# 2022-10-03:
# - Added `allow_na` and `allow_null` arguments.
# - `NULL` is now backticked.
# - Better friendly type for infinities and `NaN`.
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Prefixed usage of rlang functions with `rlang::`.
#
# 2022-06-22:
# - `friendly_type_of()` is now `obj_type_friendly()`.
# - Added `obj_type_oo()`.
#
# 2021-12-20:
# - Added support for scalar values and empty vectors.
# - Added `stop_input_type()`
#
# 2021-06-30:
# - Added support for missing arguments.
#
# 2021-04-19:
# - Added support for matrices and arrays (#141).
# - Added documentation.
# - Added changelog.
#
# nocov start
#' Return English-friendly type
#' @param x Any R object.
#' @param value Whether to describe the value of `x`. Special values
#' like `NA` or `""` are always described.
#' @param length Whether to mention the length of vectors and lists.
#' @return A string describing the type. Starts with an indefinite
#' article, e.g. "an integer vector".
#' @noRd
obj_type_friendly <- function(x, value = TRUE) {
if (is_missing(x)) {
return("absent")
}
if (is.object(x)) {
if (inherits(x, "quosure")) {
type <- "quosure"
} else {
type <- class(x)[[1L]]
}
return(sprintf("a <%s> object", type))
}
if (!is_vector(x)) {
return(.rlang_as_friendly_type(typeof(x)))
}
n_dim <- length(dim(x))
if (!n_dim) {
if (!is_list(x) && length(x) == 1) {
if (is_na(x)) {
return(switch(
typeof(x),
logical = "`NA`",
integer = "an integer `NA`",
double =
if (is.nan(x)) {
"`NaN`"
} else {
"a numeric `NA`"
},
complex = "a complex `NA`",
character = "a character `NA`",
.rlang_stop_unexpected_typeof(x)
))
}
show_infinites <- function(x) {
if (x > 0) {
"`Inf`"
} else {
"`-Inf`"
}
}
str_encode <- function(x, width = 30, ...) {
if (nchar(x) > width) {
x <- substr(x, 1, width - 3)
x <- paste0(x, "...")
}
encodeString(x, ...)
}
if (value) {
if (is.numeric(x) && is.infinite(x)) {
return(show_infinites(x))
}
if (is.numeric(x) || is.complex(x)) {
number <- as.character(round(x, 2))
what <- if (is.complex(x)) "the complex number" else "the number"
return(paste(what, number))
}
return(switch(
typeof(x),
logical = if (x) "`TRUE`" else "`FALSE`",
character = {
what <- if (nzchar(x)) "the string" else "the empty string"
paste(what, str_encode(x, quote = "\""))
},
raw = paste("the raw value", as.character(x)),
.rlang_stop_unexpected_typeof(x)
))
}
return(switch(
typeof(x),
logical = "a logical value",
integer = "an integer",
double = if (is.infinite(x)) show_infinites(x) else "a number",
complex = "a complex number",
character = if (nzchar(x)) "a string" else "\"\"",
raw = "a raw value",
.rlang_stop_unexpected_typeof(x)
))
}
if (length(x) == 0) {
return(switch(
typeof(x),
logical = "an empty logical vector",
integer = "an empty integer vector",
double = "an empty numeric vector",
complex = "an empty complex vector",
character = "an empty character vector",
raw = "an empty raw vector",
list = "an empty list",
.rlang_stop_unexpected_typeof(x)
))
}
}
vec_type_friendly(x)
}
vec_type_friendly <- function(x, length = FALSE) {
if (!is_vector(x)) {
abort("`x` must be a vector.")
}
type <- typeof(x)
n_dim <- length(dim(x))
add_length <- function(type) {
if (length && !n_dim) {
paste0(type, sprintf(" of length %s", length(x)))
} else {
type
}
}
if (type == "list") {
if (n_dim < 2) {
return(add_length("a list"))
} else if (is.data.frame(x)) {
return("a data frame")
} else if (n_dim == 2) {
return("a list matrix")
} else {
return("a list array")
}
}
type <- switch(
type,
logical = "a logical %s",
integer = "an integer %s",
numeric = ,
double = "a double %s",
complex = "a complex %s",
character = "a character %s",
raw = "a raw %s",
type = paste0("a ", type, " %s")
)
if (n_dim < 2) {
kind <- "vector"
} else if (n_dim == 2) {
kind <- "matrix"
} else {
kind <- "array"
}
out <- sprintf(type, kind)
if (n_dim >= 2) {
out
} else {
add_length(out)
}
}
.rlang_as_friendly_type <- function(type) {
switch(
type,
list = "a list",
NULL = "`NULL`",
environment = "an environment",
externalptr = "a pointer",
weakref = "a weak reference",
S4 = "an S4 object",
name = ,
symbol = "a symbol",
language = "a call",
pairlist = "a pairlist node",
expression = "an expression vector",
char = "an internal string",
promise = "an internal promise",
... = "an internal dots object",
any = "an internal `any` object",
bytecode = "an internal bytecode object",
primitive = ,
builtin = ,
special = "a primitive function",
closure = "a function",
type
)
}
.rlang_stop_unexpected_typeof <- function(x, call = caller_env()) {
abort(
sprintf("Unexpected type <%s>.", typeof(x)),
call = call
)
}
#' Return OO type
#' @param x Any R object.
#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`,
#' `"R6"`, or `"S7"`.
#' @noRd
obj_type_oo <- function(x) {
if (!is.object(x)) {
return("bare")
}
class <- inherits(x, c("R6", "S7_object"), which = TRUE)
if (class[[1]]) {
"R6"
} else if (class[[2]]) {
"S7"
} else if (isS4(x)) {
"S4"
} else {
"S3"
}
}
#' @param x The object type which does not conform to `what`. Its
#' `obj_type_friendly()` is taken and mentioned in the error message.
#' @param what The friendly expected type as a string. Can be a
#' character vector of expected types, in which case the error
#' message mentions all of them in an "or" enumeration.
#' @param show_value Passed to `value` argument of `obj_type_friendly()`.
#' @param ... Arguments passed to [abort()].
#' @inheritParams args_error_context
#' @noRd
stop_input_type <- function(x,
what,
...,
allow_na = FALSE,
allow_null = FALSE,
show_value = TRUE,
arg = caller_arg(x),
call = caller_env()) {
# From standalone-cli.R
cli <- env_get_list(
nms = c("format_arg", "format_code"),
last = topenv(),
default = function(x) sprintf("`%s`", x),
inherit = TRUE
)
if (allow_na) {
what <- c(what, cli$format_code("NA"))
}
if (allow_null) {
what <- c(what, cli$format_code("NULL"))
}
if (length(what)) {
what <- oxford_comma(what)
}
if (inherits(arg, "AsIs")) {
format_arg <- identity
} else {
format_arg <- cli$format_arg
}
message <- sprintf(
"%s must be %s, not %s.",
format_arg(arg),
what,
obj_type_friendly(x, value = show_value)
)
abort(message, ..., call = call, arg = arg)
}
oxford_comma <- function(chr, sep = ", ", final = "or") {
n <- length(chr)
if (n < 2) {
return(chr)
}
head <- chr[seq_len(n - 1)]
last <- chr[n]
head <- paste(head, collapse = sep)
# Write a or b. But a, b, or c.
if (n > 2) {
paste0(head, sep, final, " ", last)
} else {
paste0(head, " ", final, " ", last)
}
}
# nocov end
================================================
FILE: R/import-standalone-types-check.R
================================================
# Standalone file: do not edit by hand
# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-types-check.R>
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-types-check.R
# last-updated: 2023-03-13
# license: https://unlicense.org
# dependencies: standalone-obj-type.R
# imports: rlang (>= 1.1.0)
# ---
#
# ## Changelog
#
# 2024-08-15:
# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724)
#
# 2023-03-13:
# - Improved error messages of number checkers (@teunbrand)
# - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich).
# - Added `check_data_frame()` (@mgirlich).
#
# 2023-03-07:
# - Added dependency on rlang (>= 1.1.0).
#
# 2023-02-15:
# - Added `check_logical()`.
#
# - `check_bool()`, `check_number_whole()`, and
# `check_number_decimal()` are now implemented in C.
#
# - For efficiency, `check_number_whole()` and
# `check_number_decimal()` now take a `NULL` default for `min` and
# `max`. This makes it possible to bypass unnecessary type-checking
# and comparisons in the default case of no bounds checks.
#
# 2022-10-07:
# - `check_number_whole()` and `_decimal()` no longer treat
# non-numeric types such as factors or dates as numbers. Numeric
# types are detected with `is.numeric()`.
#
# 2022-10-04:
# - Added `check_name()` that forbids the empty string.
# `check_string()` allows the empty string by default.
#
# 2022-09-28:
# - Removed `what` arguments.
# - Added `allow_na` and `allow_null` arguments.
# - Added `allow_decimal` and `allow_infinite` arguments.
# - Improved errors with absent arguments.
#
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Added changelog.
#
# nocov start
# Scalars -----------------------------------------------------------------
.standalone_types_check_dot_call <- .Call
check_bool <- function(x,
...,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) {
return(invisible(NULL))
}
stop_input_type(
x,
c("`TRUE`", "`FALSE`"),
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_string <- function(x,
...,
allow_empty = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = allow_empty,
allow_na = allow_na,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a single string",
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.rlang_check_is_string <- function(x,
allow_empty,
allow_na,
allow_null) {
if (is_string(x)) {
if (allow_empty || !is_string(x, "")) {
return(TRUE)
}
}
if (allow_null && is_null(x)) {
return(TRUE)
}
if (allow_na && (identical(x, NA) || identical(x, na_chr))) {
return(TRUE)
}
FALSE
}
check_name <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = FALSE,
allow_na = FALSE,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a valid name",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
IS_NUMBER_true <- 0
IS_NUMBER_false <- 1
IS_NUMBER_oob <- 2
check_number_decimal <- function(x,
...,
min = NULL,
max = NULL,
allow_infinite = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (missing(x)) {
exit_code <- IS_NUMBER_false
} else if (0 == (exit_code <- .standalone_types_check_dot_call(
ffi_standalone_check_number_1.0.7,
x,
allow_decimal = TRUE,
min,
max,
allow_infinite,
allow_na,
allow_null
))) {
return(invisible(NULL))
}
.stop_not_number(
x,
...,
exit_code = exit_code,
allow_decimal = TRUE,
min = min,
max = max,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_number_whole <- function(x,
...,
min = NULL,
max = NULL,
allow_infinite = FALSE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (missing(x)) {
exit_code <- IS_NUMBER_false
} else if (0 == (exit_code <- .standalone_types_check_dot_call(
ffi_standalone_check_number_1.0.7,
x,
allow_decimal = FALSE,
min,
max,
allow_infinite,
allow_na,
allow_null
))) {
return(invisible(NULL))
}
.stop_not_number(
x,
...,
exit_code = exit_code,
allow_decimal = FALSE,
min = min,
max = max,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.stop_not_number <- function(x,
...,
exit_code,
allow_decimal,
min,
max,
allow_na,
allow_null,
arg,
call) {
if (allow_decimal) {
what <- "a number"
} else {
what <- "a whole number"
}
if (exit_code == IS_NUMBER_oob) {
min <- min %||% -Inf
max <- max %||% Inf
if (min > -Inf && max < Inf) {
what <- sprintf("%s between %s and %s", what, min, max)
} else if (x < min) {
what <- sprintf("%s larger than or equal to %s", what, min)
} else if (x > max) {
what <- sprintf("%s smaller than or equal to %s", what, max)
} else {
abort("Unexpected state in OOB check", .internal = TRUE)
}
}
stop_input_type(
x,
what,
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_symbol <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a symbol",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_arg <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an argument name",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_call <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_call(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a defused call",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_environment <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_environment(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an environment",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_function <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_function(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a function",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_closure <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_closure(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an R function",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_formula <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_formula(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a formula",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
# Vectors -----------------------------------------------------------------
# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE`
check_character <- function(x,
...,
allow_na = TRUE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_character(x)) {
if (!allow_na && any(is.na(x))) {
abort(
sprintf("`%s` can't contain NA values.", arg),
arg = arg,
call = call
)
}
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a character vector",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_logical <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_logical(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a logical vector",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_data_frame <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is.data.frame(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a data frame",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
# nocov end
================================================
FILE: R/manage.R
================================================
#' Use a specific version of Chrome or related binaries
#'
#' @description
#' `r lifecycle_badge("experimental")`
#'
#' This function downloads and sets up a specific version of Chrome, using the
#' [Google Chrome for Testing builds](https://googlechromelabs.github.io/chrome-for-testing/)
#' for `chrome`, `chrome-headless-shell` or `chromedriver` for use with
#' chromote.
#'
#' Managed Chrome installations is an experimental feature introduced in
#' chromote v0.5.0 and was inspired by similar features in
#' [playwright](https://playwright.dev/).
#'
#' @examplesIf rlang::is_interactive()
#' # Use the latest version of Chrome
#' local_chrome_version()
#'
#' # Use a specific version of chrome-headless-shell
#' local_chrome_version("114.0.5735.90", binary = "chrome-headless-shell")
#'
#' @details This function downloads the specified binary, if not already
#' available and configures [find_chrome()] to use the specified binary while
#' evaluating `code` or within the local scope. It uses the
#' "known-good-versions" list from the Google Chrome for Testing versions at
#' <https://googlechromelabs.github.io/chrome-for-testing/>.
#'
#' @param version A character string specifying the version to use. The default
#' value is `"latest-stable"` to follow the latest stable release of Chrome.
#' For robust results, and to avoid frequently downloading new versions of
#' Chrome, use a fully qualified version number, e.g. `"133.0.6943.141"`.
#'
#' If you specify a partial version, e.g. `"133"`, chromote will find the most
#' recent release matching that version, preferring to use the latest
#' *installed* release that matches the partially-specified version. chromote
#' also supports a few special version names:
#'
#' * `"latest-installed"`: The latest version currently installed locally in
#' chromote's cache. If you don't have any installed versions of the binary,
#' chromote uses `"latest"`.
#' * `"latest"`: The most recent Chrome for Testing release, which may be a
#' beta or canary release.
#' * `"latest-stable"`, `"latest-beta"`, `"latest-extended"`,
#' `"latest-canary"` or `"latest-dev"`: Installs the latest release from one
#' of Chrome's version channels, queried from the
#' [VersionHistory API](https://developer.chrome.com/docs/web-platform/versionhistory/reference#platform-identifiers).
#' `"latest-stable"` is the default value of `with_chrome_version()` and
#' `local_chrome_version()`.
#' * `"system"`: Use the system-wide installation of Chrome.
#'
#' Chromote also supports
#' @param binary A character string specifying which binary to
#' use. Must be one of `"chrome"`, `"chrome-headless-shell"`, or
#' `"chromedriver"`. Default is `"chrome"`.
#' @param platform A character string specifying the platform. If `NULL`
#' (default), the platform will be automatically detected.
#' @param quiet Whether to print a message indicating which version and binary
#' of Chrome is being used. By default, this message is suppressed for
#' [with_chrome_version()] and enabled for [local_chrome_version()].
#' @inheritParams withr::local_envvar
#' @param ... Ignored, used to require named arguments and for future feature
#' expansion.
#'
#' @return Temporarily sets the `CHROMOTE_CHROME` environment variable and
#' returns the result of the `code` argument.
#'
#' @describeIn with_chrome_version Temporarily use a specific version of Chrome
#' during the evaluation of `code`.
#' @export
with_chrome_version <- function(
version = "latest-stable",
code,
...,
binary = c("chrome", "chrome-headless-shell", "chromedriver"),
platform = NULL,
quiet = TRUE
) {
rlang::check_dots_empty()
local_chrome_version(
version = version,
binary = binary,
platform = platform,
quiet = quiet
)
force(code)
}
#' @describeIn with_chrome_version Use a specific version of Chrome within the
#' current scope.
#' @export
local_chrome_version <- function(
version = "latest-stable",
binary = c("chrome", "chrome-headless-shell", "chromedriver"),
platform = NULL,
...,
quiet = FALSE,
.local_envir = parent.frame()
) {
rlang::check_dots_empty()
if (identical(version, "system")) {
if (!quiet)
cli::cli_inform(
"chromote will now use {.strong the system-wide installation} of Chrome."
)
return(local_chromote_chrome("", .local_envir = .local_envir))
}
binary <- check_binary(binary)
resolved <- chrome_versions_ensure(
version = version,
binary = binary,
platform = platform
)
if (!quiet && !identical(version, resolved$version)) {
cli::cli_inform(
"chromote will now use version {.field {resolved$version}} of {.code {resolved$binary}} for {resolved$platform}."
)
}
local_chromote_chrome(resolved$path, .local_envir = .local_envir)
}
#' @param path A direct path to the Chrome (or Chrome-based) binary. See
#' [find_chrome()] for details or [chrome_versions_path()] for paths
#' from the chromote-managed cache.
#' @describeIn with_chrome_version Use a specific Chrome, by path, within the
#' current scope.
#' @export
local_chromote_chrome <- function(path, ..., .local_envir = parent.frame()) {
rlang::check_dots_empty()
old_default_chromote_object <-
if (has_default_chromote_object()) default_chromote_object() else NULL
withr::defer(
{
if (has_default_chromote_object()) {
current <- default_chromote_object()
current$close()
}
if (is.null(old_default_chromote_object)) {
globals$default_chromote <- NULL
} else if (old_default_chromote_object$is_alive()) {
set_default_chromote_object(old_default_chromote_object)
} else {
globals$default_chromote <- NULL
}
},
envir = .local_envir
)
# We always create a *new* Chromote process within `local_chromote_chrome()`
# that we completely clean up when the exit handlers run. We do this by
# unsetting the current chromote default so that next ChromoteSession uses a
# new Chromote obj, side-stepping `set_default_chromote_object()` because that
# requires a chromote obj that we don't want to create yet.
globals$default_chromote <- NULL
withr::local_envvar(
list(CHROMOTE_CHROME = path),
.local_envir = .local_envir,
action = "replace"
)
}
#' @describeIn with_chrome_version Temporarily use a specific Chrome version, by
#' path, for the evaluation of `code`.
#' @export
with_chromote_chrome <- function(path, code, ...) {
rlang::check_dots_empty()
local_chromote_chrome(path)
force(code)
}
.chrome_versions <- new.env(parent = emptyenv())
chrome_get_versions <- function(update_cached = TRUE) {
path_json <- download_json_cached(
"https://googlechromelabs.github.io/chrome-for-testing/known-good-versions-with-downloads.json",
update_cached = update_cached
)
if (exists(path_json, envir = .chrome_versions)) {
return(get(path_json, envir = .chrome_versions))
}
path_rds <- sub("\\.json$", ".rds", path_json)
if (file.exists(path_rds)) {
# Parsing the chrome versions into a tidy data frame takes a little bit, so
# if we've already done the parsing we store the data as RDS. If the cached
# object is out-of-date, we re-parse and save the data.
if (file.info(path_rds)$mtime == file.info(path_json)$mtime) {
return(readRDS(path_rds))
}
}
res <- jsonlite::fromJSON(path_json, simplifyDataFrame = FALSE)
res <- res$versions
res <- lapply(res, function(v) {
version <- data.frame(version = v$version, revision = v$revision)
all_versions <- data.frame()
for (binary_type in names(v$downloads)) {
binary <- do.call(
rbind,
lapply(v$downloads[[binary_type]], as.data.frame)
)
binary <- cbind(data.frame(binary = binary_type), binary)
binary <- cbind(version, binary)
all_versions <- rbind(all_versions, binary)
}
all_versions
})
res <- do.call(rbind, res)
class(res) <- c("tbl_df", "tbl", "data.frame")
assign(path_json, res, envir = .chrome_versions)
saveRDS(res, path_rds)
Sys.setFileTime(path_rds, file.info(path_json)$mtime)
res
}
#' List installed or available Chrome binary versions
#'
#' @description
#' `r lifecycle_badge("experimental")`
#'
#' By default lists the installed Chrome versions in the [chrome_versions_path_cache()],
#' or list all Chrome versions available via Google's
#' [Chrome for Testing](https://googlechromelabs.github.io/chrome-for-testing/)
#' service.
#'
#' Managed Chrome installations is an experimental feature introduced in
#' chromote v0.5.0 and was inspired by similar features in
#' [playwright](https://playwright.dev/).
#'
#' @examplesIf rlang::is_interactive()
#' chrome_versions_list()
#'
#' @param which Whether to list `"installed"` local binaries or to list `"all"`
#' chrome versions available from online sources.
#' @param binary A character string specifying which binary to list. Defaults to
#' `"all"` to show all binaries, or can be one or more of of `"chrome"`,
#' `"chrome-headless-shell"`, or `"chromedriver"`.
#' @param platform A character string specifying the platform(s) to list. If
#' `NULL` (default), the platform will be automatically detected, or if
#' `"all"`, then binaries for all platforms will be listed.
#'
#' @returns Returns a [data.frame()] of Chrome for Testing versions with
#' columns: `version`, `revision`, `binary`, `platform`, `url` (where the
#' binary can be downloaded), and--if `which = "installed"`--the local path to
#' the binary in the [chrome_versions_path_cache()].
#'
#' @export
chrome_versions_list <- function(
which = c("installed", "all"),
binary = c("all", "chrome", "chrome-headless-shell", "chromedriver"),
platform = NULL
) {
which <- rlang::arg_match(which)
binary <- check_binary(binary, multiple = TRUE, allow_all = TRUE)
platform <- check_platform(platform, multiple = TRUE, allow_all = TRUE)
versions <- chrome_get_versions(update_cached = which == "all")
versions <- versions[versions$binary %in% binary, ]
versions <- versions[versions$platform %in% platform, ]
versions <- versions[
order(numeric_version(versions$version), decreasing = TRUE),
]
if (which == "all") {
return(versions)
}
installed <- dir(chrome_versions_path_cache(), include.dirs = TRUE)
installed <- intersect(installed, unique(versions$version))
versions <- versions[versions$version %in% installed, ]
versions$path <- chrome_versions_path_cache(
versions$version,
Map(
chrome_relative_exe,
binary = versions$binary,
platform = versions$platform
)
)
versions[file.exists(versions$path), ]
}
#' Chrome versions cache helpers
#'
#' @description
#' `r lifecycle_badge("experimental")`
#'
#' These functions help interact with the cache used by \pkg{chromote}'s for
#' storing versioned Chrome for Testing binaries:
#'
#' * `chrome_versions_path()`: Returns a path or paths to specific Chrome
#' binaries in the cache.
#' * `chrome_versions_add()`: Add a specific version to the Chrome versions
#' cache.
#' * `chrome_versions_remove()`: Remove specific versions and binaries from the
#' Chrome cache. The `version`, `binary` and `platform` arguments can each
#' take `"all"` to remove all installed copies of that version, binary or
#' platform.
#' * `chrome_versions_path_cache()`: Returns the path to the cache directory
#' used for Chrome binaries.
#'
#' Managed Chrome installations is an experimental feature introduced in
#' chromote v0.5.0 and was inspired by similar features in
#' [playwright](https://playwright.dev/).
#'
#' @seealso [chrome_versions_list()]
#'
#' @param ... Additional path parts.
#' @param version A character string specifying the version to list, add or
#' remove.
#' @inheritParams chrome_versions_list
#' @inheritParams with_chrome_version
#'
#' @return A character vector of Chrome binary paths.
#' @name chrome_versions
NULL
#' @rdname chrome_versions
#' @export
chrome_versions_path_cache <- function(...) {
chromote_cache_path("chrome", ...)
}
# Not exported
chromote_cache_path <- function(...) {
cache_base <- normalizePath(
tools::R_user_dir("chromote", which = "cache"),
mustWork = FALSE,
winslash = "/"
)
file.path(cache_base, ...)
}
#' @rdname chrome_versions
#' @export
chrome_versions_path <- function(
version = "latest",
binary = "chrome",
platform = NULL
) {
platform <- check_platform(platform)
binary <- check_binary(binary)
versions <- chrome_versions_list(
which = "installed",
binary = binary,
platform = platform
)
version_og <- version
version <- match_version(version, versions$version)
if (is.null(version)) {
cli::cli_abort(
c(
"Version {.field {version_og}} of {.code {binary}} for {platform} is not installed.",
"i" = 'Use {.run chromote::chrome_versions_add("{version_og}", "{binary}", "{platform}")} to install, or {.run chromote::chrome_versions_list()} to list locally cached versions.'
)
)
}
versions[versions$version == version, ]$path
}
#' @rdname chrome_versions
#' @export
chrome_versions_add <- function(version, binary, platform = NULL) {
res <- chrome_versions_ensure(version, binary, platform)
res[["path"]]
}
#' @param ask Whether to ask before removing files.
#'
#' @rdname chrome_versions
#' @export
chrome_versions_remove <- function(
version,
binary,
platform = NULL,
ask = TRUE
) {
force(version)
binary <- check_binary(binary, multiple = TRUE, allow_all = TRUE)
platform <- check_platform(platform, multiple = TRUE, allow_all = TRUE)
if (grepl("latest|system", version)) {
cli::cli_abort(c(
"{.fn chrome_versions_remove} does not support deleting versions by keyword.",
"i" = "Please use {.run chromote::chrome_versions_list()} to list installed versions."
))
}
versions <- chrome_versions_list(
"installed",
binary = binary,
platform = platform
)
version <-
if (identical(version, "all")) {
versions$version
} else {
match_version(version, available_versions = versions$version)
}
# versions is already filtered by binary + platform
to_delete <- versions[versions$version %in% version, ]
dirs_delete <- chrome_versions_path_cache(
to_delete$version,
paste0(to_delete$binary, "-", to_delete$platform)
)
if (length(dirs_delete) == 0) {
cli::cli_inform("No cached binaries to remove.")
return(invisible())
}
if (!identical(ask, FALSE)) {
cli::cli_inform(
"Will remove {length(dirs_delete)} cached version{?s} of chrome:"
)
cli::cli_bullets(sprintf("{.path %s}", dirs_delete))
cli::cli_inform("Delete from cache?")
do_delete <- utils::menu(gettext(c("Yes", "No", "Cancel")))
if (do_delete != 1L) {
cli::cli_inform("Canceled.")
return(invisible(dirs_delete))
}
}
for (path_dir in dirs_delete) {
path_parent <- dirname(path_dir)
if (identical(dir(path_parent, full.names = TRUE), path_dir)) {
# This version contains only the binary being removed...
unlink(path_parent, recursive = TRUE)
} else {
unlink(path_dir, recursive = TRUE)
}
}
invisible(dirs_delete)
}
chrome_versions_ensure <- function(
version = "latest",
binary = "chrome",
platform = NULL,
prefer_installed = TRUE
) {
platform <- check_platform(platform)
binary <- check_binary(binary)
if (length(version) != 1) {
cli::cli_abort(
"`version` must be a single string or integer value, not {.val {version}}."
)
}
requested_latest_installed <- identical(version, "latest-installed")
if (requested_latest_installed) {
prefer_installed <- TRUE
version <- "latest"
} else if (identical(version, "latest")) {
prefer_installed <- FALSE
} else if (grepl("^latest-", version)) {
version <- chrome_resolve_latest_channel(version, platform)
prefer_installed <- TRUE
}
versions <- if (prefer_installed) {
chrome_versions_list("installed", binary = binary, platform = platform)
} else {
chrome_versions_list("all", binary = binary, platform = platform)
}
versions <- versions[
versions$binary == binary & versions$platform == platform,
]
version_og <- version
version <- match_version(version, available_versions = versions$version)
if (is.null(version)) {
if (prefer_installed) {
return(
chrome_versions_ensure(
if (requested_latest_installed) "latest-stable" else version_og,
binary = binary,
platform = platform,
prefer_installed = FALSE
)
)
}
cli::cli_abort(
c(
"Version {.field {version_og}} is not a known {.code {binary}} version.",
"i" = "Use {.run [chrome_versions_list()](chromote::chrome_versions_list())} to show all available versions."
)
)
}
url <- versions[versions$version == version, ]$url
stopifnot(length(url) == 1)
cache_path <- chrome_versions_path_cache(version)
binary_path <- file.path(cache_path, chrome_relative_exe(binary, platform))
resolved <- list(
path = binary_path,
version = version,
binary = binary,
platform = platform
)
if (file.exists(binary_path)) {
return(resolved)
}
old <- options(timeout = max(300, getOption("timeout")))
on.exit(options(old), add = TRUE)
cli::cli_progress_step(
"Downloading {.code {binary}} version {.field {version}} for {platform}"
)
dir.create(cache_path, recursive = TRUE, showWarnings = FALSE)
zip_path <- chrome_versions_path_cache("chrome.zip")
withr::with_options(list(timeout = max(20 * 60, getOption("timeout"))), {
utils::download.file(url, zip_path, mode = "wb")
})
zip::unzip(zip_path, exdir = cache_path)
cli::cli_progress_done()
if (!file.exists(binary_path)) {
cli::cli_abort(
c(
"The Chrome binary was not found at the expected path.",
"x" = "Expected {.path {binary_path}}",
"i" = "The downloaded zip was not deleted: {.path {zip_path}}",
"i" = "If the problem persists, please report this issue to {.href [rstudio/chromote](https://github.com/rstudio/chromote/issues/new)}."
)
)
}
if (!ensure_user_exec(binary_path)) {
cli::cli_abort(
c(
"Extracted {.code {binary}} binary does not have execution permissions.",
"i" = "You may need to manually adjust the permissions of {.path {binary_path}}."
)
)
}
if (binary == "chrome" && platform %in% c("win32", "win64")) {
chrome_install_windows_run_setup(binary_path)
}
unlink(zip_path)
resolved
}
chrome_relative_exe <- function(binary, platform) {
check_binary(binary)
switch(
binary,
chrome = chrome_relative_exe_chrome(platform),
chromedriver = chrome_relative_exe_chromedriver(platform),
"chrome-headless-shell" = chrome_relative_exe_chrome_headless_shell(
platform
)
)
}
chrome_relative_exe_chrome_headless_shell <- function(platform) {
# chrome-headless-shell: https://github.com/puppeteer/puppeteer/blob/main/packages/browsers/src/browser-data/chrome-headless-shell.ts
check_platform(platform)
dir_binary <- paste0("chrome-headless-shell-", platform)
switch(
platform,
"mac-x64" = ,
"mac-arm64" = ,
linux64 = file.path(dir_binary, "chrome-headless-shell"),
win64 = ,
win32 = file.path(dir_binary, "chrome-headless-shell.exe")
)
}
chrome_relative_exe_chrome <- function(platform) {
# chrome: https://github.com/puppeteer/puppeteer/blob/main/packages/browsers/src/browser-data/chrome.ts
check_platform(platform)
dir_binary <- paste0("chrome-", platform)
switch(
platform,
"mac-x64" = ,
"mac-arm64" = {
file.path(
dir_binary,
"Google Chrome for Testing.app",
"Contents",
"MacOS",
"Google Chrome for Testing"
)
},
linux64 = file.path(dir_binary, "chrome"),
win32 = ,
win64 = file.path(dir_binary, "chrome.exe")
)
}
chrome_relative_exe_chromedriver <- function(platform) {
# chromedriver: https://github.com/puppeteer/puppeteer/blob/main/packages/browsers/src/browser-data/chromedriver.ts
check_platform(platform)
dir_binary <- paste0("chromedriver-", platform)
switch(
platform,
"mac-x64" = ,
"mac-arm64" = ,
linux64 = file.path(dir_binary, "chromedriver"),
win32 = ,
win64 = file.path(dir_binary, "chromedriver.exe")
)
}
chrome_platforms <- c("mac-arm64", "mac-x64", "linux64", "win32", "win64")
chrome_binaries <- c("chrome", "chrome-headless-shell", "chromedriver")
check_platform <- function(
platform = NULL,
multiple = FALSE,
allow_all = FALSE
) {
if (is.null(platform)) {
return(guess_platform())
}
if (allow_all && "all" %in% platform) {
return(chrome_platforms)
}
rlang::arg_match(platform, chrome_platforms, multiple = multiple)
}
guess_platform <- function() {
os <- Sys.info()["sysname"]
arch <- Sys.info()["machine"]
is_arch_x86_64 <- grepl("^x86[_-]64$", arch)
if (os == "Linux" && is_arch_x86_64) {
return("linux64")
} else if (os == "Darwin") {
if (arch == "arm64") {
return("mac-arm64")
} else if (is_arch_x86_64) {
return("mac-x64")
}
} else if (os == "Windows") {
if (is_arch_x86_64) {
return("win64")
} else if (arch == "x86") {
return("win32")
}
}
cli::cli_abort(
"Chrome is not available for {.val {os}} (OS) and {.val {arch}} (arch)."
)
}
check_binary <- function(binary, multiple = FALSE, allow_all = FALSE) {
if (allow_all && "all" %in% binary) {
return(chrome_binaries)
}
rlang::arg_match(binary, chrome_binaries, multiple = multiple)
}
match_version <- function(version, available_versions = NULL) {
stopifnot(length(version) == 1)
if (!is.character(version)) {
if (as.integer(version) != version) {
rlang::abort(
"`version` must be an character version number or an integer."
)
}
version <- as.character(version)
}
if (length(available_versions) == 0) {
return(NULL)
}
if (is.null(available_versions)) {
available_versions <- unique(chrome_get_versions()$version)
}
if (identical(version, "latest")) {
return(max(numeric_version(available_versions)))
}
available_versions <- numeric_version(unique(available_versions))
version_parts <- unclass(numeric_version(version))[[1]]
max_version <- rep(99999, 4)
max_version[seq_along(version_parts)] <- version_parts
max_version <- numeric_version(paste(max_version, collapse = "."))
min_version <- rep(0, 4)
min_version[seq_along(version_parts)] <- version_parts
min_version <- numeric_version(paste(min_version, collapse = "."))
available_versions <- available_versions[
available_versions <= max_version &
available_versions >= min_version
]
if (length(available_versions) == 0) {
return(NULL)
}
max(available_versions)
}
curl_fetch_headers <- function(url) {
h <- curl::new_handle()
curl::handle_setopt(h, nobody = TRUE)
req <- curl::curl_fetch_memory(url, handle = h)
req_parse_headers(req)
}
req_parse_headers <- function(req) {
headers <- rawToChar(req$headers)
parsed_headers <- strsplit(headers, "\r\n")[[1]]
parsed_headers <- parsed_headers[parsed_headers != ""]
parsed_headers <- strsplit(parsed_headers, ": ")
parsed_headers <- rlang::set_names(
lapply(parsed_headers, `[`, 2),
sapply(parsed_headers, `[`, 1)
)
parsed_headers
}
req_headers_last_modified <- function(headers) {
names(headers) <- tolower(names(headers))
if (!"last-modified" %in% names(headers)) {
return(NULL)
}
withr::with_locale(new = c("LC_TIME" = "C"), {
last_modified <- as.POSIXct(
headers[["last-modified"]],
format = "%a, %d %b %Y %H:%M:%S GMT",
tz = "GMT"
)
last_modified
})
}
chrome_resolve_latest_channel <- function(
channel,
platform = guess_platform()
) {
channel <- sub("latest-", "", channel)
path_json <- download_json_cached(
chrome_version_history_url(channel, platform),
filename = sprintf("chrome-version-history_%s_%s.json", platform, channel)
)
res <- jsonlite::fromJSON(path_json)$versions
testing_versions <- chrome_versions_list("all", "chrome", platform)
available_versions <- intersect(res$version, testing_versions$version)
as.character(match_version("latest", available_versions))
}
chrome_version_history_url <- function(
channel = c("stable", "beta", "extended", "dev", "canary"),
platform = guess_platform()
) {
channel <- rlang::arg_match(channel)
platform <- check_platform(platform)
platform <- switch(
platform,
win32 = "win",
win64 = "win64",
"mac-x64" = "mac",
"mac-arm64" = "mac_arm64",
"linux64" = "linux"
)
sprintf(
"https://versionhistory.googleapis.com/v1/chrome/platforms/%s/channels/%s/versions",
platform,
channel
)
}
download_json_cached <- function(url, update_cached = TRUE, filename = NULL) {
path_cache <- chromote_cache_path()
dir.create(path_cache, showWarnings = FALSE, recursive = TRUE)
path_local <- file.path(path_cache, filename %||% basename(url))
# Check if local file exists and get its modified time
if (file.exists(path_local)) {
if (!update_cached) {
return(path_local)
}
local_mtime <- file.info(path_local)$mtime
is_local_stale <- tryCatch(
{
# Fetch headers from the server
headers <- curl_fetch_headers(url)
server_last_modified <- req_headers_last_modified(headers)
if (!is.null(server_last_modified)) {
length(server_last_modified) == 1 &&
local_mtime < server_last_modified
} else {
# otherwise cache for 8 hours
(local_mtime + 60 * 60 * 8) < Sys.time()
}
},
error = function(err) {
rlang::inform(
"Could not reach Chrome for Testing to update available versions.",
parent = err
)
FALSE
}
)
# Compare local file time with server's last-modified
if (!is_local_stale) {
# message("Source URL not modified, using cached version")
return(path_local)
}
}
req <- curl::curl_fetch_memory(url)
if (!req$status_code == 200) {
cli::cli_abort(
"Could not download {.url {url}}. Status code: {.field {req$status_code}}",
status = req$status_code,
request = req
)
}
# message("Source URL was updated, downloading new content")
json_content <- rawToChar(req$content)
writeLines(json_content, path_local)
# Set the local file's modified time to the last-modified
last_modified <- req_headers_last_modified(req_parse_headers(req))
if (!is.null(last_modified)) {
Sys.setFileTime(path_local, last_modified)
}
path_local
}
ensure_user_exec <- function(path) {
current_mode <- file.info(path)$mode
user_perm <- as.numeric(as.character(current_mode))
# If user permissions is even, the file is not executable
!((user_perm %/% 100) %% 2 == 0)
}
chrome_install_windows_run_setup <- function(path) {
path_setup <- file.path(dirname(path), "setup.exe")
if (!file.exists(path_setup)) {
return()
}
tryCatch(
{
processx::run(
path_setup,
args = sprintf("--configure-browser-in-directory=%s", dirname(path))
)
},
error = function(err) {
cli::cli_warn(
"Running Chrome's {.field setup.exe} failed, which may not mean anything or it may mean that you need to manually resolve permissions errors.",
parent = err
)
return()
}
)
}
================================================
FILE: R/promises.R
================================================
#' @importFrom promises %...>%
#' @export
promises::"%...>%"
#' @importFrom promises %...!%
#' @export
promises::"%...!%"
#' @importFrom promises %...T>%
#' @export
promises::"%...T>%"
#' @importFrom promises %...T!%
#' @export
promises::"%...T!%"
#' @importFrom magrittr %>%
#' @export
magrittr::"%>%"
#' @importFrom magrittr %T>%
#' @export
magrittr::"%T>%"
#' @importFrom promises promise
#' @export
promises::promise
#' @importFrom promises then
#' @export
promises::then
#' @importFrom promises catch
#' @export
promises::catch
#' @importFrom promises finally
#' @export
promises::finally
promise_timeout <- function(
p,
timeout,
loop = current_loop(),
timeout_message = NULL
) {
promise(function(resolve, reject) {
cancel_timer <- later_with_interrupt(
function() {
if (is.null(timeout_message)) {
timeout_message <- "Promise timed out"
}
reject(timeout_message)
},
timeout,
loop = loop,
on_interrupt = function() {
reject("interrupted")
}
)
p$then(
onFulfilled = function(value) {
# Timer is no longer needed, so we'll cancel it to free memory.
cancel_timer()
resolve(value)
},
onRejected = function(err) {
cancel_timer()
reject(err)
}
)
})
}
================================================
FILE: R/protocol.R
================================================
#' @import rlang
utils::globalVariables(
c("self", "private", "callback_", "error_", "timeout", "timeout_", "wait_")
)
# Given a protocol spec (essentially, the Chrome DevTools Protocol JSON
# converted to an R object), returns a list of domains of the DevTools
# Protocol (like Browser, Page, Runtime). Each domain has a function for each
# command and event (like Browser$getVersion, Page$navigate, etc). The
# `protocol` input is the protocol object from the browser, translated from
# JSON to an R object, and the `env` is the desired environment that is
# assigned to the the generated functions -- it should be the Chromote
# object's enclosing environment so that the functions can find `self` and
# `private`.
process_protocol <- function(protocol, env) {
domains <- protocol$domains
names(domains) <- vapply(domains, function(d) d$domain, "")
domains <- lapply(domains, function(domain) {
commands <- get_items(domain, "commands")
commands <- lapply(
commands,
command_to_function,
domain_name = domain$domain,
env = env
)
events <- get_items(domain, "events")
events <- lapply(
events,
event_to_function,
domain_name = domain$domain,
env = env
)
c(commands, events)
})
domains
}
# Returns commands or events for a given domain
get_items <- function(domain, type = c("commands", "events")) {
type <- match.arg(type)
methods <- domain[[type]]
if (is.null(methods)) {
return(list())
} else {
names(methods) <- fetch_key_c(methods, "name")
methods
}
}
command_to_function <- function(command, domain_name, env) {
new_function(
args = gen_command_args(command$parameters),
body = gen_command_body(
paste0(domain_name, ".", command$name),
command$parameters
),
env = env
)
# TODO:
# * Add type-checking
# * Cross-reference types for type checking
}
gen_command_args <- function(params) {
args <- lapply(params, function(param) {
if (!isTRUE(param$optional)) {
missing_arg()
} else {
NULL
}
})
names(args) <- fetch_key_c(params, "name")
args <- c(
args,
callback_ = list(NULL),
error_ = list(NULL),
timeout_ = if ("timeout" %in% names(args)) {
expr(missing_arg())
} else {
expr(self$default_timeout)
},
wait_ = TRUE
)
args
}
# Returns a function body for a command.
# method_name is something like "Browser.getVersion"
gen_command_body <- function(method_name, params) {
# Construct expressions for checking missing args
required_params <- params[!fetch_key_l(params, "optional", default = FALSE)]
check_missing_exprs <- lapply(required_params, function(param) {
name <- as.symbol(param$name)
check_missing <- expr(
if (missing(!!name))
stop("Missing required argument ", !!(expr_text(name)))
)
})
timeout_default_expr <-
if ("timeout" %in% lapply(params, `[[`, "name")) {
# Set the wall time of chromote to twice that of the execution time.
expr({
if (is_missing(timeout_)) {
timeout_ <-
if (is.null(timeout)) {
self$default_timeout
} else {
2 * timeout / 1000
}
}
})
} else {
expr({
})
}
# As of 2025-02-07, it's not possible to query CDP to determine if the value
# of `mobile` in the device metrics override, so we need to track its value
# through any calls to `Emulation.setDeviceMetricsOverride`.
track_device_override_mobile <-
if (identical(method_name, "Emulation.setDeviceMetricsOverride")) {
expr({
if (!!sym("deviceScaleFactor") > 0) {
private$pixel_ratio <- !!sym("deviceScaleFactor")
} else {
private$pixel_ratio <- NULL
}
private$is_mobile <- !!sym("mobile")
})
} else {
expr({}) # fmt: skip
}
# Construct parameters for message
param_list <- lapply(params, function(param) {
as.symbol(param$name)
})
names(param_list) <- fetch_key_c(params, "name")
expr({
if (!is.null(callback_) && !is.function(callback_))
stop("`callback_` must be a function or NULL.")
if (!is.null(error_) && !is.function(error_))
stop("`error_` must be a function or NULL.")
!!!timeout_default_expr
if (!is.null(timeout_) && !is.numeric(timeout_))
stop("`timeout_` must be a number or NULL.")
if (!identical(wait_, TRUE) && !identical(wait_, FALSE))
stop("`wait_` must be TRUE or FALSE.")
# Check for missing non-optional args
!!!check_missing_exprs
!!!track_device_override_mobile
msg <- list(
method = !!method_name,
params = drop_nulls(list(!!!param_list))
)
p <- self$send_command(
msg,
callback = callback_,
error = error_,
timeout = timeout_
)
if (wait_) {
self$wait_for(p)
} else {
p
}
})
}
event_to_function <- function(event, domain_name, env) {
new_function(
args = list(
callback_ = NULL,
timeout_ = expr(self$default_timeout),
wait_ = TRUE
),
body = gen_event_body(paste0(domain_name, ".", event$name)),
env = env
)
}
# Returns a function body for registering an event callback.
# method_name is something like "Page.loadEventFired".
gen_event_body <- function(method_name) {
expr({
if (!is.null(callback_) && !is.function(callback_))
stop("`callback_` must be a function or NULL.")
if (!is.null(timeout_) && !is.numeric(timeout_))
stop("`timeout_` must be a number or NULL.")
if (!identical(wait_, TRUE) && !identical(wait_, FALSE))
stop("`wait_` must be TRUE or FALSE.")
p <- private$register_event_listener(!!method_name, callback_, timeout_)
# If callback_ was a function, then because the callback can fire multiple
# times, p is not a promise; it is a function for deregistering the
# callback.
if (!is.null(callback_)) {
return(invisible(p))
}
if (wait_) {
self$wait_for(p)
} else {
p
}
})
}
# Given a protocol object, reassign the environment for all functions.
protocol_reassign_envs <- function(protocol, env) {
lapply(protocol, function(domain) {
lapply(domain, function(method) {
environment(method) <- env
method
})
})
}
================================================
FILE: R/screenshot.R
================================================
chromote_session_screenshot <- function(
self,
private,
filename = "screenshot.png",
selector = "html",
cliprect = NULL,
region = c("content", "padding", "border", "margin"),
expand = NULL,
scale = 1,
show = FALSE,
delay = 0.5,
options = list(),
wait_ = TRUE
) {
force(filename)
force(selector)
force(cliprect)
force(region)
force(expand)
force(scale)
force(show)
force(wait_)
region = match.arg(region)
if (length(filename) == 0 && !show) {
stop("Cannot have empty filename and show=FALSE")
}
if (!is.null(cliprect) && !(is.numeric(cliprect) && length(cliprect) == 4)) {
stop(
"`cliprect` must be NULL or a numeric vector with 4 elements (for left, top, width, and height)."
)
}
if (is.null(expand)) {
expand <- 0
}
if (
!is.numeric(expand) ||
!(length(expand) == 1 || length(expand) == 4)
) {
stop(
"`expand` must be NULL, or a numeric vector with 1 or 4 elements (for top, right, bottom, left)"
)
}
if (length(expand) == 1) {
expand <- rep(expand, 4)
}
stopifnot(
"`options` must be a list" = rlang::is_list(options),
"`options` must be named" = rlang::is_named2(options)
)
# Set up arg list from defaults & user options to pass to `Page$captureScreenshot`
screenshot_arg_defaults <- list(
fromSurface = TRUE,
captureBeyondViewport = TRUE
)
screenshot_args <- utils::modifyList(screenshot_arg_defaults, options)
if (is.null(screenshot_args$format)) {
screenshot_args$format <- screenshot_format(filename)
}
# These vars are used to store information gathered from one step to use
# in a later step.
image_data <- NULL
overall_width <- NULL
overall_height <- NULL
root_node_id <- NULL
pixel_ratio <- NULL
# Setup stuff for both selector and cliprect code paths.
p <- self$Emulation$setScrollbarsHidden(
hidden = TRUE,
wait_ = FALSE
)$then(function(value) {
# Get device pixel ratio if unknown
private$get_pixel_ratio()
})$then(function(value) {
pixel_ratio <<- value
})$then(function(value) {
# Get overall height and width of the <html> root node
self$DOM$getDocument(wait_ = FALSE)
})$then(function(value) {
root_node_id <<- value$root$nodeId
self$DOM$querySelector(value$root$nodeId, "html", wait_ = FALSE)
})$then(function(value) {
self$DOM$getBoxModel(value$nodeId, wait_ = FALSE)
})$then(function(value) {
overall_width <<- value$model$width
overall_height <<- value$model$height
promise(function(resolve, reject) {
# Wait `delay` seconds for resize to complete. For complicated apps this may need to be longer.
## TODO: Can we wait for an event instead?
later(function() resolve(TRUE), delay)
})
})
if (is.null(cliprect)) {
# This code path uses the selector instead of cliprect.
p <- p$then(function(value) {
find_selectors_bounds(self, root_node_id, selector, region)
})$then(function(value) {
# Note: `expand` values are top, right, bottom, left.
xmin <- value$xmin - expand[4]
xmax <- value$xmax + expand[2]
ymin <- value$ymin - expand[1]
ymax <- value$ymax + expand[3]
# We need to make sure that we don't go beyond the bounds of the
# page.
xmin <- max(xmin, 0)
xmax <- min(xmax, overall_width)
ymin <- max(ymin, 0)
ymax <- min(ymax, overall_height)
screenshot_args$clip <- list(
x = xmin,
y = ymin,
width = xmax - xmin,
height = ymax - ymin,
scale = scale / pixel_ratio
)
screenshot_args$wait_ <- FALSE
do.call(self$Page$captureScreenshot, screenshot_args)
})$then(function(value) {
image_data <<- value
})
} else {
# If cliprect was provided, use it instead of selector
p <- p$then(function(value) {
screenshot_args$clip <- list(
x = cliprect[[1]],
y = cliprect[[2]],
width = cliprect[[3]],
height = cliprect[[4]],
scale = scale / pixel_ratio
)
screenshot_args$wait_ <- FALSE
do.call(self$Page$captureScreenshot, screenshot_args)
})$then(function(value) {
image_data <<- value
})
}
p <- p$then(function(value) {
# Un-hide scrollbars
self$Emulation$setScrollbarsHidden(hidden = FALSE, wait_ = FALSE)
})$then(function(value) {
temp_output <- FALSE
if (is.null(filename)) {
temp_output <- TRUE
filename <- tempfile("chromote-screenshot-", fileext = ".png")
on.exit(unlink(filename))
}
writeBin(jsonlite::base64_dec(image_data$data), filename)
if (show) {
showimage::show_image(filename)
}
if (temp_output) {
invisible()
} else {
invisible(filename)
}
})$catch(function(err) {
warning("An error occurred: ", err)
})
if (wait_) {
self$wait_for(p)
} else {
p
}
}
screenshot_format <- function(filename) {
ext <- strsplit(filename, ".", fixed = TRUE)[[1]]
if (length(ext) < 2) ext <- "no_ext"
ext <- ext[length(ext)]
switch(
tolower(ext),
png = "png",
jpg = ,
jpeg = "jpeg",
webp = "webp",
pdf = rlang::abort(
"Use the `screenshot_pdf()` method to capture a PDF screenshot."
),
no_ext = rlang::abort(
sprintf(
'Could not guess screenshot format from filename "%s". Does the name include a file extension?',
filename
)
),
rlang::abort(
sprintf('"%s" is not a supported screenshot format.', ext)
)
)
}
chromote_session_screenshot_pdf <- function(
self,
private,
filename = "screenshot.pdf",
pagesize = "letter",
margins = 0.5,
units = c("in", "cm"),
landscape = FALSE,
display_header_footer = FALSE,
print_background = FALSE,
scale = 1,
wait_ = TRUE
) {
force(filename)
force(pagesize)
force(margins)
force(units)
force(landscape)
force(display_header_footer)
force(print_background)
force(scale)
force(wait_)
page_sizes <- list(
letter = c(8.5, 11),
legal = c(8.5, 14),
tabloid = c(11, 17),
ledger = c(17, 11),
a0 = c(33.1, 46.8),
a1 = c(23.4, 33.1),
a2 = c(16.54, 23.4),
a3 = c(11.7, 16.54),
a4 = c(8.27, 11.7),
a5 = c(5.83, 8.27),
a6 = c(4.13, 5.83)
)
units <- match.arg(units)
if (units == "cm") {
margins <- margins / 2.54
}
if (is.character(pagesize)) {
pagesize <- tolower(pagesize)
pagesize <- match.arg(pagesize, names(page_sizes))
pagesize <- page_sizes[[pagesize]]
} else if (is.numeric(pagesize) && length(pagesize) == 2) {
# User has passed in width and height values
if (units == "cm") {
pagesize <- pagesize / 2.54
}
} else {
stop(
'`pagesize` must be one of "',
paste(names(page_sizes), collapse = '", "'),
'", or a two-element vector of width and height.'
)
}
if (length(margins) == 1) {
margins <- rep(margins, 4)
}
if (length(margins) != 4) {
stop(
'`margins` must be a single number, or a four-element numeric vector representing',
' the margins for top, right, bottom, and left, respectively.'
)
}
p <- self$Page$printToPDF(
landscape = landscape,
displayHeaderFooter = display_header_footer,
printBackground = print_background,
scale = scale,
paperWidth = pagesize[[1]],
paperHeight = pagesize[[2]],
marginTop = margins[[1]],
marginBottom = margins[[3]],
marginLeft = margins[[4]],
marginRight = margins[[2]],
wait_ = FALSE
)$then(function(value) {
writeBin(jsonlite::base64_dec(value$data), filename)
filename
})
if (wait_) {
invisible(self$wait_for(p))
} else {
p
}
}
# Find a bounding box that contains the elements selected by any number of
# selectors. Note that a selector can pick out more than one element.
find_selectors_bounds <- function(
cm,
root_node_id,
selectors,
region = "content"
) {
ps <- lapply(selectors, function(selector) {
cm$DOM$querySelectorAll(root_node_id, selector, wait_ = FALSE)$then(
function(value) {
# There can be multiple nodes for a given selector, so we need to
# process all of them.
ps <- lapply(value$nodeIds, function(nodeId) {
cm$DOM$getBoxModel(nodeId, wait_ = FALSE)$catch(function(value) {
# Can get an error, "Could not compute box model", if the element
# is not visible. Just return NULL in this case.
NULL
})
})
promise_all(.list = ps)
}
)$then(function(values) {
# Could have gotten emtpy list for non-visible elements; remove them.
values <- drop_nulls(values)
lapply(values, function(value) {
list(
xmin = value$model[[region]][[1]],
xmax = value$model[[region]][[3]],
ymin = value$model[[region]][[2]],
ymax = value$model[[region]][[6]]
)
})
})
})
promise_all(.list = ps)$then(function(value) {
value <- unlist(value, recursive = FALSE)
if (length(value) == 0) {
stop("Unable to find any visible elements for selectors.")
}
list(
xmin = min(fetch_key_n(value, "xmin")),
xmax = max(fetch_key_n(value, "xmax")),
ymin = min(fetch_key_n(value, "ymin")),
ymax = max(fetch_key_n(value, "ymax"))
)
})
}
================================================
FILE: R/synchronize.R
================================================
promise_globals <- new.env(parent = emptyenv())
promise_globals$interrupt_domains <- list()
push_interrupt_domain <- function(domain) {
n_domains <- length(promise_globals$interrupt_domains)
promise_globals$interrupt_domains[[n_domains + 1]] <- domain
}
pop_interrupt_domain <- function() {
n_domains <- length(promise_globals$interrupt_domains)
if (length(n_domains) == 0) return(NULL)
domain <- promise_globals$interrupt_domains[[n_domains]]
promise_globals$interrupt_domains[[n_domains]] <- NULL
domain
}
current_interrupt_domain <- function() {
if (length(promise_globals$interrupt_domains) == 0) {
return(NULL)
}
promise_globals$interrupt_domains[[length(promise_globals$interrupt_domains)]]
}
create_interrupt_domain <- function() {
domain <- new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
function(...) {
push_interrupt_domain(domain)
on.exit(pop_interrupt_domain(), add = TRUE)
if (domain$interrupted) {
stop("Operation was interrupted 1")
}
tryCatch(
{
onFulfilled(...)
},
interrupt = function(e) {
# message("wrapOnFulfilled inner caught interrupt")
# Call function here that returns current interrupt
domain$interrupted <- TRUE
stop("Operation was interrupted 2")
}
)
}
},
wrapOnRejected = function(onRejected) {
function(...) {
push_interrupt_domain(domain)
on.exit(pop_interrupt_domain(), add = TRUE)
if (domain$interrupted) {
stop("Operation was interrupted 3")
}
tryCatch(
onRejected(...),
interrupt = function(e) {
domain$interrupted <- TRUE
stop("Operation was interrupted 4")
}
)
}
},
wrapOnFinally = function(onFinally) {
function(...) {
push_interrupt_domain(domain)
on.exit(pop_interrupt_domain(), add = TRUE)
tryCatch(
onFinally(...),
interrupt = function(e) {
domain$interrupted <- TRUE
stop("Operation was interrupted 5")
}
)
}
},
wrapSync = function(expr) {
push_interrupt_domain(domain)
on.exit(pop_interrupt_domain(), add = TRUE)
# Counting is currently not used
if (is.null(promise_globals$synchronized)) {
promise_globals$synchronized <- 0L
}
promise_globals$synchronized <- promise_globals$synchronized + 1L
on.exit(
promise_globals$synchronized <- promise_globals$synchronized - 1L,
add = TRUE
)
force(expr)
},
interrupted = FALSE
)
domain
}
# This function takes a promise and blocks until it is resolved. It runs the
# promise's callbacks in the provided event loop. If the promise is
# interrupted then this function tries to catch the interrupt, then runs the
# loop until it's empty; then it throws a new interrupt. If the promise throws
# an error, then also throws an error.
synchronize <- function(expr, loop) {
domain <- create_interrupt_domain()
with_promise_domain(domain, {
tryCatch(
{
result <- force(expr)
if (is.promising(result)) {
value <- NULL
type <- NULL
result$then(function(val) {
value <<- val
type <<- "success"
})$catch(function(reason) {
value <<- reason
type <<- "error"
})
while (is.null(type) && !domain$interrupted) {
run_now(loop = loop)
}
if (is.null(type)) {
generateInterrupt()
} else if (type == "success") {
value
} else if (type == "error") {
stop(value)
}
}
},
interrupt = function(e) {
domain$interrupted <<- TRUE
message(
"Attempting to interrupt gracefully; press Esc/Ctrl+C to force interrupt"
)
while (!loop_empty(loop = loop)) {
run_now(loop = loop)
}
generateInterrupt()
}
)
})
}
# A wrapper for later() which polls for interrupts. If an interrupt has
# occurred either while running another callback, or when run_now() is
# waiting, the interrupt will be detected and (1) the scheduled `func` will be
# cancelled, and (2) the `on_interrupt` callback will be invoked.
later_with_interrupt <- function(
func,
delay = 0,
loop = current_loop(),
on_interrupt = function() {
},
interrupt_domain = current_interrupt_domain(),
poll_interval = 0.1
) {
force(func)
force(loop)
force(interrupt_domain)
force(on_interrupt)
force(poll_interval)
if (is.null(interrupt_domain)) {
return(later(func, delay, loop))
}
end_time <- as.numeric(Sys.time()) + delay
cancel <- NULL
nextTurn <- function(init = FALSE) {
if (isTRUE(interrupt_domain$interrupted)) {
on_interrupt()
return()
}
this_delay <- min(poll_interval, end_time - as.numeric(Sys.time()))
if (this_delay <= 0) {
# Time has expired. If we've never progressed to the next tick (i.e.
# init == TRUE) then don't invoke the callback yet, wait until the next
# tick. Otherwise, do invoke the callback.
if (!init) {
func()
return()
}
this_delay <- 0
}
cancel <<- later::later(nextTurn, this_delay, loop)
}
nextTurn(init = TRUE)
function() {
cancel()
}
}
# TODO
#
# The notion of cancellability should go into later package. Instead of this
# function taking `interrupt_domain`, which is a promise-level object, we could
# do something like the following:
#
# Add on_interrupt option to later(); if FALSE/NULL (the default) then interrupts
# don't affect scheduled callback. If TRUE, then interrupt cancels the later().
# If a function, then interrupt cancels the later() and calls the on_interrupt
# function.
# Add later::interrupt() function, so that later can know that an interrupt
# happened.
# Add option to later() to make the callback uninterruptable.
generateInterrupt <- function() {
tools::pskill(Sys.getpid(), tools::SIGINT)
Sys.sleep(1)
}
================================================
FILE: R/utils.R
================================================
cat_line <- function(...) {
cat(paste0(..., "\n", collapse = ""))
}
# =============================================================================
# System
# =============================================================================
is_windows <- function() .Platform$OS.type == "windows"
is_mac <- function() Sys.info()[['sysname']] == 'Darwin'
is_linux <- function() Sys.info()[['sysname']] == 'Linux'
is_openbsd <- function() Sys.info()[['sysname']] == "OpenBSD"
# =============================================================================
# Vectors
# =============================================================================
get_key <- function(x, key, default = stop("Key not present")) {
if (key %in% names(x)) {
x[[key]]
} else {
default
}
}
fetch_key_list <- function(x, key, default = stop("Key not present")) {
lapply(x, get_key, key, default = default)
}
fetch_key_c <- function(x, key, default = stop("Key not present")) {
vapply(x, get_key, key, default = default, FUN.VALUE = "")
}
fetch_key_n <- function(x, key, default = stop("Key not present")) {
vapply(x, get_key, key, default = default, FUN.VALUE = 0.0)
}
fetch_key_i <- function(x, key, default = stop("Key not present")) {
vapply(x, get_key, key, default = default, FUN.VALUE = 0L)
}
fetch_key_l <- function(x, key, default = stop("Key not present")) {
vapply(x, get_key, key, default = default, FUN.VALUE = FALSE)
}
drop_nulls <- function(x) {
x[!vapply(x, is.null, TRUE)]
}
# =============================================================================
# Text
# =============================================================================
truncate <- function(x, n = 1000, message = "[truncated]") {
if (length(x) != 1) {
stop("Input must be a single string")
}
if (nchar(x) > n) {
x <- paste0(substr(x, 1, n - nchar(message)), message)
}
x
}
# =============================================================================
# Protocol-related stuff
# =============================================================================
# Given an event name, return the domain: "Page.loadEventFired" -> "Page"
find_domain <- function(event) {
sub("\\.[^.]+", "", event)
}
# =============================================================================
# Browser
# =============================================================================
# Force url to be opened by Chromium browser
browse_url <- function(path, chromote) {
if (grepl("^[a-zA-Z][a-zA-Z0-9+.-]*://", path)) {
# `path` is already a full URL
url <- path
} else {
url <- chromote$url(path)
}
browser <- chromote$get_browser()
if (inherits(browser, "Chrome")) {
# If locally available, use the local browser
browser_path <- browser$get_path()
product <- chromote$Browser$getVersion(wait_ = TRUE)$product
# And if not chrome-headless-shell (which doesn't have a UI we can use)
if (grepl("HeadlessChrome", product, fixed = TRUE)) {
cli::cli_warn(
"Cannot open a browser window with {.field chrome-headless-shell}, using your default browser instead."
)
} else {
# Quote the path if using a non-windows machine
if (!is_windows()) browser_path <- shQuote(browser_path)
utils::browseURL(url, browser_path)
return(invisible(url))
}
}
# Otherwise pray opening the url works as expected
# Users can set `options(browser=)` to override default behavior
utils::browseURL(url)
invisible(url)
}
# =============================================================================
# Random Ports
# =============================================================================
#
# Borrowed from https://github.com/rstudio/httpuv/blob/main/R/random_port.R
#' Startup a service that requires a random port
#'
#' `with_random_port()` provides `startup()` with a random port value and runs
#' the function:
#'
#' 1. `startup()` always returns a value if successful.
#' 2. If `startup()` fails with a generic error, we assume the port is occupied
#' and try the next random port.
#' 3. If `startup()` fails with an error classed with errors in `stop_on`,
#' (`error_stop_port_search` or `system_command_error` by default), we stop
#' the port search and rethrow the fatal error.
#' 4. If we try `n` random ports, the port search stops with an informative
#' error that includes the last port attempt error.
#'
#' @param startup A function that takes a `port` argument, where `port` will be
#' randomly selected. When successful, `startup()` should return a non-NULL
#' value that will also be returned from `with_random_port()`. Generic errors
#' emitted by this function are silently ignored: when `startup()` fails, we
#' assume the port was unavailable and we try with a new port. Errors with the
#' classes in `stop_on` fail immediately.
#' @param ... Additional arguments passed to `startup()`.
#' @param min,max Port range
#' @param n Maximum number of ports to try
#' @param stop_on Error classes that signal the port search should be stopped
#'
#' @return The result of `startup()`, or an error if `startup()` fails.
#' @noRd
with_random_port <- function(
startup,
...,
min = 1024L,
max = 49151L,
n = 10,
stop_on = c("error_stop_port_search", "system_command_error")
) {
stopifnot(is.function(startup))
valid_ports <- setdiff(seq.int(min, max), unsafe_ports)
# Try up to n ports
n <- min(n, length(valid_ports))
ports <- sample(valid_ports, n)
err_port <- NULL
for (port in ports) {
success <- FALSE
res <- NULL
err_fatal <- NULL
# Try to run `startup` with the random port
tryCatch(
{
res <- startup(port = port, ...)
success <- TRUE
},
error = function(cnd) {
if (rlang::cnd_inherits(cnd, stop_on)) {
# Non generic errors that signal we should stop trying new ports
err_fatal <<- cnd
return()
}
# For other errors, they are probably because the port is already in
# use. Don't do anything; we'll just continue in the loop, but we save
# the last port retry error to throw in case it's informative.
err_port <<- cnd
NULL
}
)
if (!is.null(err_fatal)) {
rlang::cnd_signal(err_fatal)
}
if (isTRUE(success)) {
return(res)
}
}
rlang::abort(
"Cannot find an available port. Please try again.",
class = "error_no_available_port",
parent = err_port
)
}
# Ports that are considered unsafe by Chrome
# http://superuser.com/questions/188058/which-ports-are-considered-unsafe-on-chrome
# https://github.com/rstudio/shiny/issues/1784
unsafe_ports <- c(
1,
7,
9,
11,
13,
15,
17,
19,
20,
21,
22,
23,
25,
37,
42,
43,
53,
77,
79,
87,
95,
101,
102,
103,
104,
109,
110,
111,
113,
115,
117,
119,
123,
135,
139,
143,
179,
389,
427,
465,
512,
513,
514,
515,
526,
530,
531,
532,
540,
548,
556,
563,
587,
601,
636,
993,
995,
2049,
3659,
4045,
6000,
6665,
6666,
6667,
6668,
6669,
6697
)
================================================
FILE: R/zzz.R
================================================
`_dummy_` <- function() {
# Make a dummy curl call to make R CMD check happy
# {jsonlite} only suggests {curl}, but is needed for standard {chromote} usage
# https://github.com/rstudio/chromote/issues/37
curl::curl
invisible()
}
================================================
FILE: README.Rmd
================================================
---
output: github_document
---
<!-- README.md is generated from README.Rmd. Please edit that file -->
<!-- Do not run R chunks that print any session information.
This produces unstable output.
Instead, copy output from a local execution
Still use README.Rmd to get special UTF-8 chars from pandoc -->
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
```
# chromote <a href="https://rstudio.github.io/chromote/"><img src="man/figures/logo.png" align="right" height="138" alt="chromote website" /></a>
<!-- badges: start -->
[](https://github.com/rstudio/chromote/actions)
[](https://CRAN.R-project.org/package=chromote)
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
<!-- badges: end -->
```{r child="man/fragments/features.Rmd"}
```
## Learn More
Learn more about using and programming with chromote:
* [Get started](https://rstudio.github.io/chromote/articles/chromote.html)
* [Commands and events](https://rstudio.github.io/chromote/articles/commands-and-events.html)
* [Synchronous vs. asynchronous usage](https://rstudio.github.io/chromote/articles/sync-async.html)
* [Choosing which Chrome-based browser to use](https://rstudio.github.io/chromote/articles/which-chrome.html)
```{r child="man/fragments/install.Rmd"}
```
```{r child="man/fragments/basic-usage.Rmd"}
```
================================================
FILE: README.md
================================================
<!-- README.md is generated from README.Rmd. Please edit that file -->
<!-- Do not run R chunks that print any session information.
This produces unstable output.
Instead, copy output from a local execution
Still use README.Rmd to get special UTF-8 chars from pandoc -->
# chromote <a href="https://rstudio.github.io/chromote/"><img src="man/figures/logo.png" align="right" height="138" alt="chromote website" /></a>
<!-- badges: start -->
[](https://github.com/rstudio/chromote/actions)
[](https://CRAN.R-project.org/package=chromote)
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
<!-- badges: end -->
Chromote is an R implementation of the [Chrome DevTools
Protocol](https://chromedevtools.github.io/devtools-protocol/). It works
with Chrome, Chromium, Opera, Vivaldi, and other browsers based on
[Chromium](https://www.chromium.org/). By default it uses Google Chrome
(which must already be installed on the system). To use a different
browser, see `vignette("which-chrome")`.
Chromote is not the only R package that implements the Chrome DevTools
Protocol. Here are some others:
- [crrri](https://github.com/RLesur/crrri) by Romain Lesur and
Christophe Dervieux
- [decapitated](https://github.com/hrbrmstr/decapitated/) by Bob Rudis
- [chradle](https://github.com/milesmcbain/chradle) by Miles McBain
The interface to Chromote is similar to
[chrome-remote-interface](https://github.com/cyrus-and/chrome-remote-interface)
for node.js.
## Features
- Install and use specific versions of Chrome from the [Chrome for
Testing](https://googlechromelabs.github.io/chrome-for-testing/)
service.
- Offers a synchronous API for ease of use and an asynchronous API for
more sophisticated tasks.
- Full support for the Chrome DevTools Protocol for any version of
Chrome or any Chrome-based browser.
- Includes convenience methods, like `$screenshot()` and
`$set_viewport_size()`, for common tasks.
- Automatically reconnects to previous sessions if the connection from R
to Chrome is lost, for example when restarting from sleep state.
- Powers many higher-level packages and functions, like `{shinytest2}`
and `rvest::read_html_live()`.
## Learn More
Learn more about using and programming with chromote:
- [Get
started](https://rstudio.github.io/chromote/articles/chromote.html)
- [Commands and
events](https://rstudio.github.io/chromote/articles/commands-and-events.html)
- [Synchronous vs. asynchronous
usage](https://rstudio.github.io/chromote/articles/sync-async.html)
- [Choosing which Chrome-based browser to
use](https://rstudio.github.io/chromote/articles/which-chrome.html)
## Installation
Install the released version of chromote from CRAN:
``` r
install.packages("chromote")
```
Or install the development version from GitHub with:
``` r
# install.packages("pak")
pak::pak("rstudio/chromote")
```
## Basic usage
This will start a headless browser and open an interactive viewer for it
in a normal browser, so that you can see what the headless browser is
doing.
``` r
library(chromote)
b <- ChromoteSession$new()
# In a web browser, open a viewer for the headless browser. Works best with
# Chromium-based browsers.
b$view()
```
The browser can be given *commands*, as specified by the [Chrome
DevTools Protocol](https://chromedevtools.github.io/devtools-protocol/).
For example, `$Browser$getVersion()` (which corresponds to the
[Browser.getVersion](https://chromedevtools.github.io/devtools-protocol/tot/Browser/#method-getVersion)
in the API docs) will query the browser for version information:
``` r
b$Browser$getVersion()
#> $protocolVersion
#> [1] "1.3"
#>
#> $product
#> [1] "HeadlessChrome/98.0.4758.102"
#>
#> $revision
#> [1] "@273bf7ac8c909cde36982d27f66f3c70846a3718"
#>
#> $userAgent
#> [1] "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) HeadlessChrome/98.0.4758.102 Safari/537.36"
#>
#> $jsVersion
#> [1] "9.8.177.11"
```
If you have the viewer open and run the following, you’ll see the web
page load in the viewer[^1]:
``` r
b$go_to("https://www.r-project.org/")
```
In addition to full support of the Chrome Devtools Protocol,
`ChromoteSession` objects also have some convenience methods, like
`$go_to()` and `$screenshot()`. (See the Examples section below for more
information about screenshots.)
``` r
# Saves to screenshot.png
b$screenshot()
# Takes a screenshot of elements picked out by CSS selector
b$screenshot("sidebar.png", selector = ".sidebar")
```
<figure>
<img src="man/figures/sidebar.png"
alt="A screenshot of the sidebar of r-rproject.org, circa 2023." />
<figcaption aria-hidden="true">A screenshot of the sidebar of
r-rproject.org, circa 2023.</figcaption>
</figure>
[^1]: This simple example works interactively, but if you’re using
chromote to programmatically take screenshots you’ll want to read
`vignette("example-loading-page")` for a consistent and reliable
approach.
================================================
FILE: chromote.Rproj
================================================
Version: 1.0
RestoreWorkspace: No
SaveWorkspace: No
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
AutoAppendNewline: Yes
StripTrailingWhitespace: Yes
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace
================================================
FILE: cran-comments.md
================================================
## R CMD check results
0 errors | 0 warnings | 0 notes
## revdepcheck results
We checked 25 reverse dependencies (24 from CRAN + 1 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package.
* We saw 0 new problems
* We failed to check 0 packages
================================================
FILE: man/Browser.Rd
================================================
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/browser.R
\name{Browser}
\alias{Browser}
\title{Browser base class}
\description{
Base class for browsers like Chrome, Chromium, etc. Defines the interface
used by various browser implementations. It can represent a local browser
process or one running remotely.
}
\details{
The \code{initialize()} method of an implementation should set \code{private$host}
and \code{private$port}. If the process is local, the \code{initialize()} method
should also set \code{private$process}.
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-Browser-is_local}{\code{Browser$is_local()}}
\item \href{#method-Browser-get_process}{\code{Browser$get_process()}}
\item \href{#method-Browser-is_alive}{\code{Browser$is_alive()}}
\item \href{#method-Browser-get_host}{\code{Browser$get_host()}}
\item \href{#method-Browser-get_port}{\code{Browser$get_port()}}
\item \href{#method-Browser-close}{\code{Browser$close()}}
\item \href{#method-Browser-clone}{\code{Browser$clone()}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-is_local"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-is_local}{}}}
\subsection{Method \code{is_local()}}{
Is local browser?
Returns TRUE if the browser is running locally, FALSE if it's remote.
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$is_local()}\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-get_process"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-get_process}{}}}
\subsection{Method \code{get_process()}}{
Browser process
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$get_process()}\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-is_alive"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-is_alive}{}}}
\subsection{Method \code{is_alive()}}{
Is the process alive?
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$is_alive()}\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-get_host"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-get_host}{}}}
\subsection{Method \code{get_host()}}{
Browser Host
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$get_host()}\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-get_port"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-get_port}{}}}
\subsection{Method \code{get_port()}}{
Browser port
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$get_port()}\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-close"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-close}{}}}
\subsection{Method \code{close()}}{
Close the browser
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$close(wait = FALSE)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{wait}}{If an integer, waits a number of seconds for the process to
exit, killing the process if it takes longer than \code{wait} seconds to
close. Use \code{wait = TRUE} to wait for 10 seconds.}
}
\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Browser-clone"></a>}}
\if{latex}{\out{\hypertarget{method-Browser-clone}{}}}
\subsection{Method \code{clone()}}{
The objects of this class are cloneable with this method.
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Browser$clone(deep = FALSE)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{deep}}{Whether to make a deep clone.}
}
\if{html}{\out{</div>}}
}
}
}
================================================
FILE: man/Chrome.Rd
================================================
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/chrome.R
\name{Chrome}
\alias{Chrome}
\title{Local Chrome process}
\description{
This is a subclass of \code{\link{Browser}} that represents a local browser. It extends
the \code{\link{Browser}} class with a \code{\link[processx:process]{processx::process}} object, which represents
the browser's system process.
}
\seealso{
\code{\link[=get_chrome_args]{get_chrome_args()}}
}
\section{Super class}{
\code{\link[chromote:Browser]{chromote::Browser}} -> \code{Chrome}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-Chrome-new}{\code{Chrome$new()}}
\item \href{#method-Chrome-get_path}{\code{Chrome$get_path()}}
\item \href{#method-Chrome-clone}{\code{Chrome$clone()}}
}
}
\if{html}{\out{
<details><summary>Inherited methods</summary>
<ul>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="close"><a href='../../chromote/html/Browser.html#method-Browser-close'><code>chromote::Browser$close()</code></a></span></li>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="get_host"><a href='../../chromote/html/Browser.html#method-Browser-get_host'><code>chromote::Browser$get_host()</code></a></span></li>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="get_port"><a href='../../chromote/html/Browser.html#method-Browser-get_port'><code>chromote::Browser$get_port()</code></a></span></li>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="get_process"><a href='../../chromote/html/Browser.html#method-Browser-get_process'><code>chromote::Browser$get_process()</code></a></span></li>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="is_alive"><a href='../../chromote/html/Browser.html#method-Browser-is_alive'><code>chromote::Browser$is_alive()</code></a></span></li>
<li><span class="pkg-link" data-pkg="chromote" data-topic="Browser" data-id="is_local"><a href='../../chromote/html/Browser.html#method-Browser-is_local'><code>chromote::Browser$is_local()</code></a></span></li>
</ul>
</details>
}}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-Chrome-new"></a>}}
\if{latex}{\out{\hypertarget{method-Chrome-new}{}}}
\subsection{Method \code{new()}}{
Create a new Chrome object.
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Chrome$new(path = find_chrome(), args = get_chrome_args())}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{path}}{Location of chrome installation}
\item{\code{args}}{A character vector of command-line arguments passed when
initializing Chrome. Single on-off arguments are passed as single
values (e.g.\code{"--disable-gpu"}), arguments with a value are given with a
nested character vector (e.g. \code{c("--force-color-profile", "srgb")}).
See
\href{https://peter.sh/experiments/chromium-command-line-switches/}{here}
for a list of possible arguments. Defaults to \code{\link[=get_chrome_args]{get_chr
gitextract_bqyizoye/
├── .Rbuildignore
├── .github/
│ ├── .gitignore
│ └── workflows/
│ └── R-CMD-check.yaml
├── .gitignore
├── .vscode/
│ ├── extensions.json
│ └── settings.json
├── DESCRIPTION
├── LICENSE
├── LICENSE.md
├── NAMESPACE
├── NEWS.md
├── R/
│ ├── browser.R
│ ├── callbacks.R
│ ├── chrome.R
│ ├── chromote-package.R
│ ├── chromote.R
│ ├── chromote_session.R
│ ├── event_manager.R
│ ├── import-standalone-obj-type.R
│ ├── import-standalone-types-check.R
│ ├── manage.R
│ ├── promises.R
│ ├── protocol.R
│ ├── screenshot.R
│ ├── synchronize.R
│ ├── utils.R
│ └── zzz.R
├── README.Rmd
├── README.md
├── chromote.Rproj
├── cran-comments.md
├── man/
│ ├── Browser.Rd
│ ├── Chrome.Rd
│ ├── ChromeRemote.Rd
│ ├── Chromote.Rd
│ ├── ChromoteSession.Rd
│ ├── chrome_versions.Rd
│ ├── chrome_versions_list.Rd
│ ├── chromote-options.Rd
│ ├── chromote-package.Rd
│ ├── chromote_info.Rd
│ ├── default_chrome_args.Rd
│ ├── default_chromote_object.Rd
│ ├── find_chrome.Rd
│ ├── fragments/
│ │ ├── basic-usage.Rmd
│ │ ├── features.Rmd
│ │ └── install.Rmd
│ ├── reexports.Rd
│ └── with_chrome_version.Rd
├── pkgdown/
│ ├── _brand.yml
│ ├── _pkgdown.yml
│ ├── extra.scss
│ └── favicon/
│ └── site.webmanifest
├── revdep/
│ ├── .gitignore
│ ├── README.md
│ ├── cran.md
│ ├── failures.md
│ └── problems.md
├── tests/
│ ├── testthat/
│ │ ├── _snaps/
│ │ │ ├── chromote_session.md
│ │ │ ├── linux64/
│ │ │ │ └── manage.md
│ │ │ ├── mac-arm64/
│ │ │ │ └── manage.md
│ │ │ └── win64/
│ │ │ └── manage.md
│ │ ├── helper.R
│ │ ├── setup.R
│ │ ├── test-chrome.R
│ │ ├── test-chromote_session.R
│ │ ├── test-default_chromote_args.R
│ │ ├── test-manage.R
│ │ └── test-utils.R
│ └── testthat.R
└── vignettes/
├── .gitignore
├── chromote.Rmd
├── commands-and-events.Rmd
├── example-attach-existing.Rmd
├── example-authentication.Rmd
├── example-cran-tests.Rmd
├── example-custom-headers.Rmd
├── example-custom-user-agent.Rmd
├── example-extract-text.Rmd
├── example-loading-page.Rmd
├── example-remote-hosts.Rmd
├── example-screenshot.Rmd
├── sync-async.Rmd
└── which-chrome.Rmd
Condensed preview — 84 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (373K chars).
[
{
"path": ".Rbuildignore",
"chars": 237,
"preview": "^chromote\\.Rproj$\n^\\.Rproj\\.user$\n^temp$\n^chromote\\.sublime-project$\n^\\.github$\n^_pkgdown\\.yml$\n^docs$\n^pkgdown$\n^README"
},
{
"path": ".github/.gitignore",
"chars": 7,
"preview": "*.html\n"
},
{
"path": ".github/workflows/R-CMD-check.yaml",
"chars": 652,
"preview": "# Workflow derived from https://github.com/rstudio/shiny-workflows\n#\n# NOTE: This Shiny team GHA workflow is overkill fo"
},
{
"path": ".gitignore",
"chars": 64,
"preview": ".Rhistory\n.RData\n.Rproj.user\ntemp\ndocs\nCRAN-SUBMISSION\ninst/doc\n"
},
{
"path": ".vscode/extensions.json",
"chars": 62,
"preview": "{\n \"recommendations\": [\n \"Posit.air-vscode\"\n ]\n}\n"
},
{
"path": ".vscode/settings.json",
"chars": 114,
"preview": "{\n \"[r]\": {\n \"editor.formatOnSave\": true,\n \"editor.defaultFormatter\": \"Posit.air-vscode\"\n }\n}\n"
},
{
"path": "DESCRIPTION",
"chars": 1482,
"preview": "Package: chromote\nTitle: Headless Chrome Web Browser Interface\nVersion: 0.5.1.9000\nAuthors@R: c(\n person(\"Garrick\", \""
},
{
"path": "LICENSE",
"chars": 46,
"preview": "YEAR: 2025\nCOPYRIGHT HOLDER: chromote authors\n"
},
{
"path": "LICENSE.md",
"chars": 1075,
"preview": "# MIT License\n\nCopyright (c) 2025 chromote authors\n\nPermission is hereby granted, free of charge, to any person obtainin"
},
{
"path": "NAMESPACE",
"chars": 1320,
"preview": "# Generated by roxygen2: do not edit by hand\n\nS3method(print,chromote_info)\nexport(\"%...!%\")\nexport(\"%...>%\")\nexport(\"%."
},
{
"path": "NEWS.md",
"chars": 7513,
"preview": "# chromote (development version)\n\n# chromote 0.5.1\n\n## New features\n\n* `ChromoteSession` gets a new helper method, `$go_"
},
{
"path": "R/browser.R",
"chars": 2243,
"preview": "globals <- new.env()\n\n#' Browser base class\n#'\n#' @description\n#' Base class for browsers like Chrome, Chromium, etc. De"
},
{
"path": "R/callbacks.R",
"chars": 2069,
"preview": "# The data structure for storing callbacks is essentially a queue: items are\n# added to the end, and removed from the fr"
},
{
"path": "R/chrome.R",
"chars": 15493,
"preview": "#' Local Chrome process\n#'\n#' @description\n#' This is a subclass of [`Browser`] that represents a local browser. It exte"
},
{
"path": "R/chromote-package.R",
"chars": 2030,
"preview": "#' @keywords internal\n\"_PACKAGE\"\n\n#' chromote Options\n#'\n#' @description\n#' These options and environment variables that"
},
{
"path": "R/chromote.R",
"chars": 27589,
"preview": "#' Chromote class\n#'\n#' @description\n#' A `Chromote` object represents the browser as a whole, and it can have\n#' multip"
},
{
"path": "R/chromote_session.R",
"chars": 32855,
"preview": "#' ChromoteSession class\n#'\n#' @description\n#' This represents one _session_ in a Chromote object. Note that in the Chro"
},
{
"path": "R/event_manager.R",
"chars": 7121,
"preview": "EventManager <- R6Class(\n \"EventManager\",\n public = list(\n initialize = function(session) {\n private$session <"
},
{
"path": "R/import-standalone-obj-type.R",
"chars": 8731,
"preview": "# Standalone file: do not edit by hand\n# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-obj-type.R>\n# --"
},
{
"path": "R/import-standalone-types-check.R",
"chars": 12536,
"preview": "# Standalone file: do not edit by hand\n# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-types-check.R>\n#"
},
{
"path": "R/manage.R",
"chars": 27713,
"preview": "#' Use a specific version of Chrome or related binaries\n#'\n#' @description\n#' `r lifecycle_badge(\"experimental\")`\n#'\n#' "
},
{
"path": "R/promises.R",
"chars": 1332,
"preview": "#' @importFrom promises %...>%\n#' @export\npromises::\"%...>%\"\n\n#' @importFrom promises %...!%\n#' @export\npromises::\"%...!"
},
{
"path": "R/protocol.R",
"chars": 6348,
"preview": "#' @import rlang\n\nutils::globalVariables(\n c(\"self\", \"private\", \"callback_\", \"error_\", \"timeout\", \"timeout_\", \"wait_\")\n"
},
{
"path": "R/screenshot.R",
"chars": 9353,
"preview": "chromote_session_screenshot <- function(\n self,\n private,\n filename = \"screenshot.png\",\n selector = \"html\",\n clipre"
},
{
"path": "R/synchronize.R",
"chars": 6228,
"preview": "promise_globals <- new.env(parent = emptyenv())\npromise_globals$interrupt_domains <- list()\n\npush_interrupt_domain <- fu"
},
{
"path": "R/utils.R",
"chars": 7153,
"preview": "cat_line <- function(...) {\n cat(paste0(..., \"\\n\", collapse = \"\"))\n}\n\n# ==============================================="
},
{
"path": "R/zzz.R",
"chars": 240,
"preview": "`_dummy_` <- function() {\n # Make a dummy curl call to make R CMD check happy\n # {jsonlite} only suggests {curl}, but "
},
{
"path": "README.Rmd",
"chars": 1661,
"preview": "---\noutput: github_document\n---\n\n<!-- README.md is generated from README.Rmd. Please edit that file -->\n<!-- Do not run "
},
{
"path": "README.md",
"chars": 5197,
"preview": "\n<!-- README.md is generated from README.Rmd. Please edit that file -->\n<!-- Do not run R chunks that print any session "
},
{
"path": "chromote.Rproj",
"chars": 386,
"preview": "Version: 1.0\n\nRestoreWorkspace: No\nSaveWorkspace: No\nAlwaysSaveHistory: Default\n\nEnableCodeIndexing: Yes\nUseSpacesForTab"
},
{
"path": "cran-comments.md",
"chars": 291,
"preview": "## R CMD check results\n\n0 errors | 0 warnings | 0 notes\n\n\n## revdepcheck results\n\nWe checked 25 reverse dependencies (24"
},
{
"path": "man/Browser.Rd",
"chars": 3786,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/browser.R\n\\name{Browser}\n\\alias{Browser}\n\\"
},
{
"path": "man/Chrome.Rd",
"chars": 3964,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chrome.R\n\\name{Chrome}\n\\alias{Chrome}\n\\tit"
},
{
"path": "man/ChromeRemote.Rd",
"chars": 3568,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chrome.R\n\\name{ChromeRemote}\n\\alias{Chrome"
},
{
"path": "man/Chromote.Rd",
"chars": 16209,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote.R\n\\name{Chromote}\n\\alias{Chromote"
},
{
"path": "man/ChromoteSession.Rd",
"chars": 30790,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote_session.R\n\\name{ChromoteSession}\n"
},
{
"path": "man/chrome_versions.Rd",
"chars": 2314,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/manage.R\n\\name{chrome_versions}\n\\alias{chr"
},
{
"path": "man/chrome_versions_list.Rd",
"chars": 2090,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/manage.R\n\\name{chrome_versions_list}\n\\alia"
},
{
"path": "man/chromote-options.Rd",
"chars": 1189,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote-package.R\n\\name{chromote-options}"
},
{
"path": "man/chromote-package.Rd",
"chars": 1069,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote-package.R\n\\docType{package}\n\\name"
},
{
"path": "man/chromote_info.Rd",
"chars": 1073,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chrome.R\n\\name{chromote_info}\n\\alias{chrom"
},
{
"path": "man/default_chrome_args.Rd",
"chars": 3847,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote.R\n\\name{default_chrome_args}\n\\ali"
},
{
"path": "man/default_chromote_object.Rd",
"chars": 923,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chromote.R\n\\name{default_chromote_object}\n"
},
{
"path": "man/find_chrome.Rd",
"chars": 1702,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chrome.R\n\\name{find_chrome}\n\\alias{find_ch"
},
{
"path": "man/fragments/basic-usage.Rmd",
"chars": 2012,
"preview": "```{r}\n#| echo: false\nif (!exists(\"MAN_PATH\")) MAN_PATH <- \"man\"\n```\n\n## Basic usage\n\nThis will start a headless browser"
},
{
"path": "man/fragments/features.Rmd",
"chars": 1537,
"preview": "Chromote is an R implementation of the [Chrome DevTools Protocol](https://chromedevtools.github.io/devtools-protocol/). "
},
{
"path": "man/fragments/install.Rmd",
"chars": 259,
"preview": "## Installation\n\nInstall the released version of chromote from CRAN:\n\n```{r, eval = FALSE}\ninstall.packages(\"chromote\")\n"
},
{
"path": "man/reexports.Rd",
"chars": 900,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/promises.R\n\\docType{import}\n\\name{reexport"
},
{
"path": "man/with_chrome_version.Rd",
"chars": 5184,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/manage.R\n\\name{with_chrome_version}\n\\alias"
},
{
"path": "pkgdown/_brand.yml",
"chars": 822,
"preview": "color:\n palette:\n blue: \"#007bc2\"\n indigo: \"#4b00c1\"\n purple: \"#74149c\"\n pink: \"#bf007f\"\n red: \"#c10000\""
},
{
"path": "pkgdown/_pkgdown.yml",
"chars": 1642,
"preview": "url: https://rstudio.github.io/chromote\n\nauthors:\n Posit Software, PBC:\n href: https://www.posit.co\n html: >-\n "
},
{
"path": "pkgdown/extra.scss",
"chars": 212,
"preview": "html[data-bs-theme=\"dark\"] code {\n background-color: transparent;\n}\n\n.navbar-brand+.nav-text {\n color: var(--bs-navbar"
},
{
"path": "pkgdown/favicon/site.webmanifest",
"chars": 421,
"preview": "{\n \"name\": \"\",\n \"short_name\": \"\",\n \"icons\": [\n {\n \"src\": \"/web-app-manifest-192x192.png\",\n \"sizes\": \"192"
},
{
"path": "revdep/.gitignore",
"chars": 79,
"preview": "checks\nlibrary\nchecks.noindex\nlibrary.noindex\ncloud.noindex\ndata.sqlite\n*.html\n"
},
{
"path": "revdep/README.md",
"chars": 171,
"preview": "# Revdeps\n\n## Failed to check (1)\n\n|package |version |error |warning |note |\n|:----------|:-------|:-----|:-------|:-"
},
{
"path": "revdep/cran.md",
"chars": 233,
"preview": "## revdepcheck results\n\nWe checked 25 reverse dependencies (24 from CRAN + 1 from Bioconductor), comparing R CMD check r"
},
{
"path": "revdep/failures.md",
"chars": 297,
"preview": "# renderthis\n\n<details>\n\n* Version: NA\n* GitHub: NA\n* Source code: https://github.com/cran/renderthis\n* Number of recurs"
},
{
"path": "revdep/problems.md",
"chars": 29,
"preview": "*Wow, no problems at all. :)*"
},
{
"path": "tests/testthat/_snaps/chromote_session.md",
"chars": 544,
"preview": "# ChromoteSession auto_events_enable_args errors\n\n Code\n chromote_session$auto_events_enable_args(\"Browser\", no_"
},
{
"path": "tests/testthat/_snaps/linux64/manage.md",
"chars": 293,
"preview": "# with_chrome_version() works\n\n Code\n with_chrome_version(\"128.0.6612.0\", with_retries(try_chromote_info))\n O"
},
{
"path": "tests/testthat/_snaps/mac-arm64/manage.md",
"chars": 383,
"preview": "# with_chrome_version() works\n\n Code\n with_chrome_version(\"128.0.6612.0\", with_retries(try_chromote_info))\n O"
},
{
"path": "tests/testthat/_snaps/win64/manage.md",
"chars": 303,
"preview": "# with_chrome_version() works\n\n Code\n with_chrome_version(\"128.0.6612.0\", with_retries(try_chromote_info))\n O"
},
{
"path": "tests/testthat/helper.R",
"chars": 1159,
"preview": "skip_if_no_chromote <- function() {\n skip_on_cran()\n skip_if(lacks_chromote(), \"chromote not available\")\n}\n\nlacks_chro"
},
{
"path": "tests/testthat/setup.R",
"chars": 241,
"preview": "on_cran <- !isTRUE(as.logical(Sys.getenv(\"NOT_CRAN\", \"false\")))\n\nif (!on_cran) {\n has_chromote_envvar <- !identical(Sys"
},
{
"path": "tests/testthat/test-chrome.R",
"chars": 1754,
"preview": "expect_true_eventually <- function(expr, max_tries = 50, delay = 0.1) {\n expr <- enquo(expr)\n\n expect_true(\n with_r"
},
{
"path": "tests/testthat/test-chromote_session.R",
"chars": 4834,
"preview": "test_that(\"respawning preserves targetId and auto_events\", {\n skip_if_no_chromote()\n\n sess1 <- create_session(auto_eve"
},
{
"path": "tests/testthat/test-default_chromote_args.R",
"chars": 1372,
"preview": "min_chrome_arg_length <- 3 + is_inside_ci() + is_windows()\n\ntest_that(\"default args are retrieved\", {\n expect_gte(lengt"
},
{
"path": "tests/testthat/test-manage.R",
"chars": 3228,
"preview": "skip_on_cran()\n\ntest_that(\"with_chrome_version('system') works\", {\n system_path <- find_chrome()\n skip_if_not(nzchar(s"
},
{
"path": "tests/testthat/test-utils.R",
"chars": 1558,
"preview": "test_that(\"with_random_port() tries expected number of ports in range\", {\n min <- 2000L\n max <- 4000L\n n <- 25\n\n tri"
},
{
"path": "tests/testthat.R",
"chars": 60,
"preview": "library(testthat)\nlibrary(chromote)\n\ntest_check(\"chromote\")\n"
},
{
"path": "vignettes/.gitignore",
"chars": 11,
"preview": "*.html\n*.R\n"
},
{
"path": "vignettes/chromote.Rmd",
"chars": 7972,
"preview": "---\ntitle: \"chromote\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{chromote}\n %\\VignetteEngine{k"
},
{
"path": "vignettes/commands-and-events.Rmd",
"chars": 3866,
"preview": "---\ntitle: \"Commands and events\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Commands and events"
},
{
"path": "vignettes/example-attach-existing.Rmd",
"chars": 1448,
"preview": "---\ntitle: \"Attaching to existing tabs\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Attaching to"
},
{
"path": "vignettes/example-authentication.Rmd",
"chars": 3747,
"preview": "---\ntitle: \"Websites that require authentication\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{We"
},
{
"path": "vignettes/example-cran-tests.Rmd",
"chars": 2254,
"preview": "---\ntitle: \"Using chromote in CRAN tests\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Using chro"
},
{
"path": "vignettes/example-custom-headers.Rmd",
"chars": 1857,
"preview": "---\ntitle: \"Setting custom headers\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Setting custom h"
},
{
"path": "vignettes/example-custom-user-agent.Rmd",
"chars": 1496,
"preview": "---\ntitle: \"Setting custom user agent\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Setting custo"
},
{
"path": "vignettes/example-extract-text.Rmd",
"chars": 2107,
"preview": "---\ntitle: \"Extracting text from a web page\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Extract"
},
{
"path": "vignettes/example-loading-page.Rmd",
"chars": 2640,
"preview": "---\ntitle: \"Loading a page reliably\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Loading a page "
},
{
"path": "vignettes/example-remote-hosts.Rmd",
"chars": 2301,
"preview": "---\ntitle: \"Chrome on remote hosts\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Chrome on remote"
},
{
"path": "vignettes/example-screenshot.Rmd",
"chars": 4010,
"preview": "---\ntitle: \"Taking a screenshot of a web page\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Takin"
},
{
"path": "vignettes/sync-async.Rmd",
"chars": 20709,
"preview": "---\ntitle: \"Synchronous vs. asynchronous usage\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{Sync"
},
{
"path": "vignettes/which-chrome.Rmd",
"chars": 6499,
"preview": "---\ntitle: \"Choosing which Chrome-based browser to use\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEn"
}
]
About this extraction
This page contains the full source code of the rstudio/chromote GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 84 files (343.9 KB), approximately 95.6k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.