Use roxygen2 parser for roxy comments + lightparser for figure and tbl captions

.github/CONTRIBUTING.md

@@ -47,7 +47,7 @@ See our guide on [how to create a great issue](https://code-review.tidyverse.org
 * `define_outline_criteria()` if an item shows as outline, but seems like a false positive, 
 
 
-* `keep_outline_element()`: if an element is **missing** from outline.
+* `keep_outline_element()`: if an element is **missing** from outline, you can add the keyword "REQUIRED ELEMENT" to get an object for debugging.
 
 * `define_important_element()` if an element is important [^1] 
 
@@ -112,6 +112,6 @@ Be careful for markdown vs non-markdown (i.e. section title not the same)
 
 5. If important, add to criteria in `define_important_element()`
 
-6. Look at the result. Ideally, add to _ref/my-analysis.R, so it shows somehow in snapshots.
+6. Look at the result. Ideally, add to _outline/my-analysis.R, so it shows somehow in snapshots.
 
 NEWS.md is handled differently than other files.

DESCRIPTION

@@ -35,11 +35,14 @@ Suggests:
     curl,
     gert,
     gt,
+    lightparser,
     magick,
     pillar,
+    roxygen2,
     testthat (>= 3.2.1),
+    tidyr,
     withr
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.1.9000

NAMESPACE

@@ -4,6 +4,7 @@ S3method(print,outline_report)
 export(active_rs_doc)
 export(active_rs_doc_copy)
 export(active_rs_doc_delete)
+export(active_rs_doc_nav)
 export(arrange_identity)
 export(browse_pkg)
 export(case_if_any)

NEWS.md

@@ -2,6 +2,18 @@
 
 * `proj_list()` / `proj_switch()` no longer opens a nested project if looking for `"pkgdown"`, `"testthat"`, etc.
 
+* `proj_outline()` was improved to work with roxygen2 and lightparser to parse file contents more consistenly. This means a slowdown, but the increased accuracy is worth it! Parsing a single file should still be pretty fast!
+
+* `proj_outline()` gains `exclude_tests` to exclude tests from outline
+
+* `doc_title`, `is_plot_or_tab_title` is better detected now.
+
+* `proj_outline()` now detects legacy `fig.cap` in the chunk header. See `knitr::convert_chunk_headers()` for the newer approach. 
+
+* `proj_outline()` now autolinks GitHub issue inside the repo.
+
+* `file_outline()` now supports [R reports](https://rmarkdown.rstudio.com/articles_report_from_r_script.html) (basic)
+
 # reuseme 0.0.2
 
 * `complete_todo()` no longer deletes the full line. It only deletes what it says it deletes (#27).

R/browse-pkg.R

@@ -88,9 +88,9 @@ browse_pkg <- function(package = NULL,
       "reference"
     )
 
-    pkgdown <- stringr::str_remove(pkgdown, "/$")
+    pkgdown <- sub("/$", "", pkgdown)
     pkgdown_tabs_url <- paste0(pkgdown, "/", pkgdown_tabs, "/")
-    if (stringr::str_detect(pkgdown, "r-lib.org|tidyverse.org|tidymodels.org") && !stringr::str_detect(pkgdown, "github.com")) {
+    if (grepl("r-lib.org|tidyverse.org|tidymodels.org", pkgdown) && !grepl("github.com", pkgdown, fixed = TRUE)) {
       # known packages with dev enabled.
       pkgdown_tabs_url[1] <- paste0(pkgdown, "/dev/news")
     }

R/dplyr-plus.R

@@ -240,10 +240,10 @@ filter_if_any <- function(.data, ..., .by = NULL, .keep_new_var = FALSE) {
   if (all(purrr::map_lgl(variables[, 1:n_var], is.logical))) {
     res <- dplyr::filter(variables, dplyr::if_any(.cols = seq_len(n_var)), .by = {{ .by }})
 
-    if (!.keep_new_var) {
-      res <- res[-seq_len(n_var)]
-    } else {
+    if (.keep_new_var) {
       cli::cli_warn("You have modified the original data")
+    } else {
+      res <- res[-seq_len(n_var)]
     }
 
     return(res)
@@ -310,14 +310,13 @@ extract_cell_value <- function(data, var, filter, name = NULL, length = NULL, un
   if (unique) {
     res2 <- unique_named(res2)
   }
-  if (!is.null(length)) {
+
+  if (!is.null(length) && !rlang::has_length(res2, length)) {
     # TODO use `check_length()` when implemented. r-lib/rlang#1618
-    if (!rlang::has_length(res2, length)) {
-      cli::cli_abort(c(
-        "Expected an output of {length}",
-        "Got an output of {length(res2)}"
-      ))
-    }
+    cli::cli_abort(c(
+      "Expected an output of {length}",
+      "Got an output of {length(res2)}"
+    ))
   }
 
   res2

R/escape-inline-markup.R

@@ -28,12 +28,12 @@ escape_markup <- function(x) {
   is_markup_okay <- is_bracket & stringr::str_detect(x, "\\{\\.[:alpha:]+[^\\{]") & !local_var_ref_in_markup & !is_markup_incorrect(x)
 
   if (all(is_markup_okay) && !any(local_var_ref_in_markup)) {
-    x[is_left_bracket & !is_bracket] <- stringr::str_replace_all(x[is_left_bracket & !is_bracket], "\\{", "{{")
-    x[is_right_bracket & !is_bracket] <- stringr::str_replace_all(x[is_right_bracket & !is_bracket], "\\}", "}}")
+    x[is_left_bracket & !is_bracket] <- gsub("{", "{{", x[is_left_bracket & !is_bracket], fixed = TRUE)
+    x[is_right_bracket & !is_bracket] <- gsub("}", "}}", x[is_right_bracket & !is_bracket], fixed = TRUE)
     return(x)
   }
   # replace fn arg {fn}(arg) -> fn({arg})
-  valid_r_variable_regex <- "[:alpha:][[:alpha:]\\_\\d]+"
+  valid_r_variable_regex <- "\\.?[:alpha:][[:alpha:]\\_\\d]+"
   x <- stringr::str_replace_all(
     x,
     paste0("\\{(", valid_r_variable_regex, ")\\}\\("),
@@ -59,16 +59,20 @@ escape_markup <- function(x) {
   # )
   # replace variables
 
+  x <- replace_r_var(x)
 
+  x[is_left_bracket & !is_bracket] <- gsub("{", "{{", x[is_left_bracket & !is_bracket], fixed = TRUE)
+  x[is_right_bracket & !is_bracket] <- gsub("}", "}}", x[is_right_bracket & !is_bracket], fixed = TRUE)
 
-  x <- replace_r_var(x)
+  # whisker replacement {{{ vignette_title }}} in usethis by vignette_title
+  x <- stringr::str_replace_all(x, "\\{\\{?\\{?(\\s?[^\\}]+) \\}?\\}?\\}", "\\1")
 
-  x[is_left_bracket & !is_bracket] <- stringr::str_replace_all(x[is_left_bracket & !is_bracket], "\\{", "{{")
-  x[is_right_bracket & !is_bracket] <- stringr::str_replace_all(x[is_right_bracket & !is_bracket], "\\}", "}}")
+  # make `{` and `}` work
+  x <- stringr::str_replace_all(x, c("`\\{`" = "`{{`", "`\\}`" = "`}}`"))
 
   if (any(stringr::str_detect(x, "\\{{3,10}"))) {
     # more than 3 {
-    cli::cli_abort("internal errror. Did not transform string correctly.")
+    rlang::abort(c("internal error. Did not transform string correctly.", x))
   }
   x
 }
@@ -84,7 +88,7 @@ escape_markup <- function(x) {
 #' is_markup_incorrect("{.file {gt}}")
 is_markup_incorrect <- function(x) {
   # no match of single { or }
-  valid_r_variable_regex <- "[:alpha:][[:alpha:]\\_\\d]+"
+  valid_r_variable_regex <- "\\.?[:alpha:][[:alpha:]\\_\\d]+"
 
   stringr::str_detect(x, pattern = paste0("(?<!\\{)\\{", valid_r_variable_regex, "\\}(?!\\})")) |
     stringr::str_detect(x, pattern = "\\]\\(\\{.+\\}\\)\\}") |
@@ -107,7 +111,7 @@ cli_escape <- function(x) {
 #' # example code
 #' replace_r_var("{gt_var} in {{gt_var}} in gt_var in {.file {gt_var}} and {my1e}.")
 replace_r_var <- function(x) {
-  valid_r_variable_regex <- "[:alpha:][[:alpha:]\\_\\d]+"
+  valid_r_variable_regex <- "\\.?[:alpha:][[:alpha:]\\_\\d]+"
   regexp <- paste0("(?<!\\{)\\{(", valid_r_variable_regex, ")\\}(?!\\})")
   stringr::str_replace_all(
     x, regexp, "\\{\\{\\1\\}\\}"
@@ -118,8 +122,8 @@ replace_r_var <- function(x) {
 #'
 #' @examples
 #' replace_r_var("i{gt_var} in {{gt_var}} in gt_var in {.file {gt_var}}.")
-#' # last instance taken care of with escape_markup with a different strategy
 #' #> "{{gt_var}} in {{gt_var}} in gt_var in {.file {gt_var}}."
+#' # last instance taken care of with escape_markup with a different strategy
 #' escape_markup("{gt_var} in {{gt_var}} in gt_var in {.file {gt_var}}.")
 #' #> "{{gt_var}} in {{gt_var}} in gt_var in {.file gt_var}."
 NULL

R/files-conflicts.R

@@ -118,7 +118,7 @@ solve_file_name_conflict <- function(files, regex, dir = ".", extra_msg = NULL,
       cli::cli_inform
     }
     # Remove duplicated Found x references
-    which_bullet_to_replace <- stringr::str_subset(extra_msg, "Found references to", negate = TRUE)
+    which_bullet_to_replace <- stringr::str_subset(extra_msg, stringr::fixed("Found references to"), negate = TRUE)
     # possibly just move up our
     # extra_msg[i] <-
     f_inform(c(
@@ -152,8 +152,8 @@ get_referenced_files <- function(files) {
     stringr::str_subset(pattern = "file.[(exist)|(delete)]|glue\\:\\:glue|unlink", negate = TRUE) |> # don't detect where we test for existence of path or construct a path with glue
     stringr::str_subset(pattern = "[(regexp)|(pattern)]\\s\\=.*\".*[:alpha:]\"", negate = TRUE) |> # remove regexp = a.pdf format
     stringr::str_subset(pattern = "grepl?\\(|stringr|g?sub\\(", negate = TRUE) |> # avoid regexp
-    stringr::str_subset(pattern = "nocheck", negate = TRUE) |> # remove nocheck and unlink statements (refers to deleted files anywa)
-    stringr::str_subset("\"") |>
+    stringr::str_subset(pattern = stringr::fixed("nocheck"), negate = TRUE) |> # remove nocheck and unlink statements (refers to deleted files anywa)
+    stringr::str_subset(stringr::fixed("\"")) |>
     stringr::str_trim() |>
     stringr::str_extract_all("\"[^\"]+\"") |>
     unlist() |>
@@ -163,7 +163,7 @@ get_referenced_files <- function(files) {
     stringr::str_subset(pattern = "tmp|temp", negate = TRUE) |> # remove common file names that are not very nice
     stringr::str_subset(pattern = "https?", negate = TRUE) |> # doesn't check for files read online.
     stringr::str_subset(pattern = "\\@.+\\.", negate = TRUE) |> # email addresses or containing @
-    stringr::str_subset(pattern = "_fichiers/", negate = TRUE) |> # manually remove false positive
+    stringr::str_subset(pattern = stringr::fixed("_fichiers/"), negate = TRUE) |> # manually remove false positive
     stringr::str_subset(pattern = "\n", negate = TRUE) |> # remove things with line breaks
     stringr::str_subset(pattern = "^\\.[:alpha:]{1,4}$", negate = TRUE) |> # remove reference to only file extensions
     stringr::str_subset(pattern = "\\.\\d+$", negate = TRUE) |> # remove 0.000 type

R/markup.R

@@ -9,14 +9,14 @@
 #'
 #' Afterwards, we use [markup_href()] to create a cli link
 #' @param x A string, usually lines of files that contains issue numbers.
-#'
+#' @param home_repo Optional, but if supplied, will be stripped.
 #' @return A markdown link linked issue to GitHub issue
 #' @export
 #' @keywords internal
 #' @family inline markup internal helpers
 #' @examples
 #' link_gh_issue(c("We really need rstudio/gt#1469 to be fixed."))
-link_gh_issue <- function(x) {
+link_gh_issue <- function(x, home_repo = NULL) {
   # Return early if no issue pattern is detected.
   regex_gh_issue <- common_regex("gh_issue")
 
@@ -37,11 +37,73 @@ link_gh_issue <- function(x) {
     regex_gh_issue,
     paste0("[\\1#\\2](https://github.com/\\1/issues/\\2)")
   )
+  if (!is.null(home_repo)) {
+    x_changed <- gsub(
+      paste0(home_repo, "#"),
+      "#",
+      x_changed
+    )
+  }
 
   x[has_gh_issue] <- x_changed
   x
 }
+# transforms (#xx) to (org/repo#xx)
+link_local_gh_issue <- function(x, repo_home) {
+  gsub(
+    # max 99999 issues.
+    pattern = "\\((#\\d{1,5})\\)",
+    paste0("(", repo_home, "\\1)"),
+    x
+  )
+}
+find_pkg_org_repo <- function(dir_common = NULL, file = NULL) {
+  rlang::local_interactive(FALSE)
+  withr::local_options("usethis.quiet" = TRUE)
+  if (!is.null(dir_common)) {
+    pkg_path <- tryCatch(
+      rprojroot::find_package_root_file(path = dir_common),
+      error = function(e) {
+        # cli::cli_inform("Could not detect path.")
+        NULL
+      }
+    )
+    if (is.null(pkg_path)) {
+      return(NULL)
+    }
+    gh_url <- tryCatch(
+      usethis::browse_github(basename(pkg_path)),
+      error = function(e) {
+        # TODO possibly look into checking desc::desc_get("BugReports", "~/path/to/DESCRIPTION")
+        # cli::cli_abort("didn't find a way to do what is required.", parent = e)
+        NULL
+      }
+    )
+    if (is.null(gh_url)) {
+      return(NULL)
+    }
+    org_repo_found <- sub(".+github.com/|.+gitlab.com/", "", gh_url)
+    return(org_repo_found)
+  }
+
+  if (!is.null(file)) {
+    pkg_path <- withCallingHandlers(
+      rprojroot::find_package_root_file(path = file),
+      error = function(e) {
+        # cli::cli_inform("Could not detect path.")
+        NULL
+      }
+    )
 
+    gh_url <- usethis::browse_github(basename(pkg_path))
+    org_repo_found <- sub(".+github.com/|.+gitlab.com/", "", gh_url)
+  } else {
+    org_repo_found <- NULL
+  }
+  if (is.null(org_repo) && is.null(org_repo_found)) {
+    cli::cli_abort("No way to discover URL.")
+  }
+}
 #' Create a cli href with a markdown link
 #'
 #' Transforms `[text](url)` -> `{.href [text](url)}`

R/open.R

@@ -39,10 +39,10 @@ open_rs_doc <- function(path, line = -1L, col = -1L, move_cursor = TRUE) {
 #' @name open_rs_doc
 #' @export
 active_rs_doc <- function() {
-  if (!interactive() && !rstudioapi::isAvailable()) {
+  if (!interactive() && !is_rstudio()) {
     return("Non-existing doc")
   }
-  if (!rstudioapi::isAvailable()) {
+  if (!is_rstudio()) {
     cli::cli_abort("Not in RStudio.")
   }
   unsaved_doc <- tryCatch(rstudioapi::documentPath(), error = function(e) TRUE)
@@ -79,20 +79,21 @@ active_rs_doc_copy <- function(new = NULL, ..., old = NULL) {
     cli::cli_abort("Unsaved document, focus on the saved doc you want to save.")
   }
 
-  if (!fs::path_ext(old) %in% c("R", "qmd", "Rmd")) {
-    cli::cli_abort("Only R docs for now")
+  if (!fs::path_ext(old) %in% c("md", "R", "qmd", "Rmd")) {
+    cli::cli_abort("Only R and md docs for now")
   }
   old_path_file <- fs::path_ext_remove(fs::path_file(old))
-  if (stringr::str_detect(old, "r-profile|Rprofile")) {
+
+  if (grepl("r-profile|Rprofile", old)) {
     cli::cli_abort("Attempting to copy Rprofile (focus on the document you want)")
   }
   if (is.null(new)) {
     new_name <- paste0(old_path_file, "-new")
   } else {
-    new_name <- stringr::str_remove(new, "\\.R|\\.qmd|\\.Rmd$")
+    new_name <- sub("\\.R|\\.[Rq]?md$", "", new)
   }
   # Hack to ensure file/file.R will be correctly renamed.
-  new_path <- stringr::str_replace(old, paste0(old_path_file, "\\."), paste0(new_name, "."))
+  new_path <- sub(paste0(old_path_file, "\\."), paste0(new_name, "."), old)
 
   copied <- file.copy(old, new_path, overwrite = FALSE)
   if (copied) {
@@ -124,7 +125,7 @@ active_rs_doc_copy <- function(new = NULL, ..., old = NULL) {
 #' @examplesIf FALSE
 #' active_rs_doc_delete()
 active_rs_doc_delete <- function() {
-  if (!rlang::is_interactive() || !rstudioapi::isAvailable()) {
+  if (!rlang::is_interactive() || !is_rstudio()) {
     cli::cli_abort(c("Can't delete files in non-interactive sessions."))
   }
   doc <- active_rs_doc()
@@ -140,7 +141,7 @@ active_rs_doc_delete <- function() {
   if (fs::is_dir(elems$full_path)) {
     cli::cli_abort("Must be a file", .internal = TRUE)
   }
-  if (interactive() && rstudioapi::isAvailable()) {
+  if (interactive() && is_rstudio()) {
     rstudioapi::documentSave()
   }
   cli::cli_inform(c(
@@ -256,7 +257,7 @@ active_rs_doc_delete <- function() {
     cli::cli_inform(c(
       "v" = "Deleted the active document {.val {elems$rel_path}} because {reasons_deleting}.",
       # FIXME (upstream) the color div doesn't go all the way r-lib/cli#694
-      "i" = paste(cli::col_grey("The deleted file"),  "{.path {elems$full_path}}", cli::col_grey("contents are returned invisibly in case you need them."))
+      "i" = paste(cli::col_grey("The deleted file"), "{.path {elems$full_path}}", cli::col_grey("contents are returned invisibly in case you need them."))
     ))
     contents <- readLines(elems$full_path, encoding = "UTF-8")
     fs::file_delete(elems$full_path)
@@ -361,3 +362,36 @@ normalize_proj_and_path <- function(path, call = caller_env()) {
     full_path = full_path
   )
 }
+
+#' Open Files Pane at current document location
+#'
+#' Easily navigate to active file document.
+#'
+#' Wrapper around [executeCommand("activateFiles")][rstudioapi::executeCommand()] +
+#' [rstudioapi::filesPaneNavigate()] + [rstudioapi::getActiveDocumentContext()]
+#'
+#' @param path A path to file to navigate to (default active document).
+#'
+#' @returns NULL, called for its side effects.
+#' @export
+active_rs_doc_nav <- function(path = active_rs_doc()) {
+  if (!is_rstudio() || !interactive()) {
+    cli::cli_abort("Must use in RStudio interactive sessions.")
+  }
+  if (is.null(path)) {
+    cli::cli_abort("Can't navigate to an unsaved file!")
+  }
+  if (fs::is_file(path)) {
+    dir <- fs::path_dir(path)
+  } else if (fs::is_dir(path)) {
+    dir <- path
+  } else {
+    cli::cli_abort("{.arg path} must be an existing file or directory.")
+  }
+  rstudioapi::executeCommand("activateFiles")
+  rstudioapi::filesPaneNavigate(dir)
+  cli::cli_inform(c(
+    "v" = "Navigated to {.path {dir}} in RStudio Files Pane."
+  ))
+  invisible()
+}