R/css.R

In highlight: Syntax Highlighter

w3c.colors <- list(
  aqua = "#00FFFF",
  black = "#000000",
  blue = "#0000FF",
  fuchsia = "#FF00FF",
  gray = "#808080",
  green = "#008000",
  lime = "#00FF00",
  maroon = "#800000",
  navy = "#000080",
  olive = "#808000",
  purple = "#800080",
  red = "#FF0000",
  silver = "#C0C0C0",
  teal = "#008080",
  white = "#FFFFFF",
  yellow = "#FFFF00"
)


css.parse.color <- function(txt, default = "#000000") {
  txt <- gsub("\\s+", "", casefold(txt), perl = TRUE)

  if (is.hex(txt)) {
    return(txt)
  }

  # css specs are from 0 to 255
  rgb <- function(...) {
    grDevices::rgb(..., maxColorValue = 255)
  }

  # first we try to match against w3c standard colors
  if (!grepl("[^a-z]", txt)) {
    if (txt %in% names(w3c.colors)) {
      return(w3c.colors[[txt]])
    }
  }

  # now we try R colors
  if (!grepl("[^a-z0-9]", txt)) {
    R.colors <- colors()
    res <- R.colors %in% txt
    if (any(res)) {
      return(rgb(t(col2rgb(R.colors[res]))))
    }
  }

  # next we try an rgb() specification
  if (grepl("rgb", txt)) {
    p <- try(parse(text = txt), silent = TRUE)
    if (!inherits(p, "try-error")) {
      res <- try(eval(p, envir = environment()), silent = T)
      if (!inherits(res, "try-error")) return(res)
    }
  }

  # fall back on the default color
  default
}

is.hex <- function(x) {
  grepl("^#[0-9a-f]{6}$", x)
}

# this is placeholder at the moment
css.parse.font_weight <- function(txt) {
  txt
}

css.parse.font_style <- function(txt) {
  txt
}

css.parse.text_decoration <- function(txt) {
  txt
}

#' Minimal CSS parser
#'
#' @param file file to parse
#' @param lines text lines to parse
#'
#' @return A list with one element per style class declaration. Each element
#'         is a list which has one element per CSS setting
#'         (\samp{color}, \samp{background}, ...)
#'
#' @note
#' 	The parser is very minimal and will only identify CSS declarations like
#' 	the following :
#'
#' \preformatted{
#' .classname{
#' 	setting1 : value ;
#' 	setting2 : value ;
#' } }
#'
#' 	The line where a declaration occurs must start with a dot,
#' 	followed by the name of the class and a left brace. The declaration
#' 	ends with the first line that starts with a right brace. The function
#' 	will warn about class names containing numbers as this is likely to
#' 	cause trouble when the parsed style is translated into another
#' 	language (e.g. latex commands).
#'
#' 	Within the css declaration, the parser identifies setting/value
#' 	pairs separated by \samp{:} on a single line. Each setting must
#' 	be on a seperate line.
#'
#' 	If the setting is \samp{color} or \samp{background}, the parser then
#' 	tries to map the value to a hex color specification
#' 	by trying the following options: the value is already a hex
#' 	color, the name of the color is one of the 16 w3c standard colors, the name
#' 	is an R color (see \code{\link[grDevices]{colors}}), the
#' 	color is specified as \samp{rgb(r,g,b)}. If all fails, the
#' 	color used is black for the \samp{color} setting and
#' 	\samp{white} for the \samp{background} setting.
#'
#' 	Other settings are not further parsed at present.
#'
#' @export
css.parser <- function(file, lines = readLines(file)) {
  rx <- "^\\.(.*?) *\\{.*$"
  dec.lines <- grep(rx, lines)
  dec.names <- sub(rx, "\\1", lines[dec.lines])
  if (any(grepl("[0-9]", dec.names))) {
    warning("use of numbers in style names")
  }

  end.rx <- "^[[:space:]]*\\}"
  end.lines <- grep(end.rx, lines)

  # find the closing brace of each declaration
  dec.close <- end.lines[sapply(dec.lines, function(x) {
    which.min(end.lines < x)
  })]

  pos <- matrix(c(dec.lines, dec.close), ncol = 2)
  styles <- apply(pos, 1, function(x) {
    data <- lines[(x[1] + 1):(x[2] - 1)]
    settings.rx <- "^\\s*(.*?)\\s*:\\s*(.*?)\\s*;\\s*$"
    settings <- sub(settings.rx, "\\1", data, perl = TRUE)
    contents <- sub(settings.rx, "\\2", data, perl = TRUE)
    out <- list()
    for (i in 1:length(settings)) {
      setting <- settings[i]
      content <- contents[i]
      out[[setting]] <- switch(
        setting,
        "color" = css.parse.color(content, "#000000"),
        "background" = css.parse.color(content, "#FFFFFF"),
        "font-weight" = css.parse.font_weight(content),
        "font-style" = css.parse.font_style(content),
        "text-decoration" = css.parse.text_decoration(content),
        content
      )
    }
    out
  })
  names(styles) <- dec.names
  styles
}