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