1
###########################################################################/**
2
# @RdocDefault rargs
3
#
4
# @title "Gets RSP arguments of an RSP document"
5
#
6
# \description{
7
#  @get "title", if any.
8
# }
9
#
10
# @synopsis
11
#
12
# \arguments{
13
#   \item{...}{Arguments passed to @see "rcompile".}
14
# }
15
#
16
# \value{
17
#   Returns a @data.frame of class 'RspArguments'.
18
# }
19
#
20
# \details{
21
#   Any RSP preprocessing variable with an 'description' attribute
22
#   is considered to be an RSP argument.
23
# }
24
#
25
# @examples "../incl/rargs.Rex"
26
#
27
# @author
28
#
29
# \seealso{
30
#  @see "rfile".
31
# }
32
#
33
# @keyword file
34
# @keyword IO
35
# @keyword internal
36
#*/###########################################################################
37
setMethodS3("rargs", "default", function(...) {
38
  # Parse RSP document
39 1
  doc <- rcompile(..., until="directives", output=RspDocument())
40

41
  # Extract RSP preprocessing directives
42 1
  keep <- unlist(sapply(doc, FUN=inherits, "RspUnparsedDirective"), use.names=FALSE)
43 1
  doc <- doc[keep]
44

45
  # Parse RSP directives
46 1
  for (idx in seq_along(doc)) {
47 1
    doc[[idx]] <- parseDirective(doc[[idx]])
48
  }
49

50
  # Extract RSP preprocessing variables
51 1
  keep <- unlist(sapply(doc, FUN=inherits, "RspVariableDirective"), use.names=FALSE)
52 1
  doc <- doc[keep]
53

54
  # Subset by those with 'description' attributes.
55 1
  keep <- unlist(sapply(doc, FUN=hasAttribute, "description"), use.names=FALSE)
56 1
  doc <- doc[keep]
57

58 1
  args <- lapply(doc, FUN=function(d) {
59 1
    attrs <- getNameContentDefaultAttributes(d)
60 1
    type <- as.character(d)
61 1
    default <- attrs$default
62 0
    if (is.null(default)) default <- vector(mode=type, length=1L)
63 1
    default <- as(default, type)
64 1
    data.frame(
65 1
      name        = attrs$name,
66 1
      type        = type,
67 1
      default     = default,
68 1
      description = attr(d, "description"),
69 1
      stringsAsFactors=FALSE
70
    )
71
  })
72 1
  if (length(args) > 0L) {
73 1
    args <- Reduce(rbind, args)
74
  } else {
75
    # Default
76 0
    args <- data.frame(
77 0
      name        = "",
78 0
      type        = "",
79 0
      default     = "",
80 0
      description = "",
81 0
      stringsAsFactors=FALSE
82
    )
83 0
    args <- args[c(),]
84
  }
85

86 1
  rownames(args) <- NULL
87 1
  class(args) <- c("RspArguments", class(args))
88 1
  args
89
}) # rargs()
90

91

92
#########################################################################/**
93
# @set "class=RspArguments"
94
# @RdocMethod print
95
#
96
# @title "Prints RSP arguments"
97
#
98
# \description{
99
#  @get "title" returned by @see "rargs".
100
# }
101
#
102
# @synopsis
103
#
104
# \arguments{
105
#   \item{...}{Not used.}
106
# }
107
#
108
# \value{
109
#  Returns nothing.
110
# }
111
#
112
# @author
113
#
114
# \seealso{
115
#   @see "rargs".
116
# }
117
#*/#########################################################################
118
setMethodS3("print", "RspArguments", function(x, ...) {
119 1
  s <- NULL
120 1
  for (kk in seq_len(nrow(x))) {
121 1
    arg <- x[kk,]
122 1
    title <- sprintf("'%s' [%s]", arg$name, arg$type)
123 1
    title <- sprintf("%s:", title)
124 1
    if (!is.null(arg$default)) {
125 1
      default <- sprintf("    Default: '%s'", arg$default)
126
    } else {
127 0
      default <- "    Default:"
128
    }
129 1
    desc <- arg$description
130 1
    desc <- sprintf("    %s", desc)
131 1
    s <- c(s, title, default, desc, "")
132
  } # for (kk ...)
133 1
  s <- paste(s, collapse="\n")
134 1
  cat(s, "\n", sep="")
135
})

Read our documentation on viewing source code .

Loading