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