Throw error if libdir is not empty but selfcontained = TRUE

NEWS.md

@@ -1,6 +1,7 @@
 htmlwidgets 1.6.2.9000
 ------------------------------------------------------
 
+* Closed #417: `saveWidget()` will now throw an error if `libdir` is provided and not empty or non-existent when writing self-contained widget files to avoid unexpectedly deleting user files. (#468)
 
 htmlwidgets 1.6.2
 ------------------------------------------------------

R/savewidget.R

@@ -8,7 +8,9 @@
 #'   (with external resources base64 encoded) or a file with external resources
 #'   placed in an adjacent directory.
 #' @param libdir Directory to copy HTML dependencies into (defaults to
-#'   filename_files).
+#'   filename_files). When `selfcontained = TRUE`, this directory must be empty
+#'   or not exist, in which case it will be created temporarily and removed
+#'   when the widget is saved.
 #' @param background Text string giving the html background color of the widget.
 #'   Defaults to white.
 #' @param title Text to use as the title of the generated page.
@@ -18,6 +20,24 @@ saveWidget <- function(widget, file, selfcontained = TRUE, libdir = NULL,
                        background = "white", title = class(widget)[[1]],
                        knitrOptions = list()) {
 
+  # form a path for dependenent files
+  if (is.null(libdir)){
+    libdir <- paste(tools::file_path_sans_ext(basename(file)), "_files",
+      sep = "")
+  }
+
+  if (selfcontained && file_test("-d", libdir)) {
+    libdir_files <- setdiff(dir(libdir, all.files = TRUE), c(".", ".."))
+    if (length(libdir_files) > 0) {
+      stop(
+        "`selfcontained = TRUE` but the `libdir` directory '", libdir,
+        "' exists and contains files. ",
+        "When `selfcontained = TRUE`, the `libdir` directory is used ",
+        "temporarily and then deleted when the widget is saved."
+      )
+    }
+  }
+
   # Transform #RRGGBB/#RRGGBBAA colors to rgba(r,g,b,a) form, because the
   # pound sign interferes with pandoc processing
   if (grepl("^#", background, perl = TRUE)) {
@@ -28,12 +48,6 @@ saveWidget <- function(widget, file, selfcontained = TRUE, libdir = NULL,
   # convert to HTML tags
   html <- toHTML(widget, standalone = TRUE, knitrOptions = knitrOptions)
 
-  # form a path for dependenent files
-  if (is.null(libdir)){
-    libdir <- paste(tools::file_path_sans_ext(basename(file)), "_files",
-      sep = "")
-  }
-
   # make it self-contained if requested
   if (selfcontained) {
 

tests/testthat/test-savewidget.R

@@ -0,0 +1,19 @@
+test_that("saveWidget errors if `selfcontained = TRUE` and `libdir` is not empty", {
+  tmpdir <- tempfile()
+  dir.create(tmpdir)
+  on.exit(unlink(tmpdir, recursive = TRUE), add = TRUE)
+
+  owd <- setwd(tmpdir)
+  on.exit(setwd(owd), add = TRUE)
+
+  # widget
+  widget <- widget_html("widgetE", "htmlwidgets", id = "id", style = NULL, class = NULL)
+
+  # Create a libdir with something in it
+  dir.create("libdir")
+  writeLines("not empty", file.path("libdir", "not-empty.txt"))
+
+  expect_error(
+    saveWidget(widget, "widget.html", selfcontained = TRUE, libdir = "libdir")
+  )
+})