Nothing
######
# new S3 classes for Startup-message
### constructor of condition "StartupMessage"
StartupMessage <- function (message, call = NULL, pkg = "", type = "version",
endline = FALSE)
structure(list(message = message, call = call, package = pkg, type = type,
endline = endline),
class = c("StartupMessage", "packageStartupMessage", "condition",
"message", "simpleMessage"))
### accessor to slot package
startupPackage <- function(startupmessage) {startupmessage$"package"}
### accessor to slot type
startupType <- function(startupmessage) {startupmessage$"type"}
### accessor to slot endline
startupEndline <- function(startupmessage) {startupmessage$"endline"}
### suppressing Startup messages by a wrapper
suppressStartupMessages<-
function (expr)
withCallingHandlers(expr, StartupMessage =
function(c) invokeRestart("muffleMessage"))
onlytypeStartupMessages<-
function (expr,atypes="version")
{withCallingHandlers(expr, StartupMessage =
function(c) {invokeRestart(r = "onlytypeMessage",
c0 = c, atypes=atypes)}) }
### generating a startupMessage
startupMessage <- function(..., domain=NULL, pkg="", type="version", endline = FALSE) {
withRestarts( withCallingHandlers(
message(..., domain=domain),
message = function(cond)
{SM <- StartupMessage(conditionMessage(cond),
conditionCall(cond),
pkg, type, endline)
signalCondition(SM)
} ),
onlytypeMessage = function(c0,atypes){
if(startupType(c0) %in% atypes)
writeLines(conditionMessage(c0),stderr())
},
#as suggested by Seth Falcon:
custom = function(c,f) f(c),
muffleMessage = function() NULL )
invisible(NULL)
}
###############################################################
#Utilities for reading the DESCRIPTION file and NEWS file out
# for starting information on the package
###############################################################
readVersionInformation <- function(pkg, library=NULL){
## 20241113: use utils::packageDescription
ver <- utils::packageDescription(pkg, lib.loc = library, fields = "Version")
ver <- as.character(ver)
title <- utils::packageDescription(pkg, lib.loc = library, fields = "Title")
title <- as.character(title)
#
list(ver=ver, title=title)
}
readURLInformation <- function(pkg, library=NULL){
## 20241113: use utils::packageDescription
URL <- utils::packageDescription(pkg, lib.loc = library, fields = "URL")
if(is.na(URL)||(is.character(URL)&&length(URL)==0)) return(NULL)
else return(as.character(URL))
}
pointertoNEWS <- function(pkg, library=NULL){
if(file.exists(file.path(system.file(package=pkg, lib.loc=library),"NEWS")))
return(paste("NEWS(\"",pkg,"\")",sep=""))
else return(NULL)
}
infoShow <- function(pkg, filename, library=NULL)
{file.show(file.path(system.file(package = pkg, lib.loc=library),
paste(filename,sep=.Platform$file.sep,collapse=.Platform$file.sep)))}
### filename may also be given as a vector of characters with the corresponding
### names of folders i.e. c(folder.1,....,folder.n,filename)
### (to be system-independent) --- for Windows and Linux
### the usual [folder.1/..../folder.n/]filename will do
NEWS<-function(pkg, library=NULL)
{ ## inspired by Andy Liaw
infoShow(pkg, filename="NEWS", library=library)
}
#######################################################################
### analogously:
TOBEDONE<-function(pkg, library=NULL)
{ ## inspired by Andy Liaw
infoShow(pkg, filename="TOBEDONE", library=library)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.