update the embedded svglite implementation

Author: thomasp85

DESCRIPTION

@@ -30,17 +30,13 @@ Depends:
 Imports:
     devtools,
     diffobj,
-    fontquiver (>= 0.2.0),
-    freetypeharfbuzz (>= 0.2.5),
-    gdtools,
     glue,
     grDevices,
     htmlwidgets (>= 0.6),
     htmltools,
     purrr (>= 0.2.0),
     rlang,
     R6,
-    Rcpp,
     shiny,
     testthat (>= 1.0.0),
     usethis (>= 1.4.0),
@@ -53,11 +49,9 @@ Suggests:
     withr,
     yaml
 LinkingTo:
-    freetypeharfbuzz,
-    gdtools,
-    Rcpp,
-    BH
-RoxygenNote: 7.1.1
+    cpp11
+RoxygenNote: 7.1.1.9001
 Roxygen: list(markdown = TRUE)
 URL: https://github.com/r-lib/vdiffr
 BugReports: https://github.com/r-lib/vdiffr/issues
+SystemRequirements: C++11

NAMESPACE

@@ -27,8 +27,6 @@ export(widget_toggle_)
 export(write_svg)
 import(rlang)
 importFrom(R6,R6Class)
-importFrom(Rcpp,sourceCpp)
-importFrom(gdtools,raster_view)
 importFrom(glue,glue)
 importFrom(purrr,compact)
 importFrom(purrr,every)

R/RcppExports.R

@@ -0,0 +1,17 @@
+# Generated by cpp11: do not edit by hand
+
+compare_files <- function(expected, test) {
+  .Call(`_vdiffr_compare_files`, expected, test)
+}
+
+svglite_ <- function(file, bg, width, height, pointsize, standalone, always_valid) {
+  .Call(`_vdiffr_svglite_`, file, bg, width, height, pointsize, standalone, always_valid)
+}
+
+svgstring_ <- function(env, bg, width, height, pointsize, standalone) {
+  .Call(`_vdiffr_svgstring_`, env, bg, width, height, pointsize, standalone)
+}
+
+get_svg_content <- function(p) {
+  .Call(`_vdiffr_get_svg_content`, p)
+}

R/cpp11.R

@@ -1,6 +1,3 @@
-#' @importFrom gdtools raster_view
-NULL
-
 svglite_path <- function(...) {
   file.path("R", "svglite", ...)
 }

R/embed-svglite.R

@@ -26,15 +26,10 @@ make_testcase_file <- function(fig_name) {
 #'
 #' @export
 write_svg <- function(plot, file, title = "") {
-  svglite(file, user_fonts = get_aliases())
+  svglite(file)
   on.exit(grDevices::dev.off())
   print_plot(plot, title)
 }
-get_aliases <- function() {
-  aliases <- fontquiver::font_families("Liberation")
-  aliases$symbol$symbol <- fontquiver::font_symbol("Symbola")
-  aliases
-}
 
 print_plot <- function(p, title = "") {
   UseMethod("print_plot")

R/svg.R

@@ -13,58 +13,43 @@
 #' used to create the svg, and the computer used to render the
 #' svg. See the \code{fonts} vignette for more information.
 #'
-#' @param file The file where output will appear.
+#' @param filename The file where output will appear.
 #' @param height,width Height and width in inches.
 #' @param bg Default background color for the plot (defaults to "white").
 #' @param pointsize Default point size.
 #' @param standalone Produce a standalone svg file? If \code{FALSE}, omits
 #'   xml header and default namespace.
-#' @param system_fonts Named list of font names to be aliased with
-#'   fonts installed on your system. If unspecified, the R default
-#'   families \code{sans}, \code{serif}, \code{mono} and \code{symbol}
-#'   are aliased to the family returned by
-#'   \code{\link[gdtools]{match_family}()}.
-#' @param user_fonts Named list of fonts to be aliased with font files
-#'   provided by the user rather than fonts properly installed on the
-#'   system. The aliases can be fonts from the fontquiver package,
-#'   strings containing a path to a font file, or a list containing
-#'   \code{name} and \code{file} elements with \code{name} indicating
-#'   the font alias in the SVG output and \code{file} the path to a
-#'   font file.
+#' @param always_valid Should the svgfile be a valid svg file while it is being
+#'   written to? Setting this to `TRUE` will incur a considerable performance
+#'   hit (>50% additional rendering time) so this should only be set to `TRUE`
+#'   if the file is being parsed while it is still being written to.
+#' @param file Identical to `filename`. Provided for backward compatibility.
 #' @references \emph{W3C Scalable Vector Graphics (SVG)}:
-#'   \url{http://www.w3.org/Graphics/SVG/Overview.htm8}
+#'   \url{http://www.w3.org/Graphics/SVG/}
 #' @author This driver was written by T Jake Luciani
 #'   \email{jakeluciani@@yahoo.com} 2012: updated by Matthieu Decorde
 #'   \email{matthieu.decorde@@ens-lyon.fr}
 #' @seealso \code{\link{pictex}}, \code{\link{postscript}}, \code{\link{Devices}}
+#'
 #' @examples
 #' # Save to file
-#' svglite("Rplots.svg")
+#' svglite(tempfile("Rplots.svg"))
 #' plot(1:11, (-5:5)^2, type = 'b', main = "Simple Example")
 #' dev.off()
 #'
-#' # Supply system font aliases. First check the font can be located:
-#' gdtools::match_family("Verdana")
-#'
-#' # Then supply a list of aliases:
-#' fonts <- list(sans = "Verdana", mono = "Times New Roman")
-#' svglite("Rplots.svg", system_fonts = fonts)
-#' plot.new()
-#' text(0.5, 0.5, "Some text", family = "mono")
-#' dev.off()
-#'
-#' # See the fonts vignettes for more options to deal with fonts
-#'
 #' @keywords device
-#' @useDynLib svglite
-#' @importFrom Rcpp sourceCpp
-#' @importFrom gdtools raster_view
+#' @useDynLib svglite, .registration = TRUE
+#' @importFrom systemfonts match_font
 #' @export
-svglite <- function(file = "Rplots.svg", width = 10, height = 8,
+svglite <- function(filename = "Rplot%03d.svg", width = 10, height = 8,
                     bg = "white", pointsize = 12, standalone = TRUE,
-                    system_fonts = list(), user_fonts = list()) {
-  aliases <- validate_aliases(system_fonts, user_fonts)
-  invisible(svglite_(file, bg, width, height, pointsize, standalone, aliases))
+                    always_valid = FALSE, file) {
+  if (!missing(file)) {
+    filename <- file
+  }
+  if (invalid_filename(filename))
+    stop("invalid 'file': ", filename)
+  invisible(svglite_(filename, bg, width, height, pointsize, standalone, always_valid))
 }
 
 #' Access current SVG as a string.
@@ -75,7 +60,6 @@ svglite <- function(file = "Rplots.svg", width = 10, height = 8,
 #' See \code{\link{svglite}()} documentation for information about
 #' specifying fonts.
 #'
-#' @param ... Arguments passed on to \code{\link{svglite}}.
 #' @return A function with no arguments: call the function to get the
 #'   current value of the string.
 #' @examples
@@ -92,19 +76,19 @@ svglite <- function(file = "Rplots.svg", width = 10, height = 8,
 #' @inheritParams svglite
 #' @export
 svgstring <- function(width = 10, height = 8, bg = "white",
-                      pointsize = 12, standalone = TRUE,
-                      system_fonts = list(), user_fonts = list()) {
-  aliases <- validate_aliases(system_fonts, user_fonts)
-
+                      pointsize = 12, standalone = TRUE) {
   env <- new.env(parent = emptyenv())
   string_src <- svgstring_(env, width = width, height = height, bg = bg,
-    pointsize = pointsize, standalone = standalone, aliases = aliases)
+    pointsize = pointsize, standalone = standalone)
 
   function() {
-    svgstr <- if(env$is_closed) env$svg_string else get_svg_content(string_src)
+    svgstr <- env$svg_string
+    if(!env$is_closed) {
+      svgstr <- c(svgstr, get_svg_content(string_src))
+    }
     structure(svgstr, class = "svg")
   }
 }
 
 #' @export
-print.svg <- function(x, ...) cat(x, "\n", sep = "")
+print.svg <- function(x, ...) cat(x, sep = "\n")

R/svglite/SVG.R

@@ -1,14 +1,14 @@
-#' Run plotting code and view svg in RStudio Viewer or web broswer.
+#' Run plotting code and view svg in RStudio Viewer or web browser.
 #'
 #' This is useful primarily for testing. Requires the \code{htmltools}
 #' package.
 #'
-#' @inheritParams svglite
 #' @param code Plotting code to execute.
 #' @param ... Other arguments passed on to \code{\link{svglite}}.
+#' @keywords internal
 #' @export
 #' @examples
-#' if (require("htmltools")) {
+#' if (interactive() && require("htmltools")) {
 #'   htmlSVG(plot(1:10))
 #'   htmlSVG(hist(rnorm(100)))
 #' }
@@ -26,6 +26,7 @@ htmlSVG <- function(code, ...) {
 #' @return A \code{xml2::xml_document} object.
 #' @inheritParams htmlSVG
 #' @inheritParams svglite
+#' @keywords internal
 #' @export
 #' @examples
 #' if (require("xml2")) {
@@ -48,6 +49,7 @@ xmlSVG <- function(code, ..., standalone = FALSE, height = 7, width = 7) {
 #'
 #' @inheritParams htmlSVG
 #' @inheritParams svglite
+#' @keywords internal
 #' @export
 #' @examples
 #' if (interactive()) {
@@ -72,6 +74,7 @@ editSVG <- function(code, ..., width = NA, height = NA) {
 #' alternative to \code{\link{svgstring}()}.
 #'
 #' @inheritParams htmlSVG
+#' @keywords internal
 #' @export
 #' @examples
 #' stringSVG(plot(1:10))