CSS helper

css.R

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create a CSS ruleset
#'
#' Create a CSS ruleset  consisting of a selector and one-or-more property declarations,
#' or, if no \code{.selector} is given, create an inline style string
#'
#' The list of included properties is not a complete list, but rather an
#' abbreviated list from
#' \url{https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_Properties_Reference}
#'
#' The caller is not limited to these included properties, and any named arguments
#' to this function will be interpreted as a CSS parameter/value pair.
#'
#' For convenience, any underscores in the names will be replaced by dashes. This
#' is because no sane CSS attributes are named with an underscore, but names
#' with dashes are clunky to write in R.
#'
#' @param .selector CSS selector to which this style applies
#' @param background,background_attachment,background_color,background_image,background_position,background_repeat,border,border_bottom,border_bottom_color,border_bottom_style,border_bottom_width,border_color,border_left,border_left_color,border_left_style,border_left_width,border_right,border_right_color,border_right_style,border_right_width,border_style,border_top,border_top_color,border_top_style,border_top_width,border_width,clear,clip,cursor,display,filter,float,font,font_family,font_size,font_variant,font_weight,height,left,letter_spacing,line_height,list_style,list_style_image,list_style_position,list_style_type,margin,margin_bottom,margin_left,margin_right,margin_top,overflow,padding,padding_bottom,padding_left,padding_right,padding_top,page_break_after,page_break_before,position,stroke_dasharray,stroke_dashoffset,stroke_width,text_align,text_decoration,text_indent,text_transform,top,vertical_align,visibility,width,z_index,alignment_baseline,baseline_shift,clip_path,clip_rule,color,color_interpolation,color_interpolation_filters,color_profile,color_rendering,direction,dominant_baseline,enable_background,fill,fill_opacity,fill_rule,flood_color,flood_opacity,font_size_adjust,font_stretch,font_style,glyph_orientation_vertical,image_rendering,kerning,lighting_color,marker,marker_end,marker_mid,marker_start,mask,opacity,pointer_events,shape_rendering,stop_color,stop_opacity,stroke,stroke_linecap,stroke_linejoin,stroke_miterlimit,stroke_opacity,text_anchor,text_rendering,unicode_bidi,word_spacing,writing_mode named parameters (included to help when using auto-complete)
#' @param ... other named parameters
#'
#' @return single character string of a CSS ruleset e.g. ".thing {fill: black;}"
#' @export
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
css <- function(
  .selector = NULL,
  ...,
  background, background_attachment, background_color, background_image, background_position, background_repeat, border, border_bottom, border_bottom_color, border_bottom_style, border_bottom_width, border_color, border_left, border_left_color, border_left_style, border_left_width, border_right, border_right_color, border_right_style, border_right_width, border_style, border_top, border_top_color, border_top_style, border_top_width, border_width, clear, clip, color, cursor, display, filter, float, font, font_family, font_size, font_variant, font_weight, height, left, letter_spacing, line_height, list_style, list_style_image, list_style_position, list_style_type, margin, margin_bottom, margin_left, margin_right, margin_top, overflow, padding, padding_bottom, padding_left, padding_right, padding_top, page_break_after, page_break_before, position, stroke_dasharray, stroke_dashoffset, stroke_width, text_align, text_decoration, text_indent, text_transform, top, vertical_align, visibility, width, z_index,
  alignment_baseline, baseline_shift,
  clip_path, clip_rule,
  color_interpolation, color_interpolation_filters, color_profile, color_rendering,
  direction,
  dominant_baseline,
  enable_background,
  fill, fill_opacity, fill_rule,
  flood_color,
  flood_opacity,
  font_size_adjust, font_stretch, font_style,
  glyph_orientation_vertical, image_rendering, kerning,
  lighting_color,
  marker, marker_end, marker_mid, marker_start,
  mask,
  opacity,
  pointer_events,
  shape_rendering,
  stop_color, stop_opacity,
  stroke, stroke_linecap, stroke_linejoin, stroke_miterlimit, stroke_opacity,
  text_anchor, text_rendering, unicode_bidi,
  word_spacing, writing_mode
  ) {

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # A small wrapper aruond a paste to produce "x=1;y=2;" css style strings.
  # This is partly done this way because a 'match.call()' function doesn't
  # evaluate the call arguments.
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  mypaste <- function(...) {
    varargs <- list(...)
    varargs[['.selector']] <- NULL
    attr_names <- names(varargs)

    if (is.null(attr_names) || any(attr_names == '') || any(is.na(attr_names))) {
      stop("css(): All args must be named: ", deparse(varargs))
    }

    attr_names <- gsub('colour', 'color', attr_names)
    attr_names <- gsub("_", "-", attr_names)

    style_strings <- c()

    if (is.null(.selector)) {
      spacer   <- ''
      collapse <- "; "
    } else {
      spacer   <- '    '
      collapse <- ";\n"
    }


    for (i in seq_along(attr_names)) {
      attr_name     <- attr_names[i]
      value         <- varargs[[i]]
      this_string   <- paste0(spacer, attr_name, ": ", value)
      style_strings <- c(style_strings, this_string)
    }

    style_string <- paste(style_strings, collapse = collapse)

    if (nchar(style_string) == 0) {
      NULL
    } else {
      paste0(style_string, ";")
    }
  }

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Rewrite the call to this function as a shorter call to the 'paste()' wrapper
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  new_call      <- match.call()
  new_call[[1]] <- as.name('mypaste')

  res <- eval(new_call)

  if (is.null(.selector)) {
    res
  } else {
    paste0(.selector, " {\n", res, "\n}")
  }
}



if (FALSE) {
  cat(
    css(".greg", fill_opacity = 0.3, colour = "red", fill = 'black')
  )

  cat(
    css(fill_opacity = 0.3, colour = "red", fill = 'black')
  )
}