all html is now escaped. removed obsolete dark-mode

coolbutuseless · Apr 29, 2024 · ca347ee · ca347ee
1 parent 644bbf5
commit ca347ee
Show file tree

Hide file tree

Showing 23 changed files with 76 additions and 111 deletions.
diff --git a/R/core.R b/R/core.R
@@ -247,7 +247,6 @@ as.character.emphatic <- function(x, ..., mode = 'ansi') {
     text_mode        = opt$text_mode,
     text_contrast    = opt$text_contrast,
     full_colour      = opt$full_colour,
-    dark_mode        = opt$dark_mode,
     underline_header = opt$underline_header,
     mode             = mode,
     atomic           = is_atomic(x),
@@ -281,7 +280,6 @@ as_character_inner <- function(m,
                                text_mode        = 'contrast',
                                text_contrast    = 1,
                                full_colour      = FALSE,
-                               dark_mode        = TRUE,
                                underline_header = TRUE,
                                mode             = 'ansi',
                                atomic           = FALSE,
@@ -300,7 +298,7 @@ as_character_inner <- function(m,
   # Automatic contrasting text for foreground?
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (text_mode == 'contrast') {
-    new_text <- calc_contrasting_text(fill, text_contrast = text_contrast, dark_mode = dark_mode)
+    new_text <- calc_contrasting_text(fill, text_contrast = text_contrast)
     text[] <- ifelse(is.na(text) | text == '', new_text, text)
   } else if (text_mode == 'asis') {
     # do nothing. use the default text colour for the output
@@ -374,7 +372,7 @@ as_character_inner <- function(m,
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (mode == 'html') {
     att <- attributes(m)
-    m <- htmltools::htmlEscape(m)
+    m <- escape_html(m)
     attributes(m) <- att
   }
 
@@ -453,6 +451,9 @@ as_character_inner <- function(m,
       this_rownames <- rownames(m)
       max_nchar     <- max(nchar(this_rownames))
       fmt           <- paste0("%-", max_nchar + 1, "s ")
+      if (mode == 'html') {
+        this_rownames <- escape_html(this_rownames)
+      }
       this_rownames <- sprintf(fmt, this_rownames)
       ansi_mat      <- cbind(this_rownames, ansi_mat)
       col_names     <- c(sprintf(fmt, ''), col_names)
@@ -472,6 +473,7 @@ as_character_inner <- function(m,
         if (mode == 'ansi') {
           header <- paste0(underline_on_ansi, header, underline_off_ansi)
         } else if (mode == 'html') {
+          header <- escape_html(header)
           header <- paste0(underline_on_html, header, underline_off_html)
         }
       }
@@ -487,7 +489,7 @@ as_character_inner <- function(m,
   # Legends down the bottom.
   # Generate legend from the legend specifications.
   # They need to be rendered here rather than at time of calling hl() as
-  # options such as 'full_colour' and 'dark_mode' need to be respected
+  # options such as 'full_colour' need to be respected
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (!is.null(legends)) {
     legend_texts <- vapply(legends, function(spec) {
@@ -496,7 +498,6 @@ as_character_inner <- function(m,
         values      = spec$values,
         label       = spec$label,
         full_colour = full_colour,
-        dark_mode   = dark_mode,
         mode        = mode
       )},
       character(1)
@@ -533,20 +534,14 @@ as_character_inner <- function(m,
 #'
 #' @noRd
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-calc_contrasting_text <- function(fill, text_contrast, dark_mode) {
+calc_contrasting_text <- function(fill, text_contrast) {
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # There will be elements where the user has not set a fill colour.
   # Keep track of them
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   fill_not_set <- is.na(fill) | fill == ''
 
-  if (dark_mode) {
-    fill[fill_not_set]  <- 'black'
-  } else {
-    fill[fill_not_set]  <- 'white'
-  }
-
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Convert fill colour to matrix representation
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

diff --git a/R/hl-diff.R b/R/hl-diff.R
@@ -42,36 +42,22 @@ hl_diff <- function(x, y,
   # Default colours
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   fill_default_dark  <- list(sub = 'dodgerblue' , ins = 'darkgreen', del = 'firebrick' )
-  fill_default_light <- list(sub = 'dodgerblue1', ins = 'darkgreen', del = 'firebrick3')
-
-  text_default_dark  <- list(sub = 'white', ins = 'white', del = 'white')
-  text_default_light <- list(sub = 'black', ins = 'black', del = 'black')
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Work hard to ensure we have a full complement of colours for both
   # 'fill' and 'text'.  and 'text' colours are chosen as contrasting if
   # they are not specified
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  if (opts$dark_mode) {
-    fill <- modify_list(fill_default_dark, fill)
-  } else {
-    fill <- modify_list(fill_default_light, fill)
-  }
+  fill <- modify_list(fill_default_dark, fill)
 
   if (is.null(text)) {
     text <- list(
-      sub = calc_contrasting_text(fill$sub, text_contrast = opts$text_contrast, dark_mode = opts$dark_mode),
-      ins = calc_contrasting_text(fill$ins, text_contrast = opts$text_contrast, dark_mode = opts$dark_mode),
-      del = calc_contrasting_text(fill$del, text_contrast = opts$text_contrast, dark_mode = opts$dark_mode)
+      sub = calc_contrasting_text(fill$sub, text_contrast = opts$text_contrast),
+      ins = calc_contrasting_text(fill$ins, text_contrast = opts$text_contrast),
+      del = calc_contrasting_text(fill$del, text_contrast = opts$text_contrast)
     )
   }
 
-  if (opts$dark_mode) {
-    text <- modify_list(text_default_dark, text)
-  } else {
-    text <- modify_list(text_default_light, text)
-  }
-
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Coerce
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

diff --git a/R/hl-grep.R b/R/hl-grep.R
@@ -13,7 +13,7 @@
 #' @param x character string
 #' @param pattern regular expression string. Note: don't get too fancy here
 #' @param fill solid colour for background.  If \code{NULL} (the default),
-#'        then a colour will be selected based upon \code{opts$dark_mode}
+#'        then the default colour will be selected
 #' @param text text colour. If \code{NULL} (the default), then a colour
 #'        will be seleted which contrasts with the \code{fill} colour.
 #' @param ... extra args passed to \code{gsub}
@@ -37,13 +37,12 @@ hl_grep <- function(x,
   # Choose colours
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (is.null(fill)) {
-    fill <- ifelse(opts$dark_mode, "#f0e60f", "#0F19F0")
+    fill <- "#0F19F0"
   }
   if (is.null(text)) {
     text <- calc_contrasting_text(
       fill,
-      text_contrast = opts$text_contrast,
-      dark_mode = opts$dark_mode
+      text_contrast = opts$text_contrast
     )
   }
 

diff --git a/R/knitr.R b/R/knitr.R
@@ -7,10 +7,13 @@
 #' @param style html tag styling to apply to the \code{<pre>} wrapper for the
 #'        returned HTML
 #' @param ... other arguments passed to \code{as.character.emphatic}
+#' @param complete logical. Default: FALSE.  If TRUE, then add DOCTYPE and
+#'        the tags for 'html', 'body' and 'head' to make a complete standalone
+#'        html file.
 #'
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-as_html <- function(x, style = NULL, ...) {
+as_html <- function(x, style = NULL, ..., complete = FALSE) {
 
   if (!is.null(style)) {
     pre <- paste0("<pre style='", style, "'>")
@@ -19,6 +22,12 @@ as_html <- function(x, style = NULL, ...) {
   }
 
   res <- paste0(pre, as.character(x, ..., mode = 'html'), "</pre>")
+
+  if (isTRUE(complete)) {
+    res <- paste0("<!DOCTYPE html>\n<html>\n<head></head>\n<body>", res, "\n</body>\n</html>")
+  }
+
+
   class(res) <- unique(c('knit_asis', class(res)))
 
   res
@@ -49,7 +58,7 @@ knit_print.emphatic <- function(x, style = NULL, ...) {
 #'
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-as_svg <- function(x, width = 1200, height = 900,...) {
+as_svg <- function(x, width = 1200, height = 900, ...) {
 
   res <- as_html(x, ...)
 

diff --git a/R/legend.R b/R/legend.R
@@ -18,7 +18,6 @@ create_legend_string <- function(
   values,
   label       = NULL,
   full_colour = FALSE,
-  dark_mode   = TRUE,
   mode        = 'ansi'
 ) {
 
@@ -69,7 +68,7 @@ create_legend_string <- function(
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Always use contrasting text for the legend
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  text <- calc_contrasting_text(fill, text_contrast = 1, dark_mode = dark_mode)
+  text <- calc_contrasting_text(fill, text_contrast = 1)
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # After each cell we will add the ansi RESET code to revert

diff --git a/R/options.R b/R/options.R
@@ -11,7 +11,7 @@
 #' @importFrom utils modifyList
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-hl_adjust <- function(.data, na, dark_mode, full_colour, text_mode, text_contrast, underline_header) {
+hl_adjust <- function(.data, na, full_colour, text_mode, text_contrast, underline_header) {
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Sanity check
@@ -71,10 +71,6 @@ find_args <- function () {
 #'        }
 #' @param text_contrast When \code{text_mode='contrast'} this numeric value in
 #'        range [0, 1] adjusts the visibility. Default: 1 (high contrast)
-#' @param dark_mode Output terminal is in 'dark mode'? default: TRUE means that
-#'        the terminal display is light coloured text on a dark background.
-#'        If your terminal displays dark text on a light background, set
-#'        \code{dark_mode = FALSE}
 #' @param underline_header Draw an underline separating the column header from
 #'        the data? Default: TRUE
 #'
@@ -86,7 +82,6 @@ find_args <- function () {
 #'
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 hl_opts <- function(na               = getOption("HL_NA", "NA"),
-                    dark_mode        = getOption("HL_DARK", TRUE),
                     full_colour      = getOption("HL_FULL_COLOUR", FALSE),
                     text_mode        = getOption("HL_TEXT_MODE", "contrast"),
                     text_contrast    = getOption("HL_TEXT_CONTRAST", 1),
@@ -98,12 +93,6 @@ hl_opts <- function(na               = getOption("HL_NA", "NA"),
     !is.na(na)
   })
 
-  stopifnot(exprs = {
-    is.logical(dark_mode)
-    length(dark_mode) == 1
-    !is.na(dark_mode)
-  })
-
   stopifnot(exprs = {
     is.logical(full_colour)
     length(full_colour) == 1
@@ -135,7 +124,6 @@ hl_opts <- function(na               = getOption("HL_NA", "NA"),
 
   list(
     na               = na,
-    dark_mode        = dark_mode,
     full_colour      = full_colour,
     text_mode        = text_mode,
     text_contrast    = text_contrast,

diff --git a/R/utils.R b/R/utils.R
@@ -117,6 +117,24 @@ modify_list <- function (current, new) {
 }
 
 
-if (FALSE) {
-  chunked_indices(4, 6)
+
+
+html_replacement <- c(
+  `&` = "&amp;",
+  `<` = "&lt;",
+  `>` = "&gt;",
+  `"` = "&quot;",
+  `'` = "&#39;"
+)
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Escape HTML by replacing special characters
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+escape_html <- function(x) {
+  x <- enc2utf8(x)
+  for (orig in names(html_replacement)) {
+    x <- gsub(orig, html_replacement[[orig]], x, fixed = TRUE, useBytes = TRUE)
+  }
+  Encoding(x) <- 'UTF-8'
+  x
 }
diff --git a/R/zzz.R b/R/zzz.R
@@ -1,7 +1,7 @@
 
 
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-# Method stolen from: https://github.com/rstudio/htmltools/pull/108/files
+# Idea borrowed from https://github.com/rstudio/htmltools/pull/108/files
 # (as mentioned in the) knitr::knit_print vignette)
 # This is how to have a knit_print method for 'emphatic' objects
 # without having knitr as a dependency for this package
@@ -68,7 +68,6 @@ get_env_dbl <- function(nm, unset) {
 .onLoad <- function(libname, pkgname) {
 
   options(HL_NA            = Sys.getenv ("HL_NA"           , unset =       'NA'))
-  options(HL_DARK          = get_env_lgl("HL_DARK"         , unset =       TRUE))
   options(HL_FULL_COLOUR   = get_env_lgl("HL_FULL_COLOUR"  , unset =      FALSE))
   options(HL_TEXT_MODE     = Sys.getenv ("HL_TEXT_MODE"    , unset = 'contrast'))
   options(HL_TEXT_CONTRAST = get_env_dbl("HL_TEXT_CONTRAST", unset =          1))

diff --git a/README.Rmd b/README.Rmd
@@ -15,8 +15,6 @@ knitr::opts_chunk$set(
 library(dplyr)
 library(ggplot2)
 library(emphatic)
-
-options(HL_DARK = FALSE)
 ```
 
 
@@ -261,7 +259,6 @@ hl_grep(mode, 'switch') |>
 * `hl_adjust()` to adjust options after creation.
 * Set the following options to control global behaviour within a session.
     * `HL_NA`
-    * `HL_DARK`
     * `HL_FULL_COLOUR`
     * `HL_TEXT_MODE`
     * `HL_TEXT_CONTRAST`
@@ -270,8 +267,8 @@ hl_grep(mode, 'switch') |>
   and otherwise use a default value.
   Set these values as environment variables in your `.Rprofile` to save 
   your preferred settings across different sessions.  e.g.
-    * `Sys.setenv(HL_DARK = FALSE)` prior to loading package
-    * `options(HL_DARK = FALSE)` at any time
+    * `Sys.setenv(HL_NA = FALSE)` prior to loading package
+    * `options(HL_NA = FALSE)` at any time
 
 
 

diff --git a/README.md b/README.md
@@ -150,7 +150,6 @@ hl_grep(mode, 'switch')
 - Set the following options to control global behaviour within a
   session.
   - `HL_NA`
-  - `HL_DARK`
   - `HL_FULL_COLOUR`
   - `HL_TEXT_MODE`
   - `HL_TEXT_CONTRAST`
@@ -159,8 +158,8 @@ hl_grep(mode, 'switch')
   package start, and otherwise use a default value. Set these values as
   environment variables in your `.Rprofile` to save your preferred
   settings across different sessions. e.g.
-  - `Sys.setenv(HL_DARK = FALSE)` prior to loading package
-  - `options(HL_DARK = FALSE)` at any time
+  - `Sys.setenv(HL_NA = FALSE)` prior to loading package
+  - `options(HL_NA = FALSE)` at any time
 
 ## Vignettes
 

diff --git a/man/as_html.Rd b/man/as_html.Rd
diff --git a/man/figures/example-hlgrep-1.svg b/man/figures/example-hlgrep-1.svg