1# S3 method to deal with chunks and inline text respectively 2process_group = function(x) { 3 UseMethod('process_group', x) 4} 5#' @export 6process_group.block = function(x) call_block(x) 7#' @export 8process_group.inline = function(x) { 9 x = call_inline(x) 10 knit_hooks$get('text')(x) 11} 12 13 14call_block = function(block) { 15 # now try eval all options except those in eval.after and their aliases 16 af = opts_knit$get('eval.after'); al = opts_knit$get('aliases') 17 if (!is.null(al) && !is.null(af)) af = c(af, names(al[af %in% al])) 18 19 params = opts_chunk$merge(block$params) 20 for (o in setdiff(names(params), af)) { 21 params[o] = list(eval_lang(params[[o]])) 22 # also update original options before being merged with opts_chunk 23 if (o %in% names(block$params)) block$params[o] = params[o] 24 } 25 26 label = ref.label = params$label 27 if (!is.null(params$ref.label)) { 28 ref.label = sc_split(params$ref.label) 29 # ref.label = I() implies opts.label = ref.label 30 if (inherits(params$ref.label, 'AsIs') && is.null(params$opts.label)) 31 params$opts.label = ref.label 32 } 33 # if chunk option 'file' is provided, read the file(s) as the chunk body; 34 # otherwise if 'code' is provided, use it; if neither 'file' nor 'code' is 35 # provided, use the chunk body 36 params[["code"]] = if (is.null(code_file <- params[['file']])) { 37 params[["code"]] %n% unlist(knit_code$get(ref.label), use.names = FALSE) 38 } else { 39 # TODO: use xfun::read_all() so we can read multiple files at once 40 xfun::read_utf8(code_file) 41 } 42 43 # opts.label = TRUE means inheriting chunk options from ref.label 44 if (isTRUE(params$opts.label)) params$opts.label = ref.label 45 # expand chunk options defined via opts_template and reference chunks 46 params2 = NULL 47 for (lab in params$opts.label) { 48 # referenced chunk options (if any) override template options 49 params3 = merge_list(opts_template$get(lab), attr(knit_code$get(lab), 'chunk_opts')) 50 params2 = merge_list(params2, params3) 51 } 52 if (length(params2)) { 53 # local options override referenced options 54 params2 = merge_list(params2, block$params) 55 # then override previously merged opts_chunk options 56 params = merge_list(params, params2) 57 # in case any options are not evaluated 58 for (o in setdiff(names(params), af)) params[o] = list(eval_lang(params[[o]])) 59 } 60 61 # save current chunk options in opts_current 62 opts_current$restore(params) 63 64 if (opts_knit$get('progress')) print(block) 65 66 if (!is.null(params$child)) { 67 if (!is_blank(params$code)) warning( 68 "The chunk '", params$label, "' has the 'child' option, ", 69 "and this code chunk must be empty. Its code will be ignored." 70 ) 71 if (!params$eval) return('') 72 cmds = lapply(sc_split(params$child), knit_child, options = block$params) 73 out = one_string(unlist(cmds)) 74 return(out) 75 } 76 77 params$code = parse_chunk(params$code) # parse sub-chunk references 78 79 ohooks = opts_hooks$get() 80 for (opt in names(ohooks)) { 81 hook = ohooks[[opt]] 82 if (!is.function(hook)) { 83 warning("The option hook '", opt, "' should be a function") 84 next 85 } 86 if (!is.null(params[[opt]])) params = as.strict_list(hook(params)) 87 if (!is.list(params)) 88 stop("The option hook '", opt, "' should return a list of chunk options") 89 } 90 91 params = fix_options(params) # for compatibility 92 93 # Check cache 94 if (params$cache > 0) { 95 content = c( 96 params[if (params$cache < 3) cache1.opts else setdiff(names(params), cache0.opts)], 97 75L, if (params$cache == 2) params[cache2.opts] 98 ) 99 if (params$engine == 'R' && isFALSE(params$cache.comments)) { 100 content[['code']] = parse_only(content[['code']]) 101 } 102 hash = paste(valid_path(params$cache.path, label), digest(content), sep = '_') 103 params$hash = hash 104 if (cache$exists(hash, params$cache.lazy) && 105 isFALSE(params$cache.rebuild) && 106 params$engine != 'Rcpp') { 107 if (opts_knit$get('verbose')) message(' loading cache from ', hash) 108 cache$load(hash, lazy = params$cache.lazy) 109 cache_engine(params) 110 if (!params$include) return('') 111 if (params$cache == 3) return(cache$output(hash)) 112 } 113 if (params$engine == 'R') 114 cache$library(params$cache.path, save = FALSE) # load packages 115 } else if (label %in% names(dep_list$get()) && !isFALSE(opts_knit$get('warn.uncached.dep'))) 116 warning2('code chunks must not depend on the uncached chunk "', label, '"') 117 118 params$params.src = block$params.src 119 opts_current$restore(params) # save current options 120 121 # set local options() for the current R chunk 122 if (is.list(params$R.options)) { 123 op = options(params$R.options); on.exit(options(op), add = TRUE) 124 } 125 126 block_exec(params) 127} 128 129# options that should affect cache when cache level = 1,2 130cache1.opts = c('code', 'eval', 'cache', 'cache.path', 'cache.globals', 'message', 'warning', 'error') 131# more options affecting cache level 2 132cache2.opts = c('fig.keep', 'fig.path', 'fig.ext', 'dev', 'dpi', 'dev.args', 'fig.width', 'fig.height') 133# options that should not affect cache 134cache0.opts = c('include', 'out.width.px', 'out.height.px', 'cache.rebuild') 135 136block_exec = function(options) { 137 if (options$engine == 'R') return(eng_r(options)) 138 139 # when code is not R language 140 res.before = run_hooks(before = TRUE, options) 141 engine = get_engine(options$engine) 142 output = in_dir(input_dir(), engine(options)) 143 if (is.list(output)) output = unlist(output) 144 res.after = run_hooks(before = FALSE, options) 145 output = paste(c(res.before, output, res.after), collapse = '') 146 output = knit_hooks$get('chunk')(output, options) 147 if (options$cache) { 148 cache.exists = cache$exists(options$hash, options$cache.lazy) 149 if (options$cache.rebuild || !cache.exists) block_cache(options, output, switch( 150 options$engine, 151 'stan' = options$output.var, 'sql' = options$output.var, character(0) 152 )) 153 } 154 if (options$include) output else '' 155} 156 157#' Engine for R 158#' 159#' This function handles the execution of R code blocks (when the chunk option 160#' \code{engine} is \code{'R'}) and generates the R output for each code block. 161#' 162#' This engine function has one argument \code{options}: the source code of the 163#' current chunk is in \code{options$code}. It returns a processed output that 164#' can consist of data frames (as tables), graphs, or character output. This 165#' function is intended for advanced use to allow developers to extend R, and 166#' customize the pipeline with which R code is executed and processed within 167#' knitr. 168#' 169#' @param options A list of chunk options. Usually this is just the object 170#' \code{options} associated with the current code chunk. 171#' @noRd 172eng_r = function(options) { 173 # eval chunks (in an empty envir if cache) 174 env = knit_global() 175 obj.before = ls(globalenv(), all.names = TRUE) # global objects before chunk 176 177 keep = options$fig.keep 178 keep.idx = NULL 179 if (is.logical(keep)) keep = which(keep) 180 if (is.numeric(keep)) { 181 keep.idx = keep 182 keep = "index" 183 } 184 185 if (keep.pars <- opts_knit$get('global.par')) on.exit({ 186 opts_knit$set(global.pars = par(no.readonly = TRUE)) 187 }, add = TRUE) 188 189 tmp.fig = tempfile(); on.exit(unlink(tmp.fig), add = TRUE) 190 # open a device to record plots if not using a global device or no device is 191 # open, and close this device if we don't want to use a global device 192 if (!opts_knit$get('global.device') || is.null(dev.list())) { 193 chunk_device(options, keep != 'none', tmp.fig) 194 dv = dev.cur() 195 if (!opts_knit$get('global.device')) on.exit(dev.off(dv), add = TRUE) 196 showtext(options) # showtext support 197 } 198 # preserve par() settings from the last code chunk 199 if (keep.pars) par2(opts_knit$get('global.pars')) 200 201 res.before = run_hooks(before = TRUE, options, env) # run 'before' hooks 202 203 code = options$code 204 echo = options$echo # tidy code if echo 205 if (!isFALSE(echo) && !isFALSE(options$tidy) && length(code)) { 206 tidy.method = if (isTRUE(options$tidy)) 'formatR' else options$tidy 207 if (is.character(tidy.method)) tidy.method = switch( 208 tidy.method, 209 formatR = function(code, ...) { 210 if (!loadable('formatR')) stop2( 211 'The formatR package is required by the chunk option tidy = TRUE but ', 212 'not installed; tidy = TRUE will be ignored.' 213 ) 214 formatR::tidy_source(text = code, output = FALSE, ...)$text.tidy 215 }, 216 styler = function(code, ...) unclass(styler::style_text(text = code, ...)) 217 ) 218 res = try_silent(do.call(tidy.method, c(list(code), options$tidy.opts))) 219 220 if (!inherits(res, 'try-error')) code = res else warning( 221 "Failed to tidy R code in chunk '", options$label, "'. Reason:\n", res 222 ) 223 } 224 # only evaluate certain lines 225 if (is.numeric(ev <- options$eval)) { 226 # group source code into syntactically complete expressions 227 if (isFALSE(options$tidy)) code = sapply(xfun::split_source(code), one_string) 228 iss = seq_along(code) 229 code = comment_out(code, '##', setdiff(iss, iss[ev]), newline = FALSE) 230 } 231 # guess plot file type if it is NULL 232 if (keep != 'none' && is.null(options$fig.ext)) 233 options$fig.ext = dev2ext(options$dev) 234 235 cache.exists = cache$exists(options$hash, options$cache.lazy) 236 evaluate = knit_hooks$get('evaluate') 237 # return code with class 'source' if not eval chunks 238 res = if (is_blank(code)) list() else if (isFALSE(ev)) { 239 as.source(code) 240 } else if (cache.exists && isFALSE(options$cache.rebuild)) { 241 fix_evaluate(cache$output(options$hash, 'list'), options$cache == 1) 242 } else in_dir( 243 input_dir(), 244 evaluate( 245 code, envir = env, new_device = FALSE, 246 keep_warning = !isFALSE(options$warning), 247 keep_message = !isFALSE(options$message), 248 stop_on_error = if (is.numeric(options$error)) options$error else { 249 if (options$error && options$include) 0L else 2L 250 }, 251 output_handler = knit_handlers(options$render, options) 252 ) 253 ) 254 if (options$cache %in% 1:2 && (!cache.exists || isTRUE(options$cache.rebuild))) { 255 # make a copy for cache=1,2; when cache=2, we do not really need plots 256 res.orig = if (options$cache == 2) remove_plot(res, keep == 'high') else res 257 } 258 259 # eval other options after the chunk 260 if (!isFALSE(ev)) 261 for (o in opts_knit$get('eval.after')) 262 options[o] = list(eval_lang(options[[o]], env)) 263 264 # remove some components according options 265 if (isFALSE(echo)) { 266 res = Filter(Negate(evaluate::is.source), res) 267 } else if (is.numeric(echo)) { 268 # choose expressions to echo using a numeric vector 269 res = if (isFALSE(ev)) { 270 as.source(code[echo]) 271 } else { 272 filter_evaluate(res, echo, evaluate::is.source) 273 } 274 } 275 if (options$results == 'hide') res = Filter(Negate(is.character), res) 276 if (options$results == 'hold') { 277 i = vapply(res, is.character, logical(1)) 278 if (any(i)) res = c(res[!i], merge_character(res[i])) 279 } 280 res = filter_evaluate(res, options$warning, evaluate::is.warning) 281 res = filter_evaluate(res, options$message, evaluate::is.message) 282 283 # rearrange locations of figures 284 res = rearrange_figs(res, keep, keep.idx, options$fig.show) 285 286 # number of plots in this chunk 287 if (is.null(options$fig.num)) 288 options$fig.num = if (length(res)) sum(sapply(res, function(x) { 289 if (inherits(x, 'knit_image_paths')) return(length(x)) 290 if (is_plot_output(x)) return(1) 291 0 292 })) else 0L 293 294 # merge neighbor elements of the same class into one element 295 for (cls in c('source', 'message', 'warning')) res = merge_class(res, cls) 296 297 if (isTRUE(options$fig.beforecode)) res = fig_before_code(res) 298 299 on.exit({ 300 plot_counter(reset = TRUE) 301 shot_counter(reset = TRUE) 302 opts_knit$delete('plot_files') 303 }, add = TRUE) # restore plot number 304 305 output = unlist(sew(res, options)) # wrap all results together 306 res.after = run_hooks(before = FALSE, options, env) # run 'after' hooks 307 308 output = paste(c(res.before, output, res.after), collapse = '') # insert hook results 309 output = knit_hooks$get('chunk')(output, options) 310 311 if (options$cache > 0) { 312 # if cache.vars has been specifically provided, only cache these vars and no 313 # need to look for objects in globalenv() 314 obj.new = if (is.null(options$cache.vars)) setdiff(ls(globalenv(), all.names = TRUE), obj.before) 315 copy_env(globalenv(), env, obj.new) 316 objs = if (isFALSE(ev) || length(code) == 0) character(0) else 317 options$cache.vars %n% codetools::findLocalsList(parse_only(code)) 318 # make sure all objects to be saved exist in env 319 objs = intersect(c(objs, obj.new), ls(env, all.names = TRUE)) 320 if (options$autodep) { 321 # you shall manually specify global object names if find_symbols() is not reliable 322 cache$objects( 323 objs, cache_globals(options$cache.globals, code), options$label, 324 options$cache.path 325 ) 326 dep_auto() 327 } 328 if (options$cache < 3) { 329 if (options$cache.rebuild || !cache.exists) block_cache(options, res.orig, objs) 330 } else block_cache(options, output, objs) 331 } 332 333 if (options$include) output else if (is.null(s <- options$indent)) '' else s 334} 335 336block_cache = function(options, output, objects) { 337 hash = options$hash 338 outname = cache_output_name(hash) 339 assign(outname, output, envir = knit_global()) 340 purge_cache(options) 341 cache$library(options$cache.path, save = TRUE) 342 cache$save(objects, outname, hash, lazy = options$cache.lazy) 343} 344 345purge_cache = function(options) { 346 # purge my old cache and cache of chunks dependent on me 347 cache$purge(paste0(valid_path( 348 options$cache.path, c(options$label, dep_list$get(options$label)) 349 ), '_????????????????????????????????')) 350} 351 352cache_globals = function(option, code) { 353 if (is.character(option)) option else { 354 (if (xfun::isFALSE(option)) find_symbols else find_globals)(code) 355 } 356} 357 358# open a graphical device for a chunk to record plots 359chunk_device = function(options, record = TRUE, tmp = tempfile()) { 360 width = options$fig.width[1L] 361 height = options$fig.height[1L] 362 dev = fallback_dev(options$dev) 363 dev.args = options$dev.args 364 dpi = options$dpi 365 366 # actually I should adjust the recording device according to dev, but here I 367 # have only considered devices like png and tikz (because the measurement 368 # results can be very different especially with the latter, see #1066), the 369 # cairo_pdf device (#1235), and svg (#1705) 370 if (identical(dev, 'png')) { 371 do.call(grDevices::png, c(list( 372 filename = tmp, width = width, height = height, units = 'in', res = dpi 373 ), get_dargs(dev.args, 'png'))) 374 } else if (identical(dev, 'ragg_png')) { 375 do.call(ragg_png_dev, c(list( 376 filename = tmp, width = width, height = height, units = 'in', res = dpi 377 ), get_dargs(dev.args, 'ragg_png'))) 378 } else if (identical(dev, 'tikz')) { 379 dargs = c(list( 380 file = tmp, width = width, height = height 381 ), get_dargs(dev.args, 'tikz')) 382 dargs$sanitize = options$sanitize; dargs$standAlone = options$external 383 if (is.null(dargs$verbose)) dargs$verbose = FALSE 384 do.call(tikz_dev, dargs) 385 } else if (identical(dev, 'cairo_pdf')) { 386 do.call(grDevices::cairo_pdf, c(list( 387 filename = tmp, width = width, height = height 388 ), get_dargs(dev.args, 'cairo_pdf'))) 389 } else if (identical(dev, 'svg')) { 390 do.call(grDevices::svg, c(list( 391 filename = tmp, width = width, height = height 392 ), get_dargs(dev.args, 'svg'))) 393 } else if (identical(getOption('device'), pdf_null)) { 394 if (!is.null(dev.args)) { 395 dev.args = get_dargs(dev.args, 'pdf') 396 dev.args = dev.args[intersect(names(dev.args), c('pointsize', 'bg'))] 397 } 398 do.call(pdf_null, c(list(width = width, height = height), dev.args)) 399 } else dev.new(width = width, height = height) 400 dev.control(displaylist = if (record) 'enable' else 'inhibit') 401} 402 403# fall back to a usable device (e.g., during R CMD check) 404fallback_dev = function(dev) { 405 if (length(dev) != 1 || !getOption('knitr.device.fallback', is_R_CMD_check())) 406 return(dev) 407 choices = list( 408 svg = c('png', 'jpeg', 'bmp'), cairo_pdf = c('pdf'), cairo_ps = c('postscript'), 409 png = c('jpeg', 'svg', 'bmp'), jpeg = c('png', 'svg', 'bmp') 410 ) 411 # add choices provided by users 412 choices = merge_list(choices, getOption('knitr.device.choices')) 413 if (!dev %in% names(choices)) return(dev) # no fallback devices available 414 # first test if the specified device actually works 415 if (dev_available(dev)) return(dev) 416 for (d in choices[[dev]]) if (dev_available(d)) { 417 warning2("The device '", dev, "' is not operational; falling back to '", d, "'.") 418 return(d) 419 } 420 dev # no fallback device found; you'll to run into an error soon 421} 422 423# filter out some results based on the numeric chunk option as indices 424filter_evaluate = function(res, opt, test) { 425 if (length(res) == 0 || !is.numeric(opt) || !any(idx <- sapply(res, test))) 426 return(res) 427 idx = which(idx) 428 idx = setdiff(idx, na.omit(idx[opt])) # indices of elements to remove 429 if (length(idx) == 0) res else res[-idx] 430} 431 432# find recorded plots in the output of evaluate() 433find_recordedplot = function(x) { 434 vapply(x, is_plot_output, logical(1)) 435} 436 437is_plot_output = function(x) { 438 evaluate::is.recordedplot(x) || 439 inherits(x, c('knit_image_paths', 'html_screenshot', 'knit_other_plot')) 440} 441 442# move plots before source code 443fig_before_code = function(x) { 444 s = vapply(x, evaluate::is.source, logical(1)) 445 if (length(s) == 0 || !any(s)) return(x) 446 s = which(s) 447 f = which(find_recordedplot(x)) 448 f = f[f >= min(s)] # only move those plots after the first code block 449 for (i in f) { 450 j = max(s[s < i]) 451 tmp = x[i]; x[[i]] = NULL; x = append(x, tmp, j - 1) 452 s = which(vapply(x, evaluate::is.source, logical(1))) 453 } 454 x 455} 456 457rearrange_figs = function(res, keep, idx, show) { 458 figs = find_recordedplot(res) 459 if (!any(figs)) return(res) # no figures 460 if (keep == 'none') return(res[!figs]) # remove all 461 462 if (show == 'hold') { 463 res = c(res[!figs], res[figs]) # move to the end 464 figs = find_recordedplot(res) 465 } 466 if (sum(figs) <= 1) return(res) # return early if only 1 figure to keep 467 switch( 468 keep, 469 first = res[-tail(which(figs), -1L)], 470 last = res[-head(which(figs), -1L)], 471 high = merge_low_plot(res, figs), # merge low-level plotting changes 472 index = { 473 i = which(figs)[-idx] 474 if (length(i) > 0) res[-i] else res # keep only selected 475 }, 476 res 477 ) 478} 479 480# merge neighbor elements of the same class in a list returned by evaluate() 481merge_class = function(res, class = c('source', 'message', 'warning')) { 482 483 class = match.arg(class) 484 idx = if (length(res)) which(sapply(res, inherits, what = class)) 485 if ((n <- length(idx)) <= 1) return(res) 486 487 k1 = idx[1]; k2 = NULL; res1 = res[[k1]] 488 el = c(source = 'src', message = 'message', warning = 'message')[class] 489 for (i in 1:(n - 1)) { 490 idx2 = idx[i + 1]; idx1 = idx[i] 491 if (idx2 - idx1 == 1) { 492 res2 = res[[idx2]] 493 # merge warnings/messages only if next one is identical to previous one 494 if (class == 'source' || identical(res1, res2) || 495 (class == 'message' && !grepl('\n$', tail(res1[[el]], 1)))) { 496 res[[k1]][[el]] = c(res[[k1]][[el]], res2[[el]]) 497 k2 = c(k2, idx2) 498 } else { 499 k1 = idx2 500 res1 = res[[k1]] 501 } 502 } else k1 = idx2 503 } 504 if (length(k2)) res = res[-k2] # remove lines that have been merged back 505 res 506 507} 508 509# merge character output for output='hold', if the subsequent character is of 510# the same class(es) as the previous one (e.g. should not merge normal 511# characters with asis_output()) 512merge_character = function(res) { 513 if ((n <- length(res)) <= 1) return(res) 514 k = NULL 515 for (i in 1:(n - 1)) { 516 cls = class(res[[i]]) 517 if (identical(cls, class(res[[i + 1]]))) { 518 res[[i + 1]] = paste0(res[[i]], res[[i + 1]]) 519 class(res[[i + 1]]) = cls 520 k = c(k, i) 521 } 522 } 523 if (length(k)) res = res[-k] 524 res 525} 526 527call_inline = function(block) { 528 if (opts_knit$get('progress')) print(block) 529 in_dir(input_dir(), inline_exec(block)) 530} 531 532inline_exec = function( 533 block, envir = knit_global(), hook = knit_hooks$get('inline'), 534 hook_eval = knit_hooks$get('evaluate.inline') 535) { 536 537 # run inline code and substitute original texts 538 code = block$code; input = block$input 539 if ((n <- length(code)) == 0) return(input) # untouched if no code is found 540 541 loc = block$location 542 for (i in 1:n) { 543 res = hook_eval(code[i], envir) 544 if (inherits(res, c('knit_asis', 'knit_asis_url'))) res = sew(res, inline = TRUE) 545 tryCatch(as.character(res), error = function(e) { 546 stop2("The inline value cannot be coerced to character: ", code[i]) 547 }) 548 d = nchar(input) 549 # replace with evaluated results 550 stringr::str_sub(input, loc[i, 1], loc[i, 2]) = if (length(res)) { 551 paste(hook(res), collapse = '') 552 } else '' 553 if (i < n) loc[(i + 1):n, ] = loc[(i + 1):n, ] - (d - nchar(input)) 554 # may need to move back and forth because replacement may be longer or shorter 555 } 556 input 557} 558 559process_tangle = function(x) { 560 UseMethod('process_tangle', x) 561} 562#' @export 563process_tangle.block = function(x) { 564 params = opts_chunk$merge(x$params) 565 for (o in c('purl', 'eval', 'child')) { 566 if (inherits(try(params[o] <- list(eval_lang(params[[o]]))), 'try-error')) { 567 params[['purl']] = FALSE # if any of these options cannot be determined, don't purl 568 } 569 } 570 if (isFALSE(params$purl)) return('') 571 label = params$label; ev = params$eval 572 if (params$engine != 'R') return(one_string(comment_out(knit_code$get(label)))) 573 code = if (!isFALSE(ev) && !is.null(params$child)) { 574 cmds = lapply(sc_split(params$child), knit_child) 575 one_string(unlist(cmds)) 576 } else knit_code$get(label) 577 # read external code if exists 578 if (!isFALSE(ev) && length(code) && any(grepl('read_chunk\\(.+\\)', code))) { 579 eval(parse_only(unlist(stringr::str_extract_all(code, 'read_chunk\\(([^)]+)\\)')))) 580 } 581 code = parse_chunk(code) 582 if (isFALSE(ev)) code = comment_out(code, params$comment, newline = FALSE) 583 if (opts_knit$get('documentation') == 0L) return(one_string(code)) 584 label_code(code, x$params.src) 585} 586#' @export 587process_tangle.inline = function(x) { 588 589 output = if (opts_knit$get('documentation') == 2L) { 590 output = one_string(line_prompt(x$input.src, "#' ", "#' ")) 591 } else '' 592 593 code = x$code 594 if (length(code) == 0L) return(output) 595 596 if (getOption('knitr.purl.inline', FALSE)) output = c(output, code) 597 598 idx = grepl('knit_child\\(.+\\)', code) 599 if (any(idx)) { 600 cout = sapply(code[idx], function(z) eval(parse_only(z))) 601 output = c(output, cout, '') 602 } 603 604 one_string(output) 605} 606 607 608# add a label [and extra chunk options] to a code chunk 609label_code = function(code, label) { 610 code = one_string(c('', code, '')) 611 paste0('## ----', stringr::str_pad(label, max(getOption('width') - 11L, 0L), 'right', '-'), 612 '----', code) 613} 614 615as.source = function(code) { 616 list(structure(list(src = code), class = 'source')) 617} 618