Parse {} with literal = TRUE

Closes #370.

R/glue.R

@@ -11,7 +11,7 @@
 
 glue <- function(text, .envir = parent.frame(),
                  .transformer = identity_transformer,
-                 .open = "{", .close = "}") {
+                 .open = "{", .close = "}", .cli = FALSE) {
 
   text <- paste0(text, collapse = "")
 
@@ -29,7 +29,7 @@ glue <- function(text, .envir = parent.frame(),
     eval_func <- as.character(.transformer(expr, .envir) %||% character())
   }
 
-  res <- .Call(glue_, text, f, .open, .close)
+  res <- .Call(glue_, text, f, .open, .close, .cli)
 
   res <- drop_null(res)
   if (any(lengths(res) == 0)) {

R/inline.R

@@ -267,7 +267,8 @@ make_cmd_transformer <- function(values) {
       out <- glue(
         text,
         .envir = envir,
-        .transformer = sys.function()
+        .transformer = sys.function(),
+        .cli = TRUE
       )
       paste0("<", values$marker, ".", funname, " ", out, values$marker, ">")
     }
@@ -281,7 +282,8 @@ glue_cmd <- function(..., .envir) {
   pstr <- glue(
     str,
     .envir = .envir,
-    .transformer = transformer
+    .transformer = transformer,
+    .cli = TRUE
   )
   glue_delay(
     str = post_process_plurals(pstr, values),

src/glue.c

@@ -22,7 +22,15 @@ SEXP resize(SEXP out, R_xlen_t n) {
   return Rf_xlengthgets(out, n);
 }
 
-SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
+// This is almost like the original glue parser, except that
+// - no comment_arg (always empty string)
+// - no literal_arg
+// - If cli_arg is FALSE, then literal = 1, always
+// - If cli_arg is TRUE, then we use literal = 1, except in {}
+//   evaluations (as opposed to {.} for cli styles), where literal = 0 is
+//   used.
+
+SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg, SEXP cli_arg) {
 
   typedef enum {
     text,
@@ -47,6 +55,8 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
 
   char comment_char = '\0';
 
+  Rboolean cli = LOGICAL(cli_arg)[0];
+
   Rboolean literal = 1;
 
   int delim_equal = strncmp(open, close, open_len) == 0;
@@ -73,6 +83,8 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
           state = delim;
           delim_level = 1;
           start = i + open_len;
+          // In cli mode we switch to literal = FALSE for a {} block
+          if (cli && xx[i + open_len] != '.') literal = 0;
           break;
         }
       }
@@ -124,8 +136,13 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
     case delim: {
       if (!delim_equal && strncmp(&xx[i], open, open_len) == 0) {
         ++delim_level;
+        // In cli mode we switch to literal = FALSE for a {} block
+        if (cli && xx[i + open_len] != '.') literal = 0;
         i += open_len - 1;
       } else if (strncmp(&xx[i], close, close_len) == 0) {
+        // in non-{} blocks (i.e. {.}) we need literal = 1. We can always
+        // switch to literal = 1 here, because {} blocks cannot be nested.
+        literal = 1;
         --delim_level;
         i += close_len - 1;
       } else {

src/init.c

@@ -72,7 +72,7 @@ static const R_CallMethodDef callMethods[]  = {
   { "clic_get_embedded_utf8", (DL_FUNC) clic_get_embedded_utf8, 0 },
   { "clic_set_embedded_utf8", (DL_FUNC) clic_set_embedded_utf8, 1 },
 
-  { "glue_",               (DL_FUNC) glue_,               4 },
+  { "glue_",               (DL_FUNC) glue_,               5 },
 
   { NULL, NULL, 0 }
 };

tests/testthat/_snaps/glue.md

@@ -37,3 +37,10 @@
     Message
       <URL> 2 2
 
+# { } is parsed with literal = FALSE
+
+    Code
+      format_message("{.emph {'{foo {}'}}")
+    Output
+      [1] "{foo {}"
+

tests/testthat/test-glue.R

@@ -32,9 +32,8 @@ test_that("{. } is always a style", {
   expect_false(any(grepl("^v[0-9]+$", names(vals))))
 })
 
-test_that("We can use doubling to escape { and }", {
-  txt <- "{.emph {'{{foo {{}}'}}"
+test_that("{ } is parsed with literal = FALSE", {
   expect_snapshot(
-    format_message(txt)
+    format_message("{.emph {'{foo {}'}}")
   )
 })