1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029
|
#' The YAML metadata of the current R Markdown document
#'
#' The object \code{metadata} stores the YAML metadata of the current R Markdown
#' document as a list, which you may use in the R code chunks, e.g.
#' \code{rmarkdown::metadata$title} (the title of the document),
#' \code{rmarkdown::metadata$author}, and \code{rmarkdown::metadata$foo} (if you
#' have a YAML field named \code{foo}), etc.
#' @usage NULL
#' @examples rmarkdown::metadata
#' @export
metadata <- list()
#' Render R Markdown
#'
#' Render the input file to the specified output format using pandoc. If the
#' input requires knitting then \code{\link[knitr:knit]{knit}} is called prior
#' to pandoc.
#'
#' Note that the \pkg{knitr} \code{error} option is set to \code{FALSE} during
#' rendering (which is different from the \pkg{knitr} default value of
#' \code{TRUE}).
#'
#' For additional details on rendering R scripts see
#' \link[=compile_notebook]{Compiling R scripts to a notebook}.
#'
#' If no \code{output_format} parameter is specified then the output format is
#' read from the YAML front-matter of the input file. For example, the
#' following YAML would yield a PDF document:
#'
#' \preformatted{
#' output: pdf_document
#' }
#'
#' Additional format options can also be specified in metadata. For example:
#'
#' \preformatted{
#' output:
#' pdf_document:
#' toc: true
#' highlight: zenburn
#' }
#'
#' Multiple formats can be specified in metadata. If no \code{output_format}
#' is passed to \code{render} then the first one defined will be used:
#'
#' \preformatted{
#' output:
#' pdf_document:
#' toc: true
#' highlight: zenburn
#' html_document:
#' toc: true
#' theme: united
#' }
#'
#' Formats specified in metadata can be any one of the built in formats (e.g.
#' \code{\link{html_document}}, \code{\link{pdf_document}}) or a format defined
#' in another package (e.g. \code{pkg::custom_format}).
#'
#' If there is no format defined in the YAML then
#' \code{\link{html_document}} will be used.
#' @section R Markdown:
#' R Markdown supports all of the base pandoc markdown features as well as some
#' optional features for compatibility with GitHub Flavored Markdown (which
#' previous versions of R Markdown were based on). See
#' \code{\link{rmarkdown_format}} for details.
#' @seealso
#' \link[knitr:knit]{knit}, \link{output_format},
#' \href{http://johnmacfarlane.net/pandoc}{pandoc}
#' @param input The input file to be rendered. This can be an R script (.R),
#' an R Markdown document (.Rmd), or a plain markdown document.
#' @param output_format The R Markdown output format to convert to. The option
#' \code{"all"} will render all formats defined within the file. The option can
#' be the name of a format (e.g. \code{"html_document"}) and that will render
#' the document to that single format. One can also use a vector of format
#' names to render to multiple formats. Alternatively, you can pass an output
#' format object (e.g. \code{html_document()}). If using \code{NULL} then the
#' output format is the first one defined in the YAML frontmatter in the input
#' file (this defaults to HTML if no format is specified there).
#' @param output_file The name of the output file. If using \code{NULL} then the
#' output filename will be based on filename for the input file. If a filename
#' is provided, a path to the output file can also be provided. Note that the
#' \code{output_dir} option allows for specifying the output file path as well,
#' however, if also specifying the path, the directory must exist.
#' @param output_dir The output directory for the rendered \code{output_file}.
#' This allows for a choice of an alternate directory to which the output file
#' should be written (the default output directory of that of the input file).
#' If a path is provided with a filename in \code{output_file} the directory
#' specified here will take precedence. Please note that any directory path
#' provided will create any necessary directories if they do not exist.
#' @param output_options List of output options that can override the options
#' specified in metadata (e.g. could be used to force \code{self_contained} or
#' \code{mathjax = "local"}). Note that this is only valid when the output
#' format is read from metadata (i.e. not a custom format object passed to
#' \code{output_format}).
#' @param intermediates_dir Intermediate files directory. If a path is specified
#' then intermediate files will be written to that path. If \code{NULL},
#' intermediate files are written to the same directory as the input file.
#' @param knit_root_dir The working directory in which to knit the document;
#' uses knitr's \code{root.dir} knit option. If \code{NULL} then the behavior
#' will follow the knitr default, which is to use the parent directory of the
#' document.
#' @param runtime The runtime target for rendering. The \code{static} option
#' produces output intended for static files; \code{shiny} produces output
#' suitable for use in a Shiny document (see \code{\link{run}}). The default,
#' \code{auto}, allows the \code{runtime} target specified in the YAML metadata
#' to take precedence, and renders for a \code{static} runtime target otherwise.
#' @param clean Using \code{TRUE} will clean intermediate files that are created
#' during rendering.
#' @param params A list of named parameters that override custom params
#' specified within the YAML front-matter (e.g. specifying a dataset to read or
#' a date range to confine output to). Pass \code{"ask"} to start an
#' application that helps guide parameter configuration.
#' @param knit_meta (This option is reserved for expert use.) Metadata
#' generated by \pkg{knitr}.
#' @param envir The environment in which the code chunks are to be evaluated
#' during knitting (can use \code{\link{new.env}()} to guarantee an empty new
#' environment).
#' @param run_pandoc An option for whether to run pandoc to convert Markdown
#' output.
#' @param quiet An option to suppress printing of the pandoc command line.
#' @param encoding The encoding of the input file. See \code{\link{file}} for
#' more information.
#' @return
#' When \code{run_pandoc = TRUE}, the compiled document is written into
#' the output file, and the path of the output file is returned. When
#' \code{run_pandoc = FALSE}, the path of the Markdown output file, with
#' attributes \code{knit_meta} (the \pkg{knitr} meta data collected from code
#' chunks) and \code{intermediates} (the intermediate files/directories
#' generated by \code{render()}).
#' @examples
#' \dontrun{
#' library(rmarkdown)
#'
#' # Render the default (first) format defined in the file
#' render("input.Rmd")
#'
#' # Render all formats defined in the file
#' render("input.Rmd", "all")
#'
#' # Render a single format
#' render("input.Rmd", "html_document")
#'
#' # Render multiple formats
#' render("input.Rmd", c("html_document", "pdf_document"))
#' }
#' @export
render <- function(input,
output_format = NULL,
output_file = NULL,
output_dir = NULL,
output_options = NULL,
intermediates_dir = NULL,
knit_root_dir = NULL,
runtime = c("auto", "static", "shiny", "shiny_prerendered"),
clean = TRUE,
params = NULL,
knit_meta = NULL,
envir = parent.frame(),
run_pandoc = TRUE,
quiet = FALSE,
encoding = getOption("encoding")) {
perf_timer_start("render")
init_render_context()
on.exit(clear_render_context(), add = TRUE)
# render() may call itself, e.g., in discover_rmd_resources(); in this case,
# we should not clean up temp files in the nested render() call, but wait
# until the top-level render() exits to clean up temp files
.globals$level <- .globals$level + 1L # increment level in a nested render()
on.exit({
.globals$level <- .globals$level - 1L
if (.globals$level == 0) clean_tmpfiles()
}, add = TRUE)
# check for "all" output formats
if (identical(output_format, "all")) {
output_format <- enumerate_output_formats(input, envir, encoding)
if (is.null(output_format))
output_format <- "html_document"
}
# check for a list of output formats -- if there is more than one
# then recursively call this function with each format by name
if (is.character(output_format) && length(output_format) > 1) {
outputs <- character()
for (format in output_format) {
# the output_file argument is intentionally ignored (we can't give
# the same name to each rendered output); copy the rest by name
output <- render(input = input,
output_format = format,
output_file = NULL,
output_dir = output_dir,
output_options = output_options,
intermediates_dir = intermediates_dir,
knit_root_dir = knit_root_dir,
runtime = runtime,
clean = clean,
params = params,
knit_meta = knit_meta,
envir = envir,
run_pandoc = run_pandoc,
quiet = quiet,
encoding = encoding)
outputs <- c(outputs, output)
}
if (length(output_file) > 1) {
file.rename(outputs, output_file)
outputs <- output_file
}
return(invisible(outputs))
}
# check for required version of pandoc if we are running pandoc
if (run_pandoc) {
required_pandoc <- "1.12.3"
pandoc_available(required_pandoc, error = TRUE)
}
# setup a cleanup function for intermediate files
intermediates <- c()
on.exit(if (clean) unlink(intermediates, recursive = TRUE), add = TRUE)
# ensure we have a directory to store intermediates
if (!is.null(intermediates_dir)) {
if (!dir_exists(intermediates_dir))
dir.create(intermediates_dir, recursive = TRUE)
intermediates_dir <- normalize_path(intermediates_dir)
}
intermediates_loc <- function(file) {
if (is.null(intermediates_dir))
file
else
file.path(intermediates_dir, file)
}
# resolve output directory before we change the working directory in
# preparation for rendering the document
if (!is.null(output_dir)) {
if (!dir_exists(output_dir))
dir.create(output_dir, recursive = TRUE)
output_dir <- normalize_path(output_dir)
}
# check whether this document requires a knit
requires_knit <- tolower(tools::file_ext(input)) %in% c("r", "rmd", "rmarkdown")
# remember the name of the original input document (we overwrite 'input' once
# we've knitted)
original_input <- normalize_path(input)
# if the input file has shell characters in its name then make a copy that
# doesn't have shell characters
if (grepl(.shell_chars_regex, basename(input))) {
# form the name of the file w/o shell characters
input_no_shell_chars <- intermediates_loc(
file_name_without_shell_chars(basename(input)))
if (file.exists(input_no_shell_chars)) {
stop("The name of the input file cannot contain the special shell ",
"characters: ", .shell_chars_regex, " (attempted to copy to a ",
"version without those characters '", input_no_shell_chars, "' ",
"however that file already exists)", call. = FALSE)
}
file.copy(input, input_no_shell_chars, overwrite = TRUE)
intermediates <- c(intermediates, input_no_shell_chars)
input <- input_no_shell_chars
# if an intermediates directory wasn't explicit before, make it explicit now
if (is.null(intermediates_dir)) {
intermediates_dir <-
dirname(normalize_path(input_no_shell_chars))
# never use the original input directory as the intermediate directory,
# otherwise external resources discovered will be deleted as intermediate
# files later (because they are copied to the "intermediate" dir)
if (same_path(intermediates_dir, dirname(original_input)))
intermediates_dir <- NULL
}
}
# force evaluation of knitr root dir before we change directory context
force(knit_root_dir)
# execute within the input file's directory
oldwd <- setwd(dirname(tools::file_path_as_absolute(input)))
on.exit(setwd(oldwd), add = TRUE)
# reset the name of the input file to be relative and calculate variations
# on the filename for our various intermediate targets
input <- basename(input)
knit_input <- input
knit_output <- intermediates_loc(file_with_meta_ext(input, "knit", "md"))
intermediates <- c(intermediates, knit_output)
utf8_input <- intermediates_loc(file_with_meta_ext(input, "utf8", "md"))
intermediates <- c(intermediates, utf8_input)
# track whether this was straight markdown input (to prevent keep_md later)
md_input <- identical(tolower(tools::file_ext(input)), "md")
# if this is an R script then spin it first
if (identical(tolower(tools::file_ext(input)), "r")) {
# make a copy of the file to spin
spin_input <- intermediates_loc(file_with_meta_ext(input, "spin", "R"))
file.copy(input, spin_input, overwrite = TRUE)
intermediates <- c(intermediates, spin_input)
# spin it
spin_rmd <- knitr::spin(spin_input,
knit = FALSE,
envir = envir,
format = "Rmd")
intermediates <- c(intermediates, spin_rmd)
knit_input <- spin_rmd
# append default metadata (this will be ignored if there is user
# metadata elsewhere in the file)
metadata <- paste('\n',
'---\n',
'title: "', input, '"\n',
'author: "', Sys.info()[["user"]], '"\n',
'date: "', date(), '"\n',
'---\n'
, sep = "")
if (!identical(encoding, "native.enc"))
metadata <- iconv(metadata, to = encoding)
cat(metadata, file = knit_input, append = TRUE)
}
# read the input file
input_lines <- read_utf8(knit_input, encoding)
# read the yaml front matter
yaml_front_matter <- parse_yaml_front_matter(input_lines)
# metadata to be attached to the returned value of render() as an attribute
old_output_metadata <- output_metadata$get()
on.exit(output_metadata$restore(old_output_metadata), add = TRUE)
output_metadata$restore(as.list(yaml_front_matter[['rmd_output_metadata']]))
# if this is shiny_prerendered then modify the output format to
# be single-page and to output dependencies to the shiny.dep file
shiny_prerendered_dependencies <- list()
if (requires_knit && is_shiny_prerendered(yaml_front_matter$runtime)) {
# first validate that the user hasn't passed an already created output_format
if (is_output_format(output_format)) {
stop("You cannot pass a fully constructed output_format to render when ",
"using runtime: shiny_prerendered")
}
# require shiny for the knit
if (requireNamespace("shiny")) {
if (!"package:shiny" %in% search())
attachNamespace("shiny")
}
else
stop("The shiny package is required for 'shiny_prerendered' documents")
# force various output options
output_options$self_contained <- FALSE
output_options$dependency_resolver <- function(deps) {
shiny_prerendered_dependencies <<- list(
deps = deps,
packages = get_loaded_packages()
)
list()
}
}
# if we haven't been passed a fully formed output format then
# resolve it by looking at the yaml
if (!is_output_format(output_format)) {
output_format <- output_format_from_yaml_front_matter(input_lines,
output_options,
output_format,
encoding = encoding)
output_format <- create_output_format(output_format$name,
output_format$options)
}
pandoc_to <- output_format$pandoc$to
# generate outpout file based on input filename
if (is.null(output_file))
output_file <- pandoc_output_file(input, output_format$pandoc)
# if an output_dir was specified then concatenate it with the output file
if (!is.null(output_dir)) {
output_file <- file.path(output_dir, basename(output_file))
}
output_dir <- dirname(output_file)
# Stop the render process early if the output directory does not exist
if (!dir_exists(output_dir)) {
stop("The directory '", output_dir, "') does not not exist.",
call. = FALSE)
}
# use output filename based files dir
files_dir_slash <- file.path(output_dir, knitr_files_dir(basename(output_file)))
files_dir <- pandoc_path_arg(files_dir_slash)
# default to no cache_dir (may be generated by the knit)
cache_dir <- NULL
# call any intermediate files generator, if we have an intermediates directory
# (do this before knitting in case the knit requires intermediates)
if (!is.null(intermediates_dir) &&
!is.null(output_format$intermediates_generator)) {
intermediates <- c(intermediates,
output_format$intermediates_generator(original_input,
encoding,
intermediates_dir))
}
# reset knit_meta (and ensure it's always reset before exiting render)
old_knit_meta <- knit_meta_reset()
on.exit({
knit_meta_reset()
if (length(old_knit_meta)) {
knitr::knit_meta_add(old_knit_meta, attr(old_knit_meta, 'knit_meta_id'))
}
}, add = TRUE)
# presume that we're rendering as a static document unless specified
# otherwise in the parameters
runtime <- match.arg(runtime)
if (identical(runtime, "auto")) {
if (!is.null(yaml_front_matter$runtime))
runtime <- yaml_front_matter$runtime
else
runtime <- "static"
}
# set df_print
context <- render_context()
context$df_print <- resolve_df_print(output_format$df_print)
# call any pre_knit handler
if (!is.null(output_format$pre_knit)) {
output_format$pre_knit(input = original_input)
}
# function used to call post_knit handler
call_post_knit_handler <- function() {
if (!is.null(output_format$post_knit)) {
post_knit_extra_args <- output_format$post_knit(yaml_front_matter,
knit_input,
runtime,
encoding = encoding)
} else {
post_knit_extra_args <- NULL
}
c(output_format$pandoc$args, post_knit_extra_args)
}
# determine our id-prefix (add one if necessary for runtime: shiny)
id_prefix <- id_prefix_from_args(output_format$pandoc$args)
if (!nzchar(id_prefix) && is_shiny(runtime)) {
id_prefix <- "section-"
output_format$pandoc$args <- c(output_format$pandoc$args, rbind("--id-prefix", id_prefix))
}
# knit if necessary
if (requires_knit) {
# restore options and hooks after knit
optk <- knitr::opts_knit$get()
on.exit(knitr::opts_knit$restore(optk), add = TRUE)
optc <- knitr::opts_chunk$get()
on.exit(knitr::opts_chunk$restore(optc), add = TRUE)
hooks <- knitr::knit_hooks$get()
on.exit(knitr::knit_hooks$restore(hooks), add = TRUE)
ohooks <- knitr::opts_hooks$get()
on.exit(knitr::opts_hooks$restore(ohooks), add = TRUE)
templates <- knitr::opts_template$get()
on.exit(knitr::opts_template$restore(templates), add = TRUE)
# run render on_exit (run after the knit hooks are saved so that
# any hook restoration can take precedence)
if (is.function(output_format$on_exit))
on.exit(output_format$on_exit(), add = TRUE)
# default rendering and chunk options
knitr::render_markdown()
knitr::opts_chunk$set(tidy = FALSE, error = FALSE)
# the retina option does not make sense to non-HTML output formats
if (!grepl('[.]html$', output_file)) knitr::opts_chunk$set(fig.retina = NULL)
# store info about the final output format in opts_knit
knitr::opts_knit$set(
rmarkdown.pandoc.from = output_format$pandoc$from,
rmarkdown.pandoc.to = pandoc_to,
rmarkdown.pandoc.args = output_format$pandoc$args,
rmarkdown.pandoc.id_prefix = id_prefix,
rmarkdown.keep_md = output_format$keep_md,
rmarkdown.df_print = output_format$df_print,
rmarkdown.version = 2,
rmarkdown.runtime = runtime
)
# read root directory from argument (has precedence) or front matter
root_dir <- knit_root_dir
if (is.null(root_dir))
root_dir <- yaml_front_matter$knit_root_dir
if (!is.null(root_dir))
knitr::opts_knit$set(root.dir = root_dir)
# use filename based figure and cache directories
base_pandoc_to <- gsub('[-+].*', '', pandoc_to)
if (base_pandoc_to == 'html4') base_pandoc_to <- 'html'
knitr::opts_chunk$set(fig.path = paste0(
pandoc_path_arg(files_dir_slash, backslash = FALSE),
"/figure-", base_pandoc_to, "/"
))
cache_dir <- knitr_cache_dir(input, base_pandoc_to)
knitr::opts_chunk$set(cache.path = cache_dir)
# strip the trailing slash from cache_dir so that file.exists() and unlink()
# check on it later works on windows
cache_dir <- gsub("/$", "", cache_dir)
# merge user options and hooks
if (!is.null(output_format$knitr)) {
knitr::opts_knit$set(as.list(output_format$knitr$opts_knit))
knitr::opts_chunk$set(adjust_dev(as.list(output_format$knitr$opts_chunk)))
knitr::opts_template$set(as.list(output_format$knitr$opts_template))
knitr::knit_hooks$set(as.list(output_format$knitr$knit_hooks))
knitr::opts_hooks$set(as.list(output_format$knitr$opts_hooks))
}
# setting the runtime (static/shiny) type
knitr::opts_knit$set(rmarkdown.runtime = runtime)
# install evaluate hook for shiny_prerendred
if (is_shiny_prerendered(runtime)) {
# remove uncached .RData (will be recreated from context="data" chunks)
shiny_prerendered_remove_uncached_data(original_input)
# set the cache option hook and evaluate hook
knitr::opts_hooks$set(label = shiny_prerendered_option_hook(original_input,encoding))
knitr::knit_hooks$set(evaluate = shiny_prerendered_evaluate_hook(original_input))
}
# install global chunk handling for runtime: shiny (evaluate the 'global'
# chunk only once, and in the global environment)
if (is_shiny_classic(runtime) && !is.null(shiny::getDefaultReactiveDomain())) {
# install evaluate hook to ensure that the 'global' chunk for this source
# file is evaluated only once and is run outside of a user reactive domain
knitr::knit_hooks$set(evaluate = function(code, envir, ...) {
# check for 'global' chunk label
if (identical(knitr::opts_current$get("label"), "global")) {
# check list of previously evaludated global chunks
code_string <- one_string(code)
if (!code_string %in% .globals$evaluated_global_chunks) {
# save it in our list of evaluated global chunks
.globals$evaluated_global_chunks <-
c(.globals$evaluated_global_chunks, code_string)
# evaluate with no reactive domain to prevent any shiny code (e.g.
# a reactive timer) from attaching to the current user session
# (resulting in it's destruction when that session ends)
shiny::withReactiveDomain(NULL, {
evaluate::evaluate(code, envir = globalenv(), ...)
})
} else {
list()
}
# delegate to standard evaluate for everything else
} else {
evaluate::evaluate(code, envir, ...)
}
})
}
# make the params available within the knit environment
# (only do this if there are parameters in the front matter
# so we don't require recent knitr for all users)
if (!is.null(yaml_front_matter$params)) {
params <- knit_params_get(input_lines, params)
# bail if an object called 'params' exists in this environment,
# and it seems to be an unrelated user-created object. store
# references so we can restore them post-render
hasParams <- exists("params", envir = envir, inherits = FALSE)
envirParams <- NULL
if (hasParams) {
envirParams <- get("params", envir = envir, inherits = FALSE)
isKnownParamsObject <-
inherits(envirParams, "knit_param_list") ||
inherits(envirParams, "knit_param")
if (!isKnownParamsObject) {
stop("params object already exists in knit environment ",
"so can't be overwritten by render params", call. = FALSE)
}
}
# make the params available in the knit environment
assign("params", params, envir = envir)
lockBinding("params", envir)
on.exit({
if (exists("params", envir = envir, inherits = FALSE)) {
do.call("unlockBinding", list("params", envir))
if (hasParams)
assign("params", envirParams, envir = envir)
else
remove("params", envir = envir)
}
}, add = TRUE)
}
# make the yaml_front_matter available as 'metadata' within the
# knit environment (unless it is already defined there in which case
# we emit a warning)
env <- environment(render)
metadata_this <- env$metadata
do.call("unlockBinding", list("metadata", env))
on.exit({
if (bindingIsLocked("metadata", env)) {
do.call("unlockBinding", list("metadata", env))
}
env$metadata <- metadata_this
lockBinding("metadata", env)
}, add = TRUE)
env$metadata <- yaml_front_matter
# call onKnit hooks (normalize to list)
sapply(as.list(getHook("rmarkdown.onKnit")), function(hook) {
tryCatch(hook(input = original_input), error = function(e) NULL)
})
on.exit({
sapply(as.list(getHook("rmarkdown.onKnitCompleted")), function(hook) {
tryCatch(hook(input = original_input), error = function(e) NULL)
})
}, add = TRUE)
perf_timer_start("knitr")
# perform the knit
input <- knitr::knit(knit_input,
knit_output,
envir = envir,
quiet = quiet,
encoding = encoding)
perf_timer_stop("knitr")
# call post_knit handler
output_format$pandoc$args <- call_post_knit_handler()
# pull any R Markdown warnings from knit_meta and emit
rmd_warnings <- knit_meta_reset(class = "rmd_warning")
for (rmd_warning in rmd_warnings) {
message("Warning: ", rmd_warning)
}
# pull out shiny_prerendered_contexts and append them as script tags
shiny_prerendered_append_contexts(runtime, input, encoding)
# collect remaining knit_meta
knit_meta <- knit_meta_reset()
} else {
output_format$pandoc$args <- call_post_knit_handler()
}
# if this isn't html and there are html dependencies then flag an error
if (!(is_pandoc_to_html(output_format$pandoc) ||
identical(tolower(tools::file_ext(output_file)), "html"))) {
if (has_html_dependencies(knit_meta)) {
if (!isTRUE(yaml_front_matter$always_allow_html)) {
stop("Functions that produce HTML output found in document targeting ",
pandoc_to, " output.\nPlease change the output type ",
"of this document to HTML. Alternatively, you can allow\n",
"HTML output in non-HTML formats by adding this option to the YAML front",
"-matter of\nyour rmarkdown file:\n\n",
" always_allow_html: yes\n\n",
"Note however that the HTML output will not be visible in non-HTML formats.\n\n",
call. = FALSE)
}
}
if (!identical(runtime, "static")) {
stop("Runtime '", runtime, "' is not supported for ",
pandoc_to, " output.\nPlease change the output type ",
"of this document to HTML.", call. = FALSE)
}
}
# clean the files_dir if we've either been asking to clean supporting files or
# the knitr cache is active
if (output_format$clean_supporting && (is.null(cache_dir) || !dir_exists(cache_dir)))
intermediates <- c(intermediates, files_dir)
# read the input text as UTF-8 then write it back out
input_text <- read_utf8(input, encoding)
write_utf8(input_text, utf8_input)
if (run_pandoc) {
perf_timer_start("pre-processor")
# call any pre_processor
if (!is.null(output_format$pre_processor)) {
extra_args <- output_format$pre_processor(yaml_front_matter,
utf8_input,
runtime,
knit_meta,
files_dir,
output_dir)
output_format$pandoc$args <- c(output_format$pandoc$args, extra_args)
}
# write shiny_prerendered_dependencies if we have them
if (is_shiny_prerendered(runtime)) {
shiny_prerendered_append_dependencies(utf8_input,
shiny_prerendered_dependencies,
files_dir,
output_dir)
}
perf_timer_stop("pre-processor")
need_bibtex <- grepl('[.](pdf|tex)$', output_file) &&
any(c('--natbib', '--biblatex') %in% output_format$pandoc$args)
perf_timer_start("pandoc")
convert <- function(output, citeproc = FALSE) {
# temporarily move figures and bib files to the intermediate dir if
# specified: https://github.com/rstudio/rmarkdown/issues/500
if (!is.null(intermediates_dir)) {
figures_dir <- gsub('/$', '', knitr::opts_chunk$get("fig.path"))
files <- list.files(figures_dir, full.names = TRUE, recursive = TRUE)
# https://github.com/rstudio/rmarkdown/issues/1358
if (citeproc) files <- c(files, yaml_front_matter[['bibliography']])
for (f in files) {
intermediates <<- c(intermediates, copy_file_with_dir(f, intermediates_dir))
}
}
# ensure we expand paths (for Windows where leading `~/` does
# not get expanded by pandoc)
utf8_input <- path.expand(utf8_input)
output <- path.expand(output)
# if we don't detect any invalid shell characters in the
# target path, then just call pandoc directly
if (!grepl(.shell_chars_regex, output) && !grepl(.shell_chars_regex, utf8_input)) {
return(pandoc_convert(
utf8_input, pandoc_to, output_format$pandoc$from, output,
citeproc, output_format$pandoc$args, !quiet
))
}
# render to temporary file (preserve extension)
# this also ensures we don't pass a file path with invalid
# characters to our pandoc invocation
file_ext <- tools::file_ext(output)
ext <- if (nzchar(file_ext))
paste(".", file_ext, sep = "")
else
""
# render to a path in the current working directory
# (avoid passing invalid characters to shell)
pandoc_output_tmp <- basename(tempfile("pandoc", tmpdir = getwd(), fileext = ext))
# clean up temporary file on exit
on.exit(unlink(pandoc_output_tmp), add = TRUE)
# call pandoc to render file
status <- pandoc_convert(
utf8_input, pandoc_to, output_format$pandoc$from, pandoc_output_tmp,
citeproc, output_format$pandoc$args, !quiet
)
# construct output path (when passed only a file name to '--output',
# pandoc seems to render in the same directory as the input file)
pandoc_output_tmp_path <- file.path(dirname(utf8_input), pandoc_output_tmp)
# rename output file to desired location
renamed <- suppressWarnings(file.rename(pandoc_output_tmp_path, output))
# rename can fail if the temporary directory and output path
# lie on different volumes; in such a case attempt a file copy
# see: https://github.com/rstudio/rmarkdown/issues/705
if (!renamed) {
copied <- file.copy(pandoc_output_tmp_path, output, overwrite = TRUE)
if (!copied) {
stop("failed to copy rendered pandoc artefact to '", output, "'")
}
}
# return status
status
}
texfile <- file_with_ext(output_file, "tex")
# determine whether we need to run citeproc (based on whether we have
# references in the input)
run_citeproc <- citeproc_required(yaml_front_matter, input_lines)
# if the output format is LaTeX, first convert .md to .tex, and then convert
# .tex to .pdf via latexmk() if PDF output is requested (in rmarkdown <=
# v1.8, we used to call Pandoc to convert .md to .tex and .pdf separately)
if (output_format$pandoc$keep_tex || knitr::is_latex_output()) {
# do not use pandoc-citeproc if needs to build bibliography
convert(texfile, run_citeproc && !need_bibtex)
# unless the output file has the extension .tex, we assume it is PDF
if (!grepl('[.]tex$', output_file)) {
latexmk(texfile, output_format$pandoc$latex_engine, '--biblatex' %in% output_format$pandoc$args)
file.rename(file_with_ext(texfile, "pdf"), output_file)
# clean up the tex file if necessary
if (!output_format$pandoc$keep_tex) on.exit(unlink(texfile), add = TRUE)
}
} else {
convert(output_file, run_citeproc)
}
# pandoc writes the output alongside the input, so if we rendered from an
# intermediate directory, move the output file
if (!is.null(intermediates_dir)) {
intermediate_output <- file.path(intermediates_dir, basename(output_file))
if (file.exists(intermediate_output)) {
file.rename(intermediate_output, output_file)
}
}
perf_timer_stop("pandoc")
perf_timer_start("post-processor")
# if there is a post-processor then call it
if (!is.null(output_format$post_processor))
output_file <- output_format$post_processor(yaml_front_matter,
utf8_input,
output_file,
clean,
!quiet)
if (!quiet) {
message("\nOutput created: ", relative_to(oldwd, output_file))
}
perf_timer_stop("post-processor")
}
perf_timer_stop("render")
# write markdown output if requested
if (output_format$keep_md && !md_input) {
file.copy(input, file_with_ext(output_file, "md"), overwrite = TRUE)
}
if (run_pandoc) {
# return the full path to the output file
output_file <- tools::file_path_as_absolute(output_file)
# attach the metadata specified as rmd_output_metadata in YAML
if (length(output_meta <- output_metadata$get()))
attr(output_file, 'rmd_output_metadata') <- output_meta
invisible(output_file)
} else {
# did not run pandoc; returns the markdown output with attributes of the
# knitr meta data and intermediate files
structure(input, knit_meta = knit_meta, intermediates = intermediates)
}
}
#' Render supporting files for an input document
#'
#' Render (copy) required supporting files for an input document to the
#' \code{_files} directory that is associated with the document.
#'
#' @param from The directory from which the files should be copied.
#' @param files_dir The directory that will receive the copied files.
#' @param rename_to An option to rename the source directory after the copy
#' operation is complete.
#' @return The relative path to the supporting files. This path is suitable
#' for inclusion in HTML\code{href} and \code{src} attributes.
#' @export
render_supporting_files <- function(from, files_dir, rename_to = NULL) {
# auto-create directory for supporting files
if (!dir_exists(files_dir))
dir.create(files_dir)
# target directory is based on the dirname of the path or the rename_to
# value if it was provided
target_stage_dir <- file.path(files_dir, basename(from))
target_dir <- file.path(files_dir, ifelse(is.null(rename_to),
basename(from),
rename_to))
# copy the directory if it hasn't already been copied
if (!dir_exists(target_dir) && !dir_exists(target_stage_dir)) {
file.copy(from = from,
to = files_dir,
recursive = TRUE,
copy.mode = FALSE)
if (!is.null(rename_to)) {
file.rename(from = target_stage_dir,
to = target_dir)
}
}
# return the target dir (used to form links in the HTML)
target_dir
}
# reset knitr meta output (returns any meta output generated since the last
# call to knit_meta_reset), optionally scoped to a specific output class
knit_meta_reset <- function(class = NULL) {
knitr::knit_meta(class, clean = TRUE)
}
# render context (render-related state can be stuffed here)
.render_context <- NULL # initialized in .onLoad
render_context <- function() {
.render_context$peek()
}
init_render_context <- function() {
.render_context$push(new_render_context())
}
clear_render_context <- function() {
.render_context$pop()
}
new_render_context <- function() {
env <- new.env(parent = emptyenv())
env$chunk.index <- 1
env
}
merge_render_context <- function(context) {
elements <- ls(envir = render_context(), all.names = TRUE)
for (el in elements)
context[[el]] <- get(el, envir = render_context())
context
}
id_prefix_from_args <- function(args) {
# scan for id-prefix argument
for (i in 1:length(args)) {
arg <- args[[i]]
if (identical(arg, "--id-prefix") && (i < length(args)))
return(args[[i + 1]])
}
# default to empty string
""
}
resolve_df_print <- function(df_print) {
# available methods
valid_methods <- c("default", "kable", "tibble", "paged")
# if we are passed NULL then select the first method
if (is.null(df_print))
df_print <- valid_methods[[1]]
# if we are passed all of valid_methods then select the first one
if (identical(valid_methods, df_print))
df_print <- valid_methods[[1]]
if (!is.function(df_print)) {
if (df_print == "kable")
df_print <- knitr::kable
else if (df_print == "tibble") {
if (!requireNamespace("tibble", quietly = TRUE))
stop("Printing 'tibble' without 'tibble' package available")
df_print <- function(x) print(tibble::as_tibble(x))
}
else if (df_print == "paged")
df_print <- function(x) {
if (!identical(knitr::opts_current$get("paged.print"), FALSE)) {
knitr::asis_output(paged_table_html(x))
}
else {
print(x)
}
}
else if (df_print == "default")
df_print <- print
else
stop('Invalid value for df_print (valid values are ',
paste(valid_methods, collapse = ", "), call. = FALSE)
}
df_print
}
# package level globals
.globals <- new.env(parent = emptyenv())
.globals$evaluated_global_chunks <- character()
.globals$level <- 0L
#' The output metadata object
#'
#' This object provides a mechanism for users to attach metadata as an attribute
#' (named \code{rmd_output_metadata}) of the returned value of
#' \code{\link{render}()}. The initial value of the metadata comes from in the
#' \code{rmd_output_metadata} field of the YAML frontmatter of an R Markdown
#' document. The metadata can be queried via the
#' \code{output_metadata$get()} method, and modified via the
#' \code{output_metadata$set()} method.
#' @format NULL
#' @usage NULL
#' @keywords NULL
#' @export
output_metadata = knitr:::new_defaults()
|