1#' Knit a document 2#' 3#' This function takes an input file, extracts the R code in it according to a 4#' list of patterns, evaluates the code and writes the output in another file. 5#' It can also tangle R source code from the input document (\code{purl()} is a 6#' wrapper to \code{knit(..., tangle = TRUE)}). The \code{knitr.purl.inline} 7#' option can be used to also tangle the code of inline expressions (disabled by 8#' default). 9#' 10#' For most of the time, it is not necessary to set any options outside the 11#' input document; in other words, a single call like 12#' \code{knit('my_input.Rnw')} is usually enough. This function will try to 13#' determine many internal settings automatically. For the sake of 14#' reproducibility, it is better practice to include the options inside the 15#' input document (to be self-contained), instead of setting them before 16#' knitting the document. 17#' 18#' First the filename of the output document is determined in this way: 19#' \file{foo.Rnw} generates \file{foo.tex}, and other filename extensions like 20#' \file{.Rtex}, \file{.Rhtml} (\file{.Rhtm}) and \file{.Rmd} 21#' (\file{.Rmarkdown}) will generate \file{.tex}, \file{.html} and \file{.md} 22#' respectively. For other types of files, if the filename contains 23#' \samp{_knit_}, this part will be removed in the output file, e.g., 24#' \file{foo_knit_.html} creates the output \file{foo.html}; if \samp{_knit_} is 25#' not found in the filename, \file{foo.ext} will produce \file{foo.txt} if 26#' \code{ext} is not \code{txt}, otherwise the output is \file{foo-out.txt}. If 27#' \code{tangle = TRUE}, \file{foo.ext} generates an R script \file{foo.R}. 28#' 29#' We need a set of syntax to identify special markups for R code chunks and R 30#' options, etc. The syntax is defined in a pattern list. All built-in pattern 31#' lists can be found in \code{all_patterns} (call it \code{apat}). First 32#' \pkg{knitr} will try to decide the pattern list based on the filename 33#' extension of the input document, e.g. \samp{Rnw} files use the list 34#' \code{apat$rnw}, \samp{tex} uses the list \code{apat$tex}, \samp{brew} uses 35#' \code{apat$brew} and HTML files use \code{apat$html}; for unkown extensions, 36#' the content of the input document is matched against all pattern lists to 37#' automatically determine which pattern list is being used. You can also 38#' manually set the pattern list using the \code{\link{knit_patterns}} object or 39#' the \code{\link{pat_rnw}} series functions in advance and \pkg{knitr} will 40#' respect the setting. 41#' 42#' According to the output format (\code{opts_knit$get('out.format')}), a set of 43#' output hooks will be set to mark up results from R (see 44#' \code{\link{render_latex}}). The output format can be LaTeX, Sweave and HTML, 45#' etc. The output hooks decide how to mark up the results (you can customize 46#' the hooks). 47#' 48#' The name \code{knit} comes from its counterpart \samp{weave} (as in Sweave), 49#' and the name \code{purl} (as \samp{tangle} in Stangle) comes from a knitting 50#' method `knit one, purl one'. 51#' 52#' If the input document has child documents, they will also be compiled 53#' recursively. See \code{\link{knit_child}}. 54#' 55#' See the package website and manuals in the references to know more about 56#' \pkg{knitr}, including the full documentation of chunk options and demos, 57#' etc. 58#' @param input Path to the input file. 59#' @param output Path to the output file for \code{knit()}. If \code{NULL}, this 60#' function will try to guess a default, which will be under the current 61#' working directory. 62#' @param tangle Boolean; whether to tangle the R code from the input file (like 63#' \code{utils::\link{Stangle}}). 64#' @param text A character vector. This is an alternative way to provide the 65#' input file. 66#' @param quiet Boolean; suppress the progress bar and messages? 67#' @param envir Environment in which code chunks are to be evaluated, for 68#' example, \code{\link{parent.frame}()}, \code{\link{new.env}()}, or 69#' \code{\link{globalenv}()}). 70#' @param encoding Encoding of the input file; always assumed to be UTF-8 (i.e., 71#' this argument is effectively ignored). 72#' @return The compiled document is written into the output file, and the path 73#' of the output file is returned. If the \code{text} argument is not 74#' \code{NULL}, the compiled output is returned as a character vector. In 75#' other words, if you provide a file input, you get an output filename; if 76#' you provide a character vector input, you get a character vector output. 77#' @note The working directory when evaluating R code chunks is the directory of 78#' the input document by default, so if the R code involves external files 79#' (like \code{read.table()}), it is better to put these files under the same 80#' directory of the input document so that we can use relative paths. However, 81#' it is possible to change this directory with the package option 82#' \code{\link{opts_knit}$set(root.dir = ...)} so all paths in code chunks are 83#' relative to this \code{root.dir}. It is not recommended to change the 84#' working directory via \code{\link{setwd}()} in a code chunk, because it may 85#' lead to terrible consequences (e.g. figure and cache files may be written 86#' to wrong places). If you do use \code{setwd()}, please note that 87#' \pkg{knitr} will always restore the working directory to the original one. 88#' Whenever you feel confused, print \code{getwd()} in a code chunk to see 89#' what the working directory really is. 90#' 91#' If the \code{output} argument is a file path, it is strongly recommended to 92#' be in the current working directory (e.g. \file{foo.tex} instead of 93#' \file{somewhere/foo.tex}), especially when the output has external 94#' dependencies such as figure files. If you want to write the output to a 95#' different directory, it is recommended to set the working directory to that 96#' directory before you knit a document. For example, if the source document 97#' is \file{foo.Rmd} and the expected output is \file{out/foo.md}, you can 98#' write \code{setwd('out/'); knit('../foo.Rmd')} instead of 99#' \code{knit('foo.Rmd', 'out/foo.md')}. 100#' 101#' N.B. There is no guarantee that the R script generated by \code{purl()} can 102#' reproduce the computation done in \code{knit()}. The \code{knit()} process 103#' can be fairly complicated (special values for chunk options, custom chunk 104#' hooks, computing engines besides R, and the \code{envir} argument, etc). If 105#' you want to reproduce the computation in a report generated by 106#' \code{knit()}, be sure to use \code{knit()}, instead of merely executing 107#' the R script generated by \code{purl()}. This seems to be obvious, but some 108#' people 109#' \href{https://stat.ethz.ch/pipermail/r-devel/2014-May/069113.html}{do not 110#' get it}. 111#' @export 112#' @references Package homepage: \url{https://yihui.org/knitr/}. The \pkg{knitr} 113#' \href{https://yihui.org/knitr/demo/manual/}{main manual}: and 114#' \href{https://yihui.org/knitr/demo/graphics/}{graphics manual}. 115#' 116#' See \code{citation('knitr')} for the citation information. 117#' @examples library(knitr) 118#' (f = system.file('examples', 'knitr-minimal.Rnw', package = 'knitr')) 119#' knit(f) # compile to tex 120#' 121#' purl(f) # tangle R code 122#' purl(f, documentation = 0) # extract R code only 123#' purl(f, documentation = 2) # also include documentation 124#' 125#' unlink(c('knitr-minimal.tex', 'knitr-minimal.R', 'figure'), recursive = TRUE) 126knit = function( 127 input, output = NULL, tangle = FALSE, text = NULL, quiet = FALSE, 128 envir = parent.frame(), encoding = 'UTF-8' 129) { 130 131 in.file = !missing(input) && is.character(input) # is input provided? 132 oconc = knit_concord$get(); on.exit(knit_concord$set(oconc), add = TRUE) 133 134 if (child_mode()) { 135 setwd(opts_knit$get('output.dir')) # always restore original working dir 136 # in child mode, input path needs to be adjusted 137 if (in.file && !is_abs_path(input)) { 138 input = paste0(opts_knit$get('child.path'), input) 139 input = file.path(input_dir(), input) 140 } 141 # respect the quiet argument in child mode (#741) 142 optk = opts_knit$get(); on.exit(opts_knit$set(optk), add = TRUE) 143 opts_knit$set(progress = opts_knit$get('progress') && !quiet) 144 quiet = !opts_knit$get('progress') 145 } else { 146 opts_knit$set(output.dir = getwd()) # record working directory in 1st run 147 knit_log$restore() 148 on.exit(chunk_counter(reset = TRUE), add = TRUE) # restore counter 149 adjust_opts_knit() 150 # turn off fancy quotes, use a null pdf device to record graphics 151 oopts = options( 152 useFancyQuotes = FALSE, device = pdf_null, knitr.in.progress = TRUE 153 ) 154 on.exit(options(oopts), add = TRUE) 155 # restore chunk options after parent exits 156 optc = opts_chunk$get(); on.exit(opts_chunk$restore(optc), add = TRUE) 157 ocode = knit_code$get(); on.exit(knit_code$restore(ocode), add = TRUE) 158 on.exit(opts_current$restore(), add = TRUE) 159 optk = opts_knit$get(); on.exit(opts_knit$set(optk), add = TRUE) 160 opts_knit$set(tangle = tangle, progress = opts_knit$get('progress') && !quiet) 161 } 162 # store the evaluation environment and restore on exit 163 oenvir = .knitEnv$knit_global; .knitEnv$knit_global = envir 164 on.exit({.knitEnv$knit_global = oenvir}, add = TRUE) 165 166 ext = 'unknown' 167 if (in.file) { 168 input.dir = .knitEnv$input.dir; on.exit({.knitEnv$input.dir = input.dir}, add = TRUE) 169 .knitEnv$input.dir = dirname(input) # record input dir 170 ext = tolower(file_ext(input)) 171 if ((is.null(output) || is.na(output)) && !child_mode()) 172 output = basename(auto_out_name(input, ext)) 173 # do not run purl() when the output is newer than input (the output might 174 # have been generated by hook_purl) 175 if (is.character(output) && !child_mode()) { 176 out.purl = with_ext(input, 'R') 177 if (xfun::same_path(output, out.purl) && tangle && file_test('-nt', out.purl, input)) 178 return(out.purl) 179 otangle = .knitEnv$tangle.file # the tangled R script 180 .knitEnv$tangle.file = normalizePath(out.purl, mustWork = FALSE) 181 .knitEnv$tangle.start = FALSE 182 on.exit({.knitEnv$tangle.file = otangle; .knitEnv$tangle.start = NULL}, add = TRUE) 183 } 184 if (is.null(getOption('tikzMetricsDictionary'))) { 185 options(tikzMetricsDictionary = tikz_dict(input)) # cache tikz dictionary 186 on.exit(options(tikzMetricsDictionary = NULL), add = TRUE) 187 } 188 knit_concord$set(infile = input, outfile = output) 189 } 190 191 text = if (is.null(text)) xfun::read_utf8(input) else split_lines(text) 192 if (!length(text)) { 193 if (is.character(output)) file.create(output) 194 return(output) # a trivial case: create an empty file and exit 195 } 196 197 apat = all_patterns; opat = knit_patterns$get() 198 on.exit(knit_patterns$restore(opat), add = TRUE) 199 if (length(opat) == 0 || all(vapply(opat, is.null, logical(1)))) { 200 # use ext if cannot auto detect pattern 201 if (is.null(pattern <- detect_pattern(text, ext))) { 202 # nothing to be executed; just return original input 203 if (is.null(output)) { 204 return(if (tangle) '' else one_string(text)) 205 } else { 206 write_utf8(if (tangle) '' else text, output) 207 return(output) 208 } 209 } 210 if (!(pattern %in% names(apat))) stop( 211 "a pattern list cannot be automatically found for the file extension '", 212 ext, "' in built-in pattern lists; ", 213 'see ?knit_patterns on how to set up customized patterns' 214 ) 215 set_pattern(pattern) 216 if (pattern == 'rnw' && length(sweave_lines <- which_sweave(text)) > 0) 217 remind_sweave(if (in.file) input, sweave_lines) 218 opts_knit$set(out.format = switch( 219 pattern, rnw = 'latex', tex = 'latex', html = 'html', md = 'markdown', 220 rst = 'rst', brew = 'brew', asciidoc = 'asciidoc', textile = 'textile' 221 )) 222 } 223 224 if (is.null(out_format())) auto_format(ext) 225 226 params = NULL # the params field from YAML 227 if (out_format('markdown')) { 228 if (child_mode()) { 229 # in child mode, strip off the YAML metadata in Markdown if exists 230 if (grepl('^---\\s*$', text[1])) { 231 i = grep('^---\\s*$', text) 232 if (length(i) >= 2) text[1:i[2]] = '' 233 } 234 } else { 235 params = knit_params(text) 236 params = if (length(params)) 237 c('params <-', capture.output(dput(flatten_params(params), '')), '') 238 .knitEnv$tangle.params = params # for hook_purl() 239 } 240 } 241 # change output hooks only if they are not set beforehand 242 if (identical(knit_hooks$get(names(.default.hooks)), .default.hooks) && !child_mode()) { 243 getFromNamespace(paste('render', out_format(), sep = '_'), 'knitr')() 244 on.exit(knit_hooks$set(.default.hooks), add = TRUE) 245 } 246 247 progress = opts_knit$get('progress') 248 if (in.file && !quiet) message(ifelse(progress, '\n\n', ''), 'processing file: ', input) 249 res = process_file(text, output) 250 res = one_string(knit_hooks$get('document')(res)) 251 if (tangle) res = c(params, res) 252 if (!is.null(output)) write_utf8(res, output) 253 if (!child_mode()) { 254 dep_list$restore() # empty dependency list 255 .knitEnv$labels = NULL 256 } 257 258 if (in.file && is.character(output) && file.exists(output)) { 259 concord_gen(input, output) 260 if (!quiet) message('output file: ', output, ifelse(progress, '\n', '')) 261 } 262 263 output %n% res 264} 265#' @rdname knit 266#' @param documentation An integer specifying the level of documentation to add to 267#' the tangled script. \code{0} means to output pure code, discarding all text chunks); 268#' \code{1} (the default) means to add the chunk headers to the code; \code{2} means to 269#' add all text chunks to code as roxygen comments. 270#' @param ... arguments passed to \code{\link{knit}()} from \code{purl()} 271#' @export 272purl = function(..., documentation = 1L) { 273 doc = opts_knit$get('documentation'); on.exit(opts_knit$set(documentation = doc)) 274 opts_knit$set(documentation = documentation) 275 knit(..., tangle = TRUE) 276} 277 278process_file = function(text, output) { 279 groups = split_file(lines = text) 280 n = length(groups); res = character(n) 281 tangle = opts_knit$get('tangle') 282 283 # when in R CMD check, turn off the progress bar (R-exts said the progress bar 284 # was not appropriate for non-interactive mode, and I don't want to argue) 285 progress = opts_knit$get('progress') && !is_R_CMD_check() 286 if (progress) { 287 pb = txtProgressBar(0, n, char = '.', style = 3) 288 on.exit(close(pb), add = TRUE) 289 } 290 wd = getwd() 291 for (i in 1:n) { 292 if (!is.null(.knitEnv$terminate)) { 293 if (!child_mode() || !.knitEnv$terminate_fully) { 294 # reset the internal variable `terminate` in the top parent 295 res[i] = one_string(.knitEnv$terminate) 296 knit_exit(NULL, NULL) 297 } 298 break # must have called knit_exit(), so exit early 299 } 300 if (progress) { 301 setTxtProgressBar(pb, i) 302 if (!tangle) cat('\n') # under tangle mode, only show one progress bar 303 flush.console() 304 } 305 group = groups[[i]] 306 res[i] = withCallingHandlers( 307 if (tangle) process_tangle(group) else process_group(group), 308 error = function(e) { 309 setwd(wd) 310 cat(res, sep = '\n', file = output %n% '') 311 message( 312 'Quitting from lines ', paste(current_lines(i), collapse = '-'), 313 ' (', knit_concord$get('infile'), ') ' 314 ) 315 } 316 ) 317 } 318 319 if (!tangle) res = insert_header(res) # insert header 320 # output line numbers 321 if (concord_mode()) knit_concord$set(outlines = line_count(res)) 322 print_knitlog() 323 if (tangle) res = strip_white(res) 324 325 res 326} 327 328auto_out_name = function(input, ext = tolower(file_ext(input))) { 329 base = sans_ext(input) 330 name = if (opts_knit$get('tangle')) c(base, '.R') else 331 if (ext %in% c('rnw', 'snw')) c(base, '.tex') else 332 if (ext %in% c('rmd', 'rmarkdown', 'rhtml', 'rhtm', 'rtex', 'stex', 'rrst', 'rtextile')) 333 c(base, '.', substring(ext, 2L)) else 334 if (grepl('_knit_', input)) sub('_knit_', '', input) else 335 if (ext != 'txt') c(base, '.txt') else c(base, '-out.', ext) 336 paste(name, collapse = '') 337} 338 339# determine output format based on file extension 340ext2fmt = c( 341 rnw = 'latex', snw = 'latex', tex = 'latex', rtex = 'latex', stex = 'latex', 342 htm = 'html', html = 'html', rhtml = 'html', rhtm = 'html', 343 md = 'markdown', markdown = 'markdown', rmd = 'markdown', rmarkdown = 'markdown', 344 brew = 'brew', rst = 'rst', rrst = 'rst' 345) 346 347auto_format = function(ext) { 348 fmt = ext2fmt[ext] 349 if (is.na(fmt)) fmt = { 350 warning('cannot automatically decide the output format') 351 'unknown' 352 } 353 opts_knit$set(out.format = fmt) 354 invisible(fmt) 355} 356 357#' Knit a child document 358#' 359#' This function knits a child document and returns a character string to input 360#' the result into the main document. It is designed to be used in the chunk 361#' option \code{child} and serves as the alternative to the 362#' \command{SweaveInput} command in Sweave. 363#' @param ... Arguments passed to \code{\link{knit}}. 364#' @param options A list of chunk options to be used as global options inside 365#' the child document. When one uses the \code{child} 366#' option in a parent chunk, the chunk options of the parent chunk will be 367#' passed to the \code{options} argument here. Ignored if not a list. 368#' @inheritParams knit 369#' @return A character string of the content of the compiled child document is 370#' returned as a character string so it can be written back to the parent 371#' document directly. 372#' @references \url{https://yihui.org/knitr/demo/child/} 373#' @note This function is not supposed be called directly like 374#' \code{\link{knit}()}; instead it must be placed in a parent document to let 375#' \code{\link{knit}()} call it indirectly. 376#' 377#' The path of the child document is determined relative to the parent document. 378#' @export 379#' @examples # you can write \Sexpr{knit_child('child-doc.Rnw')} in an Rnw file 'main.Rnw' 380#' # to input results from child-doc.Rnw in main.tex 381#' 382#' # comment out the child doc by \Sexpr{knit_child('child-doc.Rnw', eval = FALSE)} 383knit_child = function(..., options = NULL, envir = knit_global()) { 384 child = child_mode() 385 opts_knit$set(child = TRUE) # yes, in child mode now 386 on.exit(opts_knit$set(child = child)) # restore child status 387 if (is.list(options)) { 388 options$label = options$child = NULL # do not need to pass the parent label on 389 if (length(options)) { 390 optc = opts_chunk$get(names(options), drop = FALSE); opts_chunk$set(options) 391 # if user did not touch opts_chunk$set() in child, restore the chunk option 392 on.exit({ 393 for (i in names(options)) if (identical(options[[i]], opts_chunk$get(i))) 394 opts_chunk$set(optc[i]) 395 }, add = TRUE) 396 } 397 } 398 res = knit(..., tangle = opts_knit$get('tangle'), envir = envir) 399 one_string(c('', res)) 400} 401 402#' Exit knitting early 403#' 404#' Sometimes we may want to exit the knitting process early, and completely 405#' ignore the rest of the document. This function provides a mechanism to 406#' terminate \code{\link{knit}()}. 407#' @param append A character vector to be appended to the results from 408#' \code{knit()} so far. By default, this is \samp{\end{document}} for LaTeX 409#' output, and \samp{</body></html>} for HTML output, to make the output 410#' document complete. For other types of output, it is an empty string. 411#' @param fully Whether to fully exit the knitting process if \code{knit_exit()} 412#' is called from a child document. If \code{FALSE}, only exit the knitting 413#' process of the child document. 414#' @return Invisible \code{NULL}. An internal signal is set up (as a side 415#' effect) to notify \code{knit()} to quit as if it had reached the end of the 416#' document. 417#' @export 418#' @examples # see https://github.com/yihui/knitr-examples/blob/master/096-knit-exit.Rmd 419knit_exit = function(append, fully = TRUE) { 420 if (missing(append)) append = if (out_format(c('latex', 'sweave', 'listings'))) 421 '\\end{document}' else if (out_format('html')) '</body>\n</html>' else '' 422 .knitEnv$terminate = append # use this terminate variable to notify knit() 423 .knitEnv$terminate_fully = fully 424 invisible() 425} 426 427knit_log = new_defaults() # knitr log for errors, warnings and messages 428 429#' Wrap evaluated results for output 430#' 431#' This function is mainly for internal use: it is called on each part of the 432#' output of the code chunk (code, messages, text output, and plots, etc.) after 433#' all statements in the code chunk have been evaluated, and will sew these 434#' pieces of output together into a character vector. 435#' @param x Output from \code{evaluate::\link{evaluate}()}. 436#' @param options A list of chunk options used to control output. 437#' @param ... Other arguments to pass to methods. 438#' @export 439sew = function(x, options = list(), ...) { 440 UseMethod('sew', x) 441} 442 443# TODO: see if we can remove this function in the future 444wrap = function(...) { 445 warning2( 446 'The internal function knitr:::wrap() has been deprecated. Please use the ', 447 'exported function knitr::sew() instead.' 448 ) 449 sew(...) 450} 451 452#' @export 453sew.list = function(x, options = list(), ...) { 454 if (length(x) == 0L) return(x) 455 lapply(x, sew, options, ...) 456} 457 458# ignore unknown classes 459#' @export 460sew.default = function(x, options, ...) return() 461 462#' @export 463sew.character = function(x, options, ...) { 464 if (options$results == 'hide') return() 465 if (output_asis(x, options)) { 466 if (!out_format('latex')) return(x) # latex output still need a tweak 467 } else x = comment_out(x, options$comment) 468 knit_hooks$get('output')(x, options) 469} 470 471# If you provide a custom print function that returns a character object of 472# class 'knit_asis', it will be written as is. 473#' @export 474sew.knit_asis = function(x, options, inline = FALSE, ...) { 475 m = attr(x, 'knit_meta') 476 knit_meta_add(m, if (missing(options)) '' else options$label) 477 if (!missing(options)) { 478 if (options$cache > 0 && isFALSE(attr(x, 'knit_cacheable'))) stop( 479 "The code chunk '", options$label, "' is not cacheable; ", 480 "please use the chunk option cache=FALSE on this chunk" 481 ) 482 # store metadata in an object named of the form .hash_meta when cache=TRUE 483 if (length(m) && options$cache == 3) 484 assign(cache_meta_name(options$hash), m, envir = knit_global()) 485 if (inherits(x, 'knit_asis_htmlwidget')) { 486 options$fig.cur = plot_counter() 487 options = reduce_plot_opts(options) 488 return(add_html_caption(options, x)) 489 } 490 } 491 x = as.character(x) 492 if (!out_format('latex') || inline) return(x) 493 # latex output need the \end{kframe} trick 494 options$results = 'asis' 495 knit_hooks$get('output')(x, options) 496} 497 498#' @export 499sew.source = function(x, options, ...) { 500 if (isFALSE(options$echo)) return() 501 src = sub('\n$', '', x$src) 502 if (options$strip.white) src = strip_white(src) 503 if (is_blank(src)) return() # an empty chunk 504 knit_hooks$get('source')(src, options) 505} 506 507msg_wrap = function(message, type, options) { 508 # when the output format is LaTeX, do not wrap messages (let LaTeX deal with wrapping) 509 if (!length(grep('\n', message)) && !out_format(c('latex', 'listings', 'sweave'))) 510 message = stringr::str_wrap(message, width = getOption('width')) 511 knit_log$set(setNames( 512 list(c(knit_log$get(type), paste0('Chunk ', options$label, ':\n ', message))), 513 type 514 )) 515 message = msg_sanitize(message, type) 516 knit_hooks$get(type)(comment_out(message, options$comment), options) 517} 518 519# set options(knitr.sanitize.errors = TRUE) to hide error messages, etc 520msg_sanitize = function(message, type) { 521 type = match.arg(type, c('error', 'warning', 'message')) 522 opt = getOption(sprintf('knitr.sanitize.%ss', type), FALSE) 523 if (isTRUE(opt)) message = switch( 524 type, error = 'An error occurred', warning = 'A warning was emitted', 525 message = 'A message was emitted' 526 ) else if (is.character(opt)) message = opt 527 message 528} 529 530#' @export 531sew.warning = function(x, options, ...) { 532 call = if (is.null(x$call)) '' else { 533 call = deparse(x$call)[1] 534 if (call == 'eval(expr, envir, enclos)') '' else paste(' in', call) 535 } 536 msg_wrap(sprintf('Warning%s: %s', call, conditionMessage(x)), 'warning', options) 537} 538 539#' @export 540sew.message = function(x, options, ...) { 541 msg_wrap(paste(conditionMessage(x), collapse = ''), 'message', options) 542} 543 544#' @export 545sew.error = function(x, options, ...) { 546 msg_wrap(as.character(x), 'error', options) 547} 548 549#' @export 550sew.recordedplot = function(x, options, ...) { 551 # figure number sequence for multiple plots 552 fig.cur = plot_counter() 553 options$fig.cur = fig.cur # put fig num in options 554 name = fig_path('', options, number = fig.cur) 555 in_base_dir( 556 # automatically creates dir for plots 557 if (!file_test('-d', dirname(name))) 558 dir.create(dirname(name), recursive = TRUE) 559 ) 560 # vectorize over dev, ext and dpi: save multiple versions of the plot 561 files = mapply( 562 save_plot, width = options$fig.width, height = options$fig.height, 563 dev = options$dev, ext = options$fig.ext, dpi = options$dpi, 564 MoreArgs = list(plot = x, name = name, options = options), SIMPLIFY = FALSE 565 ) 566 opts_knit$append(plot_files = unlist(files)) 567 if (options$fig.show == 'hide') return('') 568 in_base_dir(run_hook_plot(files[[1]], reduce_plot_opts(options))) 569} 570 571#' @export 572sew.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE, ...) { 573 if (options$fig.show == 'hide') return('') 574 # remove the automatically set out.width when fig.retina is set, otherwise the 575 # size of external images embedded via include_graphics() will be set to 576 # fig.width * dpi in fix_options() 577 if (is.numeric(r <- options$fig.retina)) { 578 w1 = options$out.width 579 w2 = options$fig.width * options$dpi / r 580 if (length(w1) * length(w2) == 1 && is.numeric(w1) && w1 == w2) 581 options['out.width'] = list(NULL) 582 } 583 options$fig.num = options$fig.num %n% length(x) 584 dpi = attr(x, 'dpi') %n% options$dpi 585 hook = knit_hooks$get('plot') 586 paste(unlist(lapply(seq_along(x), function(i) { 587 options$fig.cur = plot_counter() 588 if (is.null(options[['out.width']])) 589 options['out.width'] = list(raster_dpi_width(x[i], dpi)) 590 hook(x[i], reduce_plot_opts(options)) 591 })), collapse = '') 592} 593 594# TODO: remove this in the future 595wrap.knit_image_paths = function(...) { 596 warning2( 597 "The internal function knitr:::wrap.knit_image_paths has been deprecated. ", 598 "Please use knitr::sew() on an object of the class 'knit_image_paths' instead." 599 ) 600 sew.knit_image_paths(...) 601} 602 603#' @export 604sew.html_screenshot = function(x, options = opts_chunk$get(), inline = FALSE, ...) { 605 ext = x$extension 606 in_base_dir({ 607 i = plot_counter() 608 if (is.null(f <- x$file)) { 609 f = fig_path(ext, options, i) 610 dir.create(dirname(f), recursive = TRUE, showWarnings = FALSE) 611 writeBin(x$image, f, useBytes = TRUE) 612 } 613 options$fig.cur = i 614 options = reduce_plot_opts(options) 615 if (!is.null(x$url) && is.null(options$fig.link)) options$fig.link = x$url 616 run_hook_plot(f, options) 617 }) 618} 619 620# record plot filenames in opts_knit$get('plot_files'), including those from R 621# code and auto screenshots of HTML widgets, etc. Then run the plot hook. 622run_hook_plot = function(x, options) { 623 opts_knit$append(plot_files = x) 624 hook = knit_hooks$get('plot') 625 hook(x, options) 626} 627 628#' @export 629sew.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE, ...) { 630 options$fig.cur = plot_counter() 631 options = reduce_plot_opts(options) 632 if (length(extra <- options$out.extra)) extra = paste('', extra, collapse = '') 633 add_html_caption(options, sprintf( 634 '<iframe src="%s" width="%s" height="%s" data-external="1"%s></iframe>', 635 escape_html(x$url), options$out.width %n% '100%', x$height %n% '400px', 636 extra %n% '' 637 )) 638} 639 640add_html_caption = function(options, code) { 641 cap = .img.cap(options) 642 if (cap == '') return(code) 643 sprintf( 644 '<div class="figure"%s>\n%s\n<p class="caption">%s</p>\n</div>', 645 css_text_align(options$fig.align), code, cap 646 ) 647} 648 649#' A custom printing function 650#' 651#' The S3 generic function \code{knit_print} is the default printing function in 652#' \pkg{knitr}. The chunk option \code{render} uses this function by default. 653#' The main purpose of this S3 generic function is to customize printing of R 654#' objects in code chunks. We can fall back to the normal printing behavior by 655#' setting the chunk option \code{render = normal_print}. 656#' 657#' Users can write custom methods based on this generic function. For example, 658#' if we want to print all data frames as tables in the output, we can define a 659#' method \code{knit_print.data.frame} that turns a data.frame into a table (the 660#' implementation may use other R packages or functions, e.g. \pkg{xtable} or 661#' \code{\link{kable}()}). 662#' @param x An R object to be printed 663#' @param ... Additional arguments passed to the S3 method. Currently ignored, 664#' except two optional arguments \code{options} and \code{inline}; see 665#' the references below. 666#' @return The value returned from the print method should be a character vector 667#' or can be converted to a character value. You can wrap the value in 668#' \code{\link{asis_output}()} so that \pkg{knitr} writes the character value 669#' as is in the output. 670#' @note It is recommended to leave a \code{...} argument in your method, to 671#' allow future changes of the \code{knit_print()} API without breaking your 672#' method. 673#' @references See \code{vignette('knit_print', package = 'knitr')}. 674#' @export 675#' @examples library(knitr) 676#' # write tables for data frames 677#' knit_print.data.frame = function(x, ...) { 678#' res = paste(c('', '', kable(x, output = FALSE)), collapse = '\n') 679#' asis_output(res) 680#' } 681#' # register the method 682#' registerS3method("knit_print", "data.frame", knit_print.data.frame) 683#' # after you define and register the above method, data frames will be printed 684#' # as tables in knitr, which is different with the default print() behavior 685knit_print = function(x, ...) { 686 if (need_screenshot(x, ...)) { 687 html_screenshot(x) 688 } else { 689 UseMethod('knit_print') 690 } 691} 692 693#" the default print method is just print()/show() 694#' @export 695knit_print.default = function(x, ..., inline = FALSE) { 696 if (inline) x else normal_print(x) 697} 698 699#' @export 700knit_print.knit_asis = function(x, ...) x 701 702#' @export 703knit_print.knit_asis_url = function(x, ...) x 704 705#' @rdname knit_print 706#' @export 707normal_print = default_handlers$value 708formals(normal_print) = alist(x = , ... = ) 709 710#' Mark an R object with a special class 711#' 712#' This is a convenience function that assigns the input object a class named 713#' \code{knit_asis}, so that \pkg{knitr} will treat it as is (the effect is the 714#' same as the chunk option \code{results = 'asis'}) when it is written to the 715#' output. 716#' 717#' This function is normally used in a custom S3 method based on the printing 718#' function \code{\link{knit_print}()}. 719#' 720#' For the \code{cacheable} argument, you need to be careful when printing the 721#' object involves non-trivial side effects, in which case it is strongly 722#' recommended to use \code{cacheable = FALSE} to instruct \pkg{knitr} that this 723#' object should not be cached using the chunk option \code{cache = TRUE}, 724#' otherwise the side effects will be lost the next time the chunk is knitted. 725#' For example, printing a \pkg{shiny} input element or an HTML widget in an R 726#' Markdown document may involve registering metadata about some JavaScript 727#' libraries or stylesheets, and the metadata may be lost if we cache the code 728#' chunk, because the code evaluation will be skipped the next time. This 729#' particular issue has been solved in \pkg{knitr} after v1.13 (the metadata 730#' will be saved and loaded automatically when caching is enabled), but not all 731#' metadata can be saved and loaded next time and still works in the new R 732#' session. 733#' @param x An R object. Typically a character string, or an object which can 734#' be converted to a character string via \code{\link{as.character}()}. 735#' @param meta Additional metadata of the object to be printed. The metadata 736#' will be collected when the object is printed, and accessible via 737#' \code{knit_meta()}. 738#' @param cacheable Boolean indicating whether this object is cacheable. If 739#' \code{FALSE}, \pkg{knitr} will stop when caching is enabled on code chunks 740#' that contain \code{asis_output()}. 741#' @note This function only works in top-level R expressions, and it will not 742#' work when it is called inside another expression, such as a for-loop. See 743#' \url{https://github.com/yihui/knitr/issues/1137} for a discussion. 744#' @export 745#' @examples # see ?knit_print 746asis_output = function(x, meta = NULL, cacheable = NA) { 747 structure(x, class = 'knit_asis', knit_meta = meta, knit_cacheable = cacheable) 748} 749 750#' Metadata about objects to be printed 751#' 752#' As an object is printed, \pkg{knitr} will collect metadata about it (if 753#' available). After knitting is done, all the metadata is accessible via this 754#' function. You can manually add metadata to the \pkg{knitr} session via 755#' \code{knit_meta_add()}. 756#' @param class Optionally return only metadata entries that inherit from the 757#' specified class. The default, \code{NULL}, returns all entries. 758#' @param clean Whether to clean the collected metadata. By default, the 759#' metadata stored in \pkg{knitr} is cleaned up once retrieved, because we may 760#' not want the metadata to be passed to the next \code{knit()} call; to be 761#' defensive (i.e. not to have carryover metadata), you can call 762#' \code{knit_meta()} before \code{knit()}. 763#' @export 764#' @return \code{knit_meta()} returns the matched metadata specified by 765#' \code{class}; \code{knit_meta_add()} returns all current metadata. 766knit_meta = function(class = NULL, clean = TRUE) { 767 if (is.null(class)) { 768 if (clean) on.exit({.knitEnv$meta = list()}, add = TRUE) 769 return(.knitEnv$meta) 770 } 771 # if a class was specified, match the items belonging to the class 772 matches = if (length(.knitEnv$meta)) { 773 vapply(.knitEnv$meta, inherits, logical(1), what = class) 774 } 775 if (!any(matches)) return(list()) 776 if (clean) on.exit({ 777 .knitEnv$meta[matches] = NULL 778 id = attr(.knitEnv$meta, 'knit_meta_id') 779 if (length(id)) attr(.knitEnv$meta, 'knit_meta_id') = id[!matches] 780 }, add = TRUE) 781 .knitEnv$meta[matches] 782} 783 784#' @param meta A metadata object to be added to the session. 785#' @param label A chunk label to indicate which chunk the metadata belongs to. 786#' @rdname knit_meta 787#' @export 788knit_meta_add = function(meta, label = '') { 789 if (length(meta)) { 790 meta_id = attr(.knitEnv$meta, 'knit_meta_id') 791 .knitEnv$meta = c(.knitEnv$meta, meta) 792 attr(.knitEnv$meta, 'knit_meta_id') = c(meta_id, rep_len(label, length(meta))) 793 } 794 .knitEnv$meta 795} 796