diff --git a/R/check_fix.R b/R/check_fix.R index 61d4d6825..625e765e1 100644 --- a/R/check_fix.R +++ b/R/check_fix.R @@ -20,13 +20,21 @@ check_fix = function(sfc, shp_name, reproj, messages) { 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 index d95c63c5e..711d910a9 100644 --- a/R/messages.R +++ b/R/messages.R @@ -46,12 +46,12 @@ message_c4a = function(old_palette_name, info, fullname = FALSE) { 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_wrapstack = function(horizontal = TRUE) { 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 index a82f81269..11be80b5f 100644 --- a/R/misc_other.R +++ b/R/misc_other.R @@ -175,7 +175,7 @@ leaflet2crs = function(x) { } 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 @@ number_text_lines = function(txt) { nonempty_text = function(txt) { if (is.character(txt)) { - txt!="" + nzchar(txt) } else rep(TRUE, length(txt)) } @@ -261,7 +261,7 @@ process_just = function(just, interactive) { 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 @@ process_just = function(just, interactive) { 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 @@ process_just = function(just, interactive) { 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 @@ process_just = function(just, interactive) { 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 @@ native_to_npc_to_native <- function(x, scale) { 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 index 2523a1b98..2010e153f 100644 --- a/R/misc_stars.R +++ b/R/misc_stars.R @@ -135,11 +135,11 @@ transwarp = function(x, crs, raster.warp) { 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 index 8c1381433..5d0b36c30 100644 --- 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 @@ pchs = stats::setNames(c(seq(0L, 25L, 1L), seq(100L, 109L, 1L)), 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 index b3938c737..f7194ef97 100644 --- a/R/process_breaks.R +++ b/R/process_breaks.R @@ -212,9 +212,13 @@ num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left } 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 @@ num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left } 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 index f4234c54b..9e5b384a1 100644 --- a/R/step1_helper_facets.R +++ b/R/step1_helper_facets.R @@ -251,7 +251,7 @@ step1_rearrange_facets = function(tmo, o) { 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 @@ step1_rearrange_facets = function(tmo, o) { 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 @@ step1_rearrange_facets = function(tmo, o) { 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 index 5859c741a..9f148f933 100644 --- a/R/step2_helper_data.R +++ b/R/step2_helper_data.R @@ -419,7 +419,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, group, mfun, args, plot } 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")) { @@ -427,7 +427,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, group, mfun, args, plot } 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")) { @@ -435,7 +435,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, group, mfun, args, plot } 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,7 +470,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, group, mfun, args, plot } 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) @@ -478,19 +478,19 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, group, mfun, args, plot 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 index 2c8a0c24d..df10a74e0 100644 --- a/R/step4_helper_legends.R +++ b/R/step4_helper_legends.R @@ -83,7 +83,7 @@ step4_plot_collect_legends = function(tmx) { 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 index 45c9e9399..77b895502 100644 --- a/R/tmapScale_defaults.R +++ b/R/tmapScale_defaults.R @@ -4,14 +4,14 @@ tmapValuesCheck_col = function(x, is_var = TRUE) { 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 } @@ -19,7 +19,7 @@ tmapValuesCheck_col = function(x, is_var = TRUE) { 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 index f04d72e25..d4f0195ca 100644 --- 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.