R/import-standalone-cli_call_env.R

In gtsummary: Presentation-Ready Data Summary and Analytic Result Tables

# Standalone file: do not edit by hand
# Source: <https://github.com/ddsjoberg/standalone/blob/main/R/standalone-cli_call_env.R>
# ----------------------------------------------------------------------
#
# ---
# repo: ddsjoberg/standalone
# file: standalone-cli_call_env.R
# last-updated: 2024-04-10
# license: https://unlicense.org
# imports: [rlang, cli]
# ---
#
# This file provides functions to set and access the call environment to use in cli::cli_abort() in check functions.
#
# ## Changelog
# nocov start
# styler: off

#' Set Call Environment for [cli::cli_abort()]
#'
#' Set a call environment to be used as the `call` parameter in [cli::cli_abort()] for package checks. This function
#' is used to ensure that the correct user-facing function is reported for errors generated by internal checks that
#' use [cli::cli_abort()].
#'
#' @param env (`enviroment`)\cr
#'   call environment used as the `call` parameter in [cli::cli_abort()] for package checks
#'
#' @seealso [get_cli_abort_call()]
#'
#' @keywords internal
#' @noRd
set_cli_abort_call <- function(env = rlang::caller_env()) {
  if (getOption("cli_abort_call") |> is.null()) {
    options(cli_abort_call = env)
    set_call <- as.call(list(function() options(cli_abort_call = NULL)))
    do.call(on.exit, list(expr = set_call, add = TRUE, after = FALSE), envir = env)
  }
  invisible()
}

#' Get Call Environment for [cli::cli_abort()]
#'
#' @inheritParams set_cli_abort_call
#' @seealso [set_cli_abort_call()]
#'
#' @keywords internal
#' @noRd
get_cli_abort_call <- function() {
  getOption("cli_abort_call", default = parent.frame())
}

# nocov end
# styler: on