use sans_ext() and file_ext() in xfun instead of tools, because we should allow trailing ~ or # in file extensions: yihui/xfun@1f59942

Author: yihui

R/draft.R

@@ -92,7 +92,7 @@ draft <- function(file,
   if (create_dir) {
 
     # remove .Rmd extension if necessary
-    file <- tools::file_path_sans_ext(file)
+    file <- xfun::sans_ext(file)
 
     # create dir (new dir only)
     if (dir_exists(file))
@@ -104,7 +104,7 @@ draft <- function(file,
   }
 
   # Ensure we have an Rmd extension
-  if (!identical(tolower(tools::file_ext(file)), "rmd"))
+  if (!identical(tolower(xfun::file_ext(file)), "rmd"))
     file <- paste(file, ".Rmd", sep = "")
 
   # Ensure the file doesn't already exist

R/html_resource_copy.R

@@ -13,7 +13,7 @@ copy_html_resources <- function(html_str, lib_dir, output_dir) {
       # if the resource is a CSS file, perform a similar rewriting of its
       # content in the library directory
       res_path <- file.path(output_dir, res_src)
-      if (identical(tolower(tools::file_ext(res_path)), "css") &&
+      if (identical(tolower(xfun::file_ext(res_path)), "css") &&
           file.exists(res_path)) {
         css_content <- copy_resources(
           file_string(res_path), lib_dir, lib_dir, call_css_resource_attrs

R/html_resources.R

@@ -53,7 +53,7 @@
 find_external_resources <- function(input_file, encoding = 'UTF-8') {
 
   # ensure we're working with valid input
-  ext <- tolower(tools::file_ext(input_file))
+  ext <- tolower(xfun::file_ext(input_file))
   if (!(ext %in% c("md", "rmd", "html", "htm", "r", "css"))) {
     stop("Resource discovery is only supported for R Markdown files or HTML files.")
   }
@@ -78,7 +78,7 @@ find_external_resources <- function(input_file, encoding = 'UTF-8') {
           file.exists(file.path(input_dir, path))))
       return(FALSE)
 
-    ext <- tolower(tools::file_ext(file.path(input_dir, path)))
+    ext <- tolower(xfun::file_ext(file.path(input_dir, path)))
 
     if (identical(ext, "r")) {
       # if this is a .R script, look for resources it contains, too
@@ -299,7 +299,7 @@ discover_rmd_resources <- function(rmd_file, discover_single_resource) {
   }
 
   # check for knitr child documents in R Markdown documents
-  if (tolower(tools::file_ext(rmd_file)) == "rmd") {
+  if (tolower(xfun::file_ext(rmd_file)) == "rmd") {
     chunk_lines <- gregexpr(knitr::all_patterns$md$chunk.begin, rmd_content, perl = TRUE)
     for (idx in seq_along(chunk_lines)) {
       chunk_line <- chunk_lines[idx][[1]]
@@ -351,7 +351,7 @@ discover_rmd_resources <- function(rmd_file, discover_single_resource) {
   discover_html_resources(html_file, discover_single_resource)
 
   # if this is an R Markdown file, purl the file to extract just the R code
-  if (tolower(tools::file_ext(rmd_file)) == "rmd") {
+  if (tolower(xfun::file_ext(rmd_file)) == "rmd") {
     r_file <- tempfile(fileext = ".R")
     # suppress possible try() errors https://github.com/rstudio/rmarkdown/issues/1247
     try_file <- tempfile()
@@ -443,7 +443,7 @@ discover_css_resources <- function(css_file, discover_single_resource) {
 
 # given a filename, return true if the file appears to be a web file
 is_web_file <- function(filename) {
-  tolower(tools::file_ext(filename)) %in% c(
+  tolower(xfun::file_ext(filename)) %in% c(
     "css", "gif", "htm", "html", "jpeg", "jpg", "js", "mp3", "mp4", "png", "wav"
   )
 }

R/ioslides_presentation.R

@@ -318,7 +318,7 @@ ioslides_presentation <- function(number_sections = FALSE,
       logo_path <- logo
       if (!self_contained) {
         # use same extension as specified logo (default is png if unspecified)
-        logo_ext <- tools::file_ext(logo)
+        logo_ext <- xfun::file_ext(logo)
         if (nchar(logo_ext) < 1)
           logo_ext <- "png"
         logo_path <- file.path(files_dir, paste("logo", logo_ext, sep = "."))

R/output_format.R

@@ -612,7 +612,7 @@ enumerate_output_formats <- function(input, envir, encoding, output_yaml = NULL)
   input_lines <- read_utf8(input)
 
   # if this is an R file then spin it
-  if (identical(tolower(tools::file_ext(input)), "r"))
+  if (identical(tolower(xfun::file_ext(input)), "r"))
     input_lines <- knitr::spin(text = input_lines, knit = FALSE)
 
   # parse _site.yml output format if we have it

R/render.R

@@ -342,7 +342,7 @@ render <- function(input,
   }
 
   # check whether this document requires a knit
-  requires_knit <- tolower(tools::file_ext(input)) %in% c("r", "rmd", "rmarkdown")
+  requires_knit <- tolower(xfun::file_ext(input)) %in% c("r", "rmd", "rmarkdown")
 
   # remember the name of the original input document (we overwrite 'input' once
   # we've knitted)
@@ -395,10 +395,10 @@ render <- function(input,
   intermediates <- c(intermediates, utf8_input)
 
   # track whether this was straight markdown input (to prevent keep_md later)
-  md_input <- identical(tolower(tools::file_ext(input)), "md")
+  md_input <- identical(tolower(xfun::file_ext(input)), "md")
 
   # if this is an R script then spin it first
-  if (identical(tolower(tools::file_ext(input)), "r")) {
+  if (identical(tolower(xfun::file_ext(input)), "r")) {
     # make a copy of the file to spin
     spin_input <- intermediates_loc(file_with_meta_ext(input, "spin", "R"))
     file.copy(input, spin_input, overwrite = TRUE)
@@ -768,7 +768,7 @@ render <- function(input,
 
   # if this isn't html and there are html dependencies then flag an error
   if (!(is_pandoc_to_html(output_format$pandoc) ||
-        identical(tolower(tools::file_ext(output_file)), "html")))  {
+        identical(tolower(xfun::file_ext(output_file)), "html")))  {
     if (has_html_dependencies(knit_meta)) {
       if (!isTRUE(front_matter$always_allow_html)) {
         stop("Functions that produce HTML output found in document targeting ",
@@ -900,7 +900,7 @@ render <- function(input,
       # render to temporary file (preserve extension)
       # this also ensures we don't pass a file path with invalid
       # characters to our pandoc invocation
-      file_ext <- tools::file_ext(output)
+      file_ext <- xfun::file_ext(output)
       ext <- if (nzchar(file_ext))
         paste(".", file_ext, sep = "")
       else

R/shiny.R

@@ -312,7 +312,7 @@ rmarkdown_shiny_ui <- function(dir, file) {
     }
 
     # request must be for an R Markdown or HTML document
-    ext <- tolower(tools::file_ext(req_path))
+    ext <- tolower(xfun::file_ext(req_path))
     if (!(ext %in% c("rmd", "htm", "html"))) return(NULL)
 
     # document must exist
@@ -378,7 +378,7 @@ rmd_cached_output <- function(input) {
   resource_folder <- ""
 
   # if the file is raw HTML, return it directly
-  if (tolower(tools::file_ext(input)) %in% c("htm", "html")) {
+  if (tolower(xfun::file_ext(input)) %in% c("htm", "html")) {
     return(list(
       cacheable = TRUE,
       cached = TRUE,

R/shiny_prerendered.R

@@ -612,7 +612,7 @@ shiny_prerendered_append_context <- function(con, name, code) {
 
 # Prerendred data_dir for a given Rmd input file
 shiny_prerendered_data_dir <- function(input, create = FALSE) {
-  data_dir <- paste0(tools::file_path_sans_ext(input), "_data")
+  data_dir <- paste0(xfun::sans_ext(input), "_data")
   if (create && !dir_exists(data_dir))
     dir.create(data_dir)
   data_dir

R/util.R

@@ -20,7 +20,7 @@ is_osx <- function() {
 pandoc_output_file <- function(input, pandoc_options) {
   to <- strsplit(pandoc_options$to, "[+-]")[[1]][[1]]
   ext <- pandoc_output_ext(pandoc_options$ext, to, input)
-  output <- paste0(tools::file_path_sans_ext(input), ext)
+  output <- paste0(xfun::sans_ext(input), ext)
   basename(output)
 }
 
@@ -29,7 +29,7 @@ pandoc_output_ext <- function(ext, to, input) {
   if (to %in% c("latex", "beamer")) return(".pdf")
   if (to %in% c("html", "html4", "html5", "s5", "slidy", "slideous", "dzslides", "revealjs"))
     return(".html")
-  if (to == "markdown" && tolower(tools::file_ext(input)) != "md") return(".md")
+  if (to == "markdown" && tolower(xfun::file_ext(input)) != "md") return(".md")
   paste0(".", to)
 }
 
@@ -148,25 +148,25 @@ dir_exists <- function(x) {
 }
 
 file_with_ext <- function(file, ext) {
-  paste(tools::file_path_sans_ext(file), ".", ext, sep = "")
+  paste(xfun::sans_ext(file), ".", ext, sep = "")
 }
 
 
-file_with_meta_ext <- function(file, meta_ext, ext = tools::file_ext(file)) {
-  paste(tools::file_path_sans_ext(file),
+file_with_meta_ext <- function(file, meta_ext, ext = xfun::file_ext(file)) {
+  paste(xfun::sans_ext(file),
         ".", meta_ext, ".", ext, sep = "")
 }
 
 knitr_files_dir <- function(file) {
-  paste(tools::file_path_sans_ext(file), "_files", sep = "")
+  paste(xfun::sans_ext(file), "_files", sep = "")
 }
 
 knitr_root_cache_dir <- function(file) {
-  paste(tools::file_path_sans_ext(file), "_cache", sep = "")
+  paste(xfun::sans_ext(file), "_cache", sep = "")
 }
 
 knitr_cache_dir <- function(file, pandoc_to) {
-  paste(tools::file_path_sans_ext(file), "_cache/", pandoc_to, "/", sep = "")
+  paste(xfun::sans_ext(file), "_cache/", pandoc_to, "/", sep = "")
 }
 
 get_knitr_hook_list <- function(hook_names = NULL) {