1
2pandoc_available <- function(version = NULL) {
3
4  # ensure we've scanned for pandoc
5  find_pandoc()
6
7  # check availability
8  if (!is.null(.pandoc$dir))
9    if (!is.null(version))
10      .pandoc$version >= version
11  else
12    TRUE
13  else
14    FALSE
15}
16
17pandoc_save_markdown <- function(html, file, background = "white", title, libdir = "lib") {
18  # Forked from htmltools::save_html to work better with pandoc_self_contained_html
19
20  # ensure that the paths to dependencies are relative to the base
21  # directory where the webpage is being built.
22  if (is.character(file)) {
23    dir <- normalizePath(dirname(file), mustWork = TRUE)
24    file <- file.path(dir, basename(file))
25    owd <- setwd(dir)
26    on.exit(setwd(owd), add = TRUE)
27  }
28
29  rendered <- renderTags(html)
30
31  deps <- lapply(rendered$dependencies, function(dep) {
32    dep <- htmltools::copyDependencyToDir(dep, libdir, FALSE)
33    dep <- htmltools::makeDependencyRelative(dep, dir, FALSE)
34    dep
35  })
36
37  # Build the markdown page. Anything that goes into the eventual <head> goes in
38  # the yaml header, and will be rendered using the pandoc template.
39  html <- c(
40    "---",
41    yaml::as.yaml(list(
42      title = htmltools::htmlEscape(title),
43      "header-include" = renderDependencies(deps, c("href", "file")),
44      "head" = rendered$head,
45      "background-color" = htmltools::htmlEscape(background, attribute = TRUE)
46    )),
47    "---",
48    rendered$html
49  )
50
51  # write it
52  writeLines(html, file, useBytes = TRUE)
53}
54
55# The input should be the path to a file that was created using pandoc_save_markdown
56pandoc_self_contained_html <- function(input, output) {
57
58  # make input file path absolute
59  input <- normalizePath(input)
60
61  # ensure output file exists and make it's path absolute
62  if (!file.exists(output))
63    file.create(output)
64  output <- normalizePath(output)
65
66  # create a template
67  template <- tempfile(fileext = ".html")
68  writeLines(c(
69    "<!DOCTYPE html>",
70    "<html>",
71    "<head>",
72    "<meta charset=\"utf-8\"/>",
73    "<title>$title$</title>",
74    "$for(header-include)$",
75    "$header-include$",
76    "$endfor$",
77    "$for(head)$",
78    "$head$",
79    "$endfor$",
80    "</head>",
81    "<body style=\"background-color: $background-color$;\">",
82    "$body$",
83    "</body>",
84    "</html>"
85  ), template)
86
87  # convert from markdown to html to get base64 encoding
88  # (note there is no markdown in the source document but
89  # we still need to do this "conversion" to get the
90  # base64 encoding)
91  pandoc_convert(
92    input = input,
93    from = "markdown",
94    output = output,
95    options = c(
96      "--self-contained",
97      "--template", template
98    )
99  )
100
101  invisible(output)
102}
103
104
105pandoc_convert <- function(input,
106                           to = NULL,
107                           from = NULL,
108                           output = NULL,
109                           citeproc = FALSE,
110                           options = NULL,
111                           verbose = FALSE,
112                           wd = NULL) {
113
114  # ensure we've scanned for pandoc
115  find_pandoc()
116
117  # execute in specified working directory
118  if (is.null(wd)) {
119    wd <- base_dir(input)
120  }
121  oldwd <- setwd(wd)
122  on.exit(setwd(oldwd), add = TRUE)
123
124
125  # input file and formats
126  args <- c(input)
127  if (!is.null(to))
128    args <- c(args, "--to", to)
129  if (!is.null(from))
130    args <- c(args, "--from", from)
131
132  #  output file
133  if (!is.null(output))
134    args <- c(args, "--output", output)
135
136  # additional command line options
137  args <- c(args, options)
138
139  # set pandoc stack size
140  stack_size <- getOption("pandoc.stack.size", default = "512m")
141  args <- c(c("+RTS", paste0("-K", stack_size), "-RTS"), args)
142
143  # build the conversion command
144  command <- paste(quoted(pandoc()), paste(quoted(args), collapse = " "))
145
146  # show it in verbose mode
147  if (verbose)
148    cat(command, "\n")
149
150  # run the conversion
151  with_pandoc_safe_environment({
152    result <- system(command)
153  })
154  if (result != 0)
155    stop("pandoc document conversion failed with error ", result, call. = FALSE)
156
157  invisible(NULL)
158}
159
160# get the path to the pandoc binary
161pandoc <- function() {
162  find_pandoc()
163  file.path(.pandoc$dir, "pandoc")
164}
165
166# Scan for a copy of pandoc and set the internal cache if it's found.
167find_pandoc <- function() {
168
169  if (is.null(.pandoc$dir)) {
170
171    # define potential sources
172    sys_pandoc <- Sys.which("pandoc")
173    sources <- c(Sys.getenv("RSTUDIO_PANDOC"),
174                 ifelse(nzchar(sys_pandoc), dirname(sys_pandoc), ""))
175    if (!is_windows())
176      sources <- c(sources, path.expand("~/opt/pandoc"))
177
178    # determine the versions of the sources
179    versions <- lapply(sources, function(src) {
180      if (file.exists(src))
181        get_pandoc_version(src)
182      else
183        numeric_version("0")
184    })
185
186    # find the maximum version
187    found_src <- NULL
188    found_ver <- numeric_version("0")
189    for (i in 1:length(sources)) {
190      ver <- versions[[i]]
191      if (ver > found_ver) {
192        found_ver <- ver
193        found_src <- sources[[i]]
194      }
195    }
196
197    # did we find a version?
198    if (!is.null(found_src)) {
199      .pandoc$dir <- found_src
200      .pandoc$version <- found_ver
201    }
202  }
203}
204
205# wrap a system call to pandoc so that LC_ALL is not set
206# see: https://github.com/rstudio/rmarkdown/issues/31
207# see: https://ghc.haskell.org/trac/ghc/ticket/7344
208with_pandoc_safe_environment <- function(code) {
209  lc_all <- Sys.getenv("LC_ALL", unset = NA)
210  if (!is.na(lc_all)) {
211    Sys.unsetenv("LC_ALL")
212    on.exit(Sys.setenv(LC_ALL = lc_all), add = TRUE)
213  }
214  lc_ctype <- Sys.getenv("LC_CTYPE", unset = NA)
215  if (!is.na(lc_ctype)) {
216    Sys.unsetenv("LC_CTYPE")
217    on.exit(Sys.setenv(LC_CTYPE = lc_ctype), add = TRUE)
218  }
219  if (Sys.info()['sysname'] == "Linux" &&
220      is.na(Sys.getenv("HOME", unset = NA))) {
221    stop("The 'HOME' environment variable must be set before running Pandoc.")
222  }
223  if (Sys.info()['sysname'] == "Linux" &&
224      is.na(Sys.getenv("LANG", unset = NA))) {
225    # fill in a the LANG environment variable if it doesn't exist
226    Sys.setenv(LANG=detect_generic_lang())
227    on.exit(Sys.unsetenv("LANG"), add = TRUE)
228  }
229  if (Sys.info()['sysname'] == "Linux" &&
230      identical(Sys.getenv("LANG"), "en_US")) {
231    Sys.setenv(LANG="en_US.UTF-8")
232    on.exit(Sys.setenv(LANG="en_US"), add = TRUE)
233  }
234  force(code)
235}
236
237
238# if there is no LANG environment variable set pandoc is going to hang so
239# we need to specify a "generic" lang setting. With glibc >= 2.13 you can
240# specify C.UTF-8 so we prefer that. If we can't find that then we fall back
241# to en_US.UTF-8.
242detect_generic_lang <- function() {
243
244  locale_util <- Sys.which("locale")
245
246  if (nzchar(locale_util)) {
247    locales <- system(paste(locale_util, "-a"), intern = TRUE)
248    locales <- suppressWarnings(
249      strsplit(locales, split = "\n", fixed = TRUE)
250    )
251    if ("C.UTF-8" %in% locales)
252      return ("C.UTF-8")
253  }
254
255  # default to en_US.UTF-8
256  "en_US.UTF-8"
257}
258
259# quote args if they need it
260quoted <- function(args) {
261  spaces <- grepl(' ', args, fixed=TRUE)
262  args[spaces] <- shQuote(args[spaces])
263  args
264}
265
266# Find common base directory, throw error if it doesn't exist
267base_dir <- function(x) {
268  abs <- vapply(x, tools::file_path_as_absolute, character(1))
269
270  base <- unique(dirname(abs))
271  if (length(base) > 1) {
272    stop("Input files not all in same directory, please supply explicit wd",
273         call. = FALSE)
274  }
275
276  base
277}
278
279# Get an S3 numeric_version for the pandoc utility at the specified path
280get_pandoc_version <- function(pandoc_dir) {
281  pandoc_path <- file.path(pandoc_dir, "pandoc")
282  with_pandoc_safe_environment({
283    version_info <- system(paste(shQuote(pandoc_path), "--version"),
284                           intern = TRUE)
285  })
286  version <- strsplit(version_info, "\n")[[1]][1]
287  version <- strsplit(version, " ")[[1]][2]
288  numeric_version(version)
289}
290
291is_windows <- function() {
292  identical(.Platform$OS.type, "windows")
293}
294
295# Environment used to cache the current pandoc directory and version
296.pandoc <- new.env()
297.pandoc$dir <- NULL
298.pandoc$version <- NULL
299
300