1
###########################################################################/**
2
# @RdocClass RRspPackage
3
#
4
# @title "The RRspPackage class"
5
#
6
# \description{
7
#  @classhierarchy
8
# }
9
#
10
# @synopsis
11
#
12
# \arguments{
13
#   \item{...}{Not used.}
14
# }
15
#
16
# \section{Fields and Methods}{
17
#  @allmethods "public"
18
# }
19
#
20
# @author "HB"
21
#
22
# @keyword internal
23
#*/###########################################################################
24
setConstructorS3("RRspPackage", function(...) {
25 0
  extend(Package(...), "RRspPackage")
26
})
27

28

29

30
###########################################################################/**
31
# @RdocMethod capabilitiesOf
32
# @aliasmethod isCapableOf
33
#
34
# @title "Checks which tools are supported"
35
#
36
# \description{
37
#   @get "title".
38
# }
39
#
40
# @synopsis
41
#
42
# \arguments{
43
#  \item{what}{Optional @character @vector of which tools to check.}
44
#  \item{force}{If @TRUE, cached results are ignored, otherwise not.}
45
#  \item{...}{Not used.}
46
# }
47
#
48
# \value{
49
#   Returns a @logical named @character @vector.
50
# }
51
#
52
# \examples{
53
#   # Display which tools are supported by the package
54
#   print(capabilitiesOf(R.rsp))
55
#
56
#   # Check whether AsciiDoc is supported
57
#   print(isCapableOf(R.rsp, "asciidoc"))
58
#
59
#   # Check whether pandoc v1.12 or newer is supported
60
#   print(isCapableOf(R.rsp, "pandoc (>= 1.12)"))
61
# }
62
#
63
# @author "HB"
64
#
65
#*/###########################################################################
66
setMethodS3("capabilitiesOf", "RRspPackage", function(static, what=NULL, force=FALSE, ...) {
67 1
  res <- static$.capabilities
68 1
  if (force || is.null(res)) {
69 1
    res <- list()
70

71
    # Check software
72 1
    res$asciidoc <- !is.null(findAsciiDoc(mustExist=FALSE))
73 1
    res$knitr <- !is.null(isPackageInstalled("knitr"))
74 1
    res$markdown <- !is.null(isPackageInstalled("markdown"))
75 1
    res$pandoc <- !is.null(findPandoc(mustExist=FALSE))
76 1
    res$sweave <- !is.null(isPackageInstalled("utils"))
77

78
    # Check LaTeX
79 1
    path <- system.file("rsp_LoremIpsum", package="R.rsp")
80 1
    pathname <- file.path(path, "LoremIpsum.tex")
81 1
    res$latex <- tryCatch({
82 1
      pathnameR <- compileLaTeX(pathname, outPath=tempdir())
83 1
      isFile(pathnameR)
84 1
    }, error = function(ex) FALSE)
85

86
    # Order lexicographically
87 1
    o <- order(names(res))
88 1
    res <- res[o]
89

90
    # Coerce into a named character vector
91 1
    res <- unlist(res, use.names=TRUE)
92

93
    # Record
94 1
    static$.capabilities <- res
95
  }
96

97 1
  if (!is.null(what)) {
98 1
    res <- res[what]
99
  }
100

101 1
  res
102
}, static=TRUE)
103

104

105
setMethodS3("isCapableOf", "RRspPackage", function(static, what, ...) {
106
  # Argument 'what':
107 1
  what <- Arguments$getCharacter(what)
108 1
  pattern <- "^([^ ]+)[ ]*(|[(](<|<=|==|>=|>)[ ]*([^)]+)[)])$"
109 1
  if (regexpr(pattern, what) == -1L) {
110 0
    throw("Unknown syntax of argument 'what': ", what)
111
  }
112

113 1
  name <- gsub(pattern, "\\1", what)
114 1
  op <- gsub(pattern, "\\3", what)
115 1
  ver <- gsub(pattern, "\\4", what)
116 1
  if (nzchar(op)) {
117 0
    op <- get(op, mode="function", envir=baseenv())
118 1
  } else if (nzchar(ver)) {
119 0
    throw("Missing version operator in argument 'what': ", what)
120
  }
121

122 1
  res <- capabilitiesOf(static, what=name, ...)
123

124
  # Nothing more to do?
125 1
  if (!is.element(name, names(res))) {
126 1
    return(FALSE)
127
  }
128

129
  # Nothing more to do?
130 1
  if (!nzchar(ver)) {
131 1
    return(res)
132
  }
133

134
  # Get available version
135 0
  if (name == "asciidoc") {
136 0
    v <- attr(findAsciiDoc(mustExist=FALSE), "version")
137 0
  } else if (name == "pandoc") {
138 0
    v <- attr(findPandoc(mustExist=FALSE), "version")
139 0
  } else if (is.element(name, c("knitr", "markdown"))) {
140 0
    v <- packageVersion(name)
141 0
  } else if (name == "sweave") {
142 0
    v <- packageVersion("utils")
143
  } else {
144 0
    v <- NA
145
  }
146

147
  # Compare to requested version
148 0
  res <- isTRUE(op(v, ver))
149

150 0
  res
151
})

Read our documentation on viewing source code .

Loading