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
})

Read our documentation on viewing source code .

Loading