#' RegExplain gadget #' #' The function behind the RegExplain Selection and RegExplain File #' addins. Opens the RegExplain gadget interface in an RStudio viewer #' pane. #' #' @examples #' \dontrun{ #' regexplain_gadget(text = month.name, pattern = "(Ma|Ju)|(er)") #' regexplain_web(text = month.name, pattern = "(Ma|Ju)|(er)") #' regexplain_file() #' } #' #' @import miniUI #' @import shiny #' @param text Text to explore in gadget (editable using interface) #' @param pattern Regular Expression to edit or visualize using RegExplain #' @param start_page Open gadget to this tab, one of `"Text"`, `"RegEx"`, #' `"Output"`, or `"Help"` #' #' @return The regular expression built in the app is returned as a character #' string. #' @export regexplain_gadget <- function( text = NULL, pattern = NULL, start_page = if (is.null(text)) "Text" else "RegEx" ) { stopifnot(requireNamespace("miniUI"), requireNamespace("shiny")) viewer <- shiny::paneViewer(minHeight = 800) runGadget( regexplain_gadget_ui(text, pattern, start_page), regexplain_gadget_server(check_version()), viewer = viewer ) } #' @describeIn regexplain_gadget Launches the RegExplain gadget in a browser or an #' RStduio viewer pane. #' @inheritDotParams shiny::shinyApp #' @export regexplain_web <- function(text = NULL, pattern = NULL, start_page = "Text", ...) { stopifnot(requireNamespace("miniUI"), requireNamespace("shiny")) shinyApp( regexplain_gadget_ui(text, pattern, start_page), regexplain_gadget_server(check_version()), ... ) } # ---- Gadget Helper Functions and Variables ---- sanitize_text_input <- function(x) { if (is.null(x) || !nchar(x)) { return(x) } rx_unicode <- "\\\\u[0-9a-f]{4,8}" rx_hex <- "\\\\x[0-9a-f]{2}|\\\\x\\{[0-9a-f]{1,6}\\}" rx_octal <- "\\\\[0][0-7]{1,3}" rx_escape <- paste(rx_unicode, rx_hex, rx_octal, sep = "|") if (grepl(rx_escape, x, ignore.case = TRUE)) { try( { y <- stringi::stri_unescape_unicode(x) }, silent = TRUE ) if (!is.na(y)) x <- y } # x <- gsub("\u201C|\u201D", '"', x) # x <- gsub("\u2018|\u2019", "'", x) x } toHTML <- function(...) { x <- paste(..., collapse = "") x <- gsub("\n", "\\\\n", x) x <- gsub("\t", "\\\\t", x) x <- gsub("\r", "\\\\r", x) HTML(x) } regexFn_choices <- list( "Choose a function" = "", base = c( "grep", "grepl", "sub", #<< "gsub", #<< "regexpr", "gregexpr", "regexec" ), stringr = c( "str_detect", "str_locate", "str_locate_all", "str_extract", "str_extract_all", "str_match", "str_match_all", "str_replace", #<< "str_replace_all", #<< "str_split" ), "rematch2" = c( "re_match", "re_match_all", "re_exec", "re_exec_all" ) ) available_regex_functions <- function() { pkgs <- c("stringr", "rematch2") has_pkg <- vapply(pkgs, requireNamespace, quietly = TRUE, logical(1)) regexFn_choices[c("base", pkgs[has_pkg])] } regexFn_substitute <- c( paste0(c("", "g"), "sub"), paste0("str_replace", c("", "_all")) ) get_pkg_namespace <- function(fn) { x <- names(purrr::keep(regexFn_choices, ~ (fn %in% .))) if (length(x) > 1) warning(fn, " matches multiple functions in regexFn_choices, please review.") x } #' Check if an updated version is available #' #' I included this because it can be difficult to tell if your RStudio Addins #' are up to date. I may add new features that you want but you won't hear about #' the updates. This function checks if an update is available, using GitHub #' tags. If an update is available, a modal dialog is shown when you start #' the regexplain gadget. This only happens once per R session, though, so feel #' free to ignore the message. #' #' @param gh_user GitHub user account #' @param gh_repo GitHub repo name #' @param this_version The currently installed version of the package #' @keywords internal check_version <- function( gh_user = "gadenbuie", gh_repo = "regexplain", this_version = packageVersion("regexplain") ) { ok_to_check <- getOption("regexplain.no.check.version", TRUE) if (!isTRUE(ok_to_check)) { return(NULL) } if (!requireNamespace("jsonlite", quietly = TRUE)) { return(NULL) } get_json <- purrr::possibly(jsonlite::fromJSON, NULL) gh_tags <- get_json( paste0("https://api.github.com/repos/", gh_user, "/", gh_repo, "/git/refs/tags"), simplifyDataFrame = TRUE ) if (!is.null(gh_tags)) { gh_tags$tag <- sub("refs/tags/", "", gh_tags$ref, fixed = TRUE) gh_tags$version <- sub("^v\\.?", "", gh_tags$tag) } if (!is.null(gh_tags) && any(gh_tags$version > this_version)) { max_version <- max(gh_tags$version) max_tag <- gh_tags$tag[gh_tags$version == max_version] options(regexplain.no.check.version = FALSE) return( list( version = max_version, link = paste("https://github.com", gh_user, gh_repo, "releases/tag", max_tag, sep = "/") ) ) } else { return(NULL) } } #' Loads Regex Pattern Library #' #' Patterns sourced from [Regex Hub](https://projects.lukehaas.me/regexhub) #' are available at and are copyright #' Luke Haas licensed under the MIT license available at #' . #' Patterns source from [qdapRegex](https://github.com/trinker/qdapRegex) are #' copyright Tyler Rinker and Jason Gray, licensed under the GPL-2 license. #' #' @keywords internal get_regex_library <- function() { if (!requireNamespace("jsonlite", quietly = TRUE)) { warning("Please install the `jsonlite` package to use template features") return(NULL) } f_patterns <- system.file("extdata", "patterns.json", package = "regexplain") if (!file.exists(f_patterns)) { return(NULL) } patterns <- jsonlite::fromJSON( f_patterns, simplifyVector = FALSE, simplifyDataFrame = FALSE, simplifyMatrix = FALSE ) patterns <- purrr::keep(patterns, ~ .$name != "") patterns[order(purrr::map_chr(patterns, "name"))] }