r
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

150 lines
5.3KB

  1. #' R Markdown format for Reversible Reproducible Word Documents
  2. #'
  3. #' Format for converting from R Markdown to a Microsoft Word Document that can
  4. #' be reversed using [dedoc()] after editing in Word.
  5. #'
  6. #' @param highlight_outputs whether to highlight outputs from chunks and inline
  7. #' code in the final document
  8. #' @param wrap when round-tripping the document, at what width to wrap the
  9. #' markdown output? Set the default with `"redoc.wrap"` in `options()`. See [dedoc()].
  10. #' @param margins page margin size. Can be a single value or a named vector
  11. #' with values, `top`, `bottom`, `left`, `right`, `gutter`, `header`, and
  12. #' `footer`. If NULL defaults to the reference document.
  13. #' @param line_numbers either TRUE or list with any of the arguments `start`,
  14. #' `by`, `restart`, and `distance`
  15. #' @param comment_author The name to attribute any CriticMarkup tracked
  16. #' changes to. Defaults to [whoami::fullname()].
  17. #' @param keep_md whether to keep the intermediate markdown document
  18. #' @param wrappers a list of wrapper functions to capture text to protect when
  19. #' rendering and de-rendering. See [make_wrapper()].
  20. #' @param diagnostics Whether to embed diagnostic information in the output
  21. #' file. If TRUE, this will save session information and the current
  22. #' pandoc and (if used) RStudio versions inside the Word document for later
  23. #' bug-checking.
  24. #' @param ... other parameters passed to [rmarkdown::word_document()]
  25. #' @importFrom rmarkdown output_format word_document
  26. #' @importFrom officer read_docx
  27. #' @importFrom tools file_path_sans_ext
  28. #' @importFrom rmarkdown word_document
  29. #' @importFrom knitr knit_print knit_global opts_chunk opts_knit
  30. #' @export
  31. redoc <- function(highlight_outputs = FALSE, wrap = getOption("redoc.wrap", 80),
  32. margins = NULL, line_numbers = NULL,
  33. comment_author = NULL, keep_md = FALSE,
  34. wrappers = list(
  35. htmlcommentwrap, latexwrap,
  36. rawblockwrap, rawspanwrap,
  37. cmwrap, citationwrap
  38. ),
  39. diagnostics = TRUE,
  40. ...) {
  41. # Make a function to pre-process the Rmd file
  42. pre_knit <- make_preknitter(wrappers = wrappers)
  43. md_extensions <- c("+smart", "+fenced_divs", "+bracketed_spans")
  44. pandoc <- rmarkdown::pandoc_options(
  45. to = "docx+empty_paragraphs",
  46. from = rmarkdown::from_rmarkdown(extensions = md_extensions),
  47. args = c(
  48. "--lua-filter",
  49. system.file("lua-filters", "protect-empty.lua",
  50. package = "redoc"
  51. ),
  52. "--eol=lf"
  53. )
  54. )
  55. post_processor <-
  56. function(metadata, input_file, output_file, clean, verbose) {
  57. docx <- officer::read_docx(output_file)
  58. render_env <- get_parent_env_with(c(
  59. "intermediates", "intermediates_loc",
  60. "knit_input", "original_input"
  61. ))
  62. original_rmd_input <- get("original_input", envir = render_env)
  63. renv_intermediates <- get("intermediates", envir = render_env)
  64. renv_intermediates_loc <- get("intermediates_loc", envir = render_env)
  65. renv_intermediates_dir <- get("intermediates_dir", envir = render_env)
  66. codefile <- renv_intermediates_loc(
  67. file_with_meta_ext(basename(original_rmd_input), "codelist", "yml")
  68. )
  69. codelist <- read_yaml(codefile)
  70. embed_files(docx, c(original_rmd_input, renv_intermediates),
  71. internal_dir = "redoc"
  72. )
  73. roundtrip_rmd <- dedoc(
  74. output_file,
  75. to = file_with_meta_ext(
  76. basename(original_rmd_input), "roundtrip", "Rmd"
  77. ),
  78. dir = renv_intermediates_dir,
  79. wrap = wrap,
  80. overwrite = TRUE,
  81. orig_codefile = codefile
  82. )
  83. add_intermediates(roundtrip_rmd)
  84. embed_files(docx, roundtrip_rmd, internal_dir = "redoc")
  85. if (diagnostics) {
  86. diag_file <- renv_intermediates_loc(
  87. file_with_meta_ext(basename(original_rmd_input), "diagnostics", "yml")
  88. )
  89. write_yaml(get_diagnostics(), diag_file, column.major = FALSE)
  90. add_intermediates(diag_file)
  91. embed_files(docx, diag_file, internal_dir = "redoc")
  92. }
  93. docx <- hide_output_styles(docx)
  94. if (highlight_outputs) docx <- highlight_output_styles(docx)
  95. # Stuff to go to worded/officedown
  96. if (!is.null(margins)) docx <- set_body_margins(docx, margins)
  97. if (isTRUE(line_numbers)) {
  98. set_body_linenumbers(docx)
  99. } else if (is.list(line_numbers)) {
  100. do.call(set_body_linenumbers, c(list(x = docx), line_numbers))
  101. }
  102. print(docx, output_file)
  103. return(output_file)
  104. }
  105. output_format <- rmarkdown::output_format(
  106. pandoc = pandoc,
  107. knitr = rmarkdown::knitr_options(),
  108. keep_md = keep_md,
  109. pre_knit = pre_knit,
  110. post_processor = post_processor,
  111. base_format = word_document(...)
  112. )
  113. output_format
  114. }
  115. get_diagnostics <- function() {
  116. pandoc_version <- as.character(rmarkdown::pandoc_version())
  117. session_info <- sessioninfo::session_info()
  118. if (requireNamespace("rstudioapi") &&
  119. rstudioapi::isAvailable()) {
  120. rstudio_info <- rstudioapi::versionInfo()[c("version", "mode")]
  121. } else {
  122. rstudio_info <- NULL
  123. }
  124. list(
  125. redoc_version = as.list(
  126. session_info$packages[session_info$packages$package == "redoc", ]
  127. ),
  128. pandoc_version = pandoc_version,
  129. rstudio_info = rstudio_info,
  130. session_info = session_info
  131. )
  132. }