# Package hooks
#
# Author: renaud
# Creation: 26 Jun 2012
###############################################################################
#' @include utils.R
#' @include devutils.R
#' @import stats methods utils grDevices graphics
NULL
#' Default Load/Unload Functions
#'
#' @inheritParams base::.onLoad
#' @inheritParams base::library.dynam
#'
#' @return Returns nothing, used only for their side-effects.
#' @export
#' @rdname load
#'
#' @examples
#'
#' # in a package namespace:
#' .onLoad <- function(libname=NULL, pkgname){
#'
#' pkgmaker::onLoad(libname, pkgname)
#'
#' }
onLoad <- function(libname=NULL, pkgname, chname=packageName()){
# load compiled library normally or in devmode
if( !is.null(libname) ){
if( file.exists(packagePath('libs')) ){
sapply(chname, library.dynam, package=pkgname, lib.loc=libname)
}
}else{
compile_src() # compile source files and load
}
}
#' @inheritParams base::.onUnload
#' @export
#' @rdname load
#'
#' @examples
#'
#' # in a package namespace:
#' .onUnload <- function(libpath){
#'
#' pkgmaker::onUnload(libpath)
#'
#' }
onUnload <- function(libpath) {
# unload compiled library normally or in devmode
dlls <- base::getLoadedDLLs()
pname <- packageName()
if ( pname %in% names(dlls) ){
if( !missing(libpath) ) library.dynam.unload(pname, libpath)
else dyn.unload(dlls[[pname]][['path']])
}
}
#' Postponing Actions
#'
#' This function implement a mechanism to postpone actions, which can be executed
#' at a later stage.
#' This is useful when developing packages, where actions that need to be run in the
#' \code{link{.onLoad}} function but can be defined close to their context.
#'
#' @param expr expression that define the action to postpone.
#' Currently only functions are supported.
#' @param key identifier for this specific action.
#' It should be unique across the postponed actions from the same group.
#' @param group optional parent action group.
#' This enables to define meaningful sets of actions that can be run all at once.
#' @param envir environment in which the action should be executed.
#' Currently not used.
#' @param verbose logical that toggles verbose messages.
#'
#'
#' @return `postponeAction` returns the names of the postponed actions.
#'
#' @import digest
#' @export
#'
#' @examples
#' opt <- options(actions.verbose=2)
#'
#' # define actions
#' postponeAction(function(){print(10)}, "print")
#' postponeAction(function(){print(1:10)}, "more")
#' postponeAction()
#' # execute actions
#' runPostponedAction()
#' runPostponedAction()
#'
#' # restore options
#' options(opt)
#'
postponeAction <- function(expr, key=digest(tempfile()), group=NULL, envir=topns(strict=FALSE),
verbose = getOption('actions.verbose', getOption('verbose'))){
# do not do anything if already running delayed actions
if( isRunningPostponedAction() ) return()
ns <- topns(strict=FALSE)
taskObj <- simpleRegistry('.__delayedTasks__', envir=ns)
if( !missing(expr) ){
if( missing(key) ){
stop("Missing required argument `key` for registering/cancelling delayed action.")
}
# add group prefix
if( !is.null(group) )
key <- str_c(group, '::', key)
#qe <- if( !is.language(expr) ) substitute(expr) else expr
qe <- expr
if( verbose ){
if( !is.null(qe) ) message("# Postponing action '", key, "'")
else{
message("# Cancelling postponed action '", key, "'")
}
}
taskObj$set(key, list(action=qe, envir=envir))
}else{
taskObj$names()
}
}
#' @rdname postponeAction
#' @export
runPostponedAction <- function(group=NULL, verbose = getOption('actions.verbose', getOption('verbose'))){
ns <- topns(strict=FALSE)
taskObj <- simpleRegistry('.__delayedTasks__', envir=ns)
if( verbose ){
message("# Executing postponed "
, if( !is.null(group) ) paste("'", group, "' ", sep='')
, "action(s) in package '"
, packageName(ns, .Global=TRUE), "' ... "
, appendLF = FALSE)
}
# set up running flag
isRunningPostponedAction(TRUE)
on.exit(isRunningPostponedAction(FALSE))
#
# execute actions
t <- taskObj$names()
if( !is.null(group) ) t <- grep(str_c("^", group), t, value=TRUE)
if( verbose > 1 && length(t) ) message()
sapply(t, function(x){
act <- taskObj$get(x)
if( verbose > 1 ){
message("** Action '", x, "' [", packageName(act$envir, .Global=TRUE), ']')
}
act$action()
taskObj$set(x, NULL)
#eval(x$expr, x$envir)
})
if( verbose ) message('OK [', length(t), ']')
invisible(length(t))
}
# Tells if one is executing deferred tasks via \code{onLoad}
isRunningPostponedAction <- sVariable(FALSE)
#' Simple Package Registry
#'
#' @param name name of the registry object, with which it will
#' be assigned in \code{envir}.
#' @param envir environment where to store the registry object.
#' Defaults to the caller's top environment.
#' @param verbose logical that toggle a verbose message when
#' the object is first created.
#'
#' @return a simple registry object that is similar to an R5 object.
#' @export
simpleRegistry <- function(name, envir=topenv(parent.frame()), verbose=FALSE){
# return stored instance if it exists
if( exists(name, envir=envir) ){
return( invisible(get(name, envir=envir)) )
}
if( verbose ) message("# Setup simple registry '", name, "' in ", packageName(envir, .Global=TRUE))
.name <- name
.envir <- envir
.data <- list()
.get <- function(x){
if( .has(x) ){
.data[[x]]
}
}
.set <- function(x, value){
if( is.null(value) ){
if( .has(x) ){
.data[[x]] <<- NULL
}
}else{
.data[[x]] <<- value
}
}
.has <- function(x){
x %in% names(.data)
}
.cleanup <- function(){
rm(.name, envir=.envir)
}
.names <- function(){
names(.data)
}
.length <- function(){
length(.data)
}
.obj <- list(get=.get, set=.set, has=.has
, cleanup=.cleanup, names=.names
, length = .length)
# assign container object
assign(.name, .obj, envir=.envir)
#
invisible(.obj)
}
#' Defunct Functions in pkgmaker
#'
#' These functions have been defunct or superseded by other
#' functions.
#'
#' @param ... extra arguments
#' @rdname pkgmaker-defunct
#' @name pkgmaker-defunct
NULL
#' Deprecated Functions in pkgmaker
#'
#' These functions have been deprecated and will be defunct in the next release.
#'
#' @param ... extra arguments
#'
#' @rdname pkgmaker-deprecated
#' @name pkgmaker-deprecated
NULL
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.