Skip to content

Commit

Permalink
Remove usage of metaprogramming in device helpers (#267)
Browse files Browse the repository at this point in the history
And inline device opening and abstract device closing
lionel- authored Jul 31, 2024
1 parent 54e1409 commit afd84aa
Showing 3 changed files with 145 additions and 372 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -48,10 +48,9 @@ Collate:
'defer-exit.R'
'standalone-defer.R'
'defer.R'
'wrap.R'
'devices.R'
'local_.R'
'with_.R'
'devices.R'
'dir.R'
'env.R'
'file.R'
@@ -65,6 +64,7 @@ Collate:
'path.R'
'rng.R'
'seed.R'
'wrap.R'
'sink.R'
'tempfile.R'
'timezone.R'
212 changes: 113 additions & 99 deletions R/devices.R
Original file line number Diff line number Diff line change
@@ -1,59 +1,3 @@
#' @include with_.R
#' @include wrap.R
NULL

# Internal *_dev functions ------------------------------------------------

pdf_dev <- wrap(grDevices::pdf, NULL, grDevices::dev.cur())

postscript_dev <- wrap(grDevices::postscript, NULL, grDevices::dev.cur())

svg_wrapper <- function(filename, width = 7, height = 7, pointsize = 12,
onefile = FALSE, family = "sans", bg = "white",
antialias = c("default", "none", "gray", "subpixel"), ...) {
grDevices::svg(filename, width, height, pointsize, onefile, family, bg, antialias, ...)
}
svg_dev <- wrap(svg_wrapper, NULL, grDevices::dev.cur())

xfig_dev <- wrap(grDevices::xfig, NULL, grDevices::dev.cur())


# These functions arguments differ between R versions, so just use ...

cairo_pdf_dev <- function(filename, ...) {
grDevices::cairo_pdf(filename = filename, ...)
grDevices::dev.cur()
}

cairo_ps_dev <- function(filename, ...) {
grDevices::cairo_ps(filename = filename, ...)
grDevices::dev.cur()
}

# These functions arguments differ between unix and windows, so just use ...

bmp_dev <- function(filename, ...) {
grDevices::bmp(filename = filename, ...)
grDevices::dev.cur()
}

tiff_dev <- function(filename, ...) {
grDevices::tiff(filename = filename, ...)
grDevices::dev.cur()
}

png_dev <- function(filename, ...) {
grDevices::png(filename = filename, ...)
grDevices::dev.cur()
}

jpeg_dev <- function(filename, ...) {
grDevices::jpeg(filename = filename, ...)
grDevices::dev.cur()
}

# User-level with_* fns ---------------------------------------------------

#' Graphics devices
#'
#' Temporarily use a graphics device.
@@ -64,6 +8,18 @@ jpeg_dev <- function(filename, ...) {
#' @param new \code{[named character]}\cr New graphics device
#' @param ... Additional arguments passed to the graphics device.
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
#' @details
#' * `with_bmp()` and `local_bmp()` wrap around [grDevices::bmp()].
#' * `with_cairo_pdf()` and `local_cairo_pdf()` wrap around [grDevices::cairo_pdf()].
#' * `with_cairo_ps()` and `local_cairo_ps()` wrap around [grDevices::cairo_ps()].
#' * `with_pdf()` and `local_pdf()` wrap around [grDevices::pdf()].
#' * `with_postscript()` and `local_postscript()` wrap around [grDevices::postscript()].
#' * `with_svg()` and `local_svg()` wrap around [grDevices::svg()].
#' * `with_tiff()` and `local_tiff()` wrap around [grDevices::tiff()].
#' * `with_xfig()` and `local_xfig()` wrap around [grDevices::xfig()].
#' * `with_png()` and `local_png()` wrap around [grDevices::png()].
#' * `with_jpeg()` and `local_jpeg()` wrap around [grDevices::jpeg()].
#'
#' @seealso \code{\link[grDevices]{Devices}}
#' @examples
#' # dimensions are in inches
@@ -77,105 +33,163 @@ jpeg_dev <- function(filename, ...) {
#' )
NULL

dev_close <- function(which) {
prev <- grDevices::dev.prev(which)
grDevices::dev.off(which)

# No devices active
if (prev != which) {
grDevices::dev.set(prev)
}

prev
}

#' @describeIn devices BMP device
#' @export
with_bmp <- with_(bmp_dev, dev_close)
with_bmp <- function(new, code, ...) {
local_bmp(new, ...)
code
}

#' @rdname devices
#' @export
local_bmp <- local_(bmp_dev, dev_close)
local_bmp <- function(new, ..., .local_envir = parent.frame()) {
grDevices::bmp(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices CAIRO_PDF device
#' @inheritParams grDevices::cairo_pdf
#' @export
with_cairo_pdf <- with_(cairo_pdf_dev, dev_close)
with_cairo_pdf <- function(new, code, ...) {
local_cairo_pdf(new, ...)
code
}

#' @rdname devices
#' @export
local_cairo_pdf <- local_(cairo_pdf_dev, dev_close)
local_cairo_pdf <- function(new, ..., .local_envir = parent.frame()) {
grDevices::cairo_pdf(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices CAIRO_PS device
#' @inheritParams grDevices::cairo_ps
#' @export
with_cairo_ps <- with_(cairo_ps_dev, dev_close)
with_cairo_ps <- function(new, code, ...) {
local_cairo_ps(new, ...)
code
}

#' @rdname devices
#' @export
local_cairo_ps <- local_(cairo_ps_dev, dev_close)
local_cairo_ps <- function(new, ..., .local_envir = parent.frame()) {
grDevices::cairo_ps(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices PDF device
#' @inheritParams grDevices::pdf
#' @export
with_pdf <- with_(pdf_dev, dev_close)
with_pdf <- function(new, code, ...) {
local_pdf(new, ...)
code
}

#' @rdname devices
#' @export
local_pdf <- local_(pdf_dev, dev_close)
local_pdf <- function(new, ..., .local_envir = parent.frame()) {
grDevices::pdf(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices POSTSCRIPT device
#' @inheritParams grDevices::postscript
#' @param command the command to be used for \sQuote{printing}. Defaults
#' to \code{"default"}, the value of option \code{"printcmd"}. The
#' length limit is \code{2*PATH_MAX}, typically 8096 bytes on unix systems and
#' 520 bytes on windows.
#' @export
with_postscript <- with_(postscript_dev, dev_close)
with_postscript <- function(new, code, ...) {
local_postscript(new, ...)
code
}

#' @rdname devices
#' @export
local_postscript <- local_(postscript_dev, dev_close)
local_postscript <- function(new, ..., .local_envir = parent.frame()) {
grDevices::postscript(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices SVG device
#' @inheritParams grDevices::svg
#' @export
with_svg <- with_(svg_dev, dev_close)
with_svg <- function(new, code, ...) {
local_svg(new, ...)
code
}

#' @rdname devices
#' @export
local_svg <- local_(svg_dev, dev_close)
local_svg <- function(new, ..., .local_envir = parent.frame()) {
grDevices::svg(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices TIFF device
#' @export
with_tiff <- with_(tiff_dev, dev_close)

with_tiff <- function(new, code, ...) {
local_tiff(new, ...)
code
}

#' @rdname devices
#' @export
local_tiff <- local_(tiff_dev, dev_close)
local_tiff <- function(new, ..., .local_envir = parent.frame()) {
grDevices::tiff(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices XFIG device
#' @inheritParams grDevices::xfig
#' @export
with_xfig <- with_(xfig_dev, dev_close)
with_xfig <- function(new, code, ...) {
local_xfig(new, ...)
code
}

#' @rdname devices
#' @export
local_xfig <- local_(xfig_dev, dev_close)
local_xfig <- function(new, ..., .local_envir = parent.frame()) {
grDevices::xfig(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices PNG device
#' @export
with_png <- with_(png_dev, dev_close)
with_png <- function(new, code, ...) {
local_png(new, ...)
code
}

#' @rdname devices
#' @export
local_png <- local_(png_dev, dev_close)
local_png <- function(new, ..., .local_envir = parent.frame()) {
grDevices::png(new, ...)
defer_dev_close(.local_envir)
}

#' @describeIn devices JPEG device
#' @export
with_jpeg <- with_(jpeg_dev, dev_close)
with_jpeg <- function(new, code, ...) {
local_jpeg(new, ...)
code
}

#' @rdname devices
#' @export
local_jpeg <- local_(jpeg_dev, dev_close)
local_jpeg <- function(new, ..., .local_envir = parent.frame()) {
grDevices::jpeg(new, ...)
defer_dev_close(.local_envir)
}

defer_dev_close <- function(frame) {
cur <- grDevices::dev.cur()
defer(dev_close(cur), envir = frame)

# Note that unlike typical `local_` functions we return the current device
# rather than the old one
invisible(cur)
}

dev_close <- function(which) {
prev <- grDevices::dev.prev(which)
grDevices::dev.off(which)

# No devices active
if (prev != which) {
grDevices::dev.set(prev)
}

prev
}
301 changes: 30 additions & 271 deletions man/devices.Rd

0 comments on commit afd84aa

Please sign in to comment.