tests/testthat/test-slide_timing.R - IDS-Mannheim/revealjs - Gitiles

 test_that("parse_duration_seconds handles all duration formats", {
   expect_equal(parse_duration_seconds("00:30"), 30)
   expect_equal(parse_duration_seconds("1:05"), 65)
   expect_equal(parse_duration_seconds("45"), 45)
   expect_equal(parse_duration_seconds("1:00:00"), 3600)
   expect_equal(parse_duration_seconds("1:30:15"), 5415)
   expect_true(is.na(parse_duration_seconds("abc")))
 })

 test_that("extract_timing_comments finds comments", {
   lines <- c(
     "---",
     "title: x",
     "---",
     "",
     "## Slide one",
     "",
     "<!-- MK 00:30 -->",
     "",
     "## Slide two",
     "",
     "<!-- AB 1:00 -->",
     "<!-- MK 90 -->"
   )
   comments <- extract_timing_comments(lines)
   expect_equal(comments$speaker, c("MK", "AB", "MK"))
   expect_equal(comments$seconds, c(30, 60, 90))
   expect_equal(assign_slides(lines, comments, slide_level = 2),
                c("Slide one", "Slide two", "Slide two"))
 })

 test_that("comments without speaker codes are supported", {
   lines <- c("## Slide one", "<!-- 00:30 -->", "## Slide two", "<!-- 1:05 -->")
   comments <- extract_timing_comments(lines)
   expect_true(all(is.na(comments$speaker)))
   expect_equal(comments$seconds, c(30, 65))

   # a plain number must not be split into a speaker code plus duration
   comments2 <- extract_timing_comments("<!-- 45 -->")
   expect_true(is.na(comments2$speaker))
   expect_equal(comments2$seconds, 45)

   result <- apply_timing_attributes(c(
     "<section id='s1' class='level2'>",
     "<!-- 00:30 -->",
     "</section>"
   ))
   expect_match(result[1], "data-timing=\"30\"")

   report <- timing_report_message(extract_timing_comments(lines))
   expect_equal(report, "Slide timing -- total 1:35")
 })

 test_that("comments before first heading belong to title slide", {
   lines <- c("<!-- MK 00:10 -->", "", "# Title", "", "## Slide")
   comments <- extract_timing_comments(lines)
   expect_equal(assign_slides(lines, comments, slide_level = 2), "(title)")
 })

 test_that("apply_timing_attributes adds data-timing to sections", {
   lines <- c(
     "<html>",
     "<section id='title-slide'>",
     "title",
     "</section>",
     "<section id='s1' class='level2'>",
     "<!-- MK 00:30 -->",
     "</section>",
     "<section id='s2' class='level2'>",
     "<!-- MK 0:20 -->",
     "<!-- AB 00:30 -->",
     "</section>"
   )
   result <- apply_timing_attributes(lines)
   html <- paste(result, collapse = "\n")
   expect_match(result[2], "<section id='title-slide'>")
   expect_match(result[5], "data-timing=\"30\"")
   # multiple speakers on one slide are summed
   expect_match(result[8], "data-timing=\"50\"")
   comments <- attr(result, "comments")
   expect_equal(sum(comments$seconds), 80)
 })

 test_that("apply_timing_attributes is a no-op without comments", {
   lines <- c("<section id='s1'>", "x", "</section>")
   result <- apply_timing_attributes(lines)
   expect_identical(as.vector(result), lines)
   expect_equal(nrow(attr(result, "comments")), 0)
 })

 test_that("inject_total_time activates the pacing timer", {
   lines <- c(
     "var opts = {",
     "  controls: true,",
     "};",
     "Reveal.initialize({",
     "  controls: true,",
     "  slideNumber: true",
     "});"
   )
   result <- inject_total_time(lines, 90)
   expect_contains(result, "\t\t\ttotalTime: 90,")

   # existing pacing config is respected
   with_default <- c(lines, "", "defaultTiming: 60")
   expect_identical(inject_total_time(with_default, 90), with_default)
   with_total <- c("totalTime: 120", lines)
   expect_identical(inject_total_time(with_total, 90), with_total)

   # nothing to hook into -- leave the document alone
   expect_identical(inject_total_time(c("<html>", "</html>"), 90),
                    c("<html>", "</html>"))
 })

 test_that("rendered presentations carry data-timing attributes", {
   skip_if_not_pandoc()
   skip_if_not_installed("xml2")
   rmd <- local_temp_rmd_file(
     "---",
     "title: Timing test",
     "output: revealjs.ids::revealjs_presentation",
     "---",
     "",
     "## Slide A",
     "",
     "Content A",
     "",
     "<!-- MK 00:30 -->",
     "",
     "## Slide B",
     "",
     "Content B",
     "",
     "<!-- MK 01:00 -->",
     "<!-- AB 0:30 -->"
   )
   html <- .render_and_read(rmd)
   timings <- xml2::xml_attr(
     xml2::xml_find_all(html, "//section[@data-timing]"),
     "data-timing"
   )
   expect_equal(timings, c("30", "90"))
   # the grand total activates the pacing timer of the notes plugin
   expect_true(any(grepl("totalTime:\\s*120", html)))
 })

 test_that("title slide notes and timing are merged into the title section", {
   lines <- c(
     '<section class="title-frame" id="title-slide">',
     "<h1 class=\"title\">Title</h1>",
     "</section>",
     "<section class=\"slide level2\">",
     "<!-- JD 00:30 -->",
     "<aside class=\"notes\">",
     "<p>Welcome</p>",
     "</aside>",
     "</section>",
     "<section id=\"slide-a\" class=\"slide level2\">",
     "<!-- MK 01:00 -->",
     "</section>"
   )
   merged <- merge_title_slide_notes(lines)
   # phantom slide (6 lines) removed, its 4 content lines moved into the title
   expect_length(merged, length(lines) - 2)
   expect_identical(merged[1], lines[1])
   expect_match(paste(merged[1:5], collapse = "\n"), "Welcome")
   expect_match(paste(merged[1:5], collapse = "\n"), "JD 00:30")
   # only the real Slide A section remains
   expect_equal(sum(grepl('class="slide level2"', merged)), 1)

   # a phantom slide with real content is left alone
   with_content <- lines
   with_content[6] <- "<p>Visible intro content</p>"
   expect_identical(merge_title_slide_notes(with_content), with_content)

   # no title slide: nothing to merge
   no_title <- lines[-1]
   expect_identical(merge_title_slide_notes(no_title), no_title)
 })

 test_that("rendered title slides carry notes and data-timing", {
   skip_if_not_pandoc()
   skip_if_not_installed("xml2")
   rmd <- local_temp_rmd_file(
     "---",
     "title: Timing test",
     "output: revealjs.ids::revealjs_presentation",
     "---",
     "",
     "::: notes",
     "Welcome note",
     ":::",
     "",
     "<!-- 00:30 -->",
     "",
     "## Slide A",
     "",
     "Content A"
   )
   html <- .render_and_read(rmd)
   title <- xml2::xml_find_first(html, "//section[@id='title-slide']")
   expect_equal(xml2::xml_attr(title, "data-timing"), "30")
   expect_equal(
     xml2::xml_text(xml2::xml_find_first(title, "./aside[@class='notes']"), trim = TRUE),
     "Welcome note"
   )
   # no phantom slide between title and first content slide
   sections <- xml2::xml_find_all(html, "//section[@class]")
   expect_equal(
     xml2::xml_attr(sections[1:2], "id"),
     c("title-slide", "slide-a")
   )
 })

 test_that("overview slides get the TOC script", {
   skip_if_not_pandoc()
   rmd <- local_temp_rmd_file(
     "---",
     "title: Overview test",
     "output: revealjs.ids::revealjs_presentation",
     "---",
     "",
     "## Overview",
     "",
     "Placeholder",
     "",
     "# Chapter One",
     "",
     "## Slide",
     "",
     "Content"
   )
   html <- .render_and_read(rmd, xml = FALSE)
   expect_true(any(grepl("ids-overview-toc", html)))
   expect_true(any(grepl("Überblick", html, fixed = TRUE)))
 })

 test_that("a user-supplied totalTime is respected", {
   skip_if_not_pandoc()
   rmd <- local_temp_rmd_file(
     "---",
     "title: Timing test",
     "output: revealjs.ids::revealjs_presentation",
     "---",
     "",
     "## Slide A",
     "",
     "<!-- 00:30 -->"
   )
   html <- .render_and_read(rmd, output_options = list(
     reveal_options = list(totalTime = 1800)
   ))
   # passed through to the config...
   expect_true(any(grepl("totalTime:\\s*1800", html)))
   # ... and not overwritten by the calculated total
   expect_false(any(grepl("totalTime:\\s*30", html)))
 })

 test_that("slide_timing reports totals", {
   rmd_file <- tempfile(fileext = ".Rmd")
   writeLines(c(
     "---",
     "title: x",
     "output: revealjs.ids::revealjs_presentation",
     "---",
     "",
     "## Slide one",
     "",
     "<!-- MK 00:30 -->",
     "",
     "## Slide two",
     "",
     "<!-- AB 1:00 -->",
     "<!-- MK 90 -->"
   ), rmd_file)
   expect_output(result <- slide_timing(rmd_file), "total")
   expect_equal(result$total, 180)
   expect_equal(result$speakers$seconds[result$speakers$speaker == "MK"], 120)
   expect_equal(result$speakers$seconds[result$speakers$speaker == "AB"], 60)
   unlink(rmd_file)
 })
	test_that("parse_duration_seconds handles all duration formats", {
	expect_equal(parse_duration_seconds("00:30"), 30)
	expect_equal(parse_duration_seconds("1:05"), 65)
	expect_equal(parse_duration_seconds("45"), 45)
	expect_equal(parse_duration_seconds("1:00:00"), 3600)
	expect_equal(parse_duration_seconds("1:30:15"), 5415)
	expect_true(is.na(parse_duration_seconds("abc")))
	})

	test_that("extract_timing_comments finds comments", {
	lines <- c(
	"---",
	"title: x",
	"---",
	"",
	"## Slide one",
	"",
	"<!-- MK 00:30 -->",
	"",
	"## Slide two",
	"",
	"<!-- AB 1:00 -->",
	"<!-- MK 90 -->"
	)
	comments <- extract_timing_comments(lines)
	expect_equal(comments$speaker, c("MK", "AB", "MK"))
	expect_equal(comments$seconds, c(30, 60, 90))
	expect_equal(assign_slides(lines, comments, slide_level = 2),
	c("Slide one", "Slide two", "Slide two"))
	})

	test_that("comments without speaker codes are supported", {
	lines <- c("## Slide one", "<!-- 00:30 -->", "## Slide two", "<!-- 1:05 -->")
	comments <- extract_timing_comments(lines)
	expect_true(all(is.na(comments$speaker)))
	expect_equal(comments$seconds, c(30, 65))

	# a plain number must not be split into a speaker code plus duration
	comments2 <- extract_timing_comments("<!-- 45 -->")
	expect_true(is.na(comments2$speaker))
	expect_equal(comments2$seconds, 45)

	result <- apply_timing_attributes(c(
	"<section id='s1' class='level2'>",
	"<!-- 00:30 -->",
	"</section>"
	))
	expect_match(result[1], "data-timing=\"30\"")

	report <- timing_report_message(extract_timing_comments(lines))
	expect_equal(report, "Slide timing -- total 1:35")
	})

	test_that("comments before first heading belong to title slide", {
	lines <- c("<!-- MK 00:10 -->", "", "# Title", "", "## Slide")
	comments <- extract_timing_comments(lines)
	expect_equal(assign_slides(lines, comments, slide_level = 2), "(title)")
	})

	test_that("apply_timing_attributes adds data-timing to sections", {
	lines <- c(
	"<html>",
	"<section id='title-slide'>",
	"title",
	"</section>",
	"<section id='s1' class='level2'>",
	"<!-- MK 00:30 -->",
	"</section>",
	"<section id='s2' class='level2'>",
	"<!-- MK 0:20 -->",
	"<!-- AB 00:30 -->",
	"</section>"
	)
	result <- apply_timing_attributes(lines)
	html <- paste(result, collapse = "\n")
	expect_match(result[2], "<section id='title-slide'>")
	expect_match(result[5], "data-timing=\"30\"")
	# multiple speakers on one slide are summed
	expect_match(result[8], "data-timing=\"50\"")
	comments <- attr(result, "comments")
	expect_equal(sum(comments$seconds), 80)
	})

	test_that("apply_timing_attributes is a no-op without comments", {
	lines <- c("<section id='s1'>", "x", "</section>")
	result <- apply_timing_attributes(lines)
	expect_identical(as.vector(result), lines)
	expect_equal(nrow(attr(result, "comments")), 0)
	})

	test_that("inject_total_time activates the pacing timer", {
	lines <- c(
	"var opts = {",
	" controls: true,",
	"};",
	"Reveal.initialize({",
	" controls: true,",
	" slideNumber: true",
	"});"
	)
	result <- inject_total_time(lines, 90)
	expect_contains(result, "\t\t\ttotalTime: 90,")

	# existing pacing config is respected
	with_default <- c(lines, "", "defaultTiming: 60")
	expect_identical(inject_total_time(with_default, 90), with_default)
	with_total <- c("totalTime: 120", lines)
	expect_identical(inject_total_time(with_total, 90), with_total)

	# nothing to hook into -- leave the document alone
	expect_identical(inject_total_time(c("<html>", "</html>"), 90),
	c("<html>", "</html>"))
	})

	test_that("rendered presentations carry data-timing attributes", {
	skip_if_not_pandoc()
	skip_if_not_installed("xml2")
	rmd <- local_temp_rmd_file(
	"---",
	"title: Timing test",
	"output: revealjs.ids::revealjs_presentation",
	"---",
	"",
	"## Slide A",
	"",
	"Content A",
	"",
	"<!-- MK 00:30 -->",
	"",
	"## Slide B",
	"",
	"Content B",
	"",
	"<!-- MK 01:00 -->",
	"<!-- AB 0:30 -->"
	)
	html <- .render_and_read(rmd)
	timings <- xml2::xml_attr(
	xml2::xml_find_all(html, "//section[@data-timing]"),
	"data-timing"
	)
	expect_equal(timings, c("30", "90"))
	# the grand total activates the pacing timer of the notes plugin
	expect_true(any(grepl("totalTime:\\s*120", html)))
	})

	test_that("title slide notes and timing are merged into the title section", {
	lines <- c(
	'<section class="title-frame" id="title-slide">',
	"<h1 class=\"title\">Title</h1>",
	"</section>",
	"<section class=\"slide level2\">",
	"<!-- JD 00:30 -->",
	"<aside class=\"notes\">",
	"<p>Welcome</p>",
	"</aside>",
	"</section>",
	"<section id=\"slide-a\" class=\"slide level2\">",
	"<!-- MK 01:00 -->",
	"</section>"
	)
	merged <- merge_title_slide_notes(lines)
	# phantom slide (6 lines) removed, its 4 content lines moved into the title
	expect_length(merged, length(lines) - 2)
	expect_identical(merged[1], lines[1])
	expect_match(paste(merged[1:5], collapse = "\n"), "Welcome")
	expect_match(paste(merged[1:5], collapse = "\n"), "JD 00:30")
	# only the real Slide A section remains
	expect_equal(sum(grepl('class="slide level2"', merged)), 1)

	# a phantom slide with real content is left alone
	with_content <- lines
	with_content[6] <- "<p>Visible intro content</p>"
	expect_identical(merge_title_slide_notes(with_content), with_content)

	# no title slide: nothing to merge
	no_title <- lines[-1]
	expect_identical(merge_title_slide_notes(no_title), no_title)
	})

	test_that("rendered title slides carry notes and data-timing", {
	skip_if_not_pandoc()
	skip_if_not_installed("xml2")
	rmd <- local_temp_rmd_file(
	"---",
	"title: Timing test",
	"output: revealjs.ids::revealjs_presentation",
	"---",
	"",
	"::: notes",
	"Welcome note",
	":::",
	"",
	"<!-- 00:30 -->",
	"",
	"## Slide A",
	"",
	"Content A"
	)
	html <- .render_and_read(rmd)
	title <- xml2::xml_find_first(html, "//section[@id='title-slide']")
	expect_equal(xml2::xml_attr(title, "data-timing"), "30")
	expect_equal(
	xml2::xml_text(xml2::xml_find_first(title, "./aside[@class='notes']"), trim = TRUE),
	"Welcome note"
	)
	# no phantom slide between title and first content slide
	sections <- xml2::xml_find_all(html, "//section[@class]")
	expect_equal(
	xml2::xml_attr(sections[1:2], "id"),
	c("title-slide", "slide-a")
	)
	})

	test_that("overview slides get the TOC script", {
	skip_if_not_pandoc()
	rmd <- local_temp_rmd_file(
	"---",
	"title: Overview test",
	"output: revealjs.ids::revealjs_presentation",
	"---",
	"",
	"## Overview",
	"",
	"Placeholder",
	"",
	"# Chapter One",
	"",
	"## Slide",
	"",
	"Content"
	)
	html <- .render_and_read(rmd, xml = FALSE)
	expect_true(any(grepl("ids-overview-toc", html)))
	expect_true(any(grepl("Überblick", html, fixed = TRUE)))
	})

	test_that("a user-supplied totalTime is respected", {
	skip_if_not_pandoc()
	rmd <- local_temp_rmd_file(
	"---",
	"title: Timing test",
	"output: revealjs.ids::revealjs_presentation",
	"---",
	"",
	"## Slide A",
	"",
	"<!-- 00:30 -->"
	)
	html <- .render_and_read(rmd, output_options = list(
	reveal_options = list(totalTime = 1800)
	))
	# passed through to the config...
	expect_true(any(grepl("totalTime:\\s*1800", html)))
	# ... and not overwritten by the calculated total
	expect_false(any(grepl("totalTime:\\s*30", html)))
	})

	test_that("slide_timing reports totals", {
	rmd_file <- tempfile(fileext = ".Rmd")
	writeLines(c(
	"---",
	"title: x",
	"output: revealjs.ids::revealjs_presentation",
	"---",
	"",
	"## Slide one",
	"",
	"<!-- MK 00:30 -->",
	"",
	"## Slide two",
	"",
	"<!-- AB 1:00 -->",
	"<!-- MK 90 -->"
	), rmd_file)
	expect_output(result <- slide_timing(rmd_file), "total")
	expect_equal(result$total, 180)
	expect_equal(result$speakers$seconds[result$speakers$speaker == "MK"], 120)
	expect_equal(result$speakers$seconds[result$speakers$speaker == "AB"], 60)
	unlink(rmd_file)
	})