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.

82 lines
2.5KB

  1. # Functions in this file should probably eventually be moved to the `officer`
  2. # package once they are made more general
  3. #' @importFrom xml2 read_xml xml_find_first xml_add_child xml_set_attrs
  4. #' write_xml
  5. add_to_style <- function(docx, style_id, name, attrs = NULL, where = c("both", "rPr", "pPr", "top")) {
  6. where <- match.arg(where)
  7. docx <- to_docx(docx)
  8. name <- prepend_ns(name)
  9. if (!is.null(attrs)) names(attrs) <- prepend_ns(names(attrs))
  10. styles_path <- file.path(docx$package_dir, "word", "styles.xml")
  11. styles_xml <- read_xml(styles_path)
  12. style_xml <- xml_find_first(
  13. styles_xml,
  14. paste0("//w:style[@w:styleId='", style_id, "']")
  15. )
  16. if (where %in% c("rPr", "both")) {
  17. rPr <- xml_add_child(style_xml, "w:rPr")
  18. style <- xml_add_child(rPr, name)
  19. if (!is.null(attrs)) xml_set_attrs(style, attrs)
  20. }
  21. if (where %in% c("pPr", "both")) {
  22. pPr <- xml_add_child(style_xml, "w:pPr")
  23. style <- xml_add_child(pPr, name)
  24. if (!is.null(attrs)) xml_set_attrs(style, attrs)
  25. }
  26. if (where == "top") {
  27. topstyle <- xml_add_child(style_xml, name)
  28. if (!is.null(attrs)) xml_set_attrs(topstyle, attrs)
  29. }
  30. write_xml(styles_xml, styles_path)
  31. return(docx)
  32. }
  33. #' @importFrom officer styles_info
  34. #' @importFrom stringi stri_detect_regex
  35. highlight_output_styles <- function(docx, name = "shd",
  36. attrs = c(
  37. val = "clear",
  38. color = "auto",
  39. fill = "FFBEBF"
  40. )) {
  41. docx <- to_docx(docx)
  42. styles <- styles_info(docx)
  43. styles <-
  44. styles$style_id[stri_detect_regex(styles$style_id, "^redoc-")]
  45. lapply(styles, function(s) {
  46. add_to_style(docx, s, name = name, attrs = attrs)
  47. })
  48. return(docx)
  49. }
  50. #' @importFrom officer styles_info
  51. #' @importFrom stringi stri_detect_regex
  52. hide_output_styles <- function(docx, name = "shd",
  53. attrs = c(
  54. val = "clear",
  55. color = "auto",
  56. fill = "FFBEBF"
  57. )) {
  58. docx <- to_docx(docx)
  59. styles <- styles_info(docx)
  60. styles <-
  61. styles$style_id[stri_detect_regex(styles$style_id, "^redoc-")]
  62. lapply(styles, function(s) {
  63. add_to_style(docx, s, name = "hidden", where = "top")
  64. })
  65. return(docx)
  66. }
  67. #' @importFrom stringi stri_detect_regex
  68. prepend_ns <- function(x, ns = "w") {
  69. ifelse(
  70. stri_detect_regex(x, paste0("^", ns, ":")),
  71. x,
  72. paste0(ns, ":", x)
  73. )
  74. }