match.call -> rlang::call_match #950

r-tmap · Nov 8, 2024 · 0cc4b99 · 0cc4b99
1 parent fff6b36
commit 0cc4b99
Show file tree

Hide file tree

Showing 17 changed files with 212 additions and 218 deletions.
diff --git a/R/qtm.R b/R/qtm.R
@@ -91,13 +91,13 @@ qtm = function(shp,
 				format = NULL,
 				...) {
 
-	args = c(as.list(environment()), list(...))
+	args = lapply(as.list(rlang::call_match(defaults = TRUE)[-1]), eval, envir = parent.frame())
 	shp_name = deparse(substitute(shp))[1]
-	called = names(match.call(expand.dots = TRUE)[-1])
+	args_called = names(rlang::call_match()[-1])
 
-	if (any(v3_only("qtm") %in% names(args))) {
+	if (any(v3_only("qtm") %in% args_called)) {
 		v3_start_message()
-		args_called = list(args = args, called = called) |>
+		args_new = list(args = args, called = args_called) |>
 			v3_instead("symbols.size", "size", "qtm", extra_called = "shape") |>
 			v3_instead("symbols.col", "size", "qtm", extra_called = "shape") |>
 			v3_instead("dots.col", "fill", "qtm") |>
@@ -108,8 +108,8 @@ qtm = function(shp,
 			v3_instead("text.size", "text_size", "qtm") |>
 			v3_instead("text.col", "text_col", "qtm") |>
 			v3_instead("projection", "crs", "qtm")
-		args = args_called$args
-		called = args_called$called
+		args = args_new$args
+		args_called = args_new$called
 	}
 
 	o = tmap_options_mode()
@@ -133,7 +133,7 @@ qtm = function(shp,
 		nms_rst = intersect(names(args), funs_v4$tm_raster)
 		args_rst = args[nms_rst]
 
-		if (!any(c("col", "raster") %in% called)) {
+		if (!any(c("col", "raster") %in% args_called)) {
 			args_rst$col = tm_vars()
 		}
 
@@ -146,15 +146,15 @@ qtm = function(shp,
 		for (f in c("tm_polygons", "tm_lines", "tm_symbols")) {
 			nms_f = intersect(names(args), funs_v4[[f]])
 			args_f = args[nms_f]
-			nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), called)
+			nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), args_called)
 			args_other = args[nms_other]
 			names(args_other) = sub("^[^.]+[.]", "", names(args_other))
 			if (f == "tm_symbols") {
-				if (!"shape" %in% called) args_f$shape = NULL
-				if (!"col" %in% called) args_f$col = NULL
+				if (!"shape" %in% args_called) args_f$shape = NULL
+				if (!"col" %in% args_called) args_f$col = NULL
 			}
 			if (f == "tm_lines") {
-				if (!"col" %in% called) args_f$col = NULL
+				if (!"col" %in% args_called) args_f$col = NULL
 			}
 
 			if (f == "tm_polygons") {
@@ -169,14 +169,14 @@ qtm = function(shp,
 			options = opt_tm_sf()[[c(tm_polygons = "polygons", tm_lines = "lines", tm_symbols = "points")[f]]]
 			g = g + do.call(f, c(args_f, args_other, list(options = options)))
 		}
-		if ("text" %in% called) {
+		if ("text" %in% args_called) {
 			args[substr(names(args), 1, 3) %in% c("col", "siz")] = NULL
 			text_ = substr(names(args), 1, 5) == "text_"
 			names(args)[text_] = substr(names(args)[text_], 6, nchar(names(args)[text_]))
 
 			nms_f = intersect(names(args), funs_v4$tm_text)
 			args_f = args[nms_f]
-			nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), called)
+			nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), args_called)
 			args_other = args[nms_other]
 			names(args_other) = sub("^[^.]+[.]", "", names(args_other))
 			g = g + do.call(tm_text, c(args_f, args_other))
@@ -200,7 +200,7 @@ qtm = function(shp,
 	if (o$qtm.minimap) g = g + tm_minimap()
 	if (o$qtm.mouse.coordinates) g = g + tm_mouse_coordinates()
 
-	assign("last_map_new", match.call(), envir = .TMAP)
+	assign("last_map_new", rlang::call_match(), envir = .TMAP)
 	attr(g, "qtm_shortcut") = FALSE
 	g
 }
diff --git a/R/tm_add_legend.R b/R/tm_add_legend.R
@@ -1,7 +1,7 @@
 #' Map component: manual legend
-#' 
+#'
 #' Map component that adds a manual legend
-#' 
+#'
 #' @param ... visual variables and arguments passed on to `tm_legend()`.
 #'   By default, the argument `type` is set to `"Symbols"`, which means that the
 #'   supported visual variables are: `"fill"`, `"col"`, `"shape"`, `"size"`,
@@ -30,11 +30,12 @@ tm_add_legend = function(...,
 						 orientation = NULL,
 						 group = NA,
 						 group.control = "check",
-						 resize.as.group = FALSE, 
+						 resize.as.group = FALSE,
 						 z = as.integer(NA)) {
-	#args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
 	if (missing(labels)) stop("tm_add_legend: labels required", call. = FALSE)
-	args = c(as.list(environment()), list(...))
+
+	args = lapply(as.list(rlang::call_match(defaults = TRUE)[-1]), eval, envir = parent.frame())
+
 	if (type %in% c("fill", "symbol", "line")) {
 		v3_add_legend(type, names(args))
 		if ("col" %in% names(args) && !c("fill" %in% names(args))) {
@@ -67,24 +68,24 @@ tmapAddedLegend = function(comp, o) {
 	}
 	res = do.call(fun, args = list())
 	gp = res[[1]]$gpar
-	
+
 	for (gpi in names(gp)) {
 		if (gpi %in% names(l)) {
 			gp[[gpi]] = l[[gpi]]
 		} else {
 			gp[[gpi]] = getAesOption("value.const", o, aes = gpi, layer = comp$type)
 		}
 	}
-	
+
 	l$gp = gp
-	
+
 	l2 = within(l, {
 		nitems = length(labels)
 		dvalues = 1:nitems
 		vvalues = 1:nitems
 		vneutral = NA
 		na.show = FALSE
-		
+
 	})
 	l2
 }
diff --git a/R/tm_chart.R b/R/tm_chart.R
@@ -1,9 +1,9 @@
 #' Legend charts
-#' 
+#'
 #' Legend charts are small charts that are added to the map, usually in addition to legends.
-#' 
-#' Note that these charts are different from charts drawn inside the map. Those are called glyphs (to be implemented). 
-#' 
+#'
+#' Note that these charts are different from charts drawn inside the map. Those are called glyphs (to be implemented).
+#'
 #' @param breaks The breaks of the bins (for histograms)
 #' @param plot.axis.x,plot.axis.y Should the x axis and y axis be plot?
 #' @param extra.ggplot2 Extra ggplot2 code
@@ -28,8 +28,9 @@ tm_chart_histogram = function(breaks,
 							  z,
 							  group.frame,
 							  resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-
+
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "histogram"
@@ -49,8 +50,8 @@ tm_chart_bar = function( plot.axis.x,
 							  z,
 							  group.frame,
 							  resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-	
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "bar"
@@ -68,8 +69,8 @@ tm_chart_donut = function(position,
 							  z,
 							  group.frame,
 							  resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-	
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "donut"
@@ -86,8 +87,8 @@ tm_chart_violin = function(position,
 						   z,
 						   group.frame,
 						   resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-	
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "violin"
@@ -104,8 +105,8 @@ tm_chart_box = function(position,
 						   z,
 						   group.frame,
 						   resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-	
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "box"
@@ -116,7 +117,7 @@ tm_chart_box = function(position,
 #' @rdname tm_chart
 #' @export
 tm_chart_none = function() {
-	structure(list(show = FALSE, summary = "none"), class = c("tm_chart_none", "tm_chart", "tm_component", "list"))	
+	structure(list(show = FALSE, summary = "none"), class = c("tm_chart_none", "tm_chart", "tm_component", "list"))
 }
 
 
@@ -130,8 +131,8 @@ tm_chart_heatmap = function(position,
 						z,
 						group.frame,
 						resize.as.group) {
-	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
-	
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+
 	if (!("z" %in% (names(args)))) args$z = as.integer(NA)
 	args$show = TRUE
 	args$type = "heatmap"