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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
###########################################################################/**
# @RdocClass RRspPackage
#
# @title "The RRspPackage class"
#
# \description{
# @classhierarchy
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Not used.}
# }
#
# \section{Fields and Methods}{
# @allmethods "public"
# }
#
# @author "HB"
#
# @keyword internal
#*/###########################################################################
setConstructorS3("RRspPackage", function(...) {
extend(Package(...), "RRspPackage")
})
###########################################################################/**
# @RdocMethod capabilitiesOf
# @aliasmethod isCapableOf
#
# @title "Checks which tools are supported"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{what}{Optional @character @vector of which tools to check.}
# \item{force}{If @TRUE, cached results are ignored, otherwise not.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns a @logical named @character @vector.
# }
#
# \examples{
# # Display which tools are supported by the package
# print(capabilitiesOf(R.rsp))
#
# # Check whether AsciiDoc is supported
# print(isCapableOf(R.rsp, "asciidoc"))
#
# # Check whether pandoc v1.12 or newer is supported
# print(isCapableOf(R.rsp, "pandoc (>= 1.12)"))
# }
#
# @author "HB"
#
#*/###########################################################################
setMethodS3("capabilitiesOf", "RRspPackage", function(static, what=NULL, force=FALSE, ...) {
res <- static$.capabilities
if (force || is.null(res)) {
res <- list()
# Check software
res$asciidoc <- !is.null(findAsciiDoc(mustExist=FALSE))
res$knitr <- !is.null(isPackageInstalled("knitr"))
res$markdown <- !is.null(isPackageInstalled("markdown"))
res$pandoc <- !is.null(findPandoc(mustExist=FALSE))
res$sweave <- !is.null(isPackageInstalled("utils"))
# Check LaTeX
path <- system.file("rsp_LoremIpsum", package="R.rsp")
pathname <- file.path(path, "LoremIpsum.tex")
res$latex <- tryCatch({
pathnameR <- compileLaTeX(pathname, outPath=tempdir())
isFile(pathnameR)
}, error = function(ex) FALSE)
# Order lexicographically
o <- order(names(res))
res <- res[o]
# Coerce into a named character vector
res <- unlist(res, use.names=TRUE)
# Record
static$.capabilities <- res
}
if (!is.null(what)) {
res <- res[what]
}
res
}, static=TRUE)
setMethodS3("isCapableOf", "RRspPackage", function(static, what, ...) {
# Argument 'what':
what <- Arguments$getCharacter(what)
pattern <- "^([^ ]+)[ ]*(|[(](<|<=|==|>=|>)[ ]*([^)]+)[)])$"
if (regexpr(pattern, what) == -1L) {
throw("Unknown syntax of argument 'what': ", what)
}
name <- gsub(pattern, "\\1", what)
op <- gsub(pattern, "\\3", what)
ver <- gsub(pattern, "\\4", what)
if (nzchar(op)) {
op <- get(op, mode="function", envir=baseenv())
} else if (nzchar(ver)) {
throw("Missing version operator in argument 'what': ", what)
}
res <- capabilitiesOf(static, what=name, ...)
# Nothing more to do?
if (!is.element(name, names(res))) {
return(FALSE)
}
# Nothing more to do?
if (!nzchar(ver)) {
return(res)
}
# Get available version
if (name == "asciidoc") {
v <- attr(findAsciiDoc(mustExist=FALSE), "version")
} else if (name == "pandoc") {
v <- attr(findPandoc(mustExist=FALSE), "version")
} else if (is.element(name, c("knitr", "markdown"))) {
v <- packageVersion(name)
} else if (name == "sweave") {
v <- packageVersion("utils")
} else {
v <- NA
}
# Compare to requested version
res <- isTRUE(op(v, ver))
res
})
|
