Attachment 'moinFuncs.R'
Download 1 #' Escape WikiWords in \special{MoinMoin} Markup
2 #'
3 #' Words with MoinMoin would convert to page links are escaped by adding a leading exclamation mark.
4 #' @param x a character vector.
5 #' @keywords internal
6 #' @return WikiWords in x are escaped as !WikiWords. WikiWords within markup such as `WikiWord`, [[WikiWord]] and [[ ParentPage/WikiWord | WikiWord ]] are not escaped.
7 #' @examples
8 #' escapeThese <- "WikiWord, WikiWikiWord and _ThisOneToo"
9 #' escWw(escapeThese)
10 #' notThese <- "`NotThisOne`, [[NotThisTwo]], [[ NorThese |LabelMe ]]"
11 #' escWw(escapeThese)
12 #' # vector input
13 #' escWw(c(a="WikiWord", b="`NotThis`"))
14 escWw <- function(x) { # escape WikiWords with exclamation mark
15 Ww <- "([[:upper:]]{1}([[:lower:][:digit:]]){1,}){2,}"
16 pattern <- gsub("Ww", Ww,"(*UCP)(\\b|_)(Ww)(?>\\b|_)", perl = TRUE)
17 x <- gsub(pattern, "\\1\1\\2", x, perl = TRUE) #insert marker before Ww
18 x <- gsub("!\1", "!", x, perl = TRUE) # already escaped, remove marker
19 pattern <- "(?<=`)(.*?)\1(?=.*?`)" # in literal, remove marker
20 while (length(grep(pattern, x, perl = TRUE))) {
21 x <- gsub(pattern, "\\1", x, perl = TRUE)
22 }
23 pattern <- "(?<=\\[\\[)(.*?)\1(?=.*?]])" # in link, remove marker
24 while (length(grep(pattern, x, perl = TRUE))) {
25 x <- gsub(pattern, "\\1", x, perl = TRUE)
26 }
27 gsub("\1", "!", x, perl = TRUE) # convert marker to escape
28 }
29
30
31 #' Obfuscate Email Addresses
32 #'
33 #' Obfuscate email address to be used in the \special{MoinMon} macro \code{<<MailTo()>>} as a spam minimisation strategy.
34 #' @param x a character vector.
35 #' @param reverse logical: if \code{TRUE} the obfuscation process is reversed.
36 #' @keywords internal
37 #' @return An email address of "user-name@host.net" is obfuscated as "u s e r DASH n a m e AT h o s t DOT n e t".
38 #' @examples
39 #' obfuscate("email.recipient@gmail.com")
40 #' # reversable
41 #' obfuscate(obfuscate("email.recipient@gmail.com"), reverse = TRUE)
42 #' # vector input
43 #' obfuscate(list(a="joe.blogs@bloggers.net", b="no-reply@localhost"))
44 obfuscate <- function(x, reverse = FALSE) {
45 do <- function(x) {
46 x <- paste0(unlist(strsplit(x, "")), collapse = "\u00a0")
47 x <- gsub("@", "AT", x)
48 x <- gsub('\\.', "DOT", x)
49 gsub('-', "DASH", x)
50 }
51 undo <- function(x) {
52 x <- gsub("AT", "@", x)
53 x <- gsub("DOT", '.', x)
54 x <- gsub("DASH", '-', x)
55 gsub(" |\u00a0", "", x)
56 }
57 USE.NAME <- !is.null(names(x))
58 if (reverse) vapply(x, undo, "", USE.NAMES = USE.NAME)
59 else vapply(x, do, "", USE.NAMES = USE.NAME)
60 }
61
62 # MoinMoin Markup constants
63 Objects0 <- ls(all.names = TRUE, pattern = "^[.]")
64 .space <- " "
65 .heading <- "="
66 .italic <- "''"
67 .bold <- "'''"
68 .monospace <- "`"
69 .underline <- "__"
70 .superscript <- "^"
71 .subscript <- ",,"
72 .smallerOpen <- "~-"
73 .smallerClose <- "-~"
74 .smaller <- c(.smallerOpen, .smallerClose)
75 .largerOpen <- "~+"
76 .largerClose <- "+~"
77 .larger <- c(.largerOpen, .largerClose)
78 .stroke <- "--"
79 .linkOpen <- "[["
80 .linkClose <- "]]"
81 .link <- c(.linkOpen, .linkClose)
82 .linkSep <- "|"
83 .linkEsc <- "!"
84 .linkAttachOpen <- "[[attachment:"
85 .linkAttach <- c(.linkAttachOpen, .linkClose)
86 .itemBullet <- " * "
87 .itemNumeric <- " 1. "
88 .itemNumberOpen <- .space
89 .itemNumberClose <- ". "
90 .itemNumber <- c(.space, .itemNumberClose)
91 .itemNone <- " . "
92 .itemLabelOpen <- .space
93 .itemLabelClose <- ":: "
94 .itemLabel <- c(.space, .itemLabelClose)
95 .indent <- .space
96 .hozline <- "-"
97 .hozlineBase <- "---"
98 .newline <- .break <- "<<BR>>"
99 .mailToOpen <- "<<MailTo("
100 .mailToClose <- ")>>"
101 .mailTo <- c(.mailToOpen, .mailToClose)
102 .rowOpen <- "|| "
103 .rowClose <- " ||\n"
104 .rowSep <- " || "
105 .tabRow <- c(.rowOpen, .rowClose)
106 .codeOpen <- "{{{"
107 .codeClose <- "}}}"
108 .code <- c(.codeOpen, .codeClose)
109 .commentOpen <- "/* "
110 .commentClose <- " */"
111 .comment <- c(.commentOpen, .commentClose)
112 .blockClose <- "\n}}}"
113 .codeBlockOpen <- "{{{#!highlight r\n"
114 .codeBlock <- c(.codeBlockOpen, .blockClose)
115 .verbBlockOpen <- "{{{\n"
116 .verbBlock <- c(.verbBlockOpen, .blockClose)
117 .commentBlockOpen <- "{{{#!wiki comment\n"
118 .commentBlock <- c(.commentBlockOpen, .blockClose)
119 Objects <- ls(all.names = TRUE, pattern = "^[.]")
120 markupConstants <- Objects[!Objects %in% Objects0]
121 remove(Objects0) ; remove(Objects)
122
123 #' Apply \special{MoinMoin} Markup
124 #'
125 #' @param x a character vector to which markup is to be applied. For some markup types \code{x} may need to be named. For some markup, x is not not required, so it does not need to be provided, but if it is, then it is ignored (no error is generated).
126 #' @param type a string specifing the type of markup to be applied. Not specifying a recognised markup is ignored and \code{x} return unchanged.
127 #' @param level integer specifing heading level, list item number, depth of indenting, or horizontal line weight. If not needed, this paramater is ignored (no error is generated).
128 #' @keywords internal
129 #' @return \code{x} is return with selected markup applied.
130 #' @examples
131 #' markup("Introduction", "heading", 2)
132 #' markup(, "newline")
133 #' markup(, "hozline", 4)
134 #' link <- setNames("abc.net.au/news", "oz news")
135 #' markup(link, "linkNamed")
136 markup <- function(x = "", type = "", level = 1L) {
137
138 if (is.null(x)) stop("markup cannot be applied to NULL")
139
140 if (type %in% markupConstants) return(eval(as.name(type)))
141
142 fcodes <- c(l = "",
143 c = "<style=\"text-align: center;\">",
144 r = "<style=\"text-align: right;\">")
145
146 # from 'local' package:
147 # x %w% y wrap as y[1].x.y[2]; x %p% y paste as x.y
148
149 if (type != "table") {
150 x <- x[1] # no vectors
151 if (is.null(names(x))) names(x) <- ""
152 if (as.integer(level) <= 0L) level <- 1L
153 switch(type,
154 "heading" =
155 x %w% .indent %w% strrep(.heading, level),
156 "italic" =
157 x %w% .italic,
158 "bold" =
159 x %w% .bold,
160 "monospace" =
161 x %w% .monospace,
162 "underline" =
163 x %w% .underline,
164 "superscript" =
165 x %w% .superscript,
166 "subscript" =
167 x %w% .subscript,
168 "smaller" =
169 x %w% .smaller,
170 "larger" =
171 x %w% .larger,
172 "stroke" =
173 x %w% .stroke,
174 "link" =
175 x %w% .link,
176 "linkNamed" =
177 .linkSep %w% c(x, names(x)) %w% .link,
178 "linkAttach" =
179 x %w% .linkAttach,
180 "linkAttachNamed" =
181 .linkSep %w% c(x, names(x)) %w% .linkAttach,
182 "linkEsc" =
183 .linkEsc %p% x,
184 "itemBullet" =
185 .itemBullet %p% x,
186 "itemNumeric" =
187 .itemNumeric %p% x,
188 "itemNumber" =
189 as.integer(level) %w% .itemNumber %p% x,
190 "itemNone" =
191 .itemNone %p% x ,
192 "itemLabel" =
193 names(x) %w% .itemLabel %p% x,
194 "indent" =
195 strrep(.indent, level) %p% x,
196 "hozline" =
197 .hozlineBase %p% strrep(.hozline, level),
198 "newline" =
199 .newline,
200 "mailTo" =
201 obfuscate(x) %w% .mailTo,
202 "code" =
203 x %w% .code,
204 "comment" =
205 x %w% .comment,
206 "codeBlock" =
207 x %w% .codeBlock,
208 "verbBlock" =
209 x %w% .verbBlock,
210 "commentBlock" =
211 x %w% .commentBlock,
212 return(x) # if not recognised, do nothing
213 )
214 } else {
215 local::as.object(dim(x), rows, cols, envir = environment())
216 x <- vapply(2L:rows, function(r)
217 fcodes[x[1L,]] %p% x[r,], x[1L,])
218 rows <- rows - 1L
219 x <- matrix(x, rows, cols, byrow = TRUE)
220 vapply(1L:rows, function(r)
221 paste0(x[r,], collapse = .rowSep) %w% .tabRow, "")
222 }
223 }
You are not allowed to attach a file to this page.