Apply @rpkgoptskill to farm some better implementations

R/get_r_messages.R

@@ -11,16 +11,14 @@ get_r_messages <- function(dir, custom_translation_functions = NULL, is_base = F
   # strip quotation marks now rather than deal with that at write time.
   expr_data[token == 'STR_CONST', text := clean_text(text)]
 
-  setindexv(expr_data, c("file", "line1", "col1", "line2", "col2"))
   setindexv(expr_data, c("file", "id"))
   setindexv(expr_data, c("file", "parent"))
-  setindexv(expr_data, c("token", "text"))
 
   # skip # notranslate lines / blocks
   # comments assigned here & re-used below
   # NB: at the R level, each COMMENT token is restricted to a single line
   comments = expr_data[token == "COMMENT"]
-  setkeyv(comments, c("file", "line1"))
+  setkeyv(comments, c("file", "line1", "line2"))
   expr_data = exclude_untranslated(expr_data, comments)
 
   # on the XML tree, messaging calls look like
@@ -112,20 +110,41 @@ get_r_messages <- function(dir, custom_translation_functions = NULL, is_base = F
   file_lines = lapply(normalizePath(paths), readLines, warn = FALSE)
   names(file_lines) = msg_files
 
-
   msg[
     expr_data, on = c('file', parent = 'id'),
     `:=`(line1 = i.line1, col1 = i.col1, line2 = i.line2, col2 = i.col2)
   ]
-  # need to strip comments for build_call, see #59.
-  msg[ , by = c('file', 'line1', 'col1', 'line2', 'col2'),
-    call := build_call(
-      file_lines[[.BY$file]],
-      # match any comments between line1 & line2
-      comments[.(.BY$file, .BY$line1:.BY$line2), .SD, nomatch=NULL],
-      params = .BY
-    )
-  ]
+  u_calls = unique(msg[ , c("file", "line1", "col1", "line2", "col2")])
+  u_calls[ , call := character(.N)]
+  is_single = u_calls$line1 == u_calls$line2
+
+  if (any(is_single)) {
+    u_calls[is_single, call := {
+      lines_sub = file_lines[[.BY$file]][line1]
+      if (any(has_tabs <- grepl("\t", lines_sub, fixed = TRUE))) {
+        lines_sub[has_tabs] = vapply(lines_sub[has_tabs], adjust_tabs, character(1L), USE.NAMES = FALSE)
+      }
+      substr(lines_sub, col1, col2)
+    }, by = file]
+  }
+
+  multi_idx = which(!is_single)
+  if (length(multi_idx)) {
+    multi = u_calls[multi_idx]
+    ov = foverlaps(multi, comments, which = TRUE, nomatch = NULL)
+    comm_by_call = split(ov$yid, ov$xid)
+
+    calls_res = character(length(multi_idx))
+    for (j in seq_along(multi_idx)) {
+      f = multi$file[j]
+      flines = file_lines[[f]]
+      match_rows = comm_by_call[[as.character(j)]]
+      calls_res[j] = build_call(flines, comments[match_rows], multi[j])
+    }
+    u_calls[multi_idx, call := calls_res]
+  }
+
+  msg[u_calls, on = c('file', 'line1', 'col1', 'line2', 'col2'), call := i.call]
 
   # these are the parent's stats
   msg[ , c('parent', 'line1', 'line2', 'col1', 'col2') := NULL]
@@ -316,16 +335,14 @@ get_dots_strings = function(expr_data, funs, arg_names,
 
   # as we search the AST "below" call_neighbors, drop whichever of the excluded expr parents we find.
   #   practically speaking, this is how we disassociate "hi" from stop() in stop(gettext("hi"))
-  exclude_parents = expr_data[
-    expr_data[token == 'SYMBOL_FUNCTION_CALL' & text %chin% exclude, .(file, parent)],
-    on = c('file', id = 'parent'),
-    .(file, id = x.parent)
-  ]
-  # lop off these expr so they can't be found later
-  expr_data = expr_data[!exclude_parents, on = c('file', 'id')]
-
-  # drop '(', ')', ',', and now-orphaned SYMBOL_SUB/EQ_SUB
-  call_neighbors = call_neighbors[token == 'expr'][!exclude_parents, on = c('file', 'id')]
+  exclude_tokens = expr_data[token == 'SYMBOL_FUNCTION_CALL' & text %chin% exclude]
+  call_neighbors = call_neighbors[token == 'expr']
+  # nolint next: line_length_linter.
+  if (nrow(exclude_tokens) && nrow(exclude_parents <- expr_data[exclude_tokens, on=c('file', id='parent'), .(file, id=x.parent)])) {
+    # lop off these expr so they can't be found later
+    expr_data = expr_data[!exclude_parents, on = c('file', 'id')]
+    call_neighbors = call_neighbors[!exclude_parents, on = c('file', 'id')]
+  }
   setnames(call_neighbors, 'parent', 'ancestor')
 
   get_strings_from_expr(call_neighbors, expr_data, recursive = recursive)
@@ -378,52 +395,50 @@ get_named_arg_strings = function(expr_data, fun, args, recursive = FALSE, plural
 }
 
 get_strings_from_expr = function(target_expr, expr_data, recursive = FALSE) {
-  strings = string_schema()
+  str_list = list(string_schema())
   while (nrow(target_expr) > 0L) {
     target_expr = expr_data[
       target_expr, on = c('file', parent = 'id'),
       .(file, ancestor = i.ancestor, fname = i.fname, id = x.id, token = x.token, text = x.text)
     ]
-    strings = rbind(
-      strings,
-      target_expr[
-        token == 'STR_CONST',
-        .(file, parent = ancestor, id, fname, msgid = text)
-      ],
-      fill = TRUE
-    )
+    str_consts = target_expr[
+      token == 'STR_CONST',
+      .(file, parent = ancestor, id, fname, msgid = text)
+    ]
+    if (nrow(str_consts)) {
+      str_list[[length(str_list) + 1L]] = str_consts
+    }
     # much cleaner to do this tiny check a small number (e.g. nesting level of 10-15) times
     #   repetitively rather than make a whole separate branch for the once-and-done case
     if (!recursive) break
     target_expr = target_expr[token == "expr"]
   }
-  strings
+  rbindlist(str_list, fill = TRUE)
 }
 
 get_call_args = function(expr_data, calls) {
+  call_tokens = expr_data[token == "SYMBOL_FUNCTION_CALL" & text %chin% calls]
+  if (!nrow(call_tokens)) {
+    return(expr_data[0L, .(file, id, parent, token, text, fname = character())])
+  }
   msg_call_exprs = expr_data[
-    expr_data[token == "SYMBOL_FUNCTION_CALL" & text %chin% calls],
+    call_tokens,
     on = c('file', id = 'parent'),
-    .(file, call_id = i.id, call_expr_id = x.id, call_parent_id = x.parent, fname = i.text)
+    .(file, call_id = i.id, call_expr_id = x.id, call_parent_id = x.parent, fname = i.text,
+      is_indirect = i.line1 != x.line1 | i.col1 != x.col1)
   ]
-  # if not, just skip to a join to get the right schema & return
-  if (nrow(msg_call_exprs)) {
-    msg_call_expr_children = expr_data[
-      msg_call_exprs,
+  if (any(msg_call_exprs$is_indirect)) {
+    prefix_calls = msg_call_exprs[(is_indirect)]
+    prefix_children = expr_data[
+      prefix_calls,
       on = c('file', parent = 'call_expr_id'),
       .(file, parent = x.parent, token = x.token)
     ]
-    # filter out calls like l$stop("x"), keep calls like base::stop("x")
-    msg_call_expr_children = msg_call_expr_children[
-      , by = .(file, parent),
-      # filter .SD here to ensure one row per file/parent, otherwise we get duplicates below
-      if (.N == 1L || 'NS_GET' %chin% token) .SD[token == 'SYMBOL_FUNCTION_CALL']
-    ]
-    msg_call_exprs = msg_call_exprs[
-      msg_call_expr_children,
-      on = c('file', call_expr_id = 'parent'),
-      .(file, call_id, call_expr_id, call_parent_id, fname)
-    ]
+    ns_get = prefix_children[token == 'NS_GET']
+    invalid_parents = prefix_children[!ns_get, on = c('file', 'parent')]
+    if (nrow(invalid_parents)) {
+      msg_call_exprs = msg_call_exprs[!invalid_parents, on = c('file', call_expr_id = 'parent')]
+    }
   }
   msg_call_neighbors = expr_data[
     msg_call_exprs, on = c('file', parent = 'call_parent_id'),
@@ -433,29 +448,33 @@ get_call_args = function(expr_data, calls) {
 }
 
 get_named_args = function(calls_data, expr_data, target_args) {
-  # NB: use this instead of flipping the join order since that will find
-  #   a SYMBOL_SUB for every expr rather than an expr for every SYMBOL_SUB. The
-  #   former might return multiple rows if domain= is followed by more named args.
-  #   important in the current logic because we do drop_suppressed before
-  #   running this again, at which point there will be orphaned SYMBOL_SUB
+  sub_data = calls_data[token == "SYMBOL_SUB" & text %chin% target_args]
+  if (!nrow(sub_data)) {
+    return(calls_data[0L, .(file, parent, id, fname, arg_name = character(), arg_value = character())])
+  }
   # summary: rolling backwards from the expr id to the corresponding SYMBOL_SUB id
   named_args = calls_data[token == "expr"][
-    calls_data[token == "SYMBOL_SUB" & text %chin% target_args],
+    sub_data,
     on = c('file', 'parent', 'id'), roll = -Inf,
     .(file, parent, id = x.id, fname = x.fname, arg_name = i.text)
   ]
-  named_args[expr_data, on = c('file', id = 'parent'), arg_value := i.text][]
+  if (nrow(named_args)) {
+    named_args[ , arg_value := expr_data[named_args, on = c('file', parent = 'id'), mult = 'last', x.text]]
+  } else {
+    named_args[ , arg_value := character()]
+  }
+  named_args
 }
 
 drop_suppressed_and_named = function(calls_data, expr_data, target_args) {
   named_args = get_named_args(calls_data, expr_data, target_args)
+  if (!nrow(named_args)) return(calls_data)
   # strip away calls where domain=NA by dropping the common parent's immediate children;
   #   nested expressions without domain=NA will still be there
-  calls_data = calls_data[
-    # text == "NA" implicitly filtering non-literal arg values since those <expr> nodes will have empty text
-    !named_args[arg_name == "domain" & arg_value == "NA"],
-    on = c('file', 'parent')
-  ]
+  suppressed = named_args[arg_name == "domain" & arg_value == "NA"]
+  if (nrow(suppressed)) {
+    calls_data = calls_data[!suppressed, on = c('file', 'parent')]
+  }
   # strip away any other expr associated with named args (note join to id, not parent)
   calls_data[!named_args, on = c('file', 'id')]
 }
@@ -516,16 +535,21 @@ clean_text = function(x) {
     '^[rR]["\'][-]*[\\[({](.*)[\\])}][-]*["\']$|^(?s)["\'](.*)["\']$',
     '\\1\\2', x, perl = TRUE
   )
+  has_backslash = grepl('\\', x, fixed = TRUE)
+  if (!any(has_backslash)) return(x)
+
+  xb = x[has_backslash]
   # there may be others, these are the main ones... lookback since actual escaped \\n shouldn't be replaced.
   #   an non-perl approach with capture groups like (^|[^\\])[\\]n fails on consecutive \\n\\n due to greediness
-  x = gsub("(?:^|(?<![\\\\]))[\\\\]n", "\n", x, perl = TRUE)
-  x = gsub("(?:^|(?<![\\\\]))[\\\\]t", "\t", x, perl = TRUE)
+  xb = gsub("(?:^|(?<![\\\\]))[\\\\]n", "\n", xb, perl = TRUE)
+  xb = gsub("(?:^|(?<![\\\\]))[\\\\]t", "\t", xb, perl = TRUE)
   # maybe stop() instead? \r is blocked by gettext...
-  x = gsub("(?:^|(?<![\\\\]))[\\\\]r", "\r", x, perl = TRUE)
+  xb = gsub("(?:^|(?<![\\\\]))[\\\\]r", "\r", xb, perl = TRUE)
   # quotes that are escaped _in the text_ are not escaped _in R_ (i.e., after parsing),
   #   e.g. in 'a string with an \"escaped\" quote', the escapes for " disappear after parsing. See #128
-  x = gsub("(?:^|(?<![\\\\]))[\\\\](['\"])", "\\1", x, perl = TRUE)
-  x = gsub('\\\\', '\\', x, fixed = TRUE)
+  xb = gsub("(?:^|(?<![\\\\]))[\\\\](['\"])", "\\1", xb, perl = TRUE)
+  xb = gsub('\\\\', '\\', xb, fixed = TRUE)
+  x[has_backslash] = xb
   x
 }
 

R/get_src_messages.R

@@ -350,9 +350,9 @@ preprocess = function(contents) {
 
 is_outside_char_array = function(char_pos, arrays) {
   if (char_pos[1L] < 0L) return(logical())
-
-  charDT = data.table(start = char_pos, end = char_pos)
-  is.na(foverlaps(charDT, arrays, by.x = c('start', 'end'), which = TRUE)$yid)
+  if (!nrow(arrays)) return(rep(TRUE, length(char_pos)))
+  idx = findInterval(char_pos, arrays$array_start)
+  idx == 0L | char_pos > arrays$array_end[pmax(1L, idx)]
 }
 
 drop_excluded = function(msg_data, exclusions) {
@@ -383,12 +383,11 @@ match_parens = function(file, contents, arrays) {
     gregexpr("[()]", contents, perl = TRUE)[[1L]],
     gregexpr("(?<=')[()](?=')", contents, perl = TRUE)[[1L]]
   )
-  all_parens = data.table(paren_start = paren_locs, paren_end = paren_locs, key = c("paren_start", "paren_end"))
-  # exclude parens inside arrays, which needn't be balanced
-  in_array = foverlaps(arrays, all_parens, nomatch = NULL, which = TRUE)$yid
-  if (length(in_array)) {
-    all_parens = all_parens[-in_array]
+  if (nrow(arrays) && length(paren_locs) && paren_locs[1L] > 0L) {
+    idx = findInterval(paren_locs, arrays$array_start)
+    paren_locs = paren_locs[idx == 0L | paren_locs > arrays$array_end[pmax(1L, idx)]]
   }
+  all_parens = data.table(paren_start = paren_locs, paren_end = paren_locs, key = c("paren_start", "paren_end"))
 
   # goal: associate lparens with their corresponding rparen. rparens assigned end=-1 for the %in% step below to work
   all_parens[ , "lparen" := substring(contents, paren_start, paren_start) == "("]

R/onLoad.R

@@ -3,17 +3,17 @@ globalVariables(
     'msgid', 'msgstr', 'x.msgstr', 'msgid_plural', 'msgstr_plural', 'x.msgstr_plural',
     'message_source', 'type', 'line_number', 'fuzzy', 'x.fuzzy',
     'is_repeat', 'is_marked_for_translation', 'is_templated',
-    'id', 'x.id', 'i.id', 'line1', 'i.line1', 'x.line1', 'i.col1', 'i.line2', 'i.col2',
+    'id', 'x.id', 'i.id', 'line1', 'i.line1', 'x.line1', 'col1', 'i.col1', 'x.col1', 'i.line2', 'col2', 'i.col2',
     'text', 'x.text', 'i.text', 'x.token', 'token', 'fname', 'x.fname', 'i.fname',
     'parent', 'x.parent', 'i.parent', 'ancestor', 'i.ancestor',
     'call_expr', 'call_id', 'call_expr_id', 'call_parent_id', 'arg_name', 'arg_value', 'lines',
     'source_location', 'c_fmt_tag', 'msgid_plural_str', 'msgstr_plural_str', 'suggested_call',
-    'array_start', 'i.array_start', 'array_end', 'i.array_end', 'call_start', 'x.call_start', 'i.call_start',
+    'array_start', 'i.array_start', 'array_end', 'i.array_end', 'i.call', 'call_start', 'x.call_start', 'i.call_start',
     'paren_start', 'i.paren_start', 'paren_end', 'i.paren_end', 'x.paren_end',
     'i.msgid', 'replacement', 'non_spurious', 'str_arg',
     'start', 'start.x', 'end', 'special', 'redirect_start', 'redirect_length', 'id_start', 'id_length',
     'width_precision', 'width_precision_start', 'width_precision_length', 'by_id',
-    'lparen', 'N.x', 'N.y', 'next_paren', 'next_start',
+    'lparen', 'N.x', 'N.y', 'next_paren', 'next_start', 'is_indirect',
     'nplurals', 'full_name_eng', 'full_name_native', 'plural_index',
     '.', 'N'
   ),

R/po_create.R

@@ -54,9 +54,8 @@ pot_paths <- function(dir, type, package = NULL) {
   }
 
 }
-po_prefix <- function(type = c("R", "src")) {
-  data.table::fifelse(type == "R", "R-", "")
-}
+po_prefix <- function(type = c("R", "src")) fifelse(type == "R", "R-", "")
+
 pot_types <- function(dir = ".") {
   types <- c("R", "src")
   types[file.exists(pot_paths(dir, types))]

R/write_po_file.R

@@ -391,7 +391,7 @@ wrap_string = function(str, boundary, str_width, line_width) {
 
 make_src_location <- function(files, lines, message_source, use_base_rules) {
   if (use_base_rules && message_source == "R") return("")
-  s <- paste(glue("{files}:{lines}"), collapse = " ")
+  s <- paste(paste0(files, ":", lines), collapse = " ")
   # branch above implies use_base_rules => message_source == "src"
   # 77 = 80 - nchar("#: "). 80 not 79 is for strwrap. NB: strwrap("012 345", width=4)
   paste0("#: ", if (use_base_rules) strwrap(s, width=77L) else s, "\n", collapse="")