R/revealjs_presentation.R

#' Convert to a reveal.js presentation
#'
#' Format for converting from R Markdown to a reveal.js presentation.
#' 
#' In reveal.js presentations you can use level 1 or level 2 headers for slides.
#' If you use a mix of level 1 and level 2 headers then a two-dimensional layout
#' will be produced, with level 1 headers building horizontally and level 2
#' headers building vertically.
#'
#' For additional documentation on using revealjs presentations see
#' <https://github.com/rstudio/revealjs>
#' 
#' # About plugins
#'
#' The plugins `notes`, `search`, `menu` and `zoom` are activated by default;
#' only `chalkboard` is opt-in. Setting `reveal_plugins` replaces the default
#' set -- pass `NULL` to render without any plugins.
#'
#' ## Built-in plugins with reveal.js
#'
#' ### Zoom
#'
#' Activated by default: ALT + Click can be used to zoom on a slide.
#'
#' ### Notes
#'
#' Activated by default: shows a [speaker view](https://revealjs.com/speaker-view/) in a separated
#' window. This speaker view contains a timer, current slide, next slide, and
#' speaker notes. It also duplicate the window to have presentation mode
#' synchronized with main presentation.
#' 
#' Use 
#' ```markdown
#' ::: notes
#' Content of speaker notes
#' :::
#' ```
#' to create notes only viewable in presentation mode. Notes placed before
#' the first heading are attached to the title slide.
#' 
#' On mobile browsers (touch devices), a button next to the fullscreen
#' toggle overlays the current slide with its speaker notes (plus the slide
#' title and, if present, the planned time from a timing comment), which is
#' useful for practicing a talk on a phone or tablet. It follows along as
#' you change slides and only appears if the deck contains notes at all.
#' 
#' Pressing `r` -- or, on touch devices, tapping the list button next to
#' the speaker notes button -- toggles a transcript view: a single
#' scrollable page containing every slide's content and speaker notes.
#' Text-to-speech ("read aloud") browser extensions cannot walk a
#' reveal.js deck, since hidden slides are not part of the visible page
#' text -- the transcript gives them something they can read from start
#' to finish.
#' 
#' ## Slide timing
#' 
#' Speaker time can be planned per slide and per speaker by adding a comment
#' with a speaker code and the expected duration (in `MM:SS`, `HH:MM:SS`, or
#' plain seconds format) anywhere inside a slide:
#' 
#' ```markdown
#' ## My slide title
#' 
#' Some content
#' 
#' <!-- MK 00:30 -->
#' ```
#' 
#' This means Marc Kupietz will need 30 seconds for that slide. For talks
#' presented by a single speaker, the speaker code can be omitted:
#' `<!-- 00:30 -->`. Comments placed before the first heading are applied to
#' the title slide.
#' 
#' Typically you start from a known total time budget and adjust the
#' individual slides to it. You can set this budget yourself with the
#' reveal.js `totalTime` option (in seconds):
#' 
#' ```yaml
#' output:
#'   revealjs.ids::revealjs_presentation:
#'     reveal_options:
#'       totalTime: 3600 # one hour
#' ```
#' 
#' During rendering, comments are converted into `data-timing` attributes on
#' the slides' `<section>` elements (several speakers per slide are summed
#' up), and the calculated grand total is passed to reveal.js as the
#' `totalTime` config value. This activates the pacing timer in the
#' [speaker view](https://revealjs.com/speaker-view/), which shows how you
#' are doing relative to your plan. A summary of the total time per speaker
#' is printed during rendering. If the document sets `totalTime` or
#' `defaultTiming` itself (via `reveal_options`), those take precedence.
#'
#' The function [slide_timing()] computes these totals directly from an
#' `.Rmd` source file without rendering it.
#' 
#' ## Overview slides
#' 
#' Like in the original Google Docs slide workflow, a slide titled
#' "Overview" or "Überblick" is automatically turned into a table of
#' contents: its body content is replaced at presentation time with a
#' clickable list of all `#` chapter headings. Adding
#' `{data-overview-subheadings=true}` to the heading also includes the
#' `##` sub-headings below their chapters, laid out in two columns.
#' References and appendix chapters (References/Literatur/
#' Literaturverzeichnis/Appendix/Anhang) are left out, together with
#' their sub-slides.
#' 
#' ### Search
#'
#' Activated by default: pressing `CTRL + SHIFT + F` shows a search box.
#' It will search in the whole presentation, and highlight matched words. The
#' matches will also be highlighted in overview mode (pressing ESC to see all
#' slides in one scrollable view)
#' 
#' ## Menu
#'
#' Activated by default: a slideout menu plugin for Reveal.js to quickly jump
#' to any slide by title.
#' 
#' Version `r version <- readLines(revealjs_lib_path("plugin", "menu", "VERSION"))` is
#' currently used and documentation for configurations can be found at
#' [denehyg/reveal.js-menu](https://github.com/denehyg/reveal.js-menu/blob/`r version`/README.md)
#' 
#' ### Known limitations
#' 
#' Some configurations cannot be modified in the current template: 
#' 
#' * `loadIcons: false`  the fontawesome icons are loaded by \pkg{rmarkdown}
#' when this plugin is used
#' * `custom: false`
#' * `themes: false`
#' * `transitions: false`

#' ## Chalkboard
#'
#' An opt-in plugin adding a chalkboard and slide annotation
#' 
#' Version `r version <- readLines(revealjs_lib_path("plugin", "chalkboard", "VERSION"))` is
#' currently used and documentation for configurations can be found at
#' [rajgoel/reveal.js-plugins](https://github.com/rajgoel/reveal.js-plugins/tree/`r version`/4.1.5/chalkboard)
#' 
#' By default, chalkboard and annotations modes will be accessible using keyboard
#' shortcuts, respectively, pressing B, or pressing C.  
#' In addition, buttons on the bottom left can be added by using the following 
#' 
#' ```yaml
#' reveal_plugins: 
#'   - chalkboard
#' reveal_options:
#'   chalkboard:
#'     toggleNotesButton: true
#'     toggleChalkboardButton: true
#' ```
#' ## Title slide: QR code and additional logos
#'
#' Three optional yaml entries personalise the title slide for external
#' audiences (ported from \pkg{posterdown.ids}):
#'
#' * `website: <url>` -- a linked QR code pointing to the URL is placed in
#'   the top left of the title slide. Uses the \pkg{qrcode} package.
#' * `partner_logo: <path-or-url>` -- when a presentation is given by
#'   authors from two institutions, the partner institution's logo is shown
#'   next to the IDS logo, in the top right of every slide.
#' * `funder_logo: <path-or-url>` -- a funder logo (e.g. "Text+") is placed
#'   in the bottom left of the title slide, opposite the Leibniz
#'   Gemeinschaft membership logo. It is lifted above the footer band on
#'   print (pdf) pages.
#'
#' Local logo files (svg, png, jpg, gif, webp) are embedded in the html as
#' data URIs, so they do not need to be shipped with the presentation; http
#' URLs are used as-is. A QR code anywhere else on a slide can be produced
#' with [qrlink()] from inline R code. The navigation chrome (arrows, slide
#' number, menu button) is hidden on the title slide for a bare first
#' impression.
#'
#' ## Bibliography and citations
#' 
#' Documents with a `bibliography:` in their YAML header are formatted with
#' the bundled IDS citation style (`ids.csl`, based on the style developed
#' for ICLC-10 2023 in Mannheim) by default. To use a different style,
#' specify it as usual with `csl:` in the YAML header.
#' 
#' @inheritParams rmarkdown::beamer_presentation
#' @inheritParams rmarkdown::pdf_document
#' @inheritParams rmarkdown::html_document
#'
#' @param center `TRUE` to vertically center content on slides
#' @param slide_level Level of heading to denote individual slides. If
#'   `slide_level` is 2 (the default), a two-dimensional layout will be
#'   produced, with level 1 headers building horizontally and level 2 headers
#'   building vertically. It is not recommended that you use deeper nesting of
#'   section levels with reveal.js.
#' @param theme Visual theme. The dedicated IDS corporate design theme
#'   ("ids") is the default and the only supported theme.
#' @param transition Slide transition (
#' `r (trans <- knitr::combine_words(setdiff(revealjs_transitions(), "default"), before = '"', and = " or "))`
#' )
#' @param background_transition Slide background-transition (
#' `r trans`
#' )
#' @param reveal_options Additional options to specify for reveal.js (see
#'   <https://revealjs.com/config/> for details). Options for plugins can also
#'   be passed, using plugin name as first level key (e.g `list(slideNumber =
#'   FALSE, menu = list(number = TRUE))`).
#' @param reveal_plugins Reveal plugins to include. Available plugins include
#'   "notes", "search", "zoom", "chalkboard", and "menu". Defaults to
#'   `c("notes", "search", "menu", "zoom")`; pass `NULL` to render without
#'   any plugins. Note that `self_contained` must be set to `FALSE` in order
#'   to use Reveal plugins.
#' @param df_print Method used to print data frames in the document. The
#'   default, `"kable"`, renders data frames as plain HTML tables styled by
#'   the presentation theme, so that results look reasonable on slides without
#'   any extra code. Since `"kable"` prints all rows, consider showing only
#'   `head(x)` on slides with many-rowed results. Other supported methods are
#'   `"default"` (plain text output), `"tibble"`, and `"paged"` (an
#'   interactive paged table, see [rmarkdown::html_document()]).
#' @param template Pandoc template to use for rendering. Pass "default" to use
#'   the rmarkdown package default template; pass `NULL` to use pandoc's
#'   built-in template; pass a path to use a custom template that you've
#'   created. Note that if you don't use the "default" template then some
#'   features of `revealjs_presentation` won't be available (see the
#'   Templates section below for more details).
#' @param extra_dependencies Additional function arguments to pass to the base R
#'   Markdown HTML output formatter [rmarkdown::html_document_base()].
#' @param ... Ignored
#'
#' @return R Markdown output format to pass to [rmarkdown::render()]
#'
#' @examples
#' \dontrun{
#'
#' library(rmarkdown)
#' library(revealjs.ids)
#'
#' # simple invocation
#' render("pres.Rmd", revealjs_presentation())
#'
#' # specify an option for incremental rendering
#' render("pres.Rmd", revealjs_presentation(incremental = TRUE))
#' }
#'
#' @export
revealjs_presentation <- function(incremental = FALSE,
                                  center = FALSE,
                                  slide_level = 2,
                                  toc = FALSE,
                                  toc_depth = 3,
                                  fig_width = 8,
                                  fig_height = 6,
                                  fig_retina = if (!fig_caption) 2,
                                  fig_caption = FALSE,
                                  self_contained = FALSE,
                                  theme = "ids",
                                  transition = "convex",
                                  background_transition = "fade",
                                  reveal_options = NULL,
                                  reveal_plugins = c("notes", "search", "menu", "zoom"),
                                  highlight = "default",
                                  df_print = "kable",
                                  mathjax = "default",
                                  template = "default",
                                  css = NULL,
                                  includes = NULL,
                                  keep_md = FALSE,
                                  lib_dir = NULL,
                                  pandoc_args = NULL,
                                  extra_dependencies = NULL,
                                  md_extensions = NULL,
                                  ...) {

  # base pandoc options for all reveal.js output
  args <- c()
  
  # table of contents
  args <- c(args, pandoc_toc_args(toc, toc_depth))

  # template path and assets
  if (identical(template, "default")) {
    default_template <- reveal_resources("default.html")
    args <- c(args, "--template", pandoc_path_arg(default_template))
  } else if (!is.null(template)) {
    args <- c(args, "--template", pandoc_path_arg(template))
  }

  # incremental
  if (incremental) args <- c(args, "--incremental")

  # centering
  args <- c(args, pandoc_variable_arg("center", jsbool(center)))

  # slide level
  args <- c(args, "--slide-level", as.character(slide_level))

  # theme
  theme <- match.arg(theme, revealjs_themes())
  if (identical(theme, "default")) {
    theme <- "simple"
  } else if (identical(theme, "dark")) {
    theme <- "black"
  }
  if (theme %in% c("blood", "moon", "night", "black")) {
    args <- c(args, pandoc_variable_arg("theme-dark"))
  }
  args <- c(args, pandoc_variable_arg("theme", theme))

  if (theme == "ids") {
    args <- c(args, pandoc_variable_arg("theme-ids"))
    fig_height = 7
    fig_width = 12
  }

  # transition
  if (missing(transition) && identical(theme, "ids")) {
    # IDS theme: slide the slides in instead of rotating them (reveal.js'
    # own default, convex), unless the user explicitly asked for something
    # else. The formal default has to stay "convex" for the other themes.
    transition <- "slide"
  }
  transition <- match.arg(transition, revealjs_transitions())
  if (identical(transition, "default")) {
    # revealjs default is convex
    transition <- "convex"
  }
  args <- c(args, pandoc_variable_arg("transition", transition))

  # background_transition
  background_transition <- match.arg(background_transition, revealjs_transitions())
  if (identical(background_transition, "default")) {
    # revealjs default is fade
    background_transition <- "fade"
  }
  args <- c(args, pandoc_variable_arg("backgroundTransition", background_transition))

  # use history
  args <- c(args, pandoc_variable_arg("history", "true"))

  # The IDS corporate design puts the orange bar flush against the top left
  # corner of the slide. reveal.js defaults to margin = 0.04, i.e. it keeps 4%
  # of the display empty around the content, which would leave a white border
  # above and to the left of the bar. Default to 0 instead, unless the document
  # asks for a margin of its own via reveal_options.
  if (!is.list(reveal_options) || is.null(reveal_options[["margin"]])) {
    args <- c(args, pandoc_variable_arg("margin", "0"))
  }

  # additional reveal options
  if (is.list(reveal_options)) {
    for (option in names(reveal_options)) {
      # special handling for nested options
      if (option %in% c("chalkboard", "menu")) {
        nested_options <- reveal_options[[option]]
        for (nested_option in names(nested_options)) {
          args <- c(args, 
                    process_reveal_option(
                      paste0(option, "-", nested_option),
                      nested_options[[nested_option]]
                    )
          )
        }
      } else { 
        # standard top-level options
        args <- c(args, process_reveal_option(option, reveal_options[[option]]))
      }
    }
  }

  # reveal plugins
  if (is.character(reveal_plugins)) {

    # validate that we need to use self_contained for plugins
    if (self_contained) {
      if (missing(reveal_plugins)) {
        # the default plugin set collided with an explicitly requested
        # self_contained render -- drop the defaults instead of failing
        warning("Reveal plugins require self_contained: false -- ",
          "rendering without the default plugins.",
          call. = FALSE
        )
        reveal_plugins <- character(0)
      } else {
        stop("Using reveal_plugins requires self_contained: false")
      }
    }

    # validate specified plugins are supported
    supported_plugins <- c("notes", "search", "zoom", "chalkboard", "menu")
    invalid_plugins <- setdiff(reveal_plugins, supported_plugins)
    if (length(invalid_plugins) > 0) {
      stop("The following plugin(s) are not supported: ",
        paste(invalid_plugins, collapse = ", "),
        call. = FALSE
      )
    }

    # add plugins
    if ("chalkboard" %in% reveal_plugins) {
      # chalkboard require customcontrols so we add it to activate in the template
      reveal_plugins <- c(reveal_plugins, "customcontrols")
    }
    sapply(reveal_plugins, function(plugin) {
      args <<- c(args, pandoc_variable_arg(paste0("plugin-", plugin)))
      if (plugin %in% c("customcontrols", "menu")) {
        extra_dependencies <<- append(
          extra_dependencies,
          list(rmarkdown::html_dependency_font_awesome())
        )
      }
    })
  }

  # content includes
  args <- c(args, includes_to_pandoc_args(includes))

  # additional css
  for (css_file in css) {
    args <- c(args, "--css", pandoc_path_arg(css_file))
  }

  # pre-processor for arguments that may depend on the name of the
  # the input file (e.g. ones that need to copy supporting files)
  pre_processor <- function(metadata, input_file, runtime, knit_meta, files_dir,
                            output_dir) {

    # we don't work with runtime shiny
    if (identical(runtime, "shiny")) {
      stop("revealjs_presentation is not compatible with runtime 'shiny'",
        call. = FALSE
      )
    }

    # use files_dir as lib_dir if not explicitly specified
    if (is.null(lib_dir)) {
      lib_dir <- files_dir
    }

    # extra args
    args <- c()

    # reveal.js
    revealjs_path <- revealjs_lib_path()
    if (!self_contained || identical(.Platform$OS.type, "windows")) {
      revealjs_path <- relative_to(
        output_dir, render_supporting_files(revealjs_path, lib_dir)
      )
    } else {
      revealjs_path <- pandoc_path_arg(revealjs_path)
    }
    args <- c(args, pandoc_variable_arg("revealjs-url", revealjs_path))

    # highlight
    args <- c(args, pandoc_highlight_args(highlight, default = "pygments"))

    # website entry: place a linked QR code (inline SVG) in the top left of
    # the title slide
    if (!is.null(metadata$website)) {
      args <- c(args, pandoc_variable_arg("website-qr", qrlink(metadata$website)))
    }

    # partner / funder institution logos: local files are inlined as data
    # URIs so they resolve correctly in CSS and stay embedded in the output
    if (!is.null(metadata$partner_logo)) {
      args <- c(args, pandoc_variable_arg("partner-logo-src", logo_uri(metadata$partner_logo)))
    }
    if (!is.null(metadata$funder_logo)) {
      args <- c(args, pandoc_variable_arg("funder-logo-src", logo_uri(metadata$funder_logo)))
    }

    # default to the bundled IDS citation style unless the document
    # specifies a style of its own
    if (is.null(metadata$csl)) {
      args <- c(args, "--csl", pandoc_path_arg(reveal_resources("ids.csl")))
    }

    # return additional args
    args
  }

  # post-processor converting <!-- MK 00:30 --> speaker timing comments into
  # data-timing attributes on the enclosing sections (activating the pacing
  # timer of the notes plugin) and reporting per-speaker totals
  post_processor <- function(metadata, input_file, output_file, clean, verbose) {
    lines <- readLines(output_file, warn = FALSE, encoding = "UTF-8")
    lines <- merge_title_slide_notes(lines)
    result <- apply_timing_attributes(lines)
    comments <- attr(result, "comments")
    if (nrow(comments) > 0) {
      result <- inject_total_time(result, sum(comments$seconds))
      writeLines(enc2utf8(result), output_file, useBytes = TRUE)
      message(timing_report_message(comments))
    }
    output_file
  }

  # return format
  output_format(
    knitr = knitr_options_html(fig_width, fig_height, fig_retina, keep_md),
    pandoc = pandoc_options(
      to = "revealjs",
      from = from_rmarkdown(fig_caption, md_extensions),
      args = args
    ),
    keep_md = keep_md,
    clean_supporting = self_contained,
    df_print = df_print,
    pre_processor = pre_processor,
    post_processor = post_processor,
    base_format = html_document_base(
      lib_dir = lib_dir,
      self_contained = self_contained,
      mathjax = mathjax,
      pandoc_args = pandoc_args,
      extra_dependencies = extra_dependencies,
      ...
    )
  )
}

revealjs_themes <- function() {
  c(
    "default", # not used by reveal
    "ids",
    "simple",
    "dark", # our alias for black
    "black",
    "sky",
    "beige",
    "serif",
    "solarized",
    "blood",
    "moon",
    "night",
    "league",
    "white"
  )
}

revealjs_transitions <- function() {
  c(
    "default", # not used by reveal
    "convex",
    "fade",
    "slide",
    "concave",
    "zoom",
    "none"
  )
}