r-tmap · mtennekes · Mar 28, 2025 · Mar 27, 2025
diff --git a/R/check_fix.R b/R/check_fix.R
@@ -20,13 +20,21 @@
 				sf::st_make_valid(sfc)
 			}, error = function(e) {
 				suppressMessages(sf::sf_use_s2(s2))
-				warning("Unable to make ", shp_name, " valid. Invalid geometries are left out", call. = FALSE)
+				cli::cli_warn(c(
+					"Unable to make {.code {shp_name}} valid.",
+					i = "Invalid geometries are left out"
+				))
 				isv = which(sf::st_is_valid(sfc))
 				sfc = sfc[isv]
 				attr(sfc, "is_valid") = isv
 				sfc
 			})
-			if (messages) message("Shape ", shp_name, " has been fixed with s2 = ", !s2, ". If the map doesn't look correct, please run sf::sf_use_s2(", !s2, ") before running the tmap code again.")
+			if (messages) {
+				cli::cli_inform(c(
+					"Shape {shp_name} has been fixed with {.code s2 = {!s2}.",
+					"If the map doesn't look correct, please run {.code sf::sf_use_s2({!s2})} before running the tmap code again."
+				))
+			}
 
 		}
 	}

diff --git a/R/messages.R b/R/messages.R
@@ -46,12 +46,12 @@
 	if (!message_thrown(mess)) {
 		if (fullname) {
 			cli::cli_inform(
-				"{.field [cols4all]} color palettes: use palettes from the R package cols4all. Run {.code cols4all::c4a_gui()} to explore them. The old palette name {.str {old_palette_name}} is named {.str {new1}}",
+				"{.field [cols4all]} color palettes: use palettes from the R package cols4all. Run {.run cols4all::c4a_gui()} to explore them. The old palette name {.str {old_palette_name}} is named {.val {new1}}",
 				.frequency_id = "cols4all"
 			)
 		} else {
 			cli::cli_inform(
-				"{.field [cols4all]} color palettes: use palettes from the R package cols4all. Run {.code cols4all::c4a_gui()} to explore them. The old palette name {.str {old_palette_name}} is named {.str {new2}} (in long format {.str {new1}})",
+				"{.field [cols4all]} color palettes: use palettes from the R package cols4all. Run {.run cols4all::c4a_gui()} to explore them. The old palette name {.str {old_palette_name}} is named {.str {new2}} (in long format {.str {new1}})",
 				.frequency_id = "cols4all"
 			)
 
@@ -82,9 +82,9 @@
 
 message_pos_auto = function(type) {
 	if (!message_thrown("pos_auto")) {
-		fun = if (type == "autoout") "tm_pos_auto_out()" else "tm_pos_auto_in()"
-		fun2 = if (type == "autoout") "tm_pos_out()" else "tm_pos_in()"
-		cli::cli_inform("{.field [position]} use {.val {fun2}} instead of {.val {fun}}. The latter should be used with {.fn tmap_options}.")
+		fun = if (type == "autoout") "tm_pos_auto_out" else "tm_pos_auto_in"
+		fun2 = if (type == "autoout") "tm_pos_out" else "tm_pos_in"
+		cli::cli_inform("{.field [position]} use {.fn {fun2}} instead of {.fn {fun}}. The latter should be used with {.fn tmap_options}.")
 		message_reg("pos_auto")
 	}
 	NULL

diff --git a/R/misc_other.R b/R/misc_other.R
@@ -175,7 +175,7 @@
 	} else if (!is.null(x$proj4def)) {
 		sf::st_crs(x$proj4def)
 	} else {
-		stop("Unable to extract crs from leafletCRS object")
+		cli::cli_abort("Unable to extract crs from leafletCRS object.")
 	}
 }
 
@@ -226,7 +226,7 @@
 
 nonempty_text = function(txt) {
 	if (is.character(txt)) {
-		txt!=""
+		nzchar(txt)
 	} else rep(TRUE, length(txt))
 }
 
@@ -261,7 +261,7 @@
 	isnum = is_num_string(just)
 
 	if (!all(isnum | (just %in% c("left", "right", "top", "bottom", "center", "centre"))) && show.warnings) {
-		warning("wrong specification of argument just", call. = FALSE)
+		cli::cli_warn("{.arg just} is not correctly specified. ")
 	}
 
 	just[just == "centre"] = "center"
@@ -277,7 +277,7 @@
 			if (show.messages) message("In interactive mode, just cannot be a numeric value. Therefore, ", justnum, " has been cenverted to \"", just, "\".")
 		}
 	} else {
-		if (n > 2 && show.warnings) warning("The just argument should be a single value or a vector of 2 values.", call. = FALSE)
+		if (n > 2 && show.warnings) cli::cli_warn("{.arg just} should be a single value or a vector of 2 values.")
 		if (n == 1) {
 			if (just %in% c("top", "bottom")) {
 				just = c("center", just)
@@ -293,7 +293,9 @@
 						   ifelse(just[1] == "right", 1,
 						   	   ifelse(just[1] == "center", .5, NA))))
 		if (is.na(x)) {
-			if (show.warnings) warning("wrong specification of argument just", call. = FALSE)
+			if (show.warnings) {
+				cli::cli_warn("{.arg just} is not correctly specified. ")
+			}
 			x = 0.5
 		}
 
@@ -302,7 +304,9 @@
 						  ifelse(just[2] == "top", 1,
 						  	   ifelse(just[2] == "center", .5, NA))))
 		if (is.na(y)) {
-			if (show.warnings) warning("wrong specification of argument just", call. = FALSE)
+			if (show.warnings) {
+				cli::cli_warn("{.arg just} is not correctly specified. ")
+			}
 			y = 0.5
 		}
 		just = c(x, y)
@@ -444,7 +448,7 @@
 	z2 <- grDevices::xy.coords(xs2, ys2, recycle = TRUE)
 	xy2 <- toUserCoords(z2)
 
-	list(poly=polygonGrob(unit(xy2$x, "native"), grid::unit(xy2$y, "native"), id=id, gp=rg$gp))
+	list(poly = polygonGrob(unit(xy2$x, "native"), grid::unit(xy2$y, "native"), id = id, gp = rg$gp))
 	#list(poly=rectGrob(unit(x, "native"), unit(y, "native"), width = unit(w, "native"), height=unit(h, "native"), gp = rg$gp))
 }
 

diff --git a/R/misc_stars.R b/R/misc_stars.R
@@ -135,11 +135,11 @@
 				stars::st_warp(x, crs = crs)
 			}
 		}, error = function(e) {
-			warning("Unable to warp stars. Stars will be transformed now (which will take some time).", call. = FALSE)
+			cli::cli_warn(c("!" = "Unable to warp stars. Stars will be transformed now (which will take some time)."))
 			tryCatch({
 				sf::st_transform(x, crs = crs)
 			}, error = function(e) {
-				stop("Also unable to transform stars", call. = FALSE)
+				cli::cli_abort("Also unable to transform stars", call = NULL)
 			})
 		})
 	} else {

diff --git a/R/misc_symbols.R b/R/misc_symbols.R
@@ -1,9 +1,9 @@
 pchs = stats::setNames(c(seq(0L, 25L, 1L), seq(100L, 109L, 1L)),
-					   c(c('open-rect', 'open-circle', 'open-triangle', 'simple-plus', 
-					     'simple-cross', 'open-diamond', 'open-down-triangle', 'cross-rect', 
-					     'simple-star', 'plus-diamond', 'plus-circle', 'hexagram', 'plus-rect', 
-					     'cross-circle', 'triangle-rect', 'solid-rect', 'solid-circle-md', 
-					     'solid-triangle', 'solid-diamond', 'solid-circle-bg', 'solid-circle-sm', 'circle', 
+					   c(c('open-rect', 'open-circle', 'open-triangle', 'simple-plus',
+					     'simple-cross', 'open-diamond', 'open-down-triangle', 'cross-rect',
+					     'simple-star', 'plus-diamond', 'plus-circle', 'hexagram', 'plus-rect',
+					     'cross-circle', 'triangle-rect', 'solid-rect', 'solid-circle-md',
+					     'solid-triangle', 'solid-diamond', 'solid-circle-bg', 'solid-circle-sm', 'circle',
 					     'rect', 'diamond', 'triangle', 'down-triangle'
 					   ),
 					     c('rect', 'circle', 'triangle', 'plus', 'cross', 'diamond', 'star', 'stadium', 'line', 'polygon')
@@ -12,16 +12,21 @@
 
 get_pch_names = function(x) {
 	if (is.numeric(x)) {
-		if (!(all(x %in% pchs | x > 999))) stop("Unknown symbol values", call. = FALSE)
+		if (!(all(x %in% pchs | x > 999))) {
+			cli::cli_abort("Unknown symbol values")
+		}
 		y = names(pchs)[match(x, pchs)]
 		y[x > 999] = x[x>999]
 		y
 	} else {
-		if (!all(x %in% names(pchs))) stop("Unknown symbol values", call. = FALSE)
+		if (!all(x %in% names(pchs))) {
+			unknown <- unique(x[!x %in% names(pchs)])
+			cli::cli_abort("Unknown symbol values: {.val {unknown}}")
+		}
 		x
 	}
 }
-# 
+#
 # get_pch_number = function(x) {
 # 	if (is.numeric(x)) {
 # 		if (!(all(x %in% pchs | x > 999))) stop("Unknown symbol values", call. = FALSE)

diff --git a/R/process_breaks.R b/R/process_breaks.R
@@ -212,9 +212,13 @@
 		}
 
 		q <- tryCatch({
-			suppressWarnings(do.call(classInt::classIntervals, c(list(x, n, style= style, intervalClosure=interval.closure), args)))
+			suppressWarnings(do.call(classInt::classIntervals, c(list(x, n, style = style, intervalClosure = interval.closure), args)))
 		}, error = function(e) {
-			stop("Calculating interval classes failed for the variable ", var, " with style = '", style, "'. The error message from classInt::classIntervals: ", e$message, call. = FALSE)
+			cli::cli_abort(c(
+				"Calculating interval classes failed for the variable {.var {var}} with {.code style = {.val {style}}}."
+			    ),
+			    parent = e
+			)
 		})
 
 
@@ -224,18 +228,18 @@
 	}
 
 	if (approx && style != "fixed") {
-		if (n >= length(unique(x)) && style=="equal") {
+		if (n >= length(unique(x)) && style == "equal") {
 			# to prevent classIntervals to set style to "unique"
-			q <- list(var = x, brks = seq(min(x, na.rm=TRUE), max(x, na.rm=TRUE), length.out=n))
+			q <- list(var = x, brks = seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n))
 			attr(q, "intervalClosure") <- interval.closure
 			class(q) <- "classIntervals"
 		} else {
 			brks <- q$brks
 
 			# to prevent ugly rounded breaks such as -.5, .5, ..., 100.5 for n=101
-			qm1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n-1, style= style, intervalClosure=interval.closure), args)))
+			qm1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n - 1, style = style, intervalClosure = interval.closure), args)))
 			brksm1 <- qm1$brks
-			qp1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n+1, style= style, intervalClosure=interval.closure), args)))
+			qp1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n + 1, style = style, intervalClosure = interval.closure), args)))
 			brksp1 <- qp1$brks
 			if (min(brksm1) > min(brks) && max(brksm1) < max(brks)) {
 				q <- qm1

diff --git a/R/step1_helper_facets.R b/R/step1_helper_facets.R
@@ -251,7 +251,7 @@
 				split_stars_dim = get_split_stars_dim(mapping.aes)
 
 		        if (length(hover) > 1) {
-		          stop("hover should have length <= 1", call. = FALSE)
+		          cli::cli_abort("hover should have length <= 1, not {length(hover)}.", call = NULL)
 		        }
 
 				if (is.na(hover)) {
@@ -389,7 +389,7 @@
 
 
 				if (nrd > 3L) {
-					if (nrsd > 3L) stop("The shape object has more than 3 dimensions, so even tm_facets_grid cannot be used.", call. = FALSE)
+					if (nrsd > 3L) cli::cli_abort("The shape object has more than 3 dimensions, so even {.fn tm_facets_grid} cannot be used.")
 					nrvd = 0L
 					nrd = 3L
 					limitvars = TRUE
@@ -443,7 +443,7 @@
 			for (v in convert2density) {
 				sunit = tmg$tms$unit
 				if (is.null(sunit)) sunit = o$unit
-				shape.unit <- ifelse(sunit=="metric", "km", ifelse(sunit=="imperial", "mi", sunit))
+				shape.unit <- ifelse(sunit == "metric", "km", ifelse(sunit == "imperial", "mi", sunit))
 				u = paste(shape.unit, shape.unit)
 				if (is.numeric(shp[[v]])) shp[[v]] = shp[[v]] / units::set_units(shp$AREA, u, mode = "standard")
 			}

diff --git a/R/step2_helper_data.R b/R/step2_helper_data.R
@@ -419,23 +419,23 @@
 				} else if (islistof(aes$scale, "tm_scale")) {
 					scale = rep(aes$scale, length.out = nvars)
 				} else {
-					stop("incorrect scale specification")
+					cli::cli_abort("incorrect scale specification")
 				}
 
 				if (inherits(aes$legend, "tm_legend")) {
 					legend = rep(list(aes$legend), length.out = nvars)
 				} else if (islistof(aes$legend, "tm_legend")) {
 					legend = rep(aes$legend, length.out = nvars)
 				} else {
-					stop("incorrect legend specification")
+					cli::cli_abort("incorrect legend specification")
 				}
 
 				if (inherits(aes$chart, "tm_chart")) {
 					crt = rep(list(aes$chart), length.out = nvars)
 				} else if (islistof(aes$chart, "tm_chart")) {
 					crt = rep(aes$chart, length.out = nvars)
 				} else {
-					stop("incorrect chart specification")
+					cli::cli_abort("incorrect chart specification")
 				}
 
 
@@ -470,27 +470,27 @@
 				} else if (islistof(aes$scale, "tm_scale")) {
 					s = aes$scale[[1]]
 				} else {
-					stop("incorrect scale specification")
+					cli::cli_abort("incorrect scale specification")
 				}
 
 				if (length(s) == 0) stop("mapping not implemented for aesthetic ", unm, call. = FALSE)
 
 				if (inherits(aes$legend, "tm_legend")) {
 					l = aes$legend
 				} else if (islistof(aes$legend, "tm_legend")) {
-					warning("multiple legends are specified, while only one is required; the first will be used")
+					cli::cli_warn("multiple legends are specified, while only one is required; the first will be used")
 					l = aes$legend[[1]]
 				} else {
-					stop("incorrect legend specification")
+					cli::cli_abort("incorrect legend specification")
 				}
 
 				if (inherits(aes$chart, "tm_chart")) {
 					crt = aes$chart
 				} else if (islistof(aes$chart, "tm_chart")) {
-					warning("multiple charts are specified, while only one is required; the first will be used")
+					cli::cli_warn("multiple charts are specified, while only one is required; the first will be used")
 					crt = aes$chart[[1]]
 				} else {
-					stop("incorrect chart specification")
+					cli::cli_abort("incorrect chart specification")
 				}
 
 				dtl = apply_scale(s, l, crt, val, unm, nm__ord, "legnr", "crtnr", sortRev, bypass_ord)

diff --git a/R/step4_helper_legends.R b/R/step4_helper_legends.R
@@ -83,7 +83,7 @@
 							k = length(l$vvalues)
 							l$clones = lapply(clns, function(cl) {
 								vv = cl$vvalues
-								if (k != length(vv)) stop("legends could not be shared; the number of legend items is different", call. = FALSE)
+								if (k != length(vv)) cli::cli_abort("legends could not be shared; the number of legend items is different")
 								vv
 							})
 							names(l$clones) = names(clones[w])

diff --git a/R/tmapScale_defaults.R b/R/tmapScale_defaults.R
@@ -4,22 +4,22 @@
 	isnum = is.numeric(x)
 	if (isnum) {
 		structure(FALSE,
-				  info = {if (is_var) "Variable should be data varible name or color name" else " Values should be numeric (between -50 and 50)."}
+				  info = {if (is_var) "Variable should be data variable name or color name" else " Values should be numeric (between -50 and 50)."}
 		)
 	} else {
 		is_c4a = !is.null(getPalMeta(x[1])) && length(x) == 1L && !valid_colors(x[1])
 		if (is_c4a) {
 			if (is_var) {
 				structure(FALSE,
-						  info = " Variable should be a data variable name or a single color (not a color palette).")
+						  info = "Variable should be a data variable name or a single color (not a color palette).")
 			} else {
 				TRUE
 			}
 		} else {
 			all_cols = all(valid_colors(x))
 			if (!all_cols) {
 				structure(FALSE,
-						  info = if (is_var) " Variable should a data variable name or a single color." else " Values should be color names or a color palette (run  cols4all::c4a_palettes() for available ones.")
+						  info = if (is_var) "Variable should a data variable name or a single color." else "Values should be color names or a color palette (run {.run cols4all::c4a_palettes()} for available ones.")
 			} else {
 				TRUE
 			}

diff --git a/tests/testthat/_snaps/terra-stars.md b/tests/testthat/_snaps/terra-stars.md
@@ -5,5 +5,5 @@
     Condition
       Error in `tm_raster()`:
       ! Visual values used for the variable "col" are incorrect.
-      i  Variable should a data variable name or a single color.
+      i Variable should a data variable name or a single color.