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
|
#########################################################################/**
# @RdocDefault pkgStartupMessage
#
# @title "Generates a (package) startup message"
#
# \description{
# @get "title".
# Contrary to @see "base::packageStartupMessage", this method does
# \emph{not} output a message when \code{library()/require()} is
# called with argument \code{quietly=TRUE}.
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Arguments passed to @see "base::packageStartupMessage".}
# \item{quietly}{If @FALSE, the message is outputted, otherwise not.
# If @NA, the message is \emph{not} outputted if @see "base::library"
# (or \code{require()}) was called with argument \code{quietly=TRUE}.}
# }
#
# \value{
# Returns nothing.
# }
#
# @author
#
# \seealso{
# @see "base::packageStartupMessage".
# }
#
# @keyword internal
#*/#########################################################################
setMethodS3("pkgStartupMessage", "default", function(..., quietly=NA) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Infer 'quietly' from argument 'argument' in library() call?
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (is.na(quietly)) {
quietly <- FALSE
# Just in case the below won't work one day due to R updates...
tryCatch({
# The default, if not found
quietly <- formals(base::library)$quietly
# Identify the environment/frame of interest by making sure
# it at least contains all the arguments of source().
argsToFind <- names(formals(base::library))
# Scan the call frames/environments backwards...
srcfileList <- list()
for (ff in sys.nframe():0) {
env <- sys.frame(ff)
# Does the environment look like a library() environment?
exist <- sapply(argsToFind, FUN=exists, envir=env, inherits=FALSE)
if (!all(exist)) {
# Nope, then skip to the next one
next
}
# Was argument 'quietly' specified?
missing <- eval(expression(missing(quietly)), envir=env)
if (!missing) {
quietly <- get("quietly", envir=env, inherits=FALSE)
break
}
# ...otherwise keep searching due to nested library() calls.
} # for (ff ...)
}, error = function() {})
} # if (is.na(quietly)
# Output message?
if (!quietly) {
packageStartupMessage(...)
}
}, protected=TRUE)
## startupMessage <- pkgStartupMessage
## startupMessage.default <- pkgStartupMessage.default
|
