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
|
#' Escape HTML entities
#'
#' Escape HTML entities contained in a character vector so that it can be safely
#' included as text or an attribute value within an HTML document
#'
#' @param text Text to escape
#' @param attribute Escape for use as an attribute value
#'
#' @return Character vector with escaped text.
#'
#' @export
htmlEscape <- local({
.htmlSpecials <- list(
`&` = '&',
`<` = '<',
`>` = '>'
)
.htmlSpecialsPattern <- paste(names(.htmlSpecials), collapse='|')
.htmlSpecialsAttrib <- c(
.htmlSpecials,
`'` = ''',
`"` = '"',
`\r` = ' ',
`\n` = ' '
)
.htmlSpecialsPatternAttrib <- paste(names(.htmlSpecialsAttrib), collapse='|')
function(text, attribute=FALSE) {
pattern <- if(attribute)
.htmlSpecialsPatternAttrib
else
.htmlSpecialsPattern
text <- enc2utf8(as.character(text))
# Short circuit in the common case that there's nothing to escape
if (!any(grepl(pattern, text, useBytes = TRUE)))
return(text)
specials <- if(attribute)
.htmlSpecialsAttrib
else
.htmlSpecials
for (chr in names(specials)) {
text <- gsub(chr, specials[[chr]], text, fixed = TRUE, useBytes = TRUE)
}
Encoding(text) <- "UTF-8"
return(text)
}
})
|
