Created
October 1, 2025 01:06
-
-
Save jmbarbone/d07af42862382cfd2b8cb04838f0aaf4 to your computer and use it in GitHub Desktop.
R environment/class for handling handlers
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| global_calling_handlers <- local({ | |
| . <- environment() | |
| class(.) <- c("cnd:global_calling_handlers", "environment") | |
| .handlers <- NULL | |
| handlers <- NULL | |
| add <- function(...) { | |
| "Adds calling handlers | |
| If handlers with the same name already exist, they are replaced. | |
| @param ... Named calling handler functions to add | |
| " | |
| globalCallingHandlers(NULL) | |
| temp <- unique(c(list(...), handlers)) | |
| do.call(globalCallingHandlers, temp) | |
| handlers <<- temp | |
| . | |
| } | |
| remove <- function(...) { | |
| "Removes calling handlers by name or by value | |
| If character vectors are provided, these are matched against the names of | |
| the current handlers. If functions are provided, these are matched by | |
| value. | |
| @param ... Names (character) or handler functions to remove | |
| " | |
| template <- handlers | |
| to_remove <- list(...) | |
| for (i in seq_along(to_remove)) { | |
| if (is.character(to_remove[[1L]])) { | |
| template <- template[names(template) != to_remove[[i]]] | |
| } else { | |
| template <- Filter( | |
| function(h) !identical(h, to_remove[[i]]), | |
| template | |
| ) | |
| } | |
| } | |
| globalCallingHandlers(NULL) | |
| handlers <<- template | |
| do.call(globalCallingHandlers, template) | |
| . | |
| } | |
| get <- function(x = NULL) { | |
| "Retrieves the current calling handlers, or a subset if names are | |
| provided | |
| @param x A character vector of names of handlers to retrieve. If NULL, | |
| returns all handlers. | |
| " | |
| if (is.null(x)) { | |
| return(handlers) | |
| } | |
| handlers[match(names(handlers), x, 0L)] | |
| } | |
| reset <- function() { | |
| "Reset all calling handlers to original state" | |
| globalCallingHandlers(NULL) | |
| do.call(globalCallingHandlers, .handlers) | |
| handlers <<- NULL | |
| . | |
| } | |
| function() { | |
| "Creates a new global calling handlers environment" | |
| handlers <- .handlers <<- globalCallingHandlers() | |
| . | |
| } | |
| }) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment