-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathunname_chunks.R
115 lines (105 loc) · 3.37 KB
/
unname_chunks.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
#' @title Unname chunks in a single file
#'
#' @description Unname in a single file all chunks,
#' or alternatively only unname the chunknames with a given prefix.
#' In both cases, the chunk name "setup" is preserved, that chunk is never unnamed.
#'
#' @returns Always returns TRUE invisibly. Called for side effects.
#'
#' @inherit name_chunks details
#'
#' @template path
#' @template chunk_name_prefix
#'
#' @export
#'
#' @examples
#' # remove all chunklabels except the one named 'setup'
#' temp_file_path <- file.path(tempdir(), "test1.Rmd")
#' file.copy(system.file("examples", "example4.Rmd", package = "namer"),
#' temp_file_path,
#' overwrite = TRUE)
#' unname_chunks(temp_file_path)
#' if(interactive()){
#' file.edit(temp_file_path)
#' }
#' # remove all chunk labels starting with 'example4'
#' temp_file_path <- file.path(tempdir(), "test2.Rmd")
#' file.copy(system.file("examples", "example4.Rmd", package = "namer"),
#' temp_file_path,
#' overwrite = TRUE)
#' unname_chunks(temp_file_path,chunk_name_prefix='example4')
#' if(interactive()){
#' file.edit(temp_file_path)
#' }
unname_chunks <- function(path, chunk_name_prefix = NULL) {
# read the whole file
lines <- readLines(path)
# get chunk info
chunk_headers_info <- get_chunk_info(lines)
# early exit if no chunk
if (is.null(chunk_headers_info)) {
return(invisible("TRUE"))
}
if (is.null(chunk_name_prefix)) {
# preserve the setup label, delete the others
chunk_headers_info$name[chunk_headers_info$name != "setup"] <- ""
} else {
# preserve labels not starting with chunk_name_prefix
del_labels <- strtrim(chunk_headers_info$name, nchar(chunk_name_prefix)) %in%
chunk_name_prefix
setup_label <- !(chunk_headers_info$name %in% "setup")
del_labels <- del_labels & setup_label
chunk_headers_info$name[del_labels] <- ""
}
newlines <- re_write_headers(chunk_headers_info)
lines[newlines$index] <- newlines$line
# save file
writeLines(lines, path)
return(invisible(TRUE))
}
#' @title Unname chunks of all Rmds in a dir
#'
#' @description Name unnamed chunks in a dir using the filenames with extension stripped as basis.
#'
#' @returns Always returns TRUE invisibly. Called for side effects.
#'
#' @inherit name_chunks details
#'
#' @template dir
#'
#' @export
#'
#' @examples
#' temp_dir <- tempdir()
#' # just to make sure we're not overwriting
#' if(fs::dir_exists(file.path(temp_dir, "examples"))){
#' fs::dir_delete(file.path(temp_dir, "examples"))
#' }
#' fs::dir_copy(system.file("examples", package = "namer"),
#' temp_dir)
#' # this is an example file that'd fail
#' fs::file_delete(file.path(temp_dir,
#' "examples", "example4.Rmd"))
#' name_dir_chunks(temp_dir)
#' if(interactive()){
#' file.edit(file.path(temp_dir,
#' "examples", "example1.Rmd"))
#' }
unname_dir_chunks <- function(dir) {
rmds <- fs::dir_ls(dir, regexp = "*.[Rr]md")
purrr::walk(rmds, chatty_unname_chunks)
return(invisible(TRUE))
}
chatty_unname_chunks <- function(path) {
message(glue::glue("Scanning {path}..."))
unname_chunks(path)
}
#' @template path
#' @template chunk_name_prefix
#' @rdname unname_chunks
#' @export
unname_all_chunks <- function(path, chunk_name_prefix = NULL) {
warning("please use unname_chunks() instead of unname_all_chunks()", call. = FALSE)
unname_chunks(path, chunk_name_prefix = NULL)
}