startupmsg/0000755000176200001440000000000014740735173012476 5ustar liggesusersstartupmsg/MD50000644000176200001440000000075714740735173013017 0ustar liggesusers564e49bc2b92e15b222ae60f5c08cc7d *DESCRIPTION 9076c9b62685e96336be398d7da3c266 *NAMESPACE 1f386e4ef7976cbcf0f01089296291ca *R/00.r 1b80af401bd06930e088dec9a02645e9 *R/illustration.R 6bf0edd4351e01e0046c189c4051752b *R/mySMHandler.R 58f7712becb56c48cdbb6ea6dfc6b389 *R/startUpMessage.R 0ba953a665bbee41d97c4e02c37505b7 *inst/NEWS b53a8f4feb517efd4fce0c95cfd34f42 *inst/TOBEDONE a7cab112e16c98d0b1b1ef555503d0f8 *man/StartupUtilities.Rd cc223124998593b36cc54270255d9a97 *man/myStartupUtilities.Rd startupmsg/R/0000755000176200001440000000000014740530476012676 5ustar liggesusersstartupmsg/R/00.r0000644000176200001440000000063714740470135013301 0ustar liggesusers# .onLoad<-function(lib,pkg){require(methods)} .onLoad<-function(lib,pkg) {options("StartupBanner" = "no-version", "StartupShowHint_sessionInfo" = TRUE)} .onAttach <- function(library, pkg) { # if (is.null(library)) # library <- .libPaths() # if(any(file.exists(file.path(library,"startupmsg")))) buildStartupMessage(pkg="startupmsg", library=library, packageHelp=TRUE) invisible() } startupmsg/R/startUpMessage.R0000644000176200001440000001017214715160010015752 0ustar liggesusers###### # 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) } startupmsg/R/illustration.R0000644000176200001440000001524414740473170015555 0ustar liggesusers#####EXAMPLES: ##note: to avoid misunderstandings: 'SMHandler' stands for /S/tartup/M/essage/Handler/ #mySMHandler <- function(c) { # pkg <- startupPackage(c) # npkg <- nchar(pkg) # linestarter <- paste(":",pkg,"> ", sep ="") # linestarterN <- paste("\n",linestarter, sep ="") # linestarterE <- paste(linestarterN,"$",sep="") # writeLines(paste(linestarter, sub(linestarterE,"\n", # gsub("\n", linestarterN, # conditionMessage(c))),sep=""),stderr()) #} mystartupMessage <- function(..., domain = NULL, pkg = "", type = "version", SMHandler = mySMHandler, endline = FALSE){ withRestarts(withCallingHandlers( startupMessage(..., domain = domain, pkg = pkg, type=type, endline = endline), StartupMessage=function(m) {signalCondition(m) invokeRestart("custom",c=m,f=SMHandler)} ), #as suggested by Seth Falcon: onlytypeMessage = function(c0,atypes) {if(startupType(c0) %in% atypes) SMHandler(c=c0) }, #as suggested by Seth Falcon: custom = function(c,f) f(c), muffleMessage = function() NULL ) invisible(NULL) } buildStartupMessage <- function(..., pkg, library = NULL, domain = NULL, packageHelp = FALSE, MANUAL = NULL, VIGNETTE = NULL, SMHandler = mySMHandler){ # tit.vers <- readVersionInformation(pkg, library) if((!getOption("StartupBanner") == "off") || is.null(getOption("StartupBanner"))){ versionHint0 <- gettext( 'Detailed information about which packages are currently loaded ', 'or attached at which version (regardless of whether these have ', 'start-up messages managed by this package) can be obtained by ', '"sessionInfo()".\n', domain = domain) versionHint <- "" if(!is.null(getOption("StartupShowHint_sessionInfo"))) if(getOption("StartupShowHint_sessionInfo") ) versionHint <- versionHint0 if(is.null(getOption("StartupBanner")) || !getOption("StartupBanner") %in% c( "no-version", "no - version")){ mystartupMessage(tit.vers$"title", " (version ", tit.vers$"ver", ")\n", versionHint, domain = domain, pkg = pkg, type="version", SMHandler = SMHandler) }else{ versInfoText <- "" if( getOption("StartupBanner")== "no-version" ){ ## if no-version show this once but no more often: options("StartupBanner" = "no - version") versInfoText <- gettext( "Version information in start-up messages is currently suppressed. ", 'To see such information on startup as in versions of this pkg ', 'prior to this versionr, set option "StartupBanner" to a value ', 'different to {"off", "no-version", "no - version"}, e.g., by ', 'options("StartupBanner" = "complete") or by ', 'options("StartupBanner" = NULL) or by ', 'options("StartupBanner" = "something else").\n', domain = domain) } mystartupMessage("*** ",tit.vers$"title", " ***\n\n", versInfoText, versionHint, domain = domain, pkg = pkg, type="information", SMHandler = SMHandler) } options("StartupShowHint_sessionInfo" = FALSE) } ### if((getOption("StartupBanner")=="complete")|| is.null(getOption("StartupBanner"))){ llist <- length(list(...)) ### checks as to existence of URL- NEWS- and MANUAL-information # URL <- readURLInformation(pkg,library) NEWS <- pointertoNEWS(pkg,library) # if ( packageHelp) packageHelpS <- c("?\"", pkg, "\"") else packageHelpS <- "" if (!is.null(NEWS)) NEWSS <- NEWS else NEWSS <- "" if (!is.null(URL)) URLS <- c("\n ",URL) else URLS <- "" ## MANUALL : is there a MANUAL entry? MANUALL <- FALSE MANUALS <- "" if(!is.null(MANUAL)) {if (all(substr(as.character(MANUAL),1,7)=="https://")) {MANUALL <- TRUE MANUALS <- c("\n ",MANUAL)} else {MANUAL1 <- paste(MANUAL, sep = .Platform$file.sep, collapse = .Platform$file.sep) MANUALpath <- file.path(system.file(package = pkg), MANUAL1, collapse = "") if (file.exists(MANUALpath)) { MANUALL <- TRUE MANUALS <- c("\n ",MANUALpath)} } } VIGNETTES = ifelse(!is.null(VIGNETTE), paste("\n",VIGNETTE, sep = "", collapse = ""), "") ## are there any info-lines? L <- sum(!is.null(URL), packageHelp , !is.null(NEWS) , MANUALL, !is.null(VIGNETTE)) ##determining the separators: seps <- character(3) seps[1] <- ifelse(packageHelp&&L>1,", ","") seps[2] <- ifelse(!is.null(NEWS)&& sum(!is.null(NEWS) , MANUALL, !is.null(URL))>1, gettext(", as well as", domain = domain), "") seps[3] <- ifelse(MANUALL && sum(MANUALL, !is.null(URL))>1, ", ", "") if( (MANUALL|| !is.null(URL)) && is.null(NEWS)) seps[1] <- gettext(", as well as", domain = domain) # if (L>0){ if (llist > 0) mystartupMessage(..., domain = domain, pkg = pkg, type = "notabene", SMHandler = SMHandler) mystartupMessage("For more information see ", packageHelpS, seps[1], NEWSS, seps[2], URLS, seps[3], MANUALS, VIGNETTES, "\n", domain = domain, pkg = pkg, type = "information", SMHandler = SMHandler, endline = TRUE) } else{ if (llist > 0) mystartupMessage(..., domain = domain, pkg = pkg, type = "notabene", SMHandler = SMHandler, endline = TRUE) } } } ########### end Examples startupmsg/R/mySMHandler.R0000644000176200001440000000314513077114453015202 0ustar liggesusersmySMHandler <- function(c) { pkg <- startupPackage(c) endline <- startupEndline(c) linestarter <- paste(":",pkg,"> ", sep ="") ## effective number of chars / line: nceff <- getOption("width")-nchar(linestarter)-2 ## make message a list with one char vector entry per line ## (split inbetween by "\n") wds0 <- unlist(conditionMessage(c)) wdsA <- as.list(unlist(strsplit(wds0,"\n"))) for( j in 1: length(wdsA)){ wds <- unlist(strsplit(wdsA[[j]]," ")) lwds <- length(wds) if(lwds){ i <- 1 tryc <- linestarter wc <- 0 while(i<=lwds){ tryold <- tryc tryc <- paste(tryc,wds[i]) nt <- nchar(tryc) wc <- wc+1 if(nt>= nceff){ if(wc == 1) { ### one word already too long; print it nevertheless writeLines(tryc,stderr()) i <- i+1 }else{ ### only print the string upto the current word writeLines(tryold,stderr()) } ### set word counter to 0 wc <- 0 tryc <- linestarter }else{ if(i==lwds) writeLines(tryc,stderr()) i <- i+1 } } if(j < length(wdsA) &&!endline) writeLines(linestarter, stderr()) } } if(endline) writeLines("",stderr()) else writeLines(linestarter,stderr()) } startupmsg/NAMESPACE0000644000176200001440000000061614715155623013716 0ustar liggesusersimportFrom("utils", "packageDescription") export("readVersionInformation", "readURLInformation", "pointertoNEWS", "infoShow", "NEWS", "TOBEDONE", "StartupMessage", "startupPackage", "startupType", "startupMessage", "suppressStartupMessages", "startupEndline", "onlytypeStartupMessages", "buildStartupMessage", "mySMHandler", "mystartupMessage") startupmsg/inst/0000755000176200001440000000000014740530476013452 5ustar liggesusersstartupmsg/inst/NEWS0000644000176200001440000001271514740464037014156 0ustar liggesusers###################################################################### # News: to package startupmsg ###################################################################### ############## v 1.0.0 ############## under the hood: We instantiated a more refined mechanism for startup messages, to avoid unnecessary pkg version updates just triggered by startup messages issuing version information of attached packages upstream, which changes the reference output of the attaching package and hence creates diffs when tested on CRAN. Somewhat more detailed, in the prior regime, suppose we had pkgs pkgA and pkgB on CRAN, pkgB importing the NAMESPACE of pkgA via depends, and both pkgs pkgA and pkgB had startup messages including version information, and pkgB used the reference output -Ex.Rout.save as a unit test for pkgB. Then, whenever we submitted an updated version of pkgA to CRAN, we had to also submit a new version of pkgB to CRAN regardless whether we had changed anything in pkgB, because of the changed version information in the startup message of pkgA which showed up in the reference output when pkgA was attached at loading pkgB. To avoid this, by default our startup messages no longer issue version information of the attached packages, but --only once per session-- we show a startup message indicating how to show the prior behaviour, i.e., show the version information of attached packages in the startup messages. ############## v 0.9.7 (not submitted to CRAN) ############## under the hood: with the help of K. Hornik identified spurious, platform dependent LF/CR issue and capsulated calls to infoShow() in Rd files by ## IGNORE_RDIFF_BEGIN ## IGNORE_RDIFF_END ############## v 0.9.6 ############## user-visible CHANGES: + DESCRIPTION tag SVNRevision changed to VCS/SVNRevision ############## v 0.9 ############## user-visible CHANGES: + title changed to title style / capitalization GENERAL ENHANCEMENTS: under the hood: added .Rbuildignore BUGFIXES: ############## v 0.8 ############## under the hood: + startupmsg gains a namespace + added DESCRIPTION tag "ByteCompile" to all our packages + updating maintainer email address and URL. + deleted no longer needed chm folders ############## v 0.7 ############## user-visible CHANGES: + new command TOBEDONE() --- similarly to NEWS() to access TOBEDONE file GENERAL ENHANCEMENTS: + added tests/Examples folder with file startupmsg-Ex.Rout.save to have some automatic testing + added field "Encoding: latin1" to all DESCRIPTION files in order to avoid problems with e.g. Windows locale when svn replaces $LastChangedDate + added TOBEDONE (sic!) files for each package (by accident also in trunc; these are empty so far) ############## v 0.6 ############## * Rd-style: + several buglets detected with the fuzzier checking mechanism cf [Rd] More intensive checking of R help files, Prof Brian Ripley, 09.01.2009 10:25) [Rd] Warning: missing text for item ... in \describe? , Prof Brian Ripley, ############## v 0.5.3 ############## * new issuer 'mySMHandler' to cope with long package names and variable "paper" widths acc. to getOption("width") (automatically inserts line breaks...) * moved license to LGPL-3 ############## v 0.5 ############## * startup messages are now also of S3-class 'packageStartupMessage' and hence may now also be suppressed by suppressPackageStartupMessages() (from package 'base') ############## v 0.4 ############## * deleted: import "methods" from Namespace * included: argument "VIGNETTE" in function "buildStartupMessage" ############## v 0.3 ############## * inserted references to the mail thread "Wishlist: 'quietly' argument for .onAttach() / .First.lib()" on r-devel, April 2006 into seealso ############## v 0.2 ############## * abolished: S3 class StartupVersionMessage with corresponding constructor * abolished: call startupVersionMessage * abolished: control for linestarter (anyone could do this himself: + the developper using his own SMHandler + the user by specifying a suitable custom restart * abolished: wrapper onlyversionStartupMessages * abolished: modified output in startMessage * instead: extended S3 class StartupMessage by a slot 'type' with corresponding accessor startupType * instead: onlytypeStartupMessages with an atypes argument to filter out types that are to be shown * instead: introduction of mystartMessage with a * instead: startMessage now comes with a type argument * instead/new: SMHandler argument for mystartupMessage and buildStartupMessage defaulting to mySMHandler * clarified: code to buildStartupMessage * new: separation into "general routines" documented in ?"startmsg" and an illustration covering mystartupMessage and buildStartupMessage documented in ?"mystartupMessage" * new: custom restart (idea: Seth Falcon) ############## v 0.1 ############## * defined S3 classes StartupMessage, StartupVersionMessage with corresponding constructors * accessor startupPackage * wrappers suppressStartupMessages, onlyversionStartupMessages * calls startupMessage, startupVersionMessage * utilities readVersionInformation, readURLInformation, pointertoNEWS, infoShow, NEWS * main function buildStartupMessage (also controllable by options "StartupBanner" resp. "StartupLinestarter") startupmsg/inst/TOBEDONE0000644000176200001440000000023613077114453014570 0ustar liggesusers++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ to be done in package startupmsg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ startupmsg/man/0000755000176200001440000000000014740530476013250 5ustar liggesusersstartupmsg/man/StartupUtilities.Rd0000644000176200001440000002005314664034330017066 0ustar liggesusers\name{StartupUtilities} % \alias{startupmsg} % %Utilities \alias{infoShow} \alias{TOBEDONE} \alias{NEWS} \alias{readVersionInformation} \alias{readURLInformation} \alias{pointertoNEWS} % %S3 class & accessors \alias{StartupMessage} \alias{startupPackage} \alias{startupType} \alias{startupEndline} % %message generator \alias{startupMessage} % %message wrapper \alias{suppressStartupMessages} \alias{onlytypeStartupMessages} \title{Utilities for start-up messages} \description{ several utilities to produce start-up messages } \usage{ readVersionInformation(pkg, library=NULL) readURLInformation(pkg, library=NULL) pointertoNEWS(pkg, library=NULL) infoShow(pkg, filename, library=NULL) NEWS(pkg, library=NULL) TOBEDONE(pkg, library=NULL) StartupMessage(message, call = NULL, pkg="", type="version", endline = FALSE) startupPackage(startupmessage) startupType(startupmessage) startupEndline(startupmessage) startupMessage(..., domain = NULL, pkg = "", type="version", endline = FALSE) suppressStartupMessages(expr) onlytypeStartupMessages(expr,atypes="version") } \arguments{ \item{pkg}{a character string with the name of a single package} \item{library}{a character vector with path names of R libraries, or \code{NULL}. The default value of \code{NULL} corresponds to all libraries currently known. If the default is used, the loaded packages are searched before the libraries} \item{filename}{name of the file which is to be displayed by \code{infoShow} (with relative path within the package main folder)} \item{message}{a character string -- the message part of an S3-object of class \code{StartupMessage}} \item{call}{a call expression -- the call part of an S3-object of class \code{StartupMessage}} \item{type}{character -- the type part of an S3-object of class \code{StartupMessage}; currently, type should be in \code{c("version","notabene","information")}.} \item{endline}{a logical -- the decision on the ending of an S3-object of class \code{StartupMessage}} \item{startupmessage}{the \code{StartupMessage} object whose slot \code{package} is to be inspected} \item{domain}{see \code{gettext}. If \code{NA}, messages will not be translated.} \item{atypes}{a vector of characters -- the types of \code{StartupMessage}-objects which \code{onlytypeStartupMessages} lets pass through} \item{expr}{expression to evaluate.} \item{...}{character vectors (which are pasted together with no separator)} } \details{ \code{readVersionInformation} and \code{readURLInformation} read the \file{DESCRIPTION} file of the package. \code{readVersionInformation} returns a list with elements \code{ver} and \code{title} for the version and title to be found in the \file{DESCRIPTION} file; if there is a \code{URL} entry it is returned by \code{readURLInformation} else \code{readURLInformation} returns \code{NULL}. If there is a \file{NEWS} in the package main folder, \code{pointertoNEWS} returns a string with an expression how to retrieve this file from within R, else \code{pointertoNEWS} returns \code{NULL}. \code{infoShow} displays the file \code{filename} in the package main folder using \code{file.show} -- if it exists; \code{NEWS} in particular displays the \file{NEWS} file, and analogously, \code{TOBEDONE} in particular displays the \file{TOBEDONE} file; takes up an idea by Andy Liaw. A new sub-condition \code{StartupMessage} to \code{message} is introduced, with a constructor with the same name. In addition to the slots of \code{message}, it also has slots \code{package} (for the package they are for), \code{type} (currently in \code{c("version","notabene","information")}), and \code{endline} (a logical). These slots may be accessed by \code{startupPackage}, \code{startupType}, and \code{startupEndline}, respectively. \code{startupMessage} issues a start-up message which also is represented as a condition. While the start-up message is being processed, the following restarts are available: \itemize{\item \code{muffleMessage()} to suppress the \code{StartupMessage}, \item \code{onlytypeMessage(c0,atypes)} to filter out types not mentioned in \code{atypes} of \code{StartupMessages}-argument \code{c0}, \item \code{custom(c,f)} to apply the user-defined function \code{f} to \code{StartupMessages}-argument \code{c0} instead of the usual procedure } The user may suppress the start-up messages produced by these utilities as follows: \itemize{\item \code{suppressStartupMessages(expr)} suppresses all messages issued by \code{startupMessage} in the expression \code{expr} within the parentheses% \item \code{suppressPackageStartupMessages(expr)}: from package version 0.5 on, is the same as \code{suppressStartupMessages} for our start-up banners, but more generally suppresses all messages of S3-class \code{packageStartupMessage} (from \pkg{base} package)% \item \code{onlyversionStartupMessages(expr, atypes="version")} only shows messages issued by \code{startupMessage} in the expression \code{expr} within the parentheses, if there slot \code{type} is contained in the \code{atypes} argument \item by the \code{custom} restart (see example by Seth Falcon) }% } \section{Acknowledgement}{Thanks to Seth Falcon for his helpful comments.} \author{Peter Ruckdeschel \email{peter.ruckdeschel@uni-oldenburg.de}} \examples{ ## a set of test messages several.messages<-function() { startupMessage("this is a type 'version' startup message", pkg="PKG") startupMessage("this is a type 'information' startup message", pkg="PKG", type="information") message("this is an ordinary message")} ## issuing of messages with different wrappers several.messages() suppressStartupMessages(several.messages()) suppressMessages(several.messages()) onlytypeStartupMessages(several.messages(),atypes=c("version","notabene")) ##Example by Seth Falcon: ## Here is a test function doit <- function() { several.messages() return(123) } ## Here is an example message handler. Here, you could write messages ## to a file, send them as email to your friends or enemies, etc. ## For the example, we'll just prepend 'MSG:' msgLogger <- function(m) { types<-paste("(", startupType(m),"):", sep="") cat(paste("MSG: ",types, conditionMessage(m)), "\n") } ## Finally, call the doit function and customize how messages are ## handled. withCallingHandlers(doit(), StartupMessage=function(m) { invokeRestart("custom", m, msgLogger) }) ### reading information file utilities readVersionInformation("stats") readURLInformation("MASS") ## for packages with URL file see e.g. dse1 pointertoNEWS("startupmsg") ## no NEWS file; ## IGNORE_RDIFF_BEGIN NEWS("startupmsg") ## no NEWS file; ## for packages with NEWS file see e.g. randomForest, distr ## IGNORE_RDIFF_END } \seealso{\code{\link{buildStartupMessage}} for some illustration; for the ideas taken up in this package, see mails "[Rd] Wishlist: 'quietly' argument for .onAttach() / .First.lib() " on r-devel by Brian Ripley, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037281.html}, by Andy Liaw, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037286.html}, by Seth Falcon, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037317.html}, and again by Seth Falcon, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037367.html}, and by the author, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037382.html}} \keyword{utilities} \concept{startup} \concept{S3 message class} \concept{message} \concept{startup message} \concept{info file} \concept{NEWS} \concept{pointer to news} startupmsg/man/myStartupUtilities.Rd0000644000176200001440000002106414740526544017447 0ustar liggesusers\name{myStartupUtilities} \alias{mystartupMessage} \alias{mySMHandler} \alias{buildStartupMessage} \title{Example functions to utilities for start-up messages} \description{ Illustration of package 'startupmsg'} \usage{ mySMHandler(c) mystartupMessage(..., domain = NULL, pkg = "", type="version", SMHandler=mySMHandler, endline = FALSE) buildStartupMessage(..., pkg, library=NULL, domain=NULL, packageHelp=FALSE, MANUAL = NULL, VIGNETTE = NULL, SMHandler=mySMHandler) } \arguments{ \item{c}{an object of class \code{StartupMessage}} \item{pkg}{a character string with the name of a single package} \item{library}{a character vector with path names of R libraries, or \code{NULL}. The default value of \code{NULL} corresponds to all libraries currently known. If the default is used, the loaded packages are searched before the libraries} \item{domain}{see \code{gettext}. If \code{NA}, messages will not be translated.} \item{type}{character -- the type part of an S3-object of class \code{StartupMessage}; currently, type should be in \code{c("version","notabene","information")}.} \item{SMHandler}{function to handle the output of an object of class \code{StartupMessage}, defaults to \code{mySMHandler}; btw: \code{SMHandler} stands for /S/tartup/M/essage/Handler/} \item{endline}{logical: shall there be an empty line (TRUE) or a line with linestarter in the end?} \item{packageHelp}{logical: is there help available as \code{?}\var{} ?} \item{MANUAL}{character or \code{NULL} if \code{!is.null(MANUAL)} the name of a manual distributed together with the package (with relative path within the library) or an URL} \item{VIGNETTE}{character or \code{NULL} if \code{!is.null(VIGNETTE)} an indication of one or more vignettes available to this package} \item{...}{character vectors (which are pasted together with no separator)} } \details{ \code{mystartupMessage} redirects the output of \code{startupMessage} to have a particular output function \code{SMHandler} issue the message; to see how such a function may be defined, have a look at code of the default function \code{mySMHandler}: \preformatted{ mySMHandler <- function(c) { pkg <- startupPackage(c) # get the package slot of c #prefix a starter for each new line of the message: linestarterN <- paste(":",pkg,"> ", sep ="") linestarterN <- paste("\n",linestarter, sep ="") linestarterE <- paste(linestarterN,"$",sep="") writeLines(paste(linestarter, sub(linestarterE,"\n", gsub("\n",linestarterN,conditionMessage(c))), sep=""),stderr())} } Just like for \code{startupMessage}, for \code{mystartupMessage}, too, restarts \code{muffleMessage()}, \code{onlytypeMessage(c0,atypes)}, \code{custom(c,f)} are available (confer \code{\link{startupmsg}}). To generate a complete start-up message, we provide \code{buildStartupMessage}: this function automatically generates \itemize{\item a start-up message of condition \code{StartupMessage} with type \code{"version"} as to the version information. \item additional messages of class \code{StartupMessage} and of type \code{"notabene"} according to the \dots argument \item a message of class \code{StartupMessage} and of type \code{"information"} mentioning\cr \itemize{\item \code{?"}\var{}\code{"} -- according to argument \code{packageHelp}, \item \code{NEWS("}\var{}\code{")}, if there is a \file{NEWS} file, \item \code{URL}, if there is a \code{URL} mentioned in the \file{DESCRIPTION} file, \item if there is a \code{MANUAL} argument, the file / the URL to this manual \item if there is a \code{VIGNETTE} argument, \code{VIGNETTE} is printed out indicating a vignette location } } The user may suppress the start-up messages produced by \code{buildStartupMessages} in two ways: Either by \code{suppressStartupMessages(expr)} and \code{onlyversionStartupMessages(expr, atypes="version")} as for \code{startupmessage} (confer \code{\link{startupmsg}}), or -- as proposed by Brian Ripley -- by \code{options}; let us describe the latter possibility here: \itemize{\item \code{options("StartupBanner" = "off")} switches off all start-up messages% \item if option \code{"StartupBanner"} is not defined (default) or setting \code{options("StartupBanner" = NULL)} or \code{options("StartupBanner" = "complete")} the complete start-up banner is displayed \item for any other value of option \code{"StartupBanner"} (i.e., not in \code{c(NULL, "off", "complete")}) only the version information is displayed \item from pkg version 1.0.0 on, the default of this option value is "no-version" (respectively "no - version"), which suppresses version information to avoid unnecessary cascade of pkg submissions to CRAN triggered by startup messages showing changed version information of attached/loaded packages up-stream. }% Also, from version 1.0.0 on, we show a hint on how to obtain version information of all attached packages, regardless of whether these use start-up messages managed by this packages; i.e.; through sessionInfo(). This hint is only shown once per session, but can also be switched on and off through \code{options("StartupShowHint_sessionInfo")} set to \code{TRUE} or \code{FALSE}, respectively. } \author{Peter Ruckdeschel \email{peter.ruckdeschel@uni-oldenburg.de}} \examples{ #---------------------------- ### save old option values ( oldOptionStartupBanner <- getOption("StartupBanner") ) ( oldOptionStartupShowHint_sessionInfo <- getOption("StartupShowHint_sessionInfo") ) ### #---------------------------- ## a set of test messages options("StartupBanner" = "complete") msg <- "Note that you may set global options by options() --- cf. ?\"options\"." ## issuing of messages controlled by options() buildStartupMessage(pkg = "stats", msg) suppressStartupMessages(buildStartupMessage(pkg = "stats", msg) ) suppressMessages(buildStartupMessage(pkg = "stats", msg)) onlytypeStartupMessages(buildStartupMessage(pkg = "stats", msg), atypes = "version") MNH <- "https://www.r-project.org/" buildStartupMessage(pkg = "stats", msg, packageHelp = TRUE, MANUAL = MNH) ## not quite a manual, but to illustrate the principle: ## "demo/nlm.R" as a "manual": to be system-independent the ## first call is to be preferred buildStartupMessage(pkg="stats", msg, packageHelp = TRUE, MANUAL = c("demo", "nlm.R")) ### works, too, (i.e. is equivalent) under Linux and Windows (at least): buildStartupMessage(pkg = "stats", msg, packageHelp = TRUE, MANUAL = "demo/nlm.R") ### #---------------------------- ### options switching on and off hints and details of start-up messages #---------------------------- buildStartupMessage(pkg = "stats", msg) options("StartupBanner" = "off") buildStartupMessage(pkg = "stats", msg) options("StartupBanner" = "complete") buildStartupMessage(pkg = "stats", msg) options("StartupBanner"="something else") buildStartupMessage(pkg="stats", msg) options("StartupBanner" = NULL) buildStartupMessage(pkg = "stats", msg) options("StartupBanner" = "no-version") ## default buildStartupMessage(pkg = "stats", msg) options("StartupBanner" = "no - version") options("StartupShowHint_sessionInfo" = FALSE) buildStartupMessage(pkg = "startupmsg", packageHelp = TRUE) options("StartupBanner" = "no - version") options("StartupShowHint_sessionInfo" = TRUE) buildStartupMessage(pkg = "startupmsg", packageHelp = TRUE) options("StartupBanner" = "no-version") buildStartupMessage(pkg = "startupmsg", packageHelp = TRUE) options("StartupBanner" = "complete") buildStartupMessage(pkg = "startupmsg", packageHelp = TRUE) ## restore old values options("StartupBanner" = oldOptionStartupBanner) options("StartupShowHint_sessionInfo" = oldOptionStartupShowHint_sessionInfo) rm(oldOptionStartupBanner, oldOptionStartupShowHint_sessionInfo) } \seealso{Mail "[Rd] Wishlist: 'quietly' argument for .onAttach() / .First.lib() " on r-devel by Brian Ripley, \url{https://stat.ethz.ch/pipermail/r-devel/2006-April/037281.html}} \keyword{utilities} \concept{startup} \concept{S3 message class} \concept{message} \concept{startup message} \concept{constructor} \concept{generating function} startupmsg/DESCRIPTION0000644000176200001440000000155414740735173014211 0ustar liggesusersPackage: startupmsg Encoding: UTF-8 Version: 1.0.0 Date: 2025-01-11 Title: Utilities for Start-Up Messages Description: Provides utilities to create or suppress start-up messages. Authors@R: person("Peter", "Ruckdeschel", role=c("cre", "cph", "aut"), email="peter.ruckdeschel@uni-oldenburg.de", comment = c(ORCID = "0000-0001-7815-4809")) Depends: R(>= 1.8.0) Imports: utils ByteCompile: yes License: LGPL-3 LastChangedDate: {$LastChangedDate: 2024-08-29 10:38:14 +0200 (Do, 29 Aug 2024) $} LastChangedRevision: {$LastChangedRevision: 1449 $} VCS/SVNRevision: 1482 NeedsCompilation: no Packaged: 2025-01-11 17:58:22 UTC; ruckdesc Author: Peter Ruckdeschel [cre, cph, aut] () Maintainer: Peter Ruckdeschel Repository: CRAN Date/Publication: 2025-01-12 12:50:03 UTC