Add as.gtable() (#98)

Author: teunbrand

NAMESPACE

@@ -2,6 +2,9 @@
 
 S3method("[",gtable)
 S3method("dimnames<-",gtable)
+S3method(as.gtable,default)
+S3method(as.gtable,grob)
+S3method(as.gtable,gtable)
 S3method(cbind,gtable)
 S3method(dim,gtable)
 S3method(dimnames,gtable)
@@ -15,6 +18,7 @@ S3method(print,gtable)
 S3method(rbind,gtable)
 S3method(t,gtable)
 S3method(widthDetails,gtable)
+export(as.gtable)
 export(gtable)
 export(gtable_add_col_space)
 export(gtable_add_cols)

NEWS.md

@@ -1,5 +1,7 @@
 # gtable (development version)
 
+* Added `as.gtable()` S3 method (#97).
+
 # gtable 0.3.5
 
 # gtable 0.3.4

R/gtable.R

@@ -272,3 +272,43 @@ gtable_height <- function(x) sum(x$heights)
 #' @param x A gtable object
 #' @export
 gtable_width <- function(x) sum(x$widths)
+
+#' Convert to a gtable
+#'
+#' @param x An object to convert.
+#' @param ... Arguments forwarded to methods.
+#'
+#' @return A gtable object
+#' @export
+as.gtable <- function(x, ...) {
+  check_dots_used()
+  UseMethod("as.gtable")
+}
+
+#' @export
+as.gtable.default <- function(x, ...) {
+  cli::cli_abort("Can't convert {.obj_type_friendly {x}} to a {.cls gtable}.")
+}
+
+#' @export
+as.gtable.gtable <- function(x, ...) x
+
+#' @export
+#' @describeIn as.gtable Creates a 1-cell gtable containing the grob.
+#' @param widths,heights Scalar unit setting the size of the table. Defaults
+#'   to [grid::grobWidth()] and [grid::grobHeight()] of `x` respectively.
+as.gtable.grob <- function(x, widths = NULL, heights = NULL, ...) {
+  if (length(widths) > 1) {
+    widths <- widths[1]
+    cli::cli_warn("{.arg widths} truncated to length 1.")
+  }
+  if (length(heights) > 1) {
+    heights <- heights[1]
+    cli::cli_warn("{.arg heights} truncated to length 1.")
+  }
+  table <- gtable(
+    widths  = widths  %||% grobWidth(x),
+    heights = heights %||% grobHeight(x)
+  )
+  gtable_add_grob(table, x, t = 1L, l = 1L, b = 1L, r = 1L, ...)
+}

_pkgdown.yml

@@ -19,6 +19,7 @@ reference:
   - gtable_col
   - gtable_row
   - gtable_spacer
+  - as.gtable
 
 - title: Modification
   contents:

man/as.gtable.Rd

@@ -0,0 +1,11 @@
+# as.gtable sensibly converts objects
+
+    Can't convert an integer vector to a <gtable>.
+
+---
+
+    Arguments in `...` must be used.
+    x Problematic argument:
+    * foo = "bar"
+    i Did you misspell an argument name?
+

tests/testthat/_snaps/gtable.md

@@ -0,0 +1,24 @@
+test_that("as.gtable sensibly converts objects", {
+
+  # gtable --> gtable is a no-op
+  g1 <- gtable(unit(1, "npc"), unit(1, "npc"))
+  g2 <- circleGrob(r = unit(1, "cm"))
+
+  expect_identical(as.gtable(g1), g1)
+
+  test <- as.gtable(g2)
+  expect_s3_class(test, "gtable")
+  expect_equal(as.numeric(convertUnit(gtable_width(test), "cm")), 2)
+  expect_equal(as.numeric(convertUnit(gtable_height(test), "cm")), 2)
+
+  expect_warning(
+    as.gtable(g2, widths = unit(c(1, 1), "cm")),
+    "truncated to length 1"
+  )
+  expect_warning(
+    as.gtable(g2, heights = unit(c(1, 1), "cm")),
+    "truncated to length 1"
+  )
+  expect_snapshot_error(as.gtable(1:5))
+  expect_snapshot_error(as.gtable(g1, foo = "bar"))
+})