Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

f/ioslides background #687

Merged
merged 1 commit into from
Sep 6, 2017
Merged

f/ioslides background #687

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 5 additions & 1 deletion R/base64.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,10 +117,14 @@ process_html_res <- function(html, reg, processor) {
}

process_images <- function(html, processor) {
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

process_images() is called by html_document_base(), so the change in this function has potential risk of affecting all HTML output formats. I'd rather be a little conservative, and move the new process_html_res() call you added to the end of base64_encode_images() (line #140), so that this only affects ioslides_presentation(), because only ioslides_presentation() calls base64_encode_images().

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@yihui sorry I didn't see this update. No worries on the timing, I've been reporting using a branch that includes it in the intervening time. Good to see it merged. Thanks.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No worries. Thanks!

process_html_res(
html <- process_html_res(
html,
"<\\s*[Ii][Mm][Gg]\\s+[Ss][Rr][Cc]\\s*=\\s*[\"']([^\"']+)[\"']",
processor)
process_html_res(
html,
"<[^>]*style=\"[^\"]*url\\(([^\\)]+)\\)",
processor)
}

base64_encode_images <- function(html, encoder) {
Expand Down
65 changes: 63 additions & 2 deletions inst/rmd/ioslides/ioslides_presentation.lua
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,39 @@ local function attributes(attr)
return table.concat(attr_table)
end

-- Helper function to split a string on spaces
-- returns a table
local function split(str)
local words = {}
for word in str:gmatch("%S+") do table.insert(words, word) end
return words
end

-- Helper function to remove duplicates
-- returns a table http://stackoverflow.com/a/20067270
local function uniq(t)
local seen = {}
local res = {}
for _,v in ipairs(t) do
if (not seen[v]) then
res[#res+1] = v
seen[v] = true
end
end
return res
end

-- Helper function to filter a list
-- returns a table
local function grep(f, l)
local res = {}
for _,v in ipairs(l) do
if (f(v)) then
res[#res+1] = v
end
end
return res
end

-- Blocksep is used to separate block elements.
function Blocksep()
Expand Down Expand Up @@ -209,6 +242,8 @@ function Header(lev, s, attr)
-- detect level 1 header and convert it to a segue slide
local slide_class = ""
local hgroup_class = ""
local slide_style = ""

-- make all headers < slide_level as segue slides
if lev < slide_level then
-- create a segue slide but add lev class for possible customization
Expand All @@ -217,6 +252,29 @@ function Header(lev, s, attr)
lev = 2
end

-- support for slide specific image backgrounds
-- alternative is this css
-- slide > slide [data-slide-num="7"] {
-- background-image: url("figures/xx.jpg");
-- }
if attr["data-background"] then
-- dark is incompatible with fill and let us uniquify nobackground
local slide = split(slide_class .. " fill nobackground")
slide = grep(function (v)
if v:match("^dark$") then return false else return true end
end, slide)
slide_class = table.concat(uniq(slide), " ")
if attr["data-background"]:match("^#") then
slide_style = 'background-color: ' .. attr["data-background"] .. ';'
else
-- assume url
slide_style = 'background-image: url(' .. attr["data-background"] .. ');'
slide_style = slide_style .. ' background-size: 100% 100%;'
end
-- remove noise attributes for article
attr["data-background"] = nil
end

-- extract optional subtitle
local subtitle = ""
if lev == 2 then
Expand Down Expand Up @@ -264,8 +322,12 @@ function Header(lev, s, attr)
end
end

if string.len(slide_style) > 0 then
slide_style = ' style="' .. slide_style .. '"'
end

-- return the beginning of the slide
return preface .. "<slide class='" .. slide_class .. "'>" ..
return preface .. "<slide class=\"" .. slide_class .. "\"" .. slide_style .. ">" ..
"<hgroup" .. hgroup_class .. ">" .. header .. "</hgroup>" ..
"<article " .. attributes(attr) .. ">"
else
Expand Down Expand Up @@ -449,4 +511,3 @@ meta.__index =
return function() return "" end
end
setmetatable(_G, meta)

124 changes: 100 additions & 24 deletions tests/testthat/test-ioslides.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,35 +15,60 @@ context("ioslides")

}

mock_markdown <- function(mdtext = NULL, outputdir = NULL, ... ) {
# create input file
mdfile <- tempfile(pattern = "mock_XXXXX",
tmpdir = outputdir,
fileext = ".Rmd")
cat(mdtext, file = mdfile, sep = "\n", append = FALSE)

# output file name
outfile <- basename(
tempfile(pattern = "mock_XXXXX",
tmpdir = outputdir,
fileext = ".html"
)
)
# convert
output <- capture.output(
render(mdfile,
output_dir = outputdir,
output_file = outfile,
ioslides_presentation(...)
)
)

# read in output
html_file <- readLines(file.path(outputdir, outfile))

# return structure for testing properties of
invisible(structure(
list(
output = output,
html_file = html_file
),
class = "mocked")
)
}

test_ioslides_presentation <- function() {

skip_on_cran()

outputdir <- tempfile()
outputdir <- tempfile()
dir.create(outputdir)
on.exit(unlink(outputdir), add = TRUE)

# Generate mock md file
mdtext <- .generate_markdown_for_test()
mdfile <- file.path(outputdir, "mock.Rmd")
cat(mdtext, file = mdfile, sep = "\n")

# test conversion
outfile <- "mock_default.html"
rout2 <- capture.output(
render(mdfile,
output_dir = outputdir,
output_file = outfile,
ioslides_presentation()
)
)
mock2 <- mock_markdown(mdtext = mdtext, outputdir = outputdir)

# test argument passing to pandoc
expect_true(any(grepl("--slide-level 2", paste(rout2), fixed = TRUE)))
expect_true(any(grepl("--slide-level 2", paste(mock2$output), fixed = TRUE)))

# test status of headers in resulting file
# Header3 should not be a slide header
html_file <- readLines(file.path(outputdir, outfile))
html_file <- mock2$html_file
header_lines <- c(
any(grepl("<h2>Header1</h2>", html_file, fixed = TRUE)),
any(grepl("<h2>Header2</h2>", html_file, fixed = TRUE)),
Expand All @@ -66,22 +91,16 @@ test_ioslides_presentation <- function() {
)
expect_false(any(header_classes))


mock3 <- mock_markdown(mdtext = mdtext, outputdir = outputdir, slide_level = 3)
# Place the header 3 as title slide
rout3 <- capture.output(
render(mdfile,
output_dir = outputdir,
output_file = outfile,
ioslides_presentation(slide_level = 3)
)
)
rout3 <- mock3$output

# test argument passing to pandoc
expect_true(any(grepl("--slide-level 3", paste(rout3), fixed = TRUE)))

# test status of headers in resulting file
# Header3 should be a slide header
html_file <- readLines(file.path(outputdir, outfile))
html_file <- mock3$html_file
header_lines <- c(
any(grepl("<h2>Header1</h2>", html_file, fixed = TRUE)),
any(grepl("<h2>Header2</h2>", html_file, fixed = TRUE)),
Expand All @@ -107,3 +126,60 @@ test_ioslides_presentation <- function() {
}

test_that("test_ioslides_presentation", test_ioslides_presentation())

test_ioslides_presentation_css <- function() {

skip_on_cran()

outputdir <- tempfile()
dir.create(outputdir)
on.exit(unlink(outputdir), add = TRUE)

# Generate mock md file for data-background
mdtext <- c("# Slide One\n",
"## Slide Two {data-background=#CCC}\n",
"## Slide Three {data-background=img/test.png}\n",
"# Slide Four {data-background=#ABCDEF}\n"
)
mock <- mock_markdown(mdtext = mdtext, outputdir = outputdir, self_contained = FALSE)
html = mock$html_file

slide_lines <-
c(any(grepl('<slide[^>]*class="[^"]*\\bsegue\\b[^"]*".*<h2>Slide One</h2>', html, perl = TRUE))
## separated to be order agnostic
, any(grepl('<slide[^>]*class="[^"]*\\bnobackground\\b[^"]*".*<h2>Slide Two</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*class="[^"]*\\bfill\\b[^"]*".*<h2>Slide Two</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*style="background-color: #CCC;".*<h2>Slide Two</h2>', html, perl = TRUE))

## separated to be order agnostic - within values of attributes also (hence [^"]*)
, any(grepl('<slide[^>]*class="[^"]*\\bnobackground\\b[^"]*".*<h2>Slide Two</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*class="[^"]*\\bfill\\b[^"]*".*<h2>Slide Two</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*style="[^"]*background-image: url\\(img/test.png\\);[^"]*".*<h2>Slide Three</h2>', html))
, any(grepl('<slide[^>]*style="[^"]*background-size: 100% 100%;[^"]*".*<h2>Slide Three</h2>', html))

## separated to be order agnostic
, any(grepl('<slide[^>]*class="[^"]*\\bsegue\\b[^"]*".*<h2>Slide Four</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*class="[^"]*\\bnobackground\\b[^"]*".*<h2>Slide Four</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*class="[^"]*\\bfill\\b[^"]*".*<h2>Slide Four</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*class="[^"]*\\blevel1\\b[^"]*".*<h2>Slide Four</h2>', html, perl = TRUE))
, any(grepl('<slide[^>]*style="background-color: #ABCDEF;".*<h2>Slide Four</h2>', html, perl = TRUE))

)
expect_true(all(slide_lines), info = "slide lines - style attribute")

# Generate mock md file for data-background
plot <- file.path(getwd(), 'resources', 'tinyplot.png')
mdtext <- c(paste0("## BG Slide {data-background=", plot, "}\n"))
mock <- mock_markdown(mdtext = mdtext, outputdir = outputdir, self_contained = TRUE)
html = mock$html_file

slide_lines <-
c(any(grepl('<slide[^>]*style="[^"]*background-image: url\\(data:image/png;base64,[^\\)]*);[^"]*".*<h2>BG Slide</h2>', html))
## still separate
, any(grepl('<slide[^>]*style="[^"]*background-size: 100% 100%;[^"]*".*<h2>BG Slide</h2>', html))
)
expect_true(all(slide_lines), info = "slide lines - self contained image")
}


test_that("ioslides presentation is styled", test_ioslides_presentation_css())