Vendoring path

DESCRIPTION

@@ -55,4 +55,4 @@ Config/Needs/cpp11/cpp_register:
     vctrs
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.2.2

R/register.R

@@ -67,12 +67,11 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".
 
   dir.create(dirname(r_path), recursive = TRUE, showWarnings = FALSE)
 
-  brio::write_lines(path = r_path, glue::glue('
+  brio::write_lines(path = r_path, glue::glue("
       # Generated by cpp11: do not edit by hand
 
       {r_functions}
-      '
-  ))
+      "))
   if (!quiet) {
     cli::cli_alert_success("generated file {.file {basename(r_path)}}")
   }
@@ -85,11 +84,11 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".
     n_args = viapply(funs$args, nrow)
   )
 
-  cpp_function_registration <- glue::glue_collapse(cpp_function_registration, sep  = "\n")
+  cpp_function_registration <- glue::glue_collapse(cpp_function_registration, sep = "\n")
 
-  extra_includes <-  character()
+  extra_includes <- character()
   if (pkg_links_to_rcpp(path)) {
-    extra_includes <- c(extra_includes, "#include <cpp11/R.hpp>", "#include <Rcpp.h>", "using namespace Rcpp;")
+    extra_includes <- c(extra_includes, "#include <headers/R.hpp>", "#include <Rcpp.h>", "using namespace Rcpp;")
   }
 
   pkg_types <- c(
@@ -114,7 +113,7 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".
       // clang-format off
 
       {extra_includes}
-      #include "cpp11/declarations.hpp"
+      #include "headers/declarations.hpp"
       #include <R_ext/Visibility.h>
 
       {cpp_functions_definitions}
@@ -129,7 +128,7 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".
         R_forceSymbols(dll, TRUE);
       }}
       ',
-      call_entries = glue::glue_collapse(call_entries, "\n")
+    call_entries = glue::glue_collapse(call_entries, "\n")
   ))
 
   if (!quiet) {
@@ -169,7 +168,8 @@ generate_cpp_functions <- function(funs, package = "cpp11") {
   funs$calls <- mapply(wrap_call, funs$name, funs$return_type, funs$args, SIMPLIFY = TRUE)
   funs$package <- package
 
-  out <- glue::glue_data(funs,
+  out <- glue::glue_data(
+    funs,
     '
     // {basename(file)}
     {return_type} {name}({real_params});
@@ -193,20 +193,22 @@ generate_init_functions <- function(funs) {
   funs$declaration_params <- vcapply(funs$args, glue_collapse_data, "{type} {name}")
   funs$call_params <- vcapply(funs$args, `[[`, "name")
 
-  declarations <- glue::glue_data(funs,
-    '
+  declarations <- glue::glue_data(
+    funs,
+    "
     {return_type} {name}({declaration_params});
-    '
+    "
   )
 
   declarations <- paste0("\n", glue::glue_collapse(declarations, "\n"), "\n")
 
-  calls <- glue::glue_data(funs,
-    '
+  calls <- glue::glue_data(
+    funs,
+    "
       {name}({call_params});
-    '
+    "
   )
-  calls <- paste0("\n", glue::glue_collapse(calls, "\n"));
+  calls <- paste0("\n", glue::glue_collapse(calls, "\n"))
 
   list(
     declarations = declarations,
@@ -221,7 +223,7 @@ generate_r_functions <- function(funs, package = "cpp11", use_package = FALSE) {
     package_call <- glue::glue(', PACKAGE = "{package}"')
     package_names <- glue::glue_data(funs, '"_{package}_{name}"')
   } else {
-    package_names <- glue::glue_data(funs, '`_{package}_{name}`')
+    package_names <- glue::glue_data(funs, "`_{package}_{name}`")
     package_call <- ""
   }
 
@@ -231,21 +233,21 @@ generate_r_functions <- function(funs, package = "cpp11", use_package = FALSE) {
   funs$params <- vcapply(funs$list_params, function(x) if (nzchar(x)) paste0(", ", x) else x)
   is_void <- funs$return_type == "void"
   funs$calls <- ifelse(is_void,
-    glue::glue_data(funs, 'invisible(.Call({package_names}{params}{package_call}))'),
-    glue::glue_data(funs, '.Call({package_names}{params}{package_call})')
+    glue::glue_data(funs, "invisible(.Call({package_names}{params}{package_call}))"),
+    glue::glue_data(funs, ".Call({package_names}{params}{package_call})")
   )
 
-  out <- glue::glue_data(funs, '
+  out <- glue::glue_data(funs, "
     {name} <- function({list_params}) {{
       {calls}
     }}
-    ')
+    ")
   out <- glue::glue_collapse(out, sep = "\n\n")
   unclass(out)
 }
 
 wrap_call <- function(name, return_type, args) {
-  call <- glue::glue('{name}({list_params})', list_params = glue_collapse_data(args, "cpp11::as_cpp<cpp11::decay_t<{type}>>({name})"))
+  call <- glue::glue("{name}({list_params})", list_params = glue_collapse_data(args, "cpp11::as_cpp<cpp11::decay_t<{type}>>({name})"))
   if (return_type == "void") {
     unclass(glue::glue("  {call};\n    return R_NilValue;", .trim = FALSE))
   } else {
@@ -256,7 +258,8 @@ wrap_call <- function(name, return_type, args) {
 get_call_entries <- function(path, names, package) {
   con <- textConnection("res", local = TRUE, open = "w")
 
-  withr::with_collate("C",
+  withr::with_collate(
+    "C",
     tools::package_native_routine_registration_skeleton(path,
       con,
       character_only = FALSE,
@@ -274,7 +277,7 @@ get_call_entries <- function(path, names, package) {
     return("")
   }
 
-  redundant <- glue::glue_collapse(glue::glue('extern SEXP _{package}_{names}'), sep = '|')
+  redundant <- glue::glue_collapse(glue::glue("extern SEXP _{package}_{names}"), sep = "|")
 
   if (length(redundant) > 0 && nzchar(redundant)) {
     redundant <- paste0("^", redundant)
@@ -285,7 +288,7 @@ get_call_entries <- function(path, names, package) {
 
   call_calls <- startsWith(res, "extern SEXP")
 
-  if(any(call_calls)) {
+  if (any(call_calls)) {
     return(res[seq(start, end)])
   }
 
@@ -306,11 +309,10 @@ get_cpp_register_needs <- function() {
 }
 
 check_valid_attributes <- function(decorations, file = decorations$file) {
-
   bad_decor <- startsWith(decorations$decoration, "cpp11::") &
     (!decorations$decoration %in% c("cpp11::register", "cpp11::init", "cpp11::linking_to"))
 
-  if(any(bad_decor)) {
+  if (any(bad_decor)) {
     lines <- decorations$line[bad_decor]
     names <- decorations$decoration[bad_decor]
     bad_lines <- glue::glue_collapse(glue::glue("- Invalid attribute `{names}` on
@@ -320,6 +322,5 @@ check_valid_attributes <- function(decorations, file = decorations$file) {
       {bad_lines}
       ")
     stop(msg, call. = FALSE)
-
   }
 }

R/source.R

@@ -24,7 +24,7 @@
 #' @examples
 #'
 #' cpp_source(
-#'   code = '#include "cpp11/integers.hpp"
+#'   code = '#include "headers/integers.hpp"
 #'
 #'   [[cpp11::register]]
 #'   int num_odd(cpp11::integers x) {
@@ -36,15 +36,15 @@
 #'     }
 #'     return total;
 #'   }
-#'   ')
+#'   '
+#' )
 #'
 #' num_odd(as.integer(c(1:10, 15, 23)))
 #'
 #' if (interactive() && require("progress")) {
-#'
-#' cpp_source(
-#'   code = '
-#' #include <cpp11/R.hpp>
+#'   cpp_source(
+#'     code = '
+#' #include <headers/R.hpp>
 #' #include <RProgress.h>
 #'
 #' [[cpp11::linking_to("progress")]]
@@ -59,9 +59,10 @@
 #'     pb.tick();
 #'   }
 #' }
-#' ')
+#' '
+#'   )
 #'
-#' show_progress()
+#'   show_progress()
 #' }
 #'
 #' @export
@@ -96,7 +97,7 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
   # file now points to another location
   file.copy(file, file.path(new_dir, name))
 
-  #change variable name to reflect this
+  # change variable name to reflect this
   new_file_path <- file.path(new_dir, name)
   new_file_name <- basename(new_file_path)
 
@@ -106,14 +107,14 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
     all_decorations <- decor::cpp_decorations(dir, is_attribute = TRUE)
   )
 
-  #provide original path for error messages
+  # provide original path for error messages
   check_valid_attributes(all_decorations, file = orig_file_path)
 
   funs <- get_registered_functions(all_decorations, "cpp11::register", quiet = quiet)
   cpp_functions_definitions <- generate_cpp_functions(funs, package = package)
 
   cpp_path <- file.path(dirname(new_file_path), "cpp11.cpp")
-  brio::write_lines(c('#include "cpp11/declarations.hpp"', "using namespace ::cpp11;", cpp_functions_definitions), cpp_path)
+  brio::write_lines(c('#include "headers/declarations.hpp"', "using namespace ::cpp11;", cpp_functions_definitions), cpp_path)
 
   linking_to <- union(get_linking_to(all_decorations), "cpp11")
 
@@ -156,7 +157,7 @@ generate_cpp_name <- function(name, loaded_dlls = c("cpp11", names(getLoadedDLLs
   root <- tools::file_path_sans_ext(basename(name))
   count <- 2
   new_name <- root
-  while(new_name %in% loaded_dlls) {
+  while (new_name %in% loaded_dlls) {
     new_name <- sprintf("%s_%i", root, count)
     count <- count + 1
   }
@@ -184,12 +185,17 @@ generate_makevars <- function(includes, cxx_std) {
 #' @rdname cpp_source
 #' @export
 cpp_function <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11")) {
-  cpp_source(code = paste(c('#include "cpp11.hpp"',
+  cpp_source(
+    code = paste(
+      c(
+        '#include "cpp11.hpp"',
         "using namespace ::cpp11;",
         "namespace writable = ::cpp11::writable;",
         "[[cpp11::register]]",
-        code),
-      collapse = "\n"),
+        code
+      ),
+      collapse = "\n"
+    ),
     env = env,
     clean = clean,
     quiet = quiet,
@@ -202,15 +208,20 @@ utils::globalVariables("f")
 #' @rdname cpp_source
 #' @export
 cpp_eval <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11")) {
-  cpp_source(code = paste(c('#include "cpp11.hpp"',
+  cpp_source(
+    code = paste(
+      c(
+        '#include "cpp11.hpp"',
         "using namespace ::cpp11;",
         "namespace writable = ::cpp11::writable;",
         "[[cpp11::register]]",
         "SEXP f() { return as_sexp(",
         code,
         ");",
-        "}"),
-      collapse = "\n"),
+        "}"
+      ),
+      collapse = "\n"
+    ),
     env = env,
     clean = clean,
     quiet = quiet,

R/utils.R

@@ -43,18 +43,18 @@ is_windows <- function() {
 # use for stop_if_not_installed(), because rlang itself could be one of the
 # input pkgs.
 is_interactive <- function() {
-    opt <- getOption("rlang_interactive", NULL)
-    if (!is.null(opt)) {
-        return(opt)
-    }
-    if (isTRUE(getOption("knitr.in.progress"))) {
-        return(FALSE)
-    }
-    if (isTRUE(getOption("rstudio.notebook.executing"))) {
-        return(FALSE)
-    }
-    if (identical(Sys.getenv("TESTTHAT"), "true")) {
-        return(FALSE)
-    }
-    interactive()
+  opt <- getOption("rlang_interactive", NULL)
+  if (!is.null(opt)) {
+    return(opt)
+  }
+  if (isTRUE(getOption("knitr.in.progress"))) {
+    return(FALSE)
+  }
+  if (isTRUE(getOption("rstudio.notebook.executing"))) {
+    return(FALSE)
+  }
+  if (identical(Sys.getenv("TESTTHAT"), "true")) {
+    return(FALSE)
+  }
+  interactive()
 }