grkstyle

R/addins.R

@@ -20,30 +20,42 @@ regexplain_addin <- function() {
 
   # If it is one line and evaluates to something, use that
   # Otherwise treat as text
-  obj <- tryCatch({
-    if (grepl("\n", ctx_text)) {
-      ctx_text[1:min(length(ctx_text), max_lines)]
-    } else {
-      x <- eval(parse(text = ctx_text))
-      if (inherits(x, "list")) x <- unlist(x)
-      x <- as.character(x)
-      if (length(x) == 1 && grepl("\n", x))
-        x <- strsplit(x, "\n")[[1]]
-      x <- unique(x)
-      if (length(x) > max_lines) {
-        message(ctx_text, " gave ", length(x), " lines, limiting to first ",
-                max_lines, " unique lines. Set ",
-                "options('regexplain.addin.max_lines') to a higher value to ",
-                "increase the number of lines.")
+  obj <- tryCatch(
+    {
+      if (grepl("\n", ctx_text)) {
+        ctx_text[1:min(length(ctx_text), max_lines)]
+      } else {
+        x <- eval(parse(text = ctx_text))
+        if (inherits(x, "list")) x <- unlist(x)
+        x <- as.character(x)
+        if (length(x) == 1 && grepl("\n", x)) {
+          x <- strsplit(x, "\n")[[1]]
+        }
         x <- unique(x)
-        x[1:min(length(x), max_lines)]
-      } else x
+        if (length(x) > max_lines) {
+          message(
+            ctx_text,
+            " gave ",
+            length(x),
+            " lines, limiting to first ",
+            max_lines,
+            " unique lines. Set ",
+            "options('regexplain.addin.max_lines') to a higher value to ",
+            "increase the number of lines."
+          )
+          x <- unique(x)
+          x[1:min(length(x), max_lines)]
+        } else {
+          x
+        }
+      }
+    },
+    error = function(e) {
+      as.character(ctx_text[1:min(length(ctx_text), max_lines)])
     }
-  },
-  error = function(e) {as.character(ctx_text[1:min(length(ctx_text), max_lines)])})
+  )
 
   regexplain_gadget(if (length(obj) && obj != "") obj)
-
 }
 
 #' @describeIn regexplain_gadget Opens file chooser to pick file, reads lines,

R/gadget.R

@@ -29,7 +29,8 @@ regexplain_gadget <- function(
   runGadget(
     regexplain_gadget_ui(text, pattern, start_page),
     regexplain_gadget_server(check_version()),
-    viewer = viewer)
+    viewer = viewer
+  )
 }
 
 #' @describeIn regexplain_gadget Launches the RegExplain gadget in a browser or an
@@ -41,21 +42,28 @@ regexplain_web <- function(text = NULL, pattern = NULL, start_page = "Text", ...
 
   shinyApp(
     regexplain_gadget_ui(text, pattern, start_page),
-    regexplain_gadget_server(check_version()), ...)
+    regexplain_gadget_server(check_version()),
+    ...
+  )
 }
 
 # ---- Gadget Helper Functions and Variables ----
 
 sanitize_text_input <- function(x) {
-  if (is.null(x) || !nchar(x)) return(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)
+    try(
+      {
+        y <- stringi::stri_unescape_unicode(x)
+      },
+      silent = TRUE
+    )
     if (!is.na(y)) x <- y
   }
   # x <- gsub("\u201C|\u201D", '"', x)
@@ -129,11 +137,15 @@ get_pkg_namespace <- function(fn) {
 check_version <- function(
   gh_user = "gadenbuie",
   gh_repo = "regexplain",
-  this_version = packageVersion('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)
+  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"),
@@ -153,7 +165,9 @@ check_version <- function(
         link = paste("https://github.com", gh_user, gh_repo, "releases/tag", max_tag, sep = "/")
       )
     )
-  } else return(NULL)
+  } else {
+    return(NULL)
+  }
 }
 
 #' Loads Regex Pattern Library
@@ -172,7 +186,9 @@ get_regex_library <- function() {
     return(NULL)
   }
   f_patterns <- system.file("extdata", "patterns.json", package = "regexplain")
-  if (!file.exists(f_patterns)) return(NULL)
+  if (!file.exists(f_patterns)) {
+    return(NULL)
+  }
   patterns <- jsonlite::fromJSON(
     f_patterns,
     simplifyVector = FALSE,
@@ -180,5 +196,5 @@ get_regex_library <- function() {
     simplifyMatrix = FALSE
   )
   patterns <- purrr::keep(patterns, ~ .$name != "")
-  patterns[order(purrr::map_chr(patterns, 'name'))]
+  patterns[order(purrr::map_chr(patterns, "name"))]
 }

R/gadget_server.R

@@ -11,18 +11,24 @@ regexplain_gadget_server <- function(update_available = NULL) {
           footer = modalButton("OK"),
           tagList(
             tags$p(
-              "Version", update_available$version, "is",
-              tags$a(href = update_available$link,
-                     "available on GitHub.")
-            ),
-            if ("devtools" %in% installed.packages()) tags$p(
-              "The fastest way to update is with devtools:",
-              tags$pre(
-                "devtools::update_packages(\"regexplain\")"
+              "Version",
+              update_available$version,
+              "is",
+              tags$a(
+                href = update_available$link,
+                "available on GitHub."
               )
             ),
+            if ("devtools" %in% installed.packages()) {
+              tags$p(
+                "The fastest way to update is with devtools:",
+                tags$pre(
+                  "devtools::update_packages(\"regexplain\")"
+                )
+              )
+            },
             tags$p(
-              class = 'help-block',
+              class = "help-block",
               "This message won't be shown again during this R session."
             )
           )
@@ -32,9 +38,11 @@ regexplain_gadget_server <- function(update_available = NULL) {
 
     # ---- Server - Global ----
     rtext <- reactive({
-      x <- if ('text_break_lines' %in% input$regex_options) {
+      x <- if ("text_break_lines" %in% input$regex_options) {
         strsplit(input$text, "\n")[[1]]
-      } else input$text
+      } else {
+        input$text
+      }
       x
     })
 
@@ -43,13 +51,13 @@ regexplain_gadget_server <- function(update_available = NULL) {
     })
 
     observe({
-      if (getOption('regexplain.debug.gadget.text', FALSE)) {
+      if (getOption("regexplain.debug.gadget.text", FALSE)) {
         cat("\ntext   :", rtext())
       }
-      if (getOption('regexplain.debug.gadget.pattern', FALSE)) {
+      if (getOption("regexplain.debug.gadget.pattern", FALSE)) {
         cat("\npattern:", pattern())
       }
-      if (getOption('regexplain.debug.gadget.replacement', FALSE)) {
+      if (getOption("regexplain.debug.gadget.replacement", FALSE)) {
         cat("\nreplace:", replacement())
       }
       cat("\n")
@@ -58,16 +66,22 @@ regexplain_gadget_server <- function(update_available = NULL) {
     alert_result <- function(msg, type = "danger") {
       msg <- gsub("\n", "<br>", msg)
       msg <- gsub("\t", "&nbsp;&nbsp;", msg)
-      paste0("<pre class='alert alert-", type, "' ",
-             "style='padding: 4px; margin-top: 1px; margin-bottom: 4px;'>",
-             paste(msg, collapse = "<br>"),
-             "</pre>")
+      paste0(
+        "<pre class='alert alert-",
+        type,
+        "' ",
+        "style='padding: 4px; margin-top: 1px; margin-bottom: 4px;'>",
+        paste(msg, collapse = "<br>"),
+        "</pre>"
+      )
     }
 
     # ---- Server - Tab - Regex ----
     output$result <- renderUI({
-      if (is.null(rtext())) return(NULL)
-      delay <- getOption('regexplain.input_delay_ms', NULL)
+      if (is.null(rtext())) {
+        return(NULL)
+      }
+      delay <- getOption("regexplain.input_delay_ms", NULL)
       if (!is.null(delay)) invalidateLater(delay, session)
       if (pattern() == "") {
         return(toHTML(paste('<p class="regexplain">', escape_html(rtext()), "</p>", collapse = "")))
@@ -75,34 +89,39 @@ regexplain_gadget_server <- function(update_available = NULL) {
       res <- NULL
       error_message <- NULL
       warning_message <- NULL
-      tryCatch({
-        res <- paste(
-          view_regex(
-            rtext(),
-            pattern(),
-            ignore.case = 'ignore.case' %in% input$regex_options,
-            perl = 'perl' %in% input$regex_options,
-            fixed = 'fixed' %in% input$regex_options,
-            useBytes = 'useBytes' %in% input$regex_options,
-            # invert = 'invert' %in% input$regex_options,
-            render = FALSE,
-            escape = TRUE,
-            exact  = FALSE,
-            global = "global" %in% input$regex_options),
-          collapse = ""
-        )
-      },
-      error = function(e) {
-        error_message <<- alert_result(e$message, "danger")
-      },
-      warning = function(w) {
-        warning_message <<- alert_result(w$message, "warning")
-      })
-
-      if (is.null(res)) res <- toHTML(
-        paste('<p class="results">', escape_html(rtext()), "</p>", collapse = "")
+      tryCatch(
+        {
+          res <- paste(
+            view_regex(
+              rtext(),
+              pattern(),
+              ignore.case = "ignore.case" %in% input$regex_options,
+              perl = "perl" %in% input$regex_options,
+              fixed = "fixed" %in% input$regex_options,
+              useBytes = "useBytes" %in% input$regex_options,
+              # invert = 'invert' %in% input$regex_options,
+              render = FALSE,
+              escape = TRUE,
+              exact  = FALSE,
+              global = "global" %in% input$regex_options
+            ),
+            collapse = ""
+          )
+        },
+        error = function(e) {
+          error_message <<- alert_result(e$message, "danger")
+        },
+        warning = function(w) {
+          warning_message <<- alert_result(w$message, "warning")
+        }
       )
 
+      if (is.null(res)) {
+        res <- toHTML(
+          paste('<p class="results">', escape_html(rtext()), "</p>", collapse = "")
+        )
+      }
+
       toHTML(paste(error_message, warning_message, res))
     })
 
@@ -124,9 +143,14 @@ regexplain_gadget_server <- function(update_available = NULL) {
             modalButton("Cancel"),
             actionButton("library_apply_pattern", "Use Pattern", class = "btn-success")
           ),
-          selectInput("library_pattern", "Pattern",
-                      choices = c("Choose pattern" = "",
-                                  purrr::set_names(purrr::map_chr(library_patterns, 'name')))),
+          selectInput(
+            "library_pattern",
+            "Pattern",
+            choices = c(
+              "Choose pattern" = "",
+              purrr::set_names(purrr::map_chr(library_patterns, "name"))
+            )
+          ),
           uiOutput("library_pattern_info")
         )
       )
@@ -141,10 +165,12 @@ regexplain_gadget_server <- function(update_available = NULL) {
         tags$p(HTML(tp$description)),
         tags$h5("Pattern"),
         tags$pre(tp$regex),
-        if (!is.null(tp$source)) tags$p(
-          "Source:",
-          if (grepl(rx_url, tp$source)) tags$a(href = tp$source, tp$source) else HTML(tp$source)
-        )
+        if (!is.null(tp$source)) {
+          tags$p(
+            "Source:",
+            if (grepl(rx_url, tp$source)) tags$a(href = tp$source, tp$source) else HTML(tp$source)
+          )
+        }
       )
     })
 
@@ -156,9 +182,13 @@ regexplain_gadget_server <- function(update_available = NULL) {
 
     observe({
       is_empty <- input$pattern == ""
-      if (is_empty) updateTextInput(
-        session, "pattern",
-        placeholder = "Standard RegEx, e.g. \\w+_\\d{2,4}\\s+")
+      if (is_empty) {
+        updateTextInput(
+          session,
+          "pattern",
+          placeholder = "Standard RegEx, e.g. \\w+_\\d{2,4}\\s+"
+        )
+      }
     })
 
     # ---- Server - Tab - Output ----
@@ -166,10 +196,15 @@ regexplain_gadget_server <- function(update_available = NULL) {
 
     output$output_sub <- renderUI({
       req(input$regexFn)
-      if (!input$regexFn %in% regexFn_substitute) return(NULL)
-      textInputCode('regexFn_replacement', 'Subsitution',
-                    value = regexFn_replacement_val,
-                    placeholder = "Replacement Text")
+      if (!input$regexFn %in% regexFn_substitute) {
+        return(NULL)
+      }
+      textInputCode(
+        "regexFn_replacement",
+        "Subsitution",
+        value = regexFn_replacement_val,
+        placeholder = "Replacement Text"
+      )
     })
 
     replacement <- reactive({
@@ -188,9 +223,13 @@ regexplain_gadget_server <- function(update_available = NULL) {
       if (!requireNamespace(regexPkg, quietly = TRUE)) {
         return(cat(
           paste0(
-            "The package `", regexPkg, "` is not installed.\n",
+            "The package `",
+            regexPkg,
+            "` is not installed.\n",
             "To preview results from this package, please run\n\n",
-            "    install.packages(\"", regexPkg, "\")"
+            "    install.packages(\"",
+            regexPkg,
+            "\")"
           )
         ))
       }
@@ -199,17 +238,24 @@ regexplain_gadget_server <- function(update_available = NULL) {
       x <- if (regexPkg == "base") {
         if (req_sub_arg) {
           req(replacement())
-          regexFn(pattern(), replacement(), rtext(),
-                  ignore.case = 'ignore.case' %in% input$regex_options,
-                  perl = 'perl' %in% input$regex_options,
-                  fixed = 'fixed' %in% input$regex_options,
-                  useBytes = 'useBytes' %in% input$regex_options)
+          regexFn(
+            pattern(),
+            replacement(),
+            rtext(),
+            ignore.case = "ignore.case" %in% input$regex_options,
+            perl = "perl" %in% input$regex_options,
+            fixed = "fixed" %in% input$regex_options,
+            useBytes = "useBytes" %in% input$regex_options
+          )
         } else {
-          regexFn(pattern(), rtext(),
-                  ignore.case = 'ignore.case' %in% input$regex_options,
-                  perl = 'perl' %in% input$regex_options,
-                  fixed = 'fixed' %in% input$regex_options,
-                  useBytes = 'useBytes' %in% input$regex_options)
+          regexFn(
+            pattern(),
+            rtext(),
+            ignore.case = "ignore.case" %in% input$regex_options,
+            perl = "perl" %in% input$regex_options,
+            fixed = "fixed" %in% input$regex_options,
+            useBytes = "useBytes" %in% input$regex_options
+          )
         }
       } else if (regexPkg == "stringr") {
         if (req_sub_arg) {
@@ -218,8 +264,8 @@ regexplain_gadget_server <- function(update_available = NULL) {
             rtext(),
             stringr_regex(
               pattern(),
-              ignore_case = 'ignore.case' %in% input$regex_options,
-              literal = 'fixed' %in% input$regex_options
+              ignore_case = "ignore.case" %in% input$regex_options,
+              literal = "fixed" %in% input$regex_options
             ),
             replacement()
           )
@@ -228,17 +274,20 @@ regexplain_gadget_server <- function(update_available = NULL) {
             rtext(),
             stringr_regex(
               pattern(),
-              ignore_case = 'ignore.case' %in% input$regex_options,
-              literal = 'fixed' %in% input$regex_options
+              ignore_case = "ignore.case" %in% input$regex_options,
+              literal = "fixed" %in% input$regex_options
             )
           )
         }
       } else if (regexPkg == "rematch2") {
-        regexFn(rtext(), pattern(),
-                ignore.case = 'ignore.case' %in% input$regex_options,
-                perl = 'perl' %in% input$regex_options,
-                fixed = 'fixed' %in% input$regex_options,
-                useBytes = 'useBytes' %in% input$regex_options)
+        regexFn(
+          rtext(),
+          pattern(),
+          ignore.case = "ignore.case" %in% input$regex_options,
+          perl = "perl" %in% input$regex_options,
+          fixed = "fixed" %in% input$regex_options,
+          useBytes = "useBytes" %in% input$regex_options
+        )
       } else {
         "Um. Not sure how I got here."
       }
@@ -246,7 +295,9 @@ regexplain_gadget_server <- function(update_available = NULL) {
     })
 
     stringr_regex <- function(pattern, ignore_case = FALSE, literal = FALSE) {
-      if (!requireNamespace("stringr", quietly = TRUE)) return(NULL)
+      if (!requireNamespace("stringr", quietly = TRUE)) {
+        return(NULL)
+      }
       do.call(
         eval(parse(text = "stringr::regex")),
         list(pattern = pattern, ignore_case, ignore_case, literal = literal)
@@ -273,7 +324,7 @@ regexplain_gadget_server <- function(update_available = NULL) {
     )
 
     # avoid CRAN check NOTES
-    help_text <- NULL          # in help_server.R
+    help_text <- NULL # in help_server.R
     make_help_tab_text <- NULL # in help_server.R
     source(system.file("shiny", "help_server.R", package = "regexplain"), local = TRUE)
 
@@ -283,14 +334,25 @@ regexplain_gadget_server <- function(update_available = NULL) {
         tags$p("There are lots of great resources available for learning and working with regular expressions."),
         tags$h4("Regular Expressions in R"),
         tags$ul(
-          tags$li(tags$p("The", tags$a(href = "http://stringr.tidyverse.org/articles/regular-expressions.html", "Regular Expressions vignette"),
-                         "from", tags$code("stringr"), "is an excellent first introduction to regular expressions in R.")),
-          tags$li(tags$p("The", tags$a(href = "http://r4ds.had.co.nz/strings.html", "chapter on strings"),
-                         "in", tags$a(href = "http://r4ds.had.co.nz/", "R for Data Science"),
-                         "is also a great overall introduction.")),
-          tags$li(tags$p("RStudio's",
-                         tags$a(href = "https://www.rstudio.com/wp-content/uploads/2016/09/RegExCheatsheet.pdf", "RegEx CheatSheet"),
-                         "is a good pocket reference.")),
+          tags$li(tags$p(
+            "The",
+            tags$a(href = "http://stringr.tidyverse.org/articles/regular-expressions.html", "Regular Expressions vignette"),
+            "from",
+            tags$code("stringr"),
+            "is an excellent first introduction to regular expressions in R."
+          )),
+          tags$li(tags$p(
+            "The",
+            tags$a(href = "http://r4ds.had.co.nz/strings.html", "chapter on strings"),
+            "in",
+            tags$a(href = "http://r4ds.had.co.nz/", "R for Data Science"),
+            "is also a great overall introduction."
+          )),
+          tags$li(tags$p(
+            "RStudio's",
+            tags$a(href = "https://www.rstudio.com/wp-content/uploads/2016/09/RegExCheatsheet.pdf", "RegEx CheatSheet"),
+            "is a good pocket reference."
+          )),
           tags$li(tags$p("Or try the", tags$strong("Regexplain Cheatsheet"), "addin installed with this package."))
         ),
         tags$h4("Online Resources"),
@@ -335,8 +397,10 @@ regexplain_gadget_server <- function(update_available = NULL) {
     load_buttons <- function(..., extra_btns = NULL) {
       prefix <- paste(..., sep = "_")
       btns <- c(
-        list(c("text", "Load Text", "btn-success"),
-             c("pattern", "Load Pattern", "btn-primary")),
+        list(
+          c("text", "Load Text", "btn-success"),
+          c("pattern", "Load Pattern", "btn-primary")
+        ),
         extra_btns
       )
       tags$span(
@@ -351,69 +415,112 @@ regexplain_gadget_server <- function(update_available = NULL) {
     observeEvent(input$help_try_this, {
       tagList(
         tags$h3("Try These Examples"),
-        tags$p("Here are a couple interesting text extraction challenges you can try",
-               "with this gadget."),
+        tags$p(
+          "Here are a couple interesting text extraction challenges you can try",
+          "with this gadget."
+        ),
         tags$h4("Harvard Sentences"),
-        tags$p("These examples come from the",
-               tags$a(href = "http://r4ds.had.co.nz/strings.html", "R for Data Science"),
-               "book and are based on a collection of short sentences called the Harvard Sentences."),
+        tags$p(
+          "These examples come from the",
+          tags$a(href = "http://r4ds.had.co.nz/strings.html", "R for Data Science"),
+          "book and are based on a collection of short sentences called the Harvard Sentences."
+        ),
         tags$ol(
           tags$li(tags$p(
             "Find sentences that contain a color (i.e. red, orange, yellow, green, blue, purple).",
-            load_buttons("help_try_this", "hs", "colors"))),
+            load_buttons("help_try_this", "hs", "colors")
+          )),
           tags$li(tags$p(
             "Use the text from Exercise 1 and make sure that only full words that are colors are found.",
             HTML("E.g. <code>red</code> and not <code>flickered</code>."),
-            tags$span(style = "display: inline-block;",
-                      actionButton("help_try_this_hs_colors_word", "Load Pattern", class = "btn-xs btn-primary"),
-                      actionButton("help_try_this_hs_colors_hint", "Show Hint", class = "btn-xs"))
+            tags$span(
+              style = "display: inline-block;",
+              actionButton("help_try_this_hs_colors_word", "Load Pattern", class = "btn-xs btn-primary"),
+              actionButton("help_try_this_hs_colors_hint", "Show Hint", class = "btn-xs")
+            )
           )),
           tags$li(tags$p(
             "Extract nouns from sentences by finding any word that comes after \"a\" or \"the\".",
-            "Use", actionLink("help_try_this_hs_words_go2_groups", "Groups"),
+            "Use",
+            actionLink("help_try_this_hs_words_go2_groups", "Groups"),
             "to extract the article and possible noun separately and check your results with",
             HTML("<code>stringr::str_match()</code>:"),
-            load_buttons("help_try_this", "hs", "words",
-                         extra_btns = list(c("output", "Check str_match()")))
+            load_buttons(
+              "help_try_this",
+              "hs",
+              "words",
+              extra_btns = list(c("output", "Check str_match()"))
+            )
           )),
           tags$li(tags$p(
-            "Switch the order of the two words following the articles", '"a" or "the"',
-            "using", actionLink("help_try_this_hs_refs_go2_groups", "backreferences,"),
-            "so that", tags$code("the birch canoe"), "would read",
+            "Switch the order of the two words following the articles",
+            '"a" or "the"',
+            "using",
+            actionLink("help_try_this_hs_refs_go2_groups", "backreferences,"),
+            "so that",
+            tags$code("the birch canoe"),
+            "would read",
             HTML("<code>the canoe birch</code>. Use <code>sub</code>"),
-            "in the", tags$strong("Output"), "tab to replace the matched pattern.",
-            load_buttons("help_try_this", "hs", "refs",
-                         extra_btns = list(c("output", "Load Replacement")))
+            "in the",
+            tags$strong("Output"),
+            "tab to replace the matched pattern.",
+            load_buttons(
+              "help_try_this",
+              "hs",
+              "refs",
+              extra_btns = list(c("output", "Load Replacement"))
+            )
           ))
         ),
         tags$h4("Phone Numbers"),
-        tags$p("This example is also from the",
-               tags$a(href = "http://r4ds.had.co.nz/strings.html#other-types-of-pattern",
-                      "R for Data Science"),
-               "book. Phone numbers in the United States start with a 3-digit area code,",
-               "followed by another 3 digits and a final 4-digit group.",
-               "Sometimes the area code is wrapped in parenthesis, or sometimes dots or dashes",
-               "are used to separate the digit groups. Try to extract each digit group from these phone numbers:",
-               load_buttons("help_try_this", "phone",
-                            extra_btns = list(c("output", "Check str_match()")))),
+        tags$p(
+          "This example is also from the",
+          tags$a(
+            href = "http://r4ds.had.co.nz/strings.html#other-types-of-pattern",
+            "R for Data Science"
+          ),
+          "book. Phone numbers in the United States start with a 3-digit area code,",
+          "followed by another 3 digits and a final 4-digit group.",
+          "Sometimes the area code is wrapped in parenthesis, or sometimes dots or dashes",
+          "are used to separate the digit groups. Try to extract each digit group from these phone numbers:",
+          load_buttons(
+            "help_try_this",
+            "phone",
+            extra_btns = list(c("output", "Check str_match()"))
+          )
+        ),
         tags$h4("CSS Unit Validation"),
-        tags$p("This example is used in", tags$code("validateCssUnit()"),
-               "in the", tags$a(href="https://www.r-pkg.org/pkg/htmltools", "htmltools package."),
-               "CSS units can be integer or decimal numbers with units such as",
-               "in, cm, mm, em, ex, pt, px, etc. (see the list",
-               HTML('<a href="https://www.w3.org/Style/Examples/007/units.en.html">here</a>).'),
-               "Try to extract the number and unit from these units:",
-               load_buttons("help_try_this", "css")),
+        tags$p(
+          "This example is used in",
+          tags$code("validateCssUnit()"),
+          "in the",
+          tags$a(href = "https://www.r-pkg.org/pkg/htmltools", "htmltools package."),
+          "CSS units can be integer or decimal numbers with units such as",
+          "in, cm, mm, em, ex, pt, px, etc. (see the list",
+          HTML('<a href="https://www.w3.org/Style/Examples/007/units.en.html">here</a>).'),
+          "Try to extract the number and unit from these units:",
+          load_buttons("help_try_this", "css")
+        ),
         tags$h4("Parse Github Repos"),
-        tags$p("This example is from the",
-               tags$a(href = "https://www.r-pkg.org/pkg/rematch2", "rematch2 package."),
-               "Github repositories are often specified in like",
-               HTML("<code>user/repo/subdir@ref*release</code> or <code>user/repo/subdir#PR</code>"),
-               "where only", tags$code("user"), "and", tags$code("repo"), "are required elements.",
-               "Try to extract each piece of the repo text and use",
-               tags$code("rematch2::re_match()"), "to extract a tidy tibble of matches:",
-               load_buttons("help_try_this", "github",
-                            extra_btns = list(c("output", "Check re_match()"))))
+        tags$p(
+          "This example is from the",
+          tags$a(href = "https://www.r-pkg.org/pkg/rematch2", "rematch2 package."),
+          "Github repositories are often specified in like",
+          HTML("<code>user/repo/subdir@ref*release</code> or <code>user/repo/subdir#PR</code>"),
+          "where only",
+          tags$code("user"),
+          "and",
+          tags$code("repo"),
+          "are required elements.",
+          "Try to extract each piece of the repo text and use",
+          tags$code("rematch2::re_match()"),
+          "to extract a tidy tibble of matches:",
+          load_buttons(
+            "help_try_this",
+            "github",
+            extra_btns = list(c("output", "Check re_match()"))
+          )
+        )
       ) %>%
         as.character() %>%
         help_text()
@@ -425,30 +532,34 @@ regexplain_gadget_server <- function(update_available = NULL) {
         color_text <- stringr::sentences[grepl(color_match, stringr::sentences)]
         color_text <- sample(color_text, 25)
         updateTextAreaInput(session, "text", value = paste(color_text, collapse = "\n"))
-        showNotification("Text loaded! View it in Text tab", type = 'message')
+        showNotification("Text loaded! View it in Text tab", type = "message")
       } else {
-        showNotification("Please install {stringr} for this example", type = 'error')
+        showNotification("Please install {stringr} for this example", type = "error")
       }
     })
 
     observeEvent(input$help_try_this_hs_colors_pattern, {
       color_match <- "red|orange|yellow|green|blue|purple"
-      updateTextInput(session, 'pattern', value = color_match)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines', 'perl'))
-      showNotification("Pattern loaded! View it in RegEx tab", type = 'message')
+      updateTextInput(session, "pattern", value = color_match)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines", "perl"))
+      showNotification("Pattern loaded! View it in RegEx tab", type = "message")
     })
 
     observeEvent(input$help_try_this_hs_colors_word, {
       color_match <- "\\b(red|orange|yellow|green|blue|purple)\\b"
-      updateTextInput(session, 'pattern', value = color_match)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines', 'perl'))
-      showNotification("Pattern loaded! View it in RegEx tab", type = 'message')
+      updateTextInput(session, "pattern", value = color_match)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines", "perl"))
+      showNotification("Pattern loaded! View it in RegEx tab", type = "message")
     })
 
     observeEvent(input$help_try_this_hs_colors_hint, {
       showModal(
-        modalDialog(title = "Hint \U0001f575", footer = NULL, easyClose = TRUE,
-                    tags$p("Try using the", tags$strong("word boundary"), "anchor."))
+        modalDialog(
+          title = "Hint \U0001f575",
+          footer = NULL,
+          easyClose = TRUE,
+          tags$p("Try using the", tags$strong("word boundary"), "anchor.")
+        )
       )
     })
 
@@ -457,7 +568,7 @@ regexplain_gadget_server <- function(update_available = NULL) {
     })
 
     observeEvent(input$help_try_this_hs_words_output, {
-      updateSelectInput(session, 'regexFn', selected = 'str_match')
+      updateSelectInput(session, "regexFn", selected = "str_match")
       showNotification("Go to Output tab to see results from str_match()", type = "message")
     })
 
@@ -465,18 +576,18 @@ regexplain_gadget_server <- function(update_available = NULL) {
       if (requireNamespace("stringr", quietly = TRUE)) {
         hs_text <- sample(stringr::sentences, 25)
         updateTextAreaInput(session, "text", value = paste(hs_text, collapse = "\n"))
-        showNotification("Text loaded! View it in Text tab", type = 'message')
+        showNotification("Text loaded! View it in Text tab", type = "message")
       } else {
-        showNotification("Please install {stringr} for this example", type = 'error')
+        showNotification("Please install {stringr} for this example", type = "error")
       }
     })
 
     observeEvent(input$help_try_this_hs_words_pattern, {
       noun_pattern <- "(a|the) ([^ ]+)"
-      updateTextInput(session, 'pattern', value = noun_pattern)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines'))
-      updateSelectInput(session, 'regexFn', selected = "str_match")
-      showNotification("Pattern loaded! View it in RegEx and Output tabs", type = 'message')
+      updateTextInput(session, "pattern", value = noun_pattern)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines"))
+      updateSelectInput(session, "regexFn", selected = "str_match")
+      showNotification("Pattern loaded! View it in RegEx and Output tabs", type = "message")
     })
 
     observeEvent(input$help_try_this_hs_refs_go2_groups, {
@@ -485,7 +596,7 @@ regexplain_gadget_server <- function(update_available = NULL) {
 
     observeEvent(input$help_try_this_hs_refs_output, {
       regexFn_replacement_val <<- "\\1 \\3 \\2"
-      updateSelectInput(session, 'regexFn', selected = 'sub')
+      updateSelectInput(session, "regexFn", selected = "sub")
       showNotification("Replacement loaded! Go to Output tab to see results", type = "message")
     })
 
@@ -493,21 +604,21 @@ regexplain_gadget_server <- function(update_available = NULL) {
       if (requireNamespace("stringr", quietly = TRUE)) {
         hs_text <- sample(stringr::sentences, 25)
         updateTextAreaInput(session, "text", value = paste(hs_text, collapse = "\n"))
-        showNotification("Text loaded! View it in Text tab", type = 'message')
+        showNotification("Text loaded! View it in Text tab", type = "message")
       } else {
-        showNotification("Please install {stringr} for this example", type = 'error')
+        showNotification("Please install {stringr} for this example", type = "error")
       }
     })
 
     observeEvent(input$help_try_this_hs_refs_pattern, {
       noun_pattern <- "(a|the) ([^ ]+) ([^ ]+)"
-      updateTextInput(session, 'pattern', value = noun_pattern)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines'))
-      showNotification("Pattern loaded! View it in RegEx tab", type = 'message')
+      updateTextInput(session, "pattern", value = noun_pattern)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines"))
+      showNotification("Pattern loaded! View it in RegEx tab", type = "message")
     })
 
     observeEvent(input$help_try_this_phone_output, {
-      updateSelectInput(session, 'regexFn', selected = 'str_match')
+      updateSelectInput(session, "regexFn", selected = "str_match")
       showNotification("Go to Output tab to see results from str_match()", type = "message")
     })
 
@@ -538,14 +649,14 @@ regexplain_gadget_server <- function(update_available = NULL) {
       }
       phone_numbers <- replicate(25, phone_number())
       updateTextAreaInput(session, "text", value = paste(phone_numbers, collapse = "\n"))
-      showNotification("Text loaded! View it in Text tab", type = 'message')
+      showNotification("Text loaded! View it in Text tab", type = "message")
     })
 
     observeEvent(input$help_try_this_phone_pattern, {
       phone_pattern <- "\\(?(\\d{3})[-). ]?(\\d{3})[- .]?(\\d{4})"
-      updateTextInput(session, 'pattern', value = phone_pattern)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines'))
-      showNotification("Pattern loaded! View it in RegEx tab", type = 'message')
+      updateTextInput(session, "pattern", value = phone_pattern)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines"))
+      showNotification("Pattern loaded! View it in RegEx tab", type = "message")
     })
 
     observeEvent(input$help_try_this_github_text, {
@@ -557,37 +668,49 @@ regexplain_gadget_server <- function(update_available = NULL) {
         "r-lib/remotes@550a3c7d3f9e1493a2ba"
       )
       updateTextAreaInput(session, "text", value = paste(github_repos, collapse = "\n"))
-      showNotification("Text loaded! Go to RegEx Tab", type = 'message')
+      showNotification("Text loaded! Go to RegEx Tab", type = "message")
     })
 
     observeEvent(input$help_try_this_github_pattern, {
-      owner_rx   <- "(?:(?<owner>[^/]+)/)?"
-      repo_rx    <- "(?<repo>[^/@#]+)"
-      subdir_rx  <- "(?:/(?<subdir>[^@#]*[^@#/]))?"
-      ref_rx     <- "(?:@(?<ref>[^*].*))"
-      pull_rx    <- "(?:#(?<pull>[0-9]+))"
+      owner_rx <- "(?:(?<owner>[^/]+)/)?"
+      repo_rx <- "(?<repo>[^/@#]+)"
+      subdir_rx <- "(?:/(?<subdir>[^@#]*[^@#/]))?"
+      ref_rx <- "(?:@(?<ref>[^*].*))"
+      pull_rx <- "(?:#(?<pull>[0-9]+))"
       release_rx <- "(?:@(?<release>[*]release))"
 
       subtype_rx <- sprintf("(?:%s|%s|%s)?", ref_rx, pull_rx, release_rx)
-      github_rx  <- sprintf(
+      github_rx <- sprintf(
         "^(?:%s%s%s%s|(?<catchall>.*))$",
-        owner_rx, repo_rx, subdir_rx, subtype_rx
+        owner_rx,
+        repo_rx,
+        subdir_rx,
+        subtype_rx
       )
 
-      updateTextInput(session, 'pattern', value = github_rx)
-      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines', 'perl'))
-      showNotification("Pattern loaded! Go to RegEx Tab", type = 'message')
+      updateTextInput(session, "pattern", value = github_rx)
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines", "perl"))
+      showNotification("Pattern loaded! Go to RegEx Tab", type = "message")
     })
 
     observeEvent(input$help_try_this_github_output, {
-      updateSelectInput(session, 'regexFn', selected = 're_match')
+      updateSelectInput(session, "regexFn", selected = "re_match")
       showNotification("Go to Output tab to see results from re_match()", type = "message")
     })
 
     observeEvent(input$help_try_this_css_text, {
       css_units <- c(
-        "125%","16pt","2cm","7em","3ex","24pt",
-        ".15in","20pc","5.9vw","3.0vh","2vmin"
+        "125%",
+        "16pt",
+        "2cm",
+        "7em",
+        "3ex",
+        "24pt",
+        ".15in",
+        "20pc",
+        "5.9vw",
+        "3.0vh",
+        "2vmin"
       )
       showNotification("Example text loaded! Go to RegEx tab", type = "message")
       updateTextAreaInput(session, "text", value = paste(css_units, collapse = "\n"))
@@ -596,7 +719,7 @@ regexplain_gadget_server <- function(update_available = NULL) {
     observeEvent(input$help_try_this_css_pattern, {
       pattern <- "^(auto|inherit|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px|vh|vw|vmin|vmax))$"
       updateTextInput(session, "pattern", value = pattern)
-      updateCheckboxGroupInput(session, 'regex_options', selected = c('text_break_lines', 'perl'))
+      updateCheckboxGroupInput(session, "regex_options", selected = c("text_break_lines", "perl"))
       showNotification("Pattern loaded! Go to RegEx tab", type = "message")
     })
 
@@ -611,8 +734,11 @@ regexplain_gadget_server <- function(update_available = NULL) {
         }
         if ("regexFn_replacement" %in% names(input) && isTruthy(replacement())) {
           pattern <- paste0(
-            pattern, "\n",
-            'replacement <- "', escape_backslash(replacement()), '"'
+            pattern,
+            "\n",
+            'replacement <- "',
+            escape_backslash(replacement()),
+            '"'
           )
         }
         rstudioapi::sendToConsole(pattern, FALSE)

R/help_ui.R

@@ -10,12 +10,15 @@ generate_help_ui <- function(cheatsheet_only = TRUE) {
       shiny::tagList(
         shiny::tags$ul(
           id = "help-sidebar",
-          if (!cheatsheet_only) shiny::tagList(
-            shiny::tags$li(shiny::tags$strong("RegExplain"), class = "header"),
-            shiny::tags$li(shiny::actionLink("help_default", "Introduction")),
-            shiny::tags$li(shiny::actionLink("help_try_this", "Try These Examples")),
-            shiny::tags$li(shiny::actionLink("help_resources", "Resources")),
-            shiny::tags$li(class = "header", style = "margin-top: 5px;", shiny::tags$strong("Reference"))),
+          if (!cheatsheet_only) {
+            shiny::tagList(
+              shiny::tags$li(shiny::tags$strong("RegExplain"), class = "header"),
+              shiny::tags$li(shiny::actionLink("help_default", "Introduction")),
+              shiny::tags$li(shiny::actionLink("help_try_this", "Try These Examples")),
+              shiny::tags$li(shiny::actionLink("help_resources", "Resources")),
+              shiny::tags$li(class = "header", style = "margin-top: 5px;", shiny::tags$strong("Reference"))
+            )
+          },
           shiny::tags$li("Character Classes", class = "header"),
           shiny::tags$ul(
             class = "subgroup",
@@ -36,7 +39,7 @@ generate_help_ui <- function(cheatsheet_only = TRUE) {
       ),
       shiny::tags$div(
         style = "width: 100%; padding-left: 10px;",
-        shiny::uiOutput('help_text_selected')
+        shiny::uiOutput("help_text_selected")
       )
     )
   )

R/regex.R

@@ -18,11 +18,13 @@ regex <- function(
   m <- purrr::map2(text, m, ~ list(text = .x, idx = expand_matches(.y)))
 
   attr(m, "global") <- global
-  if (!global) return(m)
+  if (!global) {
+    return(m)
+  }
 
   mmi <- max_match_index(m)
   if (any(!is.na(mmi))) {
-    subtext <-  purrr::map_chr(m, "text") %>% purrr::map2_chr(mmi, substring)
+    subtext <- purrr::map_chr(m, "text") %>% purrr::map2_chr(mmi, substring)
     sub_idx <- which(!is.na(subtext))
     m2 <- regex(subtext[sub_idx], pattern, ignore.case, perl, fixed, useBytes)
     for (i in seq_along(m2)) {
@@ -37,16 +39,20 @@ regex <- function(
 }
 
 expand_matches <- function(m) {
-  if (m[1] == -1) return(NULL)
+  if (m[1] == -1) {
+    return(NULL)
+  }
   m_length <- attr(m, "match.length")
-  if (identical(as.vector(m[[1]]), 1L) && m_length == 0) return(NULL)
+  if (identical(as.vector(m[[1]]), 1L) && m_length == 0) {
+    return(NULL)
+  }
   x <- purrr::map2(m, m_length, ~ c(.x, .x + .y))
   x <- as.data.frame(do.call(rbind, x))
   names(x) <- c("start", "end")
   x$start <- ifelse(x$start == 0L, NA_integer_, x$start)
-  x$end   <- ifelse(x$end == 0L, NA_integer_, x$end)
+  x$end <- ifelse(x$end == 0L, NA_integer_, x$end)
   x$group <- 1:nrow(x) - 1L
-  x$pass  <- 1L
+  x$pass <- 1L
   x
 }
 
@@ -55,7 +61,9 @@ max_match_index <- function(m) {
     purrr::map_int(function(idx) {
       if (!is.null(idx)) {
         max(idx$start, idx$end, na.rm = TRUE)
-      } else NA
+      } else {
+        NA
+      }
     })
 }
 
@@ -80,10 +88,11 @@ wrap_result <- function(x, escape = FALSE, exact = FALSE) {
     if (inserts$i[j] == 0) next
     if (is.na(inserts$start[j]) || is.na(inserts$end[j])) next
     overlap <- filter(
-      inserts[1:(j-1), ],
+      inserts[1:(j - 1), ],
       .data$i != 0,
-      .data$start <= !!inserts$start[j] & .data$end >= !!inserts$end[j])
-    inserts[j, 'pad'] <- inserts$pad[j] + nrow(overlap)
+      .data$start <= !!inserts$start[j] & .data$end >= !!inserts$end[j]
+    )
+    inserts[j, "pad"] <- inserts$pad[j] + nrow(overlap)
   }
   inserts <- dplyr::bind_rows(
     inserts %>% select(-.data$end, dplyr::everything(), loc = .data$start) %>% mutate(type = "start"),
@@ -93,7 +102,7 @@ wrap_result <- function(x, escape = FALSE, exact = FALSE) {
     dplyr::arrange(loc, class, dplyr::desc(type)) %>%
     mutate(
       class = ifelse(.data$pad > 0, sprintf("%s pad%02d", .data$class, .data$pad), .data$class),
-      insert = ifelse(.data$type == 'start', sprintf('<span class="%s">', .data$class), "</span>")
+      insert = ifelse(.data$type == "start", sprintf('<span class="%s">', .data$class), "</span>")
     )
 
   inserts <- if (max(inserts$pass) == 1) {
@@ -113,11 +122,12 @@ wrap_result <- function(x, escape = FALSE, exact = FALSE) {
   # start at 0, unless there's a hit on first character
   # end at nchar(text) + 1 because window is idx[k] to idx[k+1]-1
   idx_split <- c(0 - (inserts$loc[1] == 0), inserts$loc)
-  if (!(nchar(text) + 1) %in% idx_split)
+  if (!(nchar(text) + 1) %in% idx_split) {
     idx_split <- c(idx_split, nchar(text) + 1)
+  }
   text_split <- c()
   for (k in seq_along(idx_split[-1])) {
-    text_split <- c(text_split, substr(text, idx_split[k], idx_split[k+1] - 1))
+    text_split <- c(text_split, substr(text, idx_split[k], idx_split[k + 1] - 1))
   }
   out <- c()
   for (j in seq_along(text_split)) {
@@ -128,7 +138,7 @@ wrap_result <- function(x, escape = FALSE, exact = FALSE) {
     )
   }
   if (exact) out <- escape_backslash(out)
-  paste(out, collapse = '')
+  paste(out, collapse = "")
 }
 
 collapse_span_inserts <- function(inserts) {
@@ -141,7 +151,7 @@ collapse_span_inserts <- function(inserts) {
   ) %>%
     mutate(type = sprintf("%05d%s", dplyr::row_number(), type)) %>%
     group_by(.data$loc, .data$type) %>%
-    summarize(insert = paste(.data$insert, collapse = '')) %>%
+    summarize(insert = paste(.data$insert, collapse = "")) %>%
     dplyr::ungroup() %>%
     mutate(type = sub("^\\d{5}", "", type))
 }
@@ -171,7 +181,7 @@ wrap_regex <- function(pattern, escape = TRUE, exact = TRUE) {
     if (pattern_chars[i] == "(") {
       backslash_count <- 0
       if (i != 1) {
-        j <- i-1
+        j <- i - 1
         while (pattern_chars[j] == "\\" && j > 0) {
           backslash_count <- backslash_count + 1
           j <- j - 1
@@ -184,15 +194,15 @@ wrap_regex <- function(pattern, escape = TRUE, exact = TRUE) {
       }
       if (is_capture_group) {
         group <- group + 1
-        paren_stack <- c(TRUE, paren_stack) #push
+        paren_stack <- c(TRUE, paren_stack) # push
         out <- c(out, paste0('<span class="g', sprintf("%02d", group), '">('))
       } else {
-        paren_stack <- c(FALSE, paren_stack) #push
+        paren_stack <- c(FALSE, paren_stack) # push
         out <- c(out, "(")
       }
     } else if (pattern_chars[i] == ")") {
       closes_capture_group <- paren_stack[1]
-      paren_stack <- paren_stack[-1] #pop
+      paren_stack <- paren_stack[-1] # pop
       if (closes_capture_group) {
         out <- c(out, ")</span>")
       } else {
@@ -214,8 +224,7 @@ wrap_regex <- function(pattern, escape = TRUE, exact = TRUE) {
 #' If the output is destined for a [knitr] document, set `knitr` to `TRUE`.
 #'
 #' @examples
-#' view_regex("example", "amp", render=FALSE)
-#'
+#' view_regex("example", "amp", render = FALSE)
 #' @param text Text to search
 #' @param pattern Regex pattern to look for
 #' @param render Render results as HTML?
@@ -238,7 +247,7 @@ view_regex <- function(
   exact = escape,
   result_only = FALSE
 ) {
-  knitr <- isTRUE(getOption('knitr.in.progress'))
+  knitr <- isTRUE(getOption("knitr.in.progress"))
   if (knitr) {
     render <- FALSE
     escape <- TRUE
@@ -269,7 +278,9 @@ view_regex <- function(
       )
     )
   }
-  if (!render) return(res)
+  if (!render) {
+    return(res)
+  }
   page <- result_page(wrap_regex(pattern, escape, exact), res, "View Regex")
   htmltools::browsable(page)
 }

R/shiny_modified_inputs.R

@@ -12,9 +12,18 @@
 #' @inheritParams shiny::textAreaInput
 #' @param is_code Should the text input be considered verbatim code input?
 #' @family modified shiny inputs
-textAreaInputAlt <- function(inputId, label, value = "", width = NULL, height = NULL,
-                             cols = NULL, rows = NULL, placeholder = NULL, resize = NULL,
-                             is_code = TRUE) {
+textAreaInputAlt <- function(
+  inputId,
+  label,
+  value = "",
+  width = NULL,
+  height = NULL,
+  cols = NULL,
+  rows = NULL,
+  placeholder = NULL,
+  resize = NULL,
+  is_code = TRUE
+) {
   `%AND%` <- getFromNamespace("%AND%", "shiny")
 
   value <- shiny::restoreInput(id = inputId, default = value)
@@ -24,7 +33,7 @@ textAreaInputAlt <- function(inputId, label, value = "", width = NULL, height =
   }
 
   style <- paste(
-    if (!is.null(width))  paste0("width: ",  shiny::validateCssUnit(width),  ";"),
+    if (!is.null(width)) paste0("width: ", shiny::validateCssUnit(width), ";"),
     if (!is.null(height)) paste0("height: ", shiny::validateCssUnit(height), ";"),
     if (!is.null(resize)) paste0("resize: ", resize, ";"),
     if (is_code) 'font-family: "Monaco", "Inconsolata", monospace;'
@@ -39,22 +48,23 @@ textAreaInputAlt <- function(inputId, label, value = "", width = NULL, height =
   #   https://github.com/rstudio/htmltools/issues/65
   if (length(style) == 0) style <- NULL
 
-  shiny::div(class = "form-group shiny-input-container",
-             label %AND% shiny::tags$label(label, `for` = inputId),
-             style = if (!parent_style %in% c(" ", "", "  ")) parent_style,
-             shiny::tags$textarea(
-               id = inputId,
-               class = "form-control",
-               placeholder = placeholder,
-               style = style,
-               rows = rows,
-               cols = cols,
-               autocomplete = "off",
-               autocorrect = "off",
-               autocapitalize = "off",
-               spellcheck = "false",
-               value
-             )
+  shiny::div(
+    class = "form-group shiny-input-container",
+    label %AND% shiny::tags$label(label, `for` = inputId),
+    style = if (!parent_style %in% c(" ", "", "  ")) parent_style,
+    shiny::tags$textarea(
+      id = inputId,
+      class = "form-control",
+      placeholder = placeholder,
+      style = style,
+      rows = rows,
+      cols = cols,
+      autocomplete = "off",
+      autocorrect = "off",
+      autocapitalize = "off",
+      spellcheck = "false",
+      value
+    )
   )
 }
 
@@ -68,19 +78,33 @@ textAreaInputAlt <- function(inputId, label, value = "", width = NULL, height =
 #' @param width Width of `shiny-input-container` div.
 #' @param ... Extra elements to be included in the `input-group` div.
 #' @family modified shiny inputs
-textInputCode <- function(inputId, label, value = "", width = NULL,
-                          placeholder = NULL, ...) {
+textInputCode <- function(
+  inputId,
+  label,
+  value = "",
+  width = NULL,
+  placeholder = NULL,
+  ...
+) {
   `%AND%` <- getFromNamespace("%AND%", "shiny")
   value <- shiny::restoreInput(id = inputId, default = value)
 
-  shiny::div(class = "input-group shiny-input-container",
-             style = if (!is.null(width)) paste0("width: ", shiny::validateCssUnit(width), ";"),
-             label %AND% shiny::tags$label(label, `for` = inputId),
-             shiny::tags$input(id = inputId, type="text", class="form-control", value=value,
-                               style = 'font-family: "Monaco", "Inconsolata", monospace;',
-                               autocomplete = "off", autocorrect = "off",
-                               autocapitalize = "off", spellcheck = "false",
-                               placeholder = placeholder),
-             ...
+  shiny::div(
+    class = "input-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", shiny::validateCssUnit(width), ";"),
+    label %AND% shiny::tags$label(label, `for` = inputId),
+    shiny::tags$input(
+      id = inputId,
+      type = "text",
+      class = "form-control",
+      value = value,
+      style = 'font-family: "Monaco", "Inconsolata", monospace;',
+      autocomplete = "off",
+      autocorrect = "off",
+      autocapitalize = "off",
+      spellcheck = "false",
+      placeholder = placeholder
+    ),
+    ...
   )
 }

R/utils.R

@@ -1,11 +1,11 @@
 # highr:::escape_html
 # by Yihui Xie, GPL license
 # https://github.com/yihui/highr/blob/4f54a5b8960d6246daadacea1020ebcdc458ce50/R/utils.R#L54-L61
-escape_html = function(x) {
-  x = gsub('&', '&', x)
-  x = gsub('<', '&lt;', x)
-  x = gsub('>', '&gt;', x)
-  x = gsub('"', '&quot;', x)
+escape_html <- function(x) {
+  x <- gsub("&", "&amp;", x)
+  x <- gsub("<", "&lt;", x)
+  x <- gsub(">", "&gt;", x)
+  x <- gsub('"', "&quot;", x)
   x
 }
 

tests/testthat/test-regex.R

@@ -4,9 +4,9 @@ test_that("expand_matches gives data frame of indices with groups", {
   m <- regexec("(a)(b)(d)?", "abcaba")
   idx <- data.frame(
     start = c(1L, 1L, 2L, NA_integer_),
-    end   = c(3L, 2L, 3L, NA_integer_),
+    end = c(3L, 2L, 3L, NA_integer_),
     group = c(0L, 1L, 2L, 3L),
-    pass  = rep(1L, 4)
+    pass = rep(1L, 4)
   )
   expect_equal(expand_matches(m[[1]]), idx)
 })
@@ -16,7 +16,7 @@ test_that("start/end indices are integers", {
   pattern <- "(a)(b)"
   m <- regex(text, pattern, global = TRUE)
   expect_type(m[[1]]$idx$start, "integer")
-  expect_type(m[[1]]$idx$end,   "integer")
+  expect_type(m[[1]]$idx$end, "integer")
   expect_type(m[[1]]$idx$group, "integer")
 })
 

tests/testthat/test-sanitize_text_input.R

@@ -28,6 +28,6 @@ test_that("doesn't escape normal letters", {
   expect_equal(sanitize_text_input("\a"), "\a")
   expect_equal(sanitize_text_input("\\a"), "\\a")
   expect_equal(sanitize_text_input("x"), "x")
-  #expect_error(sanitize_text_input("\x"))
+  # expect_error(sanitize_text_input("\x"))
   expect_equal(sanitize_text_input("\\x"), "\\x")
 })

tests/testthat/test-wrap_regex.R

@@ -1,8 +1,10 @@
 context("test-wrap_regex.R")
 
 test_that("wrap_regex generally works", {
-  expect_equal(wrap_regex("(a)(b)"),
-               "<span class=\"g01\">(a)</span><span class=\"g02\">(b)</span>")
+  expect_equal(
+    wrap_regex("(a)(b)"),
+    "<span class=\"g01\">(a)</span><span class=\"g02\">(b)</span>"
+  )
 })
 
 test_that("wrap_regex doesn't add parens", {
@@ -11,8 +13,10 @@ test_that("wrap_regex doesn't add parens", {
 
 test_that("wrap_regex doesn't wrap non-capture groups", {
   expect_equal(wrap_regex("(?:a)(b)"), "(?:a)<span class=\"g01\">(b)</span>")
-  expect_equal(wrap_regex("((?:a(b))c)"),
-               "<span class=\"g01\">((?:a<span class=\"g02\">(b)</span>)c)</span>")
+  expect_equal(
+    wrap_regex("((?:a(b))c)"),
+    "<span class=\"g01\">((?:a<span class=\"g02\">(b)</span>)c)</span>"
+  )
 })
 
 test_that("wrap_regex returns text if no matches", {

tests/testthat/test-wrap_result.R

@@ -30,7 +30,7 @@ test_that("wrap_results generally works", {
 test_that("wrap_results works when groups start and end at same index", {
   text <- "7282298386"
   pattern <- "\\(?(\\d{3})[-). ]?(\\d{3})[- .]?(\\d{4})"
-  res <-  wrap_result(regex(text, pattern, perl = TRUE, global = FALSE)[[1]])
+  res <- wrap_result(regex(text, pattern, perl = TRUE, global = FALSE)[[1]])
   expect_equal(res, "<span class=\"group g00\"><span class=\"group g01\">728</span><span class=\"group g02\">229</span><span class=\"group g03\">8386</span></span>")
 })
 
@@ -48,7 +48,7 @@ test_that("wrap_result starts/ends correctly with touching groups", {
     '<span class=\"group g00\"><span class=\"group g01\">The</span> <span class=\"group g02\">big</span> </span>',
     '<span class=\"group g00\"><span class=\"group g01\">red</span> <span class=\"group g02\">apple</span> </span>',
     '<span class=\"group g00\"><span class=\"group g01\">fell</span> <span class=\"group g02\">to</span> </span>',
-    'the ground.'
+    "the ground."
   )
   expect_equal(wrap_result(regex(text, pattern, global = TRUE)[[1]]), result)
 })