1# 2# SessionRMarkdown.R 3# 4# Copyright (C) 2021 by RStudio, PBC 5# 6# Unless you have received this program directly from RStudio pursuant 7# to the terms of a commercial license agreement with RStudio, then 8# this program is licensed to you under the terms of version 3 of the 9# GNU Affero General Public License. This program is distributed WITHOUT 10# ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT, 11# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the 12# AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details. 13# 14# 15 16.rs.setVar("markdown.acCompletionTypes", list( 17 COMPLETION_HREF = 1 18)) 19 20.rs.addJsonRpcHandler("markdown_get_completions", function(type, data) 21{ 22 if (type == .rs.markdown.acCompletionTypes$COMPLETION_HREF) 23 return(.rs.markdown.getCompletionsHref(data)) 24}) 25 26.rs.addFunction("markdown.resolveCompletionRoot", function(path) 27{ 28 # figure out working directory 29 props <- .rs.getSourceDocumentProperties(path) 30 workingDirProp <- props$properties$working_dir 31 32 useProject <- 33 identical(workingDirProp, "project") && 34 is.character(props$path) && 35 is.character(props$project_path) 36 37 if (useProject) 38 { 39 # path refers to the full path; project_path refers 40 # to the project-relative path. use that to infer 41 # the path to the project hosting the document 42 # (just in case the user is editing a document that 43 # belongs to an alternate project) 44 substring(props$path, 1L, nchar(props$path) - nchar(props$project_path) - 1L) 45 } 46 else if (identical(workingDirProp, "current")) 47 { 48 getwd() 49 } 50 else 51 { 52 dirname(path) 53 } 54}) 55 56.rs.addFunction("markdown.getCompletionsHref", function(data) 57{ 58 # extract parameters 59 token <- data$token 60 path <- data$path 61 62 # if we don't have a path, bail 63 if (is.null(path)) 64 return(.rs.emptyCompletions()) 65 66 # figure out working directory 67 workingDir <- .rs.markdown.resolveCompletionRoot(path) 68 69 # determine dirname, basename (need to handle trailing slashes properly 70 # so can't just use dirname / basename) 71 slashes <- gregexpr("[/\\]", token)[[1]] 72 idx <- tail(slashes, n = 1) 73 lhs <- substring(token, 1, idx - 1) 74 rhs <- substring(token, idx + 1) 75 76 # check to see if user is providing absolute path, and construct 77 # completion directory appropriately 78 isAbsolute <- grepl("^(?:[A-Z]:|/|\\\\|~)", token, perl = TRUE) 79 if (!isAbsolute) 80 lhs <- file.path(workingDir, lhs) 81 82 # retrieve completions 83 completions <- .rs.getCompletionsFile( 84 token = rhs, 85 path = lhs, 86 quote = FALSE, 87 directoriesOnly = FALSE 88 ) 89 90 return(completions) 91 92}) 93 94.rs.addFunction("scalarListFromList", function(l, expressions = FALSE) 95{ 96 # hint that every non-list element of the hierarchical list l 97 # is a scalar value if it is of length 1 98 l <- lapply(l, function(ele) { 99 if (is.null(ele)) 100 NULL 101 else if (is.list(ele)) 102 .rs.scalarListFromList(ele) 103 else if (length(ele) == 1) { 104 # mark strings with encoding unless already marked (see comment 105 # below in convert_to_yaml) 106 if (is.character(ele) && Encoding(ele) == "unknown") 107 Encoding(ele) <- "UTF-8" 108 .rs.scalar(ele) 109 } 110 else if (identical(expressions, TRUE) && (is.expression(ele) || is.call(ele))) 111 .rs.scalarListFromList(list(expr = eval(ele)))$expr 112 else 113 ele 114 }) 115}) 116 117.rs.addFunction("isREADME", function(file) { 118 identical(tools::file_path_sans_ext(basename(file)), "README") 119}) 120 121.rs.addFunction("updateRMarkdownPackage", function(archive) 122{ 123 pkgDir <- find.package("rmarkdown") 124 .rs.forceUnloadPackage("rmarkdown") 125 .Call("rs_installPackage", archive, dirname(pkgDir)) 126}) 127 128.rs.addFunction("getRmdRuntime", function(file) { 129 lines <- readLines(file, warn = FALSE) 130 131 yamlFrontMatter <- tryCatch( 132 rmarkdown:::parse_yaml_front_matter(lines), 133 error=function(e) { 134 list() 135 }) 136 137 if (!is.null(yamlFrontMatter$runtime)) 138 yamlFrontMatter$runtime 139 else 140 "" 141}) 142 143.rs.addFunction("getCustomRenderFunction", function(file) { 144 # read the contents of the file 145 lines <- readLines(file, warn = FALSE) 146 147 # mark the encoding if it's available 148 properties <- .rs.getSourceDocumentProperties(file) 149 if (identical(properties$encoding, "UTF-8")) 150 Encoding(lines) <- "UTF-8" 151 152 yamlFrontMatter <- tryCatch( 153 rmarkdown:::parse_yaml_front_matter(lines), 154 error = function(e) { 155 list() 156 } 157 ) 158 159 haveQuarto <- function() { 160 nzchar(Sys.which("quarto")) 161 } 162 163 isQuartoDoc <- function() { 164 # .qmd file 165 .rs.endsWith(file, ".qmd") || 166 # file with "format" yaml and no "output" yaml 167 (is.null(yamlFrontMatter[["output"]]) && !is.null(yamlFrontMatter[["format"]])) || 168 # quarto extended type 169 identical(.Call("rs_detectExtendedType", file), "quarto-document") || 170 # plain markdown file w/ "jupyter" metdata 171 (.rs.endsWith(file, ".md") && !is.null(yamlFrontMatter[["jupyter"]])) 172 } 173 174 if (is.character(yamlFrontMatter[["knit"]])) 175 yamlFrontMatter[["knit"]][[1]] 176 else if (haveQuarto() && isQuartoDoc()) 177 "quarto render" 178 else if (!is.null(yamlFrontMatter$runtime) && 179 grepl('^shiny', yamlFrontMatter$runtime)) { 180 # use run as a wrapper for render when the doc requires the Shiny runtime, 181 # and outputs HTML. 182 tryCatch({ 183 outputFormat <- rmarkdown:::output_format_from_yaml_front_matter(lines) 184 formatFunction <- eval(parse(text = outputFormat$name), 185 envir = asNamespace("rmarkdown")) 186 if (identical(tolower(tools::file_ext( 187 rmarkdown:::pandoc_output_file("shiny", formatFunction()$pandoc))), 188 "html")) 189 "rmarkdown::run" 190 else 191 # this situation is nonsensical (runtime: shiny only makse sense for 192 # HTML-based output formats) 193 "" 194 }, error = function(e) { 195 "" 196 }) 197 } 198 else { 199 # return render_site if we are in a website and this isn't a README 200 if (!.rs.isREADME(file)) { 201 siteGenerator <- tryCatch(rmarkdown::site_generator(file), 202 error = function(e) NULL) 203 if (!is.null(siteGenerator)) 204 "rmarkdown::render_site" 205 else 206 "" 207 } 208 else { 209 "" 210 } 211 } 212}) 213 214# given an input file, return the associated output file, and attempt to deduce 215# whether it's up to date (e.g. for input.Rmd producing input.html, see whether 216# input.html exists and has been written since input.Rmd) 217.rs.addFunction("getRmdOutputInfo", function(target) { 218 219 # read the contents of the file 220 lines <- readLines(target, warn = FALSE) 221 222 # mark the encoding if it's available 223 properties <- .rs.getSourceDocumentProperties(target) 224 if (identical(properties$encoding, "UTF-8")) 225 Encoding(lines) <- "UTF-8" 226 227 # compute the name of the output file 228 outputFormat <- rmarkdown:::output_format_from_yaml_front_matter(lines) 229 outputFormat <- rmarkdown:::create_output_format(outputFormat$name, outputFormat$options) 230 outputFile <- rmarkdown:::pandoc_output_file(target, outputFormat$pandoc) 231 232 # determine location of output file, accounting for possibility of a website project which 233 # puts the output in a different location than the source file 234 outputDir <- .Call("rs_getWebsiteOutputDir") 235 if (is.null(outputDir)) 236 outputDir <- dirname(target) 237 outputPath <- file.path(outputDir, outputFile) 238 239 # ensure output file exists 240 fileExists <- file.exists(outputPath) 241 current <- fileExists && 242 file.info(outputPath)$mtime >= file.info(target)$mtime 243 244 # return named list and alias paths (this data goes to the client) 245 list( 246 output_file = .rs.scalar(.rs.createAliasedPath(outputPath)), 247 is_current = .rs.scalar(current), 248 output_file_exists = .rs.scalar(fileExists) 249 ) 250}) 251 252.rs.addFunction("getTemplateDetails", function(templateYaml) { 253 yaml::yaml.load_file(templateYaml) 254}) 255 256# given a path to a folder on disk, return information about the R Markdown 257# template in that folder. 258.rs.addFunction("getTemplateYamlFile", function(path) 259{ 260 # check for required files 261 templateYaml <- file.path(path, "template.yaml") 262 skeletonPath <- file.path(path, "skeleton") 263 if (!file.exists(templateYaml)) { 264 templateYaml <- file.path(path, "template.yml") 265 if (!file.exists(templateYaml)) 266 return(NULL) 267 } 268 269 # validate that a skeleton.Rmd file exists 270 paths <- file.path(skeletonPath, c("skeleton.rmd", "skeleton.Rmd")) 271 if (!any(file.exists(paths))) 272 return(NULL) 273 274 # will need to enforce create_dir if there are multiple files in /skeleton/ 275 multiFile <- length(list.files(skeletonPath)) > 1 276 277 # return metadata; we won't parse until the client requests template files 278 list( 279 template_yaml = .rs.scalar(templateYaml), 280 multi_file = .rs.scalar(multiFile) 281 ) 282}) 283 284.rs.addFunction("evaluateRmdParams", function(contents) { 285 286 Encoding(contents) <- "UTF-8" 287 288 # extract the params using knitr::knit_params 289 knitParams <- knitr::knit_params(contents) 290 291 if (length(knitParams) > 0) 292 { 293 # turn them into a named list 294 params <- list() 295 for (param in knitParams) 296 params[[param$name]] <- param$value 297 298 # mark as knit_params_list (so other routines know we generated it) 299 class(params) <- "knit_param_list" 300 301 # inject into global environment 302 assign("params", params, envir = globalenv()) 303 } 304}) 305 306.rs.addJsonRpcHandler("convert_to_yaml", function(input) 307{ 308 # the yaml package doesn't treat string values kindly if they're surrounded 309 # by backticks, so we will need to replace those with UUIDs we can sub out 310 # later 311 exprs <- list() 312 tick_sub <- function(x) 313 { 314 lapply(x, function(val) 315 { 316 if (is.list(val)) 317 { 318 # if it's a list, recurse 319 tick_sub(val) 320 } 321 else if (is.character(val) && length(val) == 1) 322 { 323 needsPlaceholder <- (function() { 324 325 # if it's a character value, check to see if it's a backtick 326 # expression 327 if (identical(substr(val, 1, 1), "`") && 328 identical(substr(val, nchar(val), nchar(val)), "`")) 329 { 330 return(TRUE) 331 } 332 333 # if it's a tagged value, placeholder 334 if (grepl("^[!]", val)) 335 return(TRUE) 336 337 FALSE 338 })() 339 340 if (needsPlaceholder) 341 { 342 # replace the backtick expression with an identifier 343 key <- .Call("rs_generateShortUuid") 344 exprs[[key]] <<- val 345 key 346 } 347 else 348 { 349 # leave other character expressions as-is 350 val 351 } 352 } 353 else 354 { 355 # leave non-character values alone 356 val 357 } 358 }) 359 } 360 361 # substitute ticks and convert to yaml 362 yaml <- yaml::as.yaml(tick_sub(input)) 363 364 # the yaml package produces UTF-8 output strings, but doesn't mark them 365 # as such, which leads to trouble (in particular: on Windows the string 366 # may be later interpreted in system default encoding, which is not UTF-8.) 367 # see: https://github.com/viking/r-yaml/issues/6 368 if (Encoding(yaml) == "unknown") 369 Encoding(yaml) <- "UTF-8" 370 371 # put the backticked expressions back 372 for (key in names(exprs)) 373 yaml <- sub(key, exprs[[key]], yaml, fixed = TRUE) 374 375 list(yaml = .rs.scalar(yaml)) 376}) 377 378.rs.addJsonRpcHandler("convert_from_yaml", function(yaml) 379{ 380 Encoding(yaml) <- "UTF-8" 381 382 data <- list() 383 parseError <- "" 384 parseSucceeded <- FALSE 385 386 tryCatch( 387 { 388 handlers <- list(r = function(x) paste("!r", x)) 389 data <- .rs.scalarListFromList(yaml::yaml.load(yaml, handlers = handlers)) 390 parseSucceeded <- TRUE 391 }, 392 error = function(e) 393 { 394 parseError <<- as.character(e) 395 }) 396 list(data = data, 397 parse_succeeded = .rs.scalar(parseSucceeded), 398 parse_error = .rs.scalar(parseError)) 399}) 400 401 402.rs.addJsonRpcHandler("rmd_output_format", function(input, encoding) { 403 if (Encoding(input) == "unknown") 404 Encoding(input) <- "UTF-8" 405 formats <- rmarkdown:::enumerate_output_formats(input, encoding = encoding) 406 if (is.character(formats)) 407 .rs.scalar(formats[[1]]) 408 else 409 NULL 410}) 411 412.rs.addGlobalFunction("knit_with_parameters", 413 function(file, encoding = getOption("encoding")) { 414 415 # result to return via event 416 result <- NULL 417 418 # check for parameters 419 if (length(knitr::knit_params(readLines(file, 420 warn = FALSE, 421 encoding = encoding), 422 evaluate = FALSE)) > 0) { 423 424 # allocate temp file to hold parameter values 425 paramsFile <- .Call("rs_paramsFileForRmd", file) 426 427 # read any existing parameters contained therin 428 params <- list() 429 if (file.exists(paramsFile)) 430 params <- readRDS(paramsFile) 431 432 # ask for parameters 433 params <- rmarkdown::knit_params_ask( 434 file, 435 params = params, 436 shiny_args = list( 437 launch.browser = function(url, ...) { 438 .Call("rs_showShinyGadgetDialog", 439 "Knit with Parameters", 440 url, 441 600, 442 600) 443 }, 444 quiet = TRUE), 445 save_caption = "Knit", 446 encoding = encoding 447 ) 448 449 if (!is.null(params)) { 450 saveRDS(params, file = paramsFile) 451 result <- paramsFile 452 } 453 454 } else { 455 # return special "none" value if there are no params 456 result <- "none" 457 } 458 459 .rs.enqueClientEvent("rmd_params_ready", result) 460 461 invisible(NULL) 462}) 463 464.rs.addJsonRpcHandler("get_rmd_output_info", function(target) { 465 return(.rs.getRmdOutputInfo(target)) 466}) 467 468.rs.addFunction("inputDirToIndexFile", function(input_dir) 469{ 470 paths <- c( 471 file.path(input_dir, "index.Rmd"), 472 file.path(input_dir, "index.md") 473 ) 474 475 for (path in paths) 476 if (file.exists(path)) 477 return(path) 478}) 479 480.rs.addFunction("getAllOutputFormats", function(input_dir, encoding) { 481 index <- .rs.inputDirToIndexFile(input_dir) 482 if (!is.null(index)) 483 rmarkdown:::enumerate_output_formats(input = index, 484 envir = parent.frame(), 485 encoding = encoding) 486 else 487 character() 488}) 489 490.rs.addFunction("isBookdownDir", function(input_dir, encoding) { 491 index <- .rs.inputDirToIndexFile(input_dir) 492 if (!is.null(index)) { 493 494 formats <- rmarkdown:::enumerate_output_formats(input = index, 495 envir = parent.frame(), 496 encoding = encoding) 497 any(grepl("^bookdown", formats)) 498 } 499 else 500 FALSE 501}) 502 503.rs.addFunction("bookdown.SourceFiles", function(input_dir) { 504 wd <- getwd() 505 on.exit(setwd(wd), add = TRUE) 506 setwd(input_dir) 507 bookdown:::source_files() 508}) 509 510 511.rs.addFunction("bookdown.frontMatterValue", function(input_dir, value) { 512 wd <- getwd() 513 on.exit(setwd(wd), add = TRUE) 514 setwd(input_dir) 515 files <- bookdown:::source_files() 516 if (length(files) > 0) 517 { 518 index <- files[[1]] 519 front_matter <- rmarkdown::yaml_front_matter(index) 520 if (is.character(front_matter[[value]])) 521 front_matter[[value]] 522 else if (is.logical(front_matter[[value]])) 523 paste0("LOGICAL:",front_matter[[value]]) 524 else 525 character() 526 } 527 else 528 { 529 character() 530 } 531}) 532 533.rs.addFunction("isSiteProject", function(input_dir, encoding, site) { 534 535 index <- .rs.inputDirToIndexFile(input_dir) 536 if (!is.null(index)) { 537 any(grepl(site, readLines(index, encoding = encoding))) 538 } 539 else 540 FALSE 541}) 542 543.rs.addFunction("tinytexRoot", function() 544{ 545 # check for tlmgr path set via option; the tinytex root directory is 546 # always 2 directories up from that 547 tlmgr <- getOption("tinytex.tlmgr.path", default = NULL) 548 if (!is.null(tlmgr)) 549 { 550 root <- dirname(dirname(dirname(tlmgr))) 551 return(root) 552 } 553 554 # otherwise, use default locations for different platforms 555 sysname <- Sys.info()[["sysname"]] 556 if (sysname == "Windows") 557 file.path(Sys.getenv("APPDATA"), "TinyTeX") 558 else if (sysname == "Darwin") 559 "~/Library/TinyTeX" 560 else 561 "~/.TinyTeX" 562}) 563 564.rs.addFunction("tinytexBin", function() 565{ 566 root <- .rs.tinytexRoot() 567 if (!file.exists(root)) 568 return(NULL) 569 570 # NOTE: binary directory has a single arch-specific subdir; 571 # rather than trying to hard-code the architecture we just 572 # infer it directly. 573 # 574 # some users will end up with tinytex installations that 575 # 'exist', but are broken for some reason (no longer have 576 # a 'bin' directory). detect those cases properly 577 # 578 # https://github.com/rstudio/rstudio/issues/7615 579 bin <- file.path(root, "bin") 580 if (!file.exists(bin)) 581 return(NULL) 582 583 subbin <- list.files(bin, full.names = TRUE) 584 if (length(subbin) == 0) 585 return(NULL) 586 587 normalizePath(subbin[[1]], mustWork = TRUE) 588}) 589 590.rs.addFunction("bookdown.renderedOutputPath", function(websiteDir, outputPath) 591{ 592 # if we have a PDF for this file, use it 593 if (tools::file_ext(outputPath) == "pdf") 594 return(outputPath) 595 596 # if that fails, use root index file 597 # note that this gets remapped as appropriate to knitted posts; see: 598 # https://github.com/rstudio/rstudio/issues/6945 599 index <- file.path(websiteDir, "index.html") 600 if (file.exists(index)) 601 return(index) 602 603 # default to using output file path 604 # (necessary for self-contained books, which may not have an index) 605 outputPath 606}) 607