1
|
|
###########################################################################/**
|
2
|
|
# @RdocClass RspDirective
|
3
|
|
#
|
4
|
|
# @title "The abstract RspDirective class"
|
5
|
|
#
|
6
|
|
# \description{
|
7
|
|
# @classhierarchy
|
8
|
|
#
|
9
|
|
# An RspDirective is an @see "RspConstruct" that represents an
|
10
|
|
# RSP preprocessing directive of format \code{<\%@ ... \%>}.
|
11
|
|
# The directive is independent of the underlying programming language.
|
12
|
|
# }
|
13
|
|
#
|
14
|
|
# @synopsis
|
15
|
|
#
|
16
|
|
# \arguments{
|
17
|
|
# \item{value}{A @character string.}
|
18
|
|
# \item{...}{Arguments passed to the constructor of @see "RspConstruct".}
|
19
|
|
# }
|
20
|
|
#
|
21
|
|
# \section{Fields and Methods}{
|
22
|
|
# @allmethods
|
23
|
|
# }
|
24
|
|
#
|
25
|
|
# @author
|
26
|
|
#
|
27
|
|
# @keyword internal
|
28
|
|
#*/###########################################################################
|
29
|
|
setConstructorS3("RspDirective", function(value=character(), ...) {
|
30
|
1
|
extend(RspConstruct(value, ...), "RspDirective")
|
31
|
|
})
|
32
|
|
|
33
|
|
|
34
|
|
#########################################################################/**
|
35
|
|
# @RdocMethod "requireAttributes"
|
36
|
|
#
|
37
|
|
# @title "Asserts that certain attributes exist"
|
38
|
|
#
|
39
|
|
# \description{
|
40
|
|
# @get "title".
|
41
|
|
# }
|
42
|
|
#
|
43
|
|
# @synopsis
|
44
|
|
#
|
45
|
|
# \arguments{
|
46
|
|
# \item{condition}{A @character specifying the condition to be tested.}
|
47
|
|
# \item{...}{Not used.}
|
48
|
|
# }
|
49
|
|
#
|
50
|
|
# \value{
|
51
|
|
# Returns itself (invisibly).
|
52
|
|
# }
|
53
|
|
#
|
54
|
|
# @author
|
55
|
|
#
|
56
|
|
# \seealso{
|
57
|
|
# @seeclass
|
58
|
|
# }
|
59
|
|
#*/#########################################################################
|
60
|
|
setMethodS3("requireAttributes", "RspDirective", function(this, names, condition=c("all", "any"), ...) {
|
61
|
|
# Argument 'condition':
|
62
|
1
|
condition <- match.arg(condition)
|
63
|
|
|
64
|
1
|
attrs <- getAttributes(this)
|
65
|
1
|
ok <- is.element(names, names(attrs))
|
66
|
|
|
67
|
1
|
if (condition == "all") {
|
68
|
1
|
if (!all(ok)) {
|
69
|
0
|
throw(RspPreprocessingException(sprintf("One or more required attributes (%s) are missing", paste(sQuote(names[!ok]), collapse=", ")), item=this))
|
70
|
|
}
|
71
|
0
|
} else if (condition == "any") {
|
72
|
0
|
if (!any(ok)) {
|
73
|
0
|
throw(RspPreprocessingException(sprintf("At least one of the required attributes (%s) must be given", paste(sQuote(names[!ok]), collapse=", ")), item=this))
|
74
|
|
}
|
75
|
|
}
|
76
|
|
|
77
|
1
|
invisible(this)
|
78
|
|
}, protected=TRUE)
|
79
|
|
|
80
|
|
|
81
|
|
setMethodS3("getNameContentDefaultAttributes", "RspDirective", function(item, known=NULL, doc=NULL, ...) {
|
82
|
1
|
name <- getAttribute(item, "name")
|
83
|
1
|
content <- getAttribute(item, "content")
|
84
|
1
|
default <- getAttribute(item, "default")
|
85
|
1
|
file <- getAttribute(item, "file")
|
86
|
|
|
87
|
|
# Was directive given in short format <@<directive> file="<content>">?
|
88
|
1
|
if (is.null(name) && is.null(content) && !is.null(file)) {
|
89
|
0
|
name <- "file"
|
90
|
0
|
content <- file
|
91
|
0
|
file <- NULL
|
92
|
|
}
|
93
|
|
|
94
|
|
# Was directive given in short format <@<directive> <name>="<content>">?
|
95
|
1
|
if (is.null(name) && is.null(content)) {
|
96
|
1
|
attrs <- getAttributes(item)
|
97
|
1
|
names <- setdiff(names(attrs), c("file", "default", known))
|
98
|
1
|
if (length(names) == 0L) {
|
99
|
0
|
throw(RspPreprocessingException("At least one of attributes 'name' and 'content' must be given", item=item))
|
100
|
|
}
|
101
|
1
|
name <- names[1L]
|
102
|
1
|
content <- attrs[[name]]
|
103
|
0
|
if (length(content) > 1L) content <- paste(content, collapse="")
|
104
|
|
}
|
105
|
|
|
106
|
|
# Was directive given with 'file' attribute?
|
107
|
1
|
if (!is.null(file) && !is.null(doc)) {
|
108
|
0
|
path <- getPath(doc)
|
109
|
0
|
if (!is.null(path)) {
|
110
|
0
|
pathname <- file.path(getPath(doc), file)
|
111
|
|
} else {
|
112
|
0
|
pathname <- file
|
113
|
|
}
|
114
|
|
# Sanity check
|
115
|
0
|
stop_if_not(!is.null(pathname))
|
116
|
0
|
content <- .readText(pathname)
|
117
|
|
}
|
118
|
|
|
119
|
|
## Sanity check
|
120
|
1
|
stop_if_not(is.null(content) || length(content) == 1L)
|
121
|
|
|
122
|
|
# Use default?
|
123
|
1
|
if (!is.null(content) && (is.na(content) || content == "NA")) {
|
124
|
1
|
value <- default
|
125
|
|
} else {
|
126
|
1
|
value <- content
|
127
|
|
}
|
128
|
|
|
129
|
1
|
list(name=name, value=value, content=content, file=file, default=default)
|
130
|
|
}, protected=TRUE) # getNameContentDefaultAttributes()
|
131
|
|
|
132
|
|
|
133
|
|
setMethodS3("asRspString", "RspDirective", function(object, ...) {
|
134
|
1
|
body <- unclass(object)
|
135
|
1
|
attrs <- getAttributes(object)
|
136
|
1
|
if (length(attrs) == 0L) {
|
137
|
1
|
attrs <- ""
|
138
|
|
} else {
|
139
|
1
|
attrs <- sprintf('%s="%s"', names(attrs), attrs)
|
140
|
1
|
attrs <- paste(c("", attrs), collapse=" ")
|
141
|
|
}
|
142
|
|
|
143
|
1
|
comment <- getComment(object)
|
144
|
1
|
if (length(comment) == 0L) {
|
145
|
1
|
comment <- ""
|
146
|
|
} else {
|
147
|
1
|
comment <- sprintf(" #%s", comment)
|
148
|
|
}
|
149
|
1
|
suffixSpecs <- attr(object, "suffixSpecs")
|
150
|
1
|
if (length(suffixSpecs) == 0L) {
|
151
|
1
|
suffixSpecs <- ""
|
152
|
|
}
|
153
|
1
|
fmtstr <- "@%s%s%s%s"
|
154
|
1
|
fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
|
155
|
1
|
s <- sprintf(fmtstr, body, attrs, comment, suffixSpecs)
|
156
|
1
|
RspString(s)
|
157
|
|
})
|
158
|
|
|
159
|
|
|
160
|
|
|
161
|
|
###########################################################################/**
|
162
|
|
# @RdocClass RspUnparsedDirective
|
163
|
|
#
|
164
|
|
# @title "The RspUnparsedDirective class"
|
165
|
|
#
|
166
|
|
# \description{
|
167
|
|
# @classhierarchy
|
168
|
|
#
|
169
|
|
# An RspUnparsedDirective is an @see RspDirective that still has not
|
170
|
|
# been parsed for its class and content. After @see "parse":ing such
|
171
|
|
# an object, the class of this RSP directive will be known.
|
172
|
|
# }
|
173
|
|
#
|
174
|
|
# @synopsis
|
175
|
|
#
|
176
|
|
# \arguments{
|
177
|
|
# \item{value}{A @character string.}
|
178
|
|
# \item{...}{Arguments passed to @see "RspDirective".}
|
179
|
|
# }
|
180
|
|
#
|
181
|
|
# \section{Fields and Methods}{
|
182
|
|
# @allmethods
|
183
|
|
# }
|
184
|
|
#
|
185
|
|
# @author
|
186
|
|
#
|
187
|
|
# @keyword internal
|
188
|
|
#*/###########################################################################
|
189
|
|
setConstructorS3("RspUnparsedDirective", function(value="unparsed", ...) {
|
190
|
1
|
extend(RspDirective(value, ...), "RspUnparsedDirective")
|
191
|
|
})
|
192
|
|
|
193
|
|
|
194
|
|
|
195
|
|
#########################################################################/**
|
196
|
|
# @RdocMethod parseDirective
|
197
|
|
#
|
198
|
|
# @title "Parses the unknown RSP directive for its class"
|
199
|
|
#
|
200
|
|
# \description{
|
201
|
|
# @get "title".
|
202
|
|
# }
|
203
|
|
#
|
204
|
|
# @synopsis
|
205
|
|
#
|
206
|
|
# \arguments{
|
207
|
|
# \item{...}{Not used.}
|
208
|
|
# }
|
209
|
|
#
|
210
|
|
# \value{
|
211
|
|
# Returns an @see "RspDirective" of known class.
|
212
|
|
# }
|
213
|
|
#
|
214
|
|
# @author
|
215
|
|
#
|
216
|
|
# \seealso{
|
217
|
|
# @seeclass
|
218
|
|
# }
|
219
|
|
#*/#########################################################################
|
220
|
|
setMethodS3("parseDirective", "RspUnparsedDirective", function(expr, ...) {
|
221
|
|
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
222
|
|
# Local function
|
223
|
|
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
224
|
1
|
parseAttributes <- function(rspCode, known=mandatory, mandatory=NULL, ...) {
|
225
|
1
|
bfr <- rspCode
|
226
|
|
|
227
|
|
# Argument 'known':
|
228
|
1
|
known <- unique(union(known, mandatory))
|
229
|
|
|
230
|
|
# Remove all leading white spaces
|
231
|
1
|
pos <- regexpr("^[ \t\n\r]+", bfr)
|
232
|
1
|
len <- attr(pos, "match.length")
|
233
|
1
|
bfr <- substring(bfr, first=len+1L)
|
234
|
|
|
235
|
1
|
attrs <- list()
|
236
|
1
|
if (nchar(bfr) > 0L) {
|
237
|
|
# Add a white space
|
238
|
1
|
bfr <- paste(" ", bfr, sep="")
|
239
|
1
|
while (nchar(bfr) > 0L) {
|
240
|
|
# Read all (mandatory) white spaces
|
241
|
1
|
pos <- regexpr("^[ \t\n\r]+", bfr)
|
242
|
1
|
if (pos == -1L) {
|
243
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected white space: ", code=sQuote(rspCode)))
|
244
|
|
}
|
245
|
1
|
len <- attr(pos, "match.length")
|
246
|
1
|
bfr <- substring(bfr, first=len+1L)
|
247
|
|
|
248
|
|
# Nothing left?
|
249
|
1
|
if (nchar(bfr) == 0L) {
|
250
|
0
|
break
|
251
|
|
}
|
252
|
|
|
253
|
|
# Is the remaining part a comment?
|
254
|
1
|
if (regexpr("^#", bfr) != -1L) {
|
255
|
|
# ...then add it as an (R) attribute to 'attrs'.
|
256
|
1
|
comment <- gsub("^#", "", bfr)
|
257
|
1
|
attr(attrs, "comment") <- comment
|
258
|
|
# ...and finish.
|
259
|
1
|
break
|
260
|
|
}
|
261
|
|
|
262
|
|
# Read the attribute name
|
263
|
1
|
pos <- regexpr("^[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_][abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9_]*", bfr)
|
264
|
1
|
if (pos == -1L) {
|
265
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected an attribute name: ", code=sQuote(rspCode)))
|
266
|
|
}
|
267
|
1
|
len <- attr(pos, "match.length")
|
268
|
1
|
name <- substring(bfr, first=1L, last=len)
|
269
|
1
|
bfr <- substring(bfr, first=len+1L)
|
270
|
|
|
271
|
|
# Read the '=' with optional white spaces around it
|
272
|
1
|
pos <- regexpr("^[ \t\n\r]*=[ \t\n\r]*", bfr)
|
273
|
1
|
if (pos == -1L) {
|
274
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected an equal sign: ", code=sQuote(rspCode)))
|
275
|
|
}
|
276
|
1
|
len <- attr(pos, "match.length")
|
277
|
1
|
bfr <- substring(bfr, first=len+1L)
|
278
|
|
|
279
|
|
# Work with a raw buffer
|
280
|
1
|
bfrR <- charToRaw(bfr)
|
281
|
|
|
282
|
|
# Read the value with mandatory brackets around it
|
283
|
|
# (a) Identify the bracket symbols
|
284
|
1
|
lbracketR <- bfrR[1L]
|
285
|
1
|
lbracket <- rawToChar(lbracketR)
|
286
|
1
|
rbracket <- c("{"="}", "("=")", "["="]", "<"=">")[lbracket]
|
287
|
|
|
288
|
|
# (b) Single brackets or paired ones?
|
289
|
1
|
if (is.na(rbracket)) {
|
290
|
|
# (i) Single, e.g. '...', "...", @...@ etc.
|
291
|
1
|
bfrR <- bfrR[-1L]
|
292
|
1
|
wbracket <- 1L
|
293
|
|
|
294
|
|
# Find first non-escape symbol
|
295
|
1
|
pos <- which(bfrR == lbracketR)
|
296
|
|
|
297
|
|
# Failed to locate a string enclosed in quotation marks
|
298
|
1
|
if (length(pos) == 0L) {
|
299
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected an attribute value within quotation marks: ", code=sQuote(rspCode)))
|
300
|
|
}
|
301
|
|
|
302
|
|
# An empty value?
|
303
|
1
|
if (pos[1L] == 1L) {
|
304
|
1
|
value <- ""
|
305
|
|
} else {
|
306
|
|
# Drop escaped brackets
|
307
|
1
|
keep <- (bfrR[pos-1L] != charToRaw("\\"))
|
308
|
1
|
pos <- pos[keep]
|
309
|
|
# Failed to locate a string enclosed in quotation marks
|
310
|
1
|
if (length(pos) == 0L) {
|
311
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected an attribute value within quotation marks: ", code=sQuote(rspCode)))
|
312
|
|
}
|
313
|
1
|
pos <- pos[1L]
|
314
|
1
|
bfrR <- bfrR[1:(pos-1)]
|
315
|
1
|
value <- rawToChar(bfrR)
|
316
|
|
}
|
317
|
|
|
318
|
|
# Record brackets
|
319
|
1
|
brackets <- c(lbracket, lbracket)
|
320
|
|
|
321
|
|
# Update buffer
|
322
|
1
|
bfr <- substring(bfr, first=pos+2L)
|
323
|
|
} else {
|
324
|
|
# (ii) Paired brackets, e.g. {...}, [...], <<...>>
|
325
|
|
|
326
|
|
# Width of left bracket, i.e. how many symbols?
|
327
|
1
|
for (wbracket in seq_len(nchar(bfr))) {
|
328
|
1
|
ch <- substring(bfr, first=wbracket, last=wbracket)
|
329
|
1
|
if (ch != lbracket) {
|
330
|
1
|
wbracket <- wbracket - 1L
|
331
|
1
|
break
|
332
|
|
}
|
333
|
|
}
|
334
|
1
|
bfr <- substring(bfr, first=wbracket+1L)
|
335
|
|
|
336
|
|
# (c) Identify right bracket symbol (escaped for regexpr)
|
337
|
1
|
rbracket <- c("{"="\\}", "("="\\)", "["="\\]", "<"=">",
|
338
|
1
|
"+"="\\+", "."="\\.", "?"="\\?", "|"="\\|")[lbracket]
|
339
|
0
|
if (is.na(rbracket)) rbracket <- lbracket
|
340
|
|
|
341
|
|
# Right bracket sequence
|
342
|
1
|
rbrackets <- paste(rep(rbracket, times=wbracket), collapse="")
|
343
|
|
# .*? is a non-greedy .* expression
|
344
|
1
|
pattern <- sprintf("^(.*?)([^\\]?)%s", rbrackets)
|
345
|
1
|
pos <- regexpr(pattern, bfr)
|
346
|
|
|
347
|
|
# Failed to locate a string enclosed in brackets
|
348
|
1
|
if (pos == -1L) {
|
349
|
0
|
throw(Exception("Error when parsing attributes of RSP preprocessing directive. Expected a attribute value within brackets: ", code=sQuote(rspCode)))
|
350
|
|
}
|
351
|
|
|
352
|
|
# Extract value
|
353
|
1
|
len <- attr(pos, "match.length")
|
354
|
1
|
value <- substring(bfr, first=1L, last=len-wbracket)
|
355
|
|
|
356
|
|
# Record brackets
|
357
|
1
|
lbrackets <- paste(rep(lbracket, times=wbracket), collapse="")
|
358
|
1
|
rbrackets <- gsub("\\\\", "\\", rbrackets)
|
359
|
1
|
brackets <- c(lbrackets, rbrackets)
|
360
|
|
|
361
|
|
# Consume buffer
|
362
|
1
|
bfr <- substring(bfr, first=len+wbracket)
|
363
|
1
|
} # if (is.na(rbracket))
|
364
|
|
|
365
|
|
# Set the name of the value
|
366
|
1
|
names(value) <- name
|
367
|
|
|
368
|
|
# TODO: Record brackets used
|
369
|
|
# ...
|
370
|
|
|
371
|
1
|
attrs <- c(attrs, value)
|
372
|
|
}
|
373
|
1
|
} # if (nchar(bfr) > 0L)
|
374
|
|
|
375
|
|
# Check for duplicated attributes
|
376
|
1
|
if (length(names(attrs)) != length(unique(names(attrs))))
|
377
|
0
|
throw(Exception("Duplicated attributes in RSP preprocessing directive.", code=sQuote(rspCode)))
|
378
|
|
|
379
|
|
# Check for unknown attributes
|
380
|
1
|
if (!is.null(known)) {
|
381
|
0
|
nok <- which(is.na(match(names(attrs), known)))
|
382
|
0
|
if (length(nok) > 0L) {
|
383
|
0
|
nok <- paste("'", names(attrs)[nok], "'", collapse=", ", sep="")
|
384
|
0
|
throw(Exception("Unknown attribute(s) in RSP preprocessing directive: ", nok, code=sQuote(rspCode)))
|
385
|
|
}
|
386
|
|
}
|
387
|
|
|
388
|
|
# Check for missing mandatory attributes
|
389
|
1
|
if (!is.null(mandatory)) {
|
390
|
0
|
nok <- which(is.na(match(mandatory, names(attrs))))
|
391
|
0
|
if (length(nok) > 0L) {
|
392
|
0
|
nok <- paste("'", mandatory[nok], "'", collapse=", ", sep="")
|
393
|
0
|
throw(Exception("Missing attribute(s) in RSP preprocessing directive: ", nok, code=sQuote(rspCode)))
|
394
|
|
}
|
395
|
|
}
|
396
|
|
|
397
|
|
# Return parsed attributes.
|
398
|
1
|
attrs
|
399
|
1
|
} # parseAttributes()
|
400
|
|
|
401
|
|
|
402
|
1
|
body <- expr
|
403
|
|
|
404
|
1
|
pattern <- "^[ ]*([abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ][abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9]*)([ \t\n\r]+(.*))*"
|
405
|
|
|
406
|
|
# Sanity check
|
407
|
1
|
if (regexpr(pattern, body) == -1L) {
|
408
|
0
|
throw("Not an RSP preprocessing directive: ", body)
|
409
|
|
}
|
410
|
|
|
411
|
|
# <%@foo attr1="bar" attr2="geek"%> => ...
|
412
|
1
|
directive <- gsub(pattern, "\\1", body)
|
413
|
1
|
directive <- tolower(directive)
|
414
|
|
|
415
|
|
# Parse the attributes
|
416
|
1
|
attrs <- gsub(pattern, "\\2", body)
|
417
|
1
|
attrs <- parseAttributes(attrs, known=NULL)
|
418
|
1
|
comment <- attr(attrs, "comment")
|
419
|
|
|
420
|
|
# Infer the class name
|
421
|
1
|
className <- sprintf("Rsp%sDirective", capitalize(directive))
|
422
|
|
|
423
|
|
# Get constructor
|
424
|
1
|
clazz <- tryCatch({
|
425
|
1
|
ns <- getNamespace("R.rsp")
|
426
|
1
|
Class$forName(className, envir=ns)
|
427
|
1
|
}, error = function(ex) {
|
428
|
1
|
NULL
|
429
|
|
})
|
430
|
|
|
431
|
|
# Instantiate object
|
432
|
1
|
if (!is.null(clazz)) {
|
433
|
1
|
res <- newInstance(clazz, attrs=attrs, comment=comment)
|
434
|
|
} else {
|
435
|
1
|
res <- RspUnknownDirective(directive, attrs=attrs)
|
436
|
|
}
|
437
|
|
|
438
|
|
# Preserve attributes
|
439
|
1
|
attr(res, "suffixSpecs") <- attr(expr, "suffixSpecs")
|
440
|
|
|
441
|
1
|
res
|
442
|
|
})
|
443
|
|
|
444
|
|
|
445
|
|
setMethodS3("asRspString", "RspUnparsedDirective", function(object, ...) {
|
446
|
1
|
body <- unclass(object)
|
447
|
1
|
suffixSpecs <- attr(object, "suffixSpecs")
|
448
|
1
|
fmtstr <- "@%s%s"
|
449
|
1
|
fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
|
450
|
1
|
s <- sprintf(fmtstr, body, suffixSpecs)
|
451
|
1
|
RspString(s)
|
452
|
|
})
|
453
|
|
|
454
|
|
|
455
|
|
|
456
|
|
###########################################################################/**
|
457
|
|
# @RdocClass RspIncludeDirective
|
458
|
|
#
|
459
|
|
# @title "The RspIncludeDirective class"
|
460
|
|
#
|
461
|
|
# \description{
|
462
|
|
# @classhierarchy
|
463
|
|
#
|
464
|
|
# An RspIncludeDirective is an @see "RspDirective" that causes the
|
465
|
|
# RSP parser to include (and parse) an external RSP file.
|
466
|
|
# }
|
467
|
|
#
|
468
|
|
# @synopsis
|
469
|
|
#
|
470
|
|
# \arguments{
|
471
|
|
# \item{value}{A @character string.}
|
472
|
|
# \item{attributes}{A named @list, which must contain either
|
473
|
|
# a 'file' or a 'text' element.}
|
474
|
|
# \item{...}{Optional arguments passed to the constructor
|
475
|
|
# of @see "RspDirective".}
|
476
|
|
# }
|
477
|
|
#
|
478
|
|
# \section{Fields and Methods}{
|
479
|
|
# @allmethods
|
480
|
|
# }
|
481
|
|
#
|
482
|
|
# @author
|
483
|
|
#
|
484
|
|
# @keyword internal
|
485
|
|
#*/###########################################################################
|
486
|
|
setConstructorS3("RspIncludeDirective", function(value="include", ...) {
|
487
|
1
|
this <- extend(RspDirective(value, ...), "RspIncludeDirective")
|
488
|
1
|
if (!missing(value)) {
|
489
|
0
|
requireAttributes(this, names=c("file", "text"), condition="any")
|
490
|
|
}
|
491
|
1
|
this
|
492
|
|
})
|
493
|
|
|
494
|
|
|
495
|
|
|
496
|
|
#########################################################################/**
|
497
|
|
# @RdocMethod getFile
|
498
|
|
#
|
499
|
|
# @title "Gets the file attribute"
|
500
|
|
#
|
501
|
|
# \description{
|
502
|
|
# @get "title".
|
503
|
|
# }
|
504
|
|
#
|
505
|
|
# @synopsis
|
506
|
|
#
|
507
|
|
# \arguments{
|
508
|
|
# \item{...}{Not used.}
|
509
|
|
# }
|
510
|
|
#
|
511
|
|
# \value{
|
512
|
|
# Returns a @character string.
|
513
|
|
# }
|
514
|
|
#
|
515
|
|
# @author
|
516
|
|
#
|
517
|
|
# \seealso{
|
518
|
|
# @seeclass
|
519
|
|
# }
|
520
|
|
#*/#########################################################################
|
521
|
|
setMethodS3("getFile", "RspIncludeDirective", function(directive, ...) {
|
522
|
1
|
getAttribute(directive, "file")
|
523
|
|
})
|
524
|
|
|
525
|
|
#########################################################################/**
|
526
|
|
# @RdocMethod getContent
|
527
|
|
#
|
528
|
|
# @title "Gets the content of the RSP include directive"
|
529
|
|
#
|
530
|
|
# \description{
|
531
|
|
# @get "title".
|
532
|
|
# }
|
533
|
|
#
|
534
|
|
# @synopsis
|
535
|
|
#
|
536
|
|
# \arguments{
|
537
|
|
# \item{...}{Not used.}
|
538
|
|
# }
|
539
|
|
#
|
540
|
|
# \value{
|
541
|
|
# Returns a @character string.
|
542
|
|
# }
|
543
|
|
#
|
544
|
|
# @author
|
545
|
|
#
|
546
|
|
# \seealso{
|
547
|
|
# @seeclass
|
548
|
|
# }
|
549
|
|
#*/#########################################################################
|
550
|
|
setMethodS3("getContent", "RspIncludeDirective", function(directive, ...) {
|
551
|
1
|
getAttribute(directive, "content")
|
552
|
|
})
|
553
|
|
|
554
|
|
|
555
|
|
#########################################################################/**
|
556
|
|
# @RdocMethod getVerbatim
|
557
|
|
#
|
558
|
|
# @title "Checks if verbatim include should be used or not"
|
559
|
|
#
|
560
|
|
# \description{
|
561
|
|
# @get "title".
|
562
|
|
# }
|
563
|
|
#
|
564
|
|
# @synopsis
|
565
|
|
#
|
566
|
|
# \arguments{
|
567
|
|
# \item{...}{Not used.}
|
568
|
|
# }
|
569
|
|
#
|
570
|
|
# \value{
|
571
|
|
# Returns a @logical.
|
572
|
|
# }
|
573
|
|
#
|
574
|
|
# @author
|
575
|
|
#
|
576
|
|
# \seealso{
|
577
|
|
# @seeclass
|
578
|
|
# }
|
579
|
|
#*/#########################################################################
|
580
|
|
setMethodS3("getVerbatim", "RspIncludeDirective", function(directive, ...) {
|
581
|
0
|
res <- getAttribute(directive, "verbatim", default=FALSE)
|
582
|
0
|
res <- as.logical(res)
|
583
|
0
|
res <- isTRUE(res)
|
584
|
0
|
res
|
585
|
|
})
|
586
|
|
|
587
|
|
|
588
|
|
#########################################################################/**
|
589
|
|
# @RdocMethod getWrap
|
590
|
|
#
|
591
|
|
# @title "Get the wrap length"
|
592
|
|
#
|
593
|
|
# \description{
|
594
|
|
# @get "title".
|
595
|
|
# }
|
596
|
|
#
|
597
|
|
# @synopsis
|
598
|
|
#
|
599
|
|
# \arguments{
|
600
|
|
# \item{...}{Not used.}
|
601
|
|
# }
|
602
|
|
#
|
603
|
|
# \value{
|
604
|
|
# Returns an @integer, or @NULL.
|
605
|
|
# }
|
606
|
|
#
|
607
|
|
# @author
|
608
|
|
#
|
609
|
|
# \seealso{
|
610
|
|
# @seeclass
|
611
|
|
# }
|
612
|
|
#*/#########################################################################
|
613
|
|
setMethodS3("getWrap", "RspIncludeDirective", function(directive, ...) {
|
614
|
1
|
res <- getAttribute(directive, "wrap")
|
615
|
1
|
if (!is.null(res)) {
|
616
|
1
|
res <- as.integer(res)
|
617
|
|
}
|
618
|
1
|
res
|
619
|
|
})
|
620
|
|
|
621
|
|
|
622
|
|
|
623
|
|
|
624
|
|
###########################################################################/**
|
625
|
|
# @RdocClass RspEvalDirective
|
626
|
|
#
|
627
|
|
# @title "The RspEvalDirective class"
|
628
|
|
#
|
629
|
|
# \description{
|
630
|
|
# @classhierarchy
|
631
|
|
#
|
632
|
|
# An RspEvalDirective is an @see "RspDirective" that causes the
|
633
|
|
# RSP parser to evaluate a piece of R code (either in a text string
|
634
|
|
# or in a file) as it is being parsed.
|
635
|
|
# }
|
636
|
|
#
|
637
|
|
# @synopsis
|
638
|
|
#
|
639
|
|
# \arguments{
|
640
|
|
# \item{value}{A @character string.}
|
641
|
|
# \item{attributes}{A named @list, which must contain a 'file'
|
642
|
|
# or a 'text' element.}
|
643
|
|
# \item{...}{Optional arguments passed to the constructor
|
644
|
|
# of @see "RspDirective".}
|
645
|
|
# }
|
646
|
|
#
|
647
|
|
# \section{Fields and Methods}{
|
648
|
|
# @allmethods
|
649
|
|
# }
|
650
|
|
#
|
651
|
|
# @author
|
652
|
|
#
|
653
|
|
# @keyword internal
|
654
|
|
#*/###########################################################################
|
655
|
|
setConstructorS3("RspEvalDirective", function(value="eval", ...) {
|
656
|
1
|
this <- extend(RspDirective(value, ...), "RspEvalDirective")
|
657
|
1
|
if (!missing(value)) {
|
658
|
0
|
requireAttributes(this, names=c("file", "text"), condition="any")
|
659
|
0
|
lang <- getAttribute(this, default="R")
|
660
|
0
|
this <- setAttribute(this, "language", lang)
|
661
|
|
}
|
662
|
1
|
this
|
663
|
|
})
|
664
|
|
|
665
|
|
|
666
|
|
#########################################################################/**
|
667
|
|
# @RdocMethod getFile
|
668
|
|
#
|
669
|
|
# @title "Gets the file attribute"
|
670
|
|
#
|
671
|
|
# \description{
|
672
|
|
# @get "title".
|
673
|
|
# }
|
674
|
|
#
|
675
|
|
# @synopsis
|
676
|
|
#
|
677
|
|
# \arguments{
|
678
|
|
# \item{...}{Not used.}
|
679
|
|
# }
|
680
|
|
#
|
681
|
|
# \value{
|
682
|
|
# Returns a @character string.
|
683
|
|
# }
|
684
|
|
#
|
685
|
|
# @author
|
686
|
|
#
|
687
|
|
# \seealso{
|
688
|
|
# @seeclass
|
689
|
|
# }
|
690
|
|
#*/#########################################################################
|
691
|
|
setMethodS3("getFile", "RspEvalDirective", function(directive, ...) {
|
692
|
0
|
getAttribute(directive, "file")
|
693
|
|
})
|
694
|
|
|
695
|
|
|
696
|
|
#########################################################################/**
|
697
|
|
# @RdocMethod getContent
|
698
|
|
#
|
699
|
|
# @title "Gets the content of the RSP eval directive"
|
700
|
|
#
|
701
|
|
# \description{
|
702
|
|
# @get "title".
|
703
|
|
# }
|
704
|
|
#
|
705
|
|
# @synopsis
|
706
|
|
#
|
707
|
|
# \arguments{
|
708
|
|
# \item{...}{Not used.}
|
709
|
|
# }
|
710
|
|
#
|
711
|
|
# \value{
|
712
|
|
# Returns a @character string.
|
713
|
|
# }
|
714
|
|
#
|
715
|
|
# @author
|
716
|
|
#
|
717
|
|
# \seealso{
|
718
|
|
# @seeclass
|
719
|
|
# }
|
720
|
|
#*/#########################################################################
|
721
|
|
setMethodS3("getContent", "RspEvalDirective", function(directive, ...) {
|
722
|
0
|
getAttribute(directive, "content")
|
723
|
|
})
|
724
|
|
|
725
|
|
|
726
|
|
###########################################################################/**
|
727
|
|
# @RdocClass RspPageDirective
|
728
|
|
#
|
729
|
|
# @title "The RspPageDirective class"
|
730
|
|
#
|
731
|
|
# \description{
|
732
|
|
# @classhierarchy
|
733
|
|
#
|
734
|
|
# An RspPageDirective is an @see "RspDirective" that annotates the
|
735
|
|
# content of the RSP document, e.g. the content type.
|
736
|
|
# }
|
737
|
|
#
|
738
|
|
# @synopsis
|
739
|
|
#
|
740
|
|
# \arguments{
|
741
|
|
# \item{value}{A @character string.}
|
742
|
|
# \item{...}{Arguments passed to the constructor of @see "RspDirective".}
|
743
|
|
# }
|
744
|
|
#
|
745
|
|
# \section{Fields and Methods}{
|
746
|
|
# @allmethods
|
747
|
|
# }
|
748
|
|
#
|
749
|
|
# @author
|
750
|
|
#
|
751
|
|
# @keyword internal
|
752
|
|
#*/###########################################################################
|
753
|
|
setConstructorS3("RspPageDirective", function(value="page", ...) {
|
754
|
1
|
extend(RspDirective(value, ...), "RspPageDirective")
|
755
|
|
})
|
756
|
|
|
757
|
|
|
758
|
|
#########################################################################/**
|
759
|
|
# @RdocMethod getType
|
760
|
|
#
|
761
|
|
# @title "Gets the content type"
|
762
|
|
#
|
763
|
|
# \description{
|
764
|
|
# @get "title".
|
765
|
|
# }
|
766
|
|
#
|
767
|
|
# @synopsis
|
768
|
|
#
|
769
|
|
# \arguments{
|
770
|
|
# \item{default}{If unknown/not set, the default content type to return.}
|
771
|
|
# \item{...}{Not used.}
|
772
|
|
# }
|
773
|
|
#
|
774
|
|
# \value{
|
775
|
|
# Returns a @character string.
|
776
|
|
# }
|
777
|
|
#
|
778
|
|
# @author
|
779
|
|
#
|
780
|
|
# \seealso{
|
781
|
|
# @seeclass
|
782
|
|
# }
|
783
|
|
#*/#########################################################################
|
784
|
|
setMethodS3("getType", "RspPageDirective", function(directive, default=NA, as=c("text", "IMT"), ...) {
|
785
|
0
|
as <- match.arg(as)
|
786
|
0
|
res <- getAttribute(directive, "type", default=as.character(default))
|
787
|
0
|
res <- tolower(res)
|
788
|
0
|
if (as == "IMT" && !is.na(res)) {
|
789
|
0
|
res <- parseInternetMediaType(res)
|
790
|
|
}
|
791
|
0
|
res
|
792
|
|
})
|
793
|
|
|
794
|
|
|
795
|
|
|
796
|
|
|
797
|
|
###########################################################################/**
|
798
|
|
# @RdocClass RspUnknownDirective
|
799
|
|
#
|
800
|
|
# @title "The RspUnknownDirective class"
|
801
|
|
#
|
802
|
|
# \description{
|
803
|
|
# @classhierarchy
|
804
|
|
#
|
805
|
|
# An RspUnknownDirective is an @see "RspDirective" that is unknown.
|
806
|
|
# }
|
807
|
|
#
|
808
|
|
# @synopsis
|
809
|
|
#
|
810
|
|
# \arguments{
|
811
|
|
# \item{value}{A @character string.}
|
812
|
|
# \item{...}{Arguments passed to the constructor of @see "RspDirective".}
|
813
|
|
# }
|
814
|
|
#
|
815
|
|
# \section{Fields and Methods}{
|
816
|
|
# @allmethods
|
817
|
|
# }
|
818
|
|
#
|
819
|
|
# @author
|
820
|
|
#
|
821
|
|
# @keyword internal
|
822
|
|
#*/###########################################################################
|
823
|
|
setConstructorS3("RspUnknownDirective", function(value="unknown", ...) {
|
824
|
1
|
extend(RspDirective(value, ...), "RspUnknownDirective")
|
825
|
|
})
|
826
|
|
|
827
|
|
|
828
|
|
|
829
|
|
###########################################################################/**
|
830
|
|
# @RdocClass RspErrorDirective
|
831
|
|
#
|
832
|
|
# @title "The RspErrorDirective class"
|
833
|
|
#
|
834
|
|
# \description{
|
835
|
|
# @classhierarchy
|
836
|
|
#
|
837
|
|
# An RspErrorDirective is an @see "RspDirective" that generates an
|
838
|
|
# RSP preprocessing error (if processed).
|
839
|
|
# }
|
840
|
|
#
|
841
|
|
# @synopsis
|
842
|
|
#
|
843
|
|
# \arguments{
|
844
|
|
# \item{value}{A @character string.}
|
845
|
|
# \item{...}{Arguments passed to the constructor of @see "RspDirective".}
|
846
|
|
# }
|
847
|
|
#
|
848
|
|
# \section{Fields and Methods}{
|
849
|
|
# @allmethods
|
850
|
|
# }
|
851
|
|
#
|
852
|
|
# @author
|
853
|
|
#
|
854
|
|
# @keyword internal
|
855
|
|
#*/###########################################################################
|
856
|
|
setConstructorS3("RspErrorDirective", function(value="error", ...) {
|
857
|
1
|
extend(RspDirective(value, ...), "RspErrorDirective")
|
858
|
|
})
|