Browse Source

Fixes for docs without code

testing-framework
Noam Ross Noam Ross 1 year ago
parent
commit
81e5303060
5 changed files with 85 additions and 72 deletions
  1. +13
    -14
      R/dedoc.R
  2. +3
    -2
      R/get_style_dist.R
  3. +68
    -54
      R/wrap.R
  4. +1
    -2
      R/wrappers.R
  5. BIN
      inst/examples/example.docx

+ 13
- 14
R/dedoc.R View File

@@ -56,7 +56,8 @@ Returning markdown only. Alternate data may be provided via `orig_codefile or `o
md_only <- FALSE
}

stopifnot(track_changes %in% c("comments_only", "criticmarkup", "accept", "reject", "all"))
stopifnot(track_changes %in%
c("comments_only", "criticmarkup", "accept", "reject", "all"))
stopifnot(block_missing %in% c("comment", "omit", "restore"))
stopifnot(inline_missing %in% c("comment", "omit", "restore"))

@@ -127,9 +128,9 @@ redoc_extract_rmd <- function(docx, type = c("original", "roundtrip"),
full.names = TRUE
)
if (type == "original") {
rmdfile <- stri_subset_regex(rmdfiles, "(?:\\.preprocessed\\.|\\.roundtrip\\.)",
negate = TRUE
)[1]
rmdfile <- stri_subset_regex(rmdfiles,
"(?:\\.preprocessed\\.|\\.roundtrip\\.)",
negate = TRUE)[1]
} else if (type == "roundtrip") {
rmdfile <- stri_subset_fixed(rmdfiles, ".roundtrip.")
}
@@ -155,6 +156,7 @@ redoc_extract_code <- function(docx) {

#' @importFrom stringi stri_replace_first_fixed stri_detect_fixed stri_join
restore_code <- function(md, codelist, missing) {
if (!length(codelist)) return(md)
codelist <- sort_by(codelist, "lineno")
offset <- attr(md, "yaml_offset") %||% 0

@@ -178,22 +180,18 @@ restore_code <- function(md, codelist, missing) {
)
} else {
restorecode <- stri_join(
"<!-- originally line ", item$lineno, "\n",
item$code, "\n -->\n"
"\n<!-- originally line ", item$lineno, "\n",
item$code, "\n-->\n"
)
}
} else {
restorecode <- stri_join(item$code, "\n")
}
restoreline <- get_prior_empty_line_loc(
md,
max(last_detected_end, item$lineno + offset)
)
md <- insert_at_prior_empty_line(
md, restorecode,
item$lineno + offset
max(last_detected_end, item$lineno + offset)
)
offset <- offset + 2
offset <- offset + 3
}
}
return(md)
@@ -289,7 +287,8 @@ convert_docx_to_md <- function(docx,
"--track-changes=all",
paste0(
"--lua-filter=",
system.file("lua-filters", "criticmarkup-commentsonly.lua", package = "redoc")
system.file("lua-filters", "criticmarkup-commentsonly.lua",
package = "redoc")
)
)
} else {
@@ -311,7 +310,7 @@ convert_docx_to_md <- function(docx,
filter_opts <- character(0)
from_format <- "docx"
}
other_opts <- c("--standalone") # note adding metadata args for additional title block elements here might work (possibly as title block variable), though can't control order?
other_opts <- c("--standalone")
opts <- c(filter_opts, track_opts, wrap_opts, other_opts)
md_tmp <- tempfile(fileext = ".md")
pandoc_convert(docx,


+ 3
- 2
R/get_style_dist.R View File

@@ -24,8 +24,9 @@ get_style_distribution <- function(docx) {
}

#' @importFrom stringi stri_c
get_style_property <- function(docx, style_id, sub = c("", "pPr", "rPr"), el, attr = "val") {
get_style_property <- function(docx, style_id, sub = c("", "pPr", "rPr"),
el, attr = "val") {
docx <- "custom-reference.docx"
sxml <- read_xml(unz(docx, filename = "word/styles.xml"))
st <- xml_find_all(sxml, stri_c("/w:styles/w:style[@w:styleId=\"", style_id, "\"]"))
xml_find_all(sxml, stri_c("/w:styles/w:style[@w:styleId=\"", style_id, "\"]"))
}

+ 68
- 54
R/wrap.R View File

@@ -48,25 +48,30 @@ hide_chunks <- function(rmd) {
label <- "codechunk"

counter <- 0
chunks <- lapply(
stri_extract_all_regex(rmd$text, chunk_regex)[[1]],
function(x) {
counter <<- counter + 1
list(
code = x,
label = label,
type = "block",
name = stri_join(prefix, label, "-", counter)
chunk_text <- stri_extract_all_regex(rmd$text, chunk_regex)[[1]]
if (length(chunk_text) == 1 && is.na(chunk_text)) {
chunks <- NULL
} else {
chunks <- lapply(
stri_extract_all_regex(rmd$text, chunk_regex)[[1]],
function(x) {
counter <<- counter + 1
list(
code = x,
label = label,
type = "block",
name = stri_join(prefix, label, "-", counter)
)
}
)
for (i in seq_along(chunks)) {
chunks[[i]]$lineno <- stri_lineno_first_fixed(rmd$text, chunks[[i]]$code)
rmd$text <- stri_replace_first_fixed(
rmd$text,
chunks[[i]]$code,
brkt(chunks[[i]]$name)
)
}
)
for (i in seq_along(chunks)) {
chunks[[i]]$lineno <- stri_lineno_first_fixed(rmd$text, chunks[[i]]$code)
rmd$text <- stri_replace_first_fixed(
rmd$text,
chunks[[i]]$code,
brkt(chunks[[i]]$name)
)
}
rmd$code <- c(rmd$code, chunks)
rmd
@@ -77,26 +82,31 @@ hide_inlines <- function(rmd) {
label <- "inlinecode"

counter <- 0
inlines <- lapply(
stri_extract_all_regex(rmd$text, inline_regex)[[1]],
function(x) {
counter <<- counter + 1
list(
code = x,
label = label,
type = "inline",
name = stri_join(prefix, label, "-", counter)
inline_text <- stri_extract_all_regex(rmd$text, inline_regex)[[1]]
if (length(inline_text) == 1 && is.na(inline_text)) {
inlines <- NULL
} else {
inlines <- lapply(
inline_text,
function(x) {
counter <<- counter + 1
list(
code = x,
label = label,
type = "inline",
name = stri_join(prefix, label, "-", counter)
)
}
)

for (i in seq_along(inlines)) {
inlines[[i]]$lineno <- stri_lineno_first_fixed(rmd$text, inlines[[i]]$code)
rmd$text <- stri_replace_first_fixed(
rmd$text,
inlines[[i]]$code,
brkt(inlines[[i]]$name)
)
}
)

for (i in seq_along(inlines)) {
inlines[[i]]$lineno <- stri_lineno_first_fixed(rmd$text, inlines[[i]]$code)
rmd$text <- stri_replace_first_fixed(
rmd$text,
inlines[[i]]$code,
brkt(inlines[[i]]$name)
)
}
rmd$code <- c(rmd$code, inlines)
rmd
@@ -185,9 +195,9 @@ unhide_yaml <- function(rmd) {
yamls <- list_subset(rmd$code, label = "yaml")
if (length(yamls)) {
rmd$text <- stri_replace_all_fixed(rmd$text,
brkt(subel(yamls, "name")),
divwrap(subel(yamls, "code"), subel(yamls, "name")),
vectorize_all = FALSE
brkt(subel(yamls, "name")),
divwrap(subel(yamls, "code"), subel(yamls, "name")),
vectorize_all = FALSE
)
}

@@ -203,27 +213,31 @@ unhide_yaml <- function(rmd) {
#' @importFrom stringi stri_detect_fixed stri_replace_all_fixed
unhide_inlines <- function(rmd) {
inlines <- list_subset(rmd$code, label = "inlinecode")
rmd$text <- stri_replace_all_fixed(rmd$text,
brkt(subel(inlines, "name")),
spanwrap(
subel(inlines, "code"),
subel(inlines, "name")
),
vectorize_all = FALSE
)
if (length(inlines)) {
rmd$text <- stri_replace_all_fixed(rmd$text,
brkt(subel(inlines, "name")),
spanwrap(
subel(inlines, "code"),
subel(inlines, "name")
),
vectorize_all = FALSE
)
}
rmd
}

#' @importFrom stringi stri_detect_fixed stri_replace_all_fixed
unhide_chunks <- function(rmd) {
chunks <- list_subset(rmd$code, label = "codechunk")
rmd$text <- stri_replace_all_fixed(rmd$text,
brkt(subel(chunks, "name")),
divwrap(
subel(chunks, "code"),
subel(chunks, "name")
),
vectorize_all = FALSE
)
if (length(chunks)) {
rmd$text <- stri_replace_all_fixed(rmd$text,
brkt(subel(chunks, "name")),
divwrap(
subel(chunks, "code"),
subel(chunks, "name")
),
vectorize_all = FALSE
)
}
rmd
}

+ 1
- 2
R/wrappers.R View File

@@ -71,7 +71,7 @@
#' type = "inline")

make_wrapper <- function(label, regex, type = c("block", "inline")) {
type = match.arg(type)
type <- match.arg(type)
if (type == "block")
container_wrapper <- divwrap
else if (type == "inline")
@@ -152,4 +152,3 @@ citationwrap <- make_wrapper(
label = "citation",
regex = "(?:@\\w+|\\[.*?-?@\\w+.*?\\](?!\\[\\(\\{))",
type = "inline")


BIN
inst/examples/example.docx View File


Loading…
Cancel
Save