slide timing: per-speaker timing comments activate speaker view pacing
Port the Google-Docs slide workflow convention: timing comments like
<!-- JD 00:30 --> (speaker code plus MM:SS/HH:MM:SS/seconds duration, or
just <!-- 00:30 --> for single-speaker talks) are converted into
data-timing attributes on the rendered slides' <section> elements, and
the calculated grand total is passed to reveal.js as the totalTime
config value, activating the pacing timer in the speaker view. A
document-supplied totalTime or defaultTiming takes precedence.
A per-speaker time summary is printed during rendering; the new
slide_timing() function computes slide, speaker, and grand totals
directly from an .Rmd source file without rendering it.
Change-Id: I89d37baab06c6ee8be7ab777a70b9b21295c8780
diff --git a/R/slide_timing.R b/R/slide_timing.R
new file mode 100644
index 0000000..560716d
--- /dev/null
+++ b/R/slide_timing.R
@@ -0,0 +1,221 @@
+# Pattern matching timing comments, e.g. <!-- MK 00:30 --> or just <!-- 00:30 -->
+timing_comment_pattern <- paste0(
+ "<!--[[:space:]]*(?:([[:alnum:]._-]+)[[:space:]]+)?",
+ "([0-9]+(?::[0-9]{2}){0,2})[[:space:]]*-->"
+)
+
+parse_duration_seconds <- function(x) {
+ vapply(x, function(t) {
+ parts <- strsplit(t, ":", fixed = TRUE)[[1]]
+ parts <- suppressWarnings(as.numeric(parts))
+ if (length(parts) == 0 || length(parts) > 3 || anyNA(parts)) {
+ return(NA_real_)
+ }
+ multipliers <- c(3600, 60, 1)[(4 - length(parts)):3]
+ sum(parts * multipliers)
+ }, numeric(1), USE.NAMES = FALSE)
+}
+
+format_seconds <- function(x) {
+ x <- round(x)
+ h <- floor(x / 3600)
+ m <- floor((x %% 3600) / 60)
+ s <- x %% 60
+ ifelse(h > 0, sprintf("%d:%02d:%02d", h, m, s), sprintf("%d:%02d", m, s))
+}
+
+# Extract all timing comments from a character vector (one line per element).
+# Returns a data frame with columns line (1-based index), speaker (NA for
+# comments without a speaker code), duration, and seconds.
+extract_timing_comments <- function(lines) {
+ matches <- regmatches(lines, regexec(timing_comment_pattern, lines))
+ hits <- which(lengths(matches) > 0)
+ if (length(hits) == 0) {
+ return(data.frame(
+ line = integer(), speaker = character(), duration = character(),
+ seconds = numeric()
+ ))
+ }
+ speaker <- trimws(vapply(matches[hits], `[[`, character(1), 2))
+ speaker[speaker == ""] <- NA_character_
+ data.frame(
+ line = hits,
+ speaker = speaker,
+ duration = vapply(matches[hits], `[[`, character(1), 3),
+ seconds = parse_duration_seconds(vapply(matches[hits], `[[`, character(1), 3)),
+ stringsAsFactors = FALSE
+ )
+}
+
+# Assign each timing comment to the slide it belongs to. A comment belongs to
+# the slide whose heading most recently appeared before it; content before the
+# first heading belongs to the title slide.
+assign_slides <- function(lines, comments, slide_level) {
+ headings <- grepl(paste0("^#{1,", slide_level, "}[[:space:]]"), lines)
+ slide_of_line <- cumsum(headings)
+ comments$slide <- slide_of_line[comments$line]
+ titles <- trimws(sub("^#+[[:space:]]+", "", lines[headings]))
+ c("(title)", titles)[comments$slide + 1]
+}
+
+#' Compute per-speaker slide times from timing comments
+#'
+#' Parses an R Markdown presentation for timing comments of the form
+#' `<!-- MK 00:30 -->` (speaker code followed by a duration in `MM:SS`,
+#' `HH:MM:SS`, or plain seconds format) or, for single-speaker talks, simply
+#' `<!-- 00:30 -->`, and computes the time allocated to each slide, each
+#' speaker, and the whole presentation.
+#'
+#' The same convention can be used directly in
+#' [revealjs_presentation()]: any such comment in the source document is
+#' automatically converted into a `data-timing` attribute on the enclosing
+#' slide's `<section>` element, which activates the pacing timer in the
+#' reveal.js speaker view.
+#'
+#' @param input Path to an R Markdown file.
+#' @param slide_level Level of heading that denotes individual slides (should
+#' match the `slide_level` used when rendering).
+#'
+#' @return A list with three elements: `slides` (one row per slide and
+#' speaker), `speakers` (total time per speaker), and `total` (grand total
+#' in seconds). `slide_timing()` is called for its side effect of printing a
+#' summary.
+#'
+#' @examples
+#' \dontrun{
+#' slide_timing("talk.Rmd")
+#' }
+#'
+#' @importFrom stats aggregate
+#' @export
+slide_timing <- function(input, slide_level = 2) {
+ lines <- readLines(input, warn = FALSE)
+ comments <- extract_timing_comments(lines)
+ if (nrow(comments) == 0) {
+ message("No timing comments found in ", input)
+ return(invisible(NULL))
+ }
+ comments$slide_title <- assign_slides(lines, comments, slide_level)
+ comments$speaker <- timing_speaker_label(comments$speaker)
+
+ by_speaker <- aggregate(seconds ~ speaker, comments, FUN = sum)
+ total <- sum(comments$seconds)
+ show_speakers <- any(comments$speaker != "(unnamed)")
+
+ cat("Slide timing for", basename(input), "\n\n")
+ if (show_speakers) {
+ per_slide <- aggregate(seconds ~ slide_title + speaker, comments, FUN = sum)
+ } else {
+ per_slide <- aggregate(seconds ~ slide_title, comments, FUN = sum)
+ }
+ print(data.frame(
+ slide = per_slide$slide_title,
+ speaker = if (show_speakers) per_slide$speaker else NULL,
+ time = format_seconds(per_slide$seconds),
+ stringsAsFactors = FALSE
+ ))
+ cat("\n")
+ named_speakers <- by_speaker[by_speaker$speaker != "(unnamed)", , drop = FALSE]
+ if (nrow(named_speakers) > 0) {
+ print(
+ data.frame(
+ speaker = c(named_speakers$speaker, "total"),
+ time = format_seconds(c(named_speakers$seconds, total)),
+ stringsAsFactors = FALSE
+ ),
+ row.names = FALSE
+ )
+ } else {
+ cat("total time:", format_seconds(total), "\n")
+ }
+
+ invisible(list(slides = comments[, c("slide_title", "speaker", "duration", "seconds")],
+ speakers = by_speaker, total = total))
+}
+
+# Display label for unnamed speakers
+timing_speaker_label <- function(speaker) {
+ ifelse(is.na(speaker), "(unnamed)", speaker)
+}
+
+# Convert timing comments into data-timing attributes on the enclosing
+# <section> elements of a rendered reveal.js HTML document. Returns the
+# modified lines invisibly along with the extracted comments as attributes.
+apply_timing_attributes <- function(lines) {
+ comments <- extract_timing_comments(lines)
+ if (nrow(comments) == 0) {
+ return(invisible(structure(lines, comments = comments)))
+ }
+
+ section_lines <- grep("^<section[^>]*>", lines)
+ section_of_comment <- findInterval(comments$line, section_lines)
+ ok <- section_of_comment > 0
+ if (!all(ok)) {
+ warning(
+ "Ignoring ", sum(!ok), " timing comment(s) outside any <section>",
+ call. = FALSE
+ )
+ comments <- comments[ok, , drop = FALSE]
+ section_of_comment <- section_of_comment[ok]
+ }
+
+ per_section <- tapply(comments$seconds, section_of_comment, sum)
+
+ for (idx in names(per_section)) {
+ target <- section_lines[as.integer(idx)]
+ lines[target] <- sub(
+ "^(<section[^>]*?)(/?>)$",
+ sprintf('\\1 data-timing="%d"\\2', round(per_section[[idx]])),
+ lines[target]
+ )
+ }
+
+ invisible(structure(lines, comments = comments))
+}
+
+# Activate the pacing timer of the notes plugin by injecting the total time
+# planned with the timing comments into the reveal.js configuration. Without
+# a totalTime or defaultTiming config value, the speaker view does not show
+# any pacing information at all.
+inject_total_time <- function(lines, seconds) {
+ # only respect explicitly configured pacing values, not e.g. the
+ # unconditional "defaultTiming: null" emitted by the pandoc template
+ pacing <- grep("\\b(totalTime|defaultTiming)\\s*:", lines, value = TRUE)
+ if (any(!grepl(":\\s*(null|0|false|\"\"|'')\\s*,?\\s*$", trimws(pacing)))) {
+ return(lines)
+ }
+ init <- grep("Reveal\\.initialize\\(\\s*\\{", lines)
+ if (length(init) == 0) {
+ return(lines)
+ }
+ append(
+ lines,
+ sprintf("\t\t\ttotalTime: %d,", round(seconds)),
+ after = init[[1]]
+ )
+}
+
+timing_report_message <- function(comments) {
+ comments$speaker <- timing_speaker_label(comments$speaker)
+ by_speaker <- aggregate(seconds ~ speaker, comments, FUN = sum)
+ total <- sum(comments$seconds)
+ named <- by_speaker[by_speaker$speaker != "(unnamed)", , drop = FALSE]
+ unnamed <- by_speaker[by_speaker$speaker == "(unnamed)", , drop = FALSE]
+ parts <- c(
+ # note: paste0() would treat a zero-length data frame column as "",
+ # so only build these strings when there is something to report
+ if (nrow(named) > 0) paste0(named$speaker, ": ", format_seconds(named$seconds)),
+ if (nrow(unnamed) > 1 || (nrow(unnamed) == 1 && nrow(named) > 0)) {
+ paste0("(unnamed): ", format_seconds(unnamed$seconds))
+ }
+ )
+ if (length(parts) > 0) {
+ sprintf(
+ "Slide timing -- %s -- total %s",
+ paste(parts, collapse = ", "),
+ format_seconds(total)
+ )
+ } else {
+ sprintf("Slide timing -- total %s", format_seconds(total))
+ }
+}