1 # backslashes need to be escaped before braces 2 # otherwise backslahes in \{ and \} may get escaped. 3.bs2 <- function(x) gsub("([\\]+)", "\\1\\1", x) # escape backslash (bs) 4.esc_br <- function(x) gsub("([{}])", "\\\\\\1", x) # escape {, } 5 6.bspercent <- function(x) gsub('([^\\%]?([\\][\\])*)%', '\\1\\\\%', x) # escape percents 7.anypercent <- function(x){ 8 tag <- attr(x, "Rd_tag") 9 if(is.null(tag) || tag != "COMMENT" ) 10 .bspercent(x) # expects, correctly that `tag' does not disappear 11 else # but see the comment above about usage with Rdapply. 12 x 13} 14 15 # this seems incomplete, since \v and \l should be doubled only in R strings when 16 # in RCODE but in contexts where parse_Rd considers them (and other 17 # escaped sequences) to be markup macros, they will be in the Rd_tag 18 # attribute, not in the string. So, it seems that more complicated 19 # processing is not needed. 20 21 # 2012-10-14 dobavyam obrabotka na poveche ot edna cherta. Togava vsichki osven 22 # poslednata tryabva da se udvoyat (may), a poslednata se udvoyava ako e 23 # posledvana ot v, l ili kray na string. 24.escape_bs_in_Rcode <- function(rdo){ 25 f <- function(x) if(grepl("\\\\", x)){ # if x contains any backslashes 26 # before 2012-10-14: gsub("(\\\\+)(v|l)", "\\1\\1\\2", x) 27 res <- x 28 res <- gsub("(\\\\+)(\\\\)", "\\1\\1\\2", res) 29 res <- gsub("(\\\\)(v|l)", "\\1\\1\\2", res) 30 res <- gsub("(\\\\)$", "\\1\\1", res) 31 res <- gsub("(\\\\)('|`|\")", "\\1\\1\\2", res) 32 # browser() 33 res 34 }else 35 x 36 37 Rdtagapply(rdo, f, "RCODE") 38} 39 # 2012-09-29 included srcref processing 40 # todo: this function was patched many times, needs rewrite 41Rdo2Rdf <- function(rdo, deparse = FALSE, ex_restore = FALSE, file = NULL, rcode = TRUE, 42 srcfile = NULL){ 43 if(is.character(rdo)) # otherwise print(rdo) may go into infinite recursion 44 rdo <- list(rdo) 45 46 if(class(rdo) != "Rd") # to force using print.Rd() 47 class(rdo) <- "Rd" 48 49 if(is.character(srcfile)){ # remember which sections have not changed 50 rdoorig <- permissive_parse_Rd(srcfile) 51 unchanged_sec <- .rdo_equal_sections(rdo, rdoorig) 52 } 53 54 # browser() 55 56 if(rcode){ 57 rdo <- .escape_bs_in_Rcode(rdo) # this also does the examples 58 }else if(ex_restore){ # 2012-09-27 promenyam da izpolzva .escape_bs_in_Rcode 59 # There should be no more than one `examples' section in a proper Rd object 60 # and no `NULL' Rd_tag's at the top level. Allow them here since `rdo' may 61 # be an `Rd' piece, not a whole Rd object or fragment. In this way this 62 # function can be used for intermediate transformations. Note though that 63 # print.Rd used below to produce the text output may be more picky. 64 indx <- Rdo_which_tag_eq(rdo, "\\examples") 65 for(i in seq_along(indx)){ 66 if(!is.null(indx[[i]])) 67 rdo[[ indx[[i]] ]] <- .escape_bs_in_Rcode(rdo[[ indx[[i]] ]]) 68 } 69 } 70 71 rdo <- Rdtagapply(rdo, .esc_br, "nonmathVERB") # escape \{, \} 72 rdo <- Rdtagapply(rdo, .anypercent, "nonmath") # escape % 73 74 # 2012-10-14 75 # rdo<-Rdtagapply(rdo, function(x) gsub("((^|[^\\])([\\][\\])*)[\\]$", "\\1\\\\\\\\", x), 76 # "VERB") 77 rdo <- Rdtagapply(rdo, function(x) gsub("(^|[^\\])(\\\\+)$", "\\1\\2\\2", x), "VERB") 78 79 # pos_only = function(x){ res <- 1; browser(); res } 80 pos_filecmd <- Rdo_locate(rdo, function(x) .tag_eq(x,"\\file"), lists = TRUE) 81 for(pos in pos_filecmd) 82 rdo[[pos]] <- Rdtagapply(rdo[[pos]], function(x) gsub("(\\\\)", "\\1\\1", x), "TEXT") 83 84 # pos_filecmd <- Rdo_locate(rdo, function(x) .tag_eq(x,"\\samp"), lists = TRUE) 85 # for(pos in pos_filecmd) 86 # rdo[[pos]] <- Rdtagapply(rdo[[pos]], 87 # function(x) gsub("(\\\\+)([^\\])", "\\1\\1\\2", x), 88 # "VERB") 89 90 # krapka, za nesta kato \code{\\} (see in base R: basename.Rd, body.Rd, Arithmetic.Rd) 91 # 2012-10-14 promenyam tozi (cautious) variant, koyto samo udvoyava edna cherta 92 # kogato sa necheten broy s variant koyto udvoyava vsichki v kraya na \code{} string. 93 # todo: da ne go pravi v examples section (no tam to trudno ste se sluchi) 94 # rdo <- Rdtagapply(rdo, function(x) gsub("((^|[^\\])([\\][\\])*)[\\]$", 95 # "\\1\\\\\\\\", x), "RCODE") 96 # 2012-10-14 otkomentiram, promenich v escape_bs po-gore. 97 # rdo <- Rdtagapply(rdo, function(x) gsub("([\\]+)$", "\\1\\1", x), "RCODE") 98 99 if(is.character(srcfile)){ # replace unchanged sections with dummy contents 100 unchanged_titles <- sapply(unchanged_sec, function(x) x$title) 101 rdo <- .replace_dummy(rdo, unchanged_titles) 102 } 103 # this was used for saving before introducing tfn, etc. 104 # res <- capture.output(print(rdo, deparse = deparse), file = file) 105 106 # as.character.Rd ima bug svarzana s newcommand i/ili argumentite 107 # na href, vzh. naprimer which.min.Rd v base, tam as.character dava 108 # \href{{http://CRAN.R-project.org/package=nnet}{\pkg{nnet}}} 109 # (nay-vanshnite skobi {} sa izlishni). todo: tova e krapka! 110 rdotxt <- paste0(as.character(rdo, deparse = deparse), collapse="") 111 rdotxt <- gsub("\\\\href\\{(\\{[^{}]*\\}\\{[^}]*\\}+)\\}", "\\\\href\\1", rdotxt) 112 113 # todo: krapka; \code{\{} becomes \code{{} which wrecks havoc for parse_Rd; \code{\}} 114 rdotxt <- gsub("(\\\\code\\{)(\\{|\\})(\\})", "\\1\\\\\\2\\3", rdotxt) 115 116 tfn <- tempfile() # use a temporary file in case file and srcfile are the same 117 on.exit(unlink(tfn)) 118 if(is.character(srcfile)){ 119 # 2018-02-07 removed the following, since redundant (see above): 120 # tfn <- tempfile() 121 # 2018-02-07 (removed the assignment) was: 122 # res <- capture.output(cat(rdotxt, sep = "", collapse = ""), 123 # file = tfn)# writes to tfn 124 # but res is re-assigned below without being used. 125 # Also, dropping capture.output() and moving 'file =' to cat() 126 cat(rdotxt, sep = "", collapse = "", file = tfn) 127 128 rdocur <- permissive_parse_Rd(tfn) # to set srcref 129 srcrefpos <- .srcrefpos(rdocur, rdoorig, unchanged_sec) 130 131 rdotxt <- rdo_text_restore(rdocur, rdoorig, srcrefpos, file = tfn) 132 133 nc_ind <- Rdo_which_tag_in(rdoorig, c("\\newcommand", "\\renewcommand")) 134 if(length(nc_ind) > 0){ 135 nclines <- sapply(nc_ind, function(x) as.character(attr(rdoorig[[x]],"srcref"))) 136 rdotxt <- c(nclines, rdotxt) # put before anything else todo: could try to put at 137 } # original place or at least after any comments? 138 139 writeLines(rdotxt, tfn) #overwrites tfn 140 141 res <- if(is.null(file)) 142 paste0(rdotxt, collapse = "\n") 143 else{ 144 file.copy(tfn, file, overwrite = TRUE) # todo: check success 145 NULL # for clarity; capture.output above set it to NULL as tfn is not NULL 146 } 147 }else 148 ## 2012-10-14 res <- capture.output(cat(rdotxt, sep = "", collapse = ""), file = file) 149 ## 2018-02-07 was: 150 ## res <- capture.output(cat(rdotxt, sep = "", collapse = "", file = file)) 151 ## restoring the syntax from 2012, since it works also in the case file = NULL; 152 ## 153 res <- capture.output(cat(rdotxt, sep = "", collapse = ""), file = file) 154 155 if(is.null(file)) 156 res 157 else{ 158 cat("\tThe Rd content was written to file ", file, "\n") 159 invisible(res) # res is NULL here 160 } 161} 162 163.tmp_pos <- function(name, pos_list){ 164 for(elem in pos_list) 165 if(elem$title == name) 166 return(elem$pos) 167 NULL 168} 169 170.rdo_srcref <- function(rdo, tag){ # todo: special cases! 171 pos <- Rdo_which_tag_eq(rdo, tag) 172 attr(rdo[[ pos[1] ]], "srcref") 173} 174 175.rdo_replace_at <- function(text, pospair){ 176 newtext <- as.character(pospair[[2]]) 177 m <- length(pospair[[1]]) 178 179 beg_line <- pospair[[1]][1] 180 beg_col <- if(m > 4) pospair[[1]][5] else pospair[[1]][2] 181 182 end_line <- pospair[[1]][3] 183 end_col <- if(m > 4) pospair[[1]][6] else pospair[[1]][4] 184 185 res <- c(text[seq_len(beg_line - 1)], 186 if(beg_col > 1) paste0(substr(text[beg_line], 1, beg_col - 1), newtext[1]) 187 else newtext[1], 188 newtext[-1] ) 189 190 le <- nchar(text[end_line]) # 2012-10-13 was: length(text[end_line]) (!?) 191 if(end_col < le) 192 res[length(res)] <- paste0(res[length(res)], substr(text[end_line], end_col + 1, le)) 193 194 c(res, text[-(1:end_line)]) 195} 196 197 # 2012-10-13 dobavyam 'ends' po-dolu, sluchva se sections da ne zapochvat na nov red! 198 # vzh. NumericConstants.Rd v base ( stava: \note{dummy} \seealso{dummy} ) 199rdo_text_restore <- function(cur, orig, pos_list, file){ 200 res <- readLines(file) 201 if(length(pos_list) == 1){ 202 res <- .rdo_replace_at(res, pos_list[[1]]) 203 }else{ 204 starts <- sapply(pos_list, function(x) x[[1]][[1]]) 205 ends <- sapply(pos_list, 206 function(x) if(length(x[[1]]) > 4) x[[1]][5] else x[[1]][2] ) 207 p <- order(starts, ends, decreasing = TRUE) 208 209 dec_pos_list <- pos_list[p] 210 for(pos in dec_pos_list) 211 res <- .rdo_replace_at(res, pos) 212 } 213 res 214} 215 216.without_duplicates <- function(x){ 217 x[!(x %in% unique(x[duplicated(x)]))] 218} 219