R/bibentry.R

In rbibutils: Read 'Bibtex' Files and Convert Between Bibliography Formats

## Do not edit this file manually.
## It has been automatically generated from *.org sources.

readBibentry <- function(file, extra = FALSE, fbibentry = NULL){
    ## TODO: fixed encoding for now, but:
    ##   It is hardly worth the bother to consider other encodings.
    ##   First, bibConvert can produce 'file' in UTF-8.
    ##       Second, the argument 'encoding' of parse only asks it to mark the input with that
    ##       encoding, it does not re-encode. The only other acceptable value is "latin1".
    ##   Third, to allow other encodings 'file' in the call below, needs to be declared as a
    ##       connection with from/to encodings for iconv().
    exprs <- parse(n = -1, file = file, srcfile = NULL, keep.source = FALSE,
                   encoding = "UTF-8")

    if(!is.null(fbibentry)) # 2021-12-17 new
        bibentry <- fbibentry
    
    if(length(exprs) == 1){
        res <- try(eval(exprs), silent = TRUE)
        if(!inherits(res, "try-error")) { # TODO: check that it is bibentry?
            names(res) <- unlist(res$key)
            class(res) <- c("bibentryExtra", class(res))
            return(res)

        } else if(identical(exprs[[1]][[1]], as.name("c")))
            exprs <- exprs[[1]][-1]  # drop enclosing c()
    }

    envir <- environment()              # for (i in seq_along(exprs))  eval(exprs[i], envir)
    n <- length(exprs)
    wrk <- vector("list", n)
    caution <- list()
    ind_caution <- numeric(0)
    for (i in seq_along(exprs)){
        ## I collect the messages and at the end of the function print more suitable ones.
        wrk[[i]] <- tryCatch(eval(exprs[[i]], envir = envir),
                             error = function(e){
                                 txt <- if(is.null(exprs[[i]]$key))
                                            paste(as.character(exprs[[i]]), collapse = ", ")
                                        else
                                            paste0("key '", exprs[[i]]$key, "'")
                                 
                                 mess <- paste0(txt, "\n      ", geterrmessage() )
                                 caution <<- c(caution, mess)
                                 ind_caution <<- c(ind_caution, i)
                                 NA
                             }
                             ## ,
                             ##  warning = function(w){
                             ##      caution <<- c(caution, w)
                             ##      NA
                             ##  }
                             )
    }

    extraflag <- FALSE
    if(length(caution) > 0) {
        if(extra){
            for(j in seq_along(caution)){
                i <- ind_caution[j]
                bibtype_flag <- grepl("bibtype", caution[[j]]) &&
                    (grepl("has to be one of ", caution[[j]]) ||
                     ## has to specify the field: or (plural) has to specify the fields:
                     grepl("has to specify the field", caution[[j]]))
                if(bibtype_flag){
                    modbib <- exprs[[i]]
                    oldtype <- modbib$bibtype
                    modbib$bibtype <- "Misc"
                    
                    miscbib <- try(eval(modbib, envir = envir), silent = TRUE)  # simple 'try' for now
                    if(inherits(miscbib, "try-error")){
                        caution[[j]] <- paste0(caution[[j]],
                                               "\n  NOT FIXED.")
                        next
                    }
                    
                    curbib <- unclass(miscbib)
                       # curbib$bibtype <- oldtype # no, bibtype is attribute!
                    attr(curbib[[1]], "bibtype") <- oldtype  # bibtype is attribute!
                    class(curbib) <- "bibentry"
                    wrk[[i]] <- curbib
                    ## 2021-10-16 was:  caution[[j]] <- ""  # success, no need for the message
                    caution[[j]] <- paste0("\nMessage: ", caution[[j]],
                                "\n  FIXED (the returned object will be 'bibentryExtra').\n")
                    extraflag <- TRUE
                }else{
                        caution[[j]] <- paste0(caution[[j]], "\n  NOT FIXED.")
                }
            }

        }

        ## message("\nTried to fix above errors/warnings, see the warnings and messages below.\n")
        for(i in seq_along(caution))
            if(caution[[i]] != ""){
                if(grepl("NOT FIXED", caution[[i]]))
                    warning(caution[[i]])
                else
                    message(caution[[i]])
            }
    }

    ind <- sapply(wrk, function(x) identical(x, NA))
    wrk <- wrk[!ind]

    if(length(wrk) > 0){       # wrk is list of bibentry objects or list()
        res <- do.call("c", wrk)
        names(res) <- unlist(res$key) # TODO: what if 'key' is missing in some entries?  #
                                      #    (this cannot happen for the output of bibConvert()
                                      #    though). If you change this, don't forget to do it
                                      #    also for the return statement earlier in this
                                      #    function!
    } else
        res <- bibentry()

    ## 2023-11-04 - unconditionally set the class
    ## if(extraflag)
    class(res) <- c("bibentryExtra", class(res))

    res
}

writeBibentry <- function(be, file = stdout(), style = c("Rstyle", "loose")){
    style <- match.arg(style)

    collapse <- style == "Rstyle"

    wrk <- format(be, style = "R", collapse = collapse)
    if(!collapse && length(wrk) > 1) { # "loose"
        wrk <- c(wrk[1], paste0("\n", wrk[-1]))
    }

    writeLines(wrk, file)
    invisible()
}

## L. Lamport's entry types (2nd edition of his book).
##
## 'Conference' is omitted here as it was a compatibility feature even back then. itAlso, it
## has a misleading name, as it is equivalent to 'InProceedings'.
##
## These are also the styles supported by the "JSS" bibstyle. 
standard_bibtex_entry_types <-
  c( "Article", "Book", "Booklet", "InBook", "InCollection", "InProceedings", "Manual",
    "MastersThesis", "Misc", "PhdThesis", "Proceedings", "TechReport", "Unpublished" )

.mangle_nonstandard_types <- function(x, all_types = FALSE){
    bibtype <- sapply(x$bibtype, function(y) if(is.null(y)) "" else y)
    if(all_types){
        tbt <- x$truebibtype
        flags <- (bibtype != "Misc") &
                 if(length(tbt) > 1) sapply(x$truebibtype, is.null) else is.null(x$truebibtype)
    }else{
        flags <- !(bibtype %in% standard_bibtex_entry_types)
    }

    y <- unclass(x[flags])
    class(x) <- "bibentry"  # TODO: Why is this? Is it necessary? Is it ok?
    if(length(y) > 0) {
        y <- lapply(y, function(s){
                           s$truebibtype <- attr(s, "bibtype")
                           attr(s, "bibtype") <- "Misc"
                           s
                       })
        class(y) <- "bibentry"
        class(x) <- "bibentry"  # TODO: Why is this? Is it necessary? Is it ok?
        x[flags] <- y
    }
    ## TODO: see the note above about class(x) <- "bibentry"
    x
}

.unmangle_nonstandard_types <- function(x){
    ##browser()        
    flags <- if(is.null(x$truebibtype))
                 FALSE
             else
                 unlist(x$bibtype) == "Misc"  &
                     sapply(x$truebibtype, function(x) !is.null(x))
    if(!any(flags))
        return(x)
    
    y <- unclass(x) ## 2023-11-06 was: unclass(x[flags]) - cuts the return value!
    ## 2023-11-06 was: ... , USE.NAMES = FALSE)
    ##    but lapply doesn't have argument USE.NAMES!
    y <- lapply(y, function(s){
                       if(!is.null(s$truebibtype)) {
                           attr(s, "bibtype") <- s$truebibtype
                           s[["truebibtype"]] <- NULL
                       }
                       s
                   })
    
    ##class(y) <- "bibentry"
    y
}

bibentryExtra <- function(bibtype = NULL, ...) {
    res <- if(length(bibtype) == 0){
               bibentry(bibtype, ...)
           } else {
               stopifnot(is.character(bibtype))
               
               flags <- !(bibtype %in% standard_bibtex_entry_types)
               if(any(flags)) {
                   truebibtype <- bibtype
                   truebibtype[flags] <- bibtype[flags]
                   bibtype[flags] <- "Misc"
                   wrk <- bibentry(bibtype, ..., truebibtype = truebibtype)
                   .unmangle_nonstandard_types(wrk)
                   ## so 'res' is 'list' from this branch
               } else {
                   bibentry(bibtype, ...)
               }
           }
    class(res) <- c("bibentryExtra", "bibentry")
    res
}

as.bibentryExtra <- function(x, ...) {
    UseMethod("as.bibentryExtra")
}

as.bibentryExtra.bibentry <- function(x, ...){
    x <- .unmangle_nonstandard_types(x)
    class(x) <- c("bibentryExtra", class(x))
    x
}

format.bibentryExtra <- function (x, style = "text", .bibstyle = "JSSextra", collapse = TRUE,
                                  ...){
    ## ... contains further arguments for format.bibentry

    if(!is.null(.bibstyle) && .bibstyle == "JSSextra"  &&
       !("JSSextra" %in% getBibstyle(TRUE)))
        register_JSSextra()
    
    x <- .mangle_nonstandard_types(x, TRUE)

    orig_collapse <- collapse
    collapse <- FALSE

    wrk <- NextMethod()

    collapse <- orig_collapse

    if(style == "R"){
        begpat <- "^[[:space:]]*c?\\(?bibentry\\(bibtype[[:space:]]*=[[:space:]]*\"([^\"]+)\",[[:space:]]*"
        starts <- which(grepl(begpat, wrk))
        b <- regexec(begpat, wrk)
 
        endpat <- "(,?[[:space:]]*truebibtype[[:space:]]*=[[:space:]]*)\"([^\"]+)\"[[:space:]]*"
        ends <- which(grepl(endpat, wrk))
        e <- regexec(endpat, wrk)

        if(length(starts) < length(ends))
            stop("mismatch between starts and ends")
        else if(length(starts) > length(ends)){
            bmatched <- numeric(length(ends))
            for(k in seq_len(length(ends))){
                prev <- starts[starts <= ends[k]]  # 2023-11-05 changed '<' to '<='
                bmatched[k] <- prev[length(prev)]
            }
            starts <- bmatched
        }

        for(i in seq_along(starts)){
            ecur <- e[[ends[i]]]
            pos_truebibtype <- ecur[2] + c(0, attr(ecur, "match.length")[2] - 1)
            pos_truetype <- ecur[3] + c(0, attr(ecur, "match.length")[3] - 1)
            truetype <- substr(wrk[ends[[i]]], pos_truetype[1], pos_truetype[2])
            chafter <- substr(wrk[ends[[i]]], ecur[3], ecur[3] )
                                                # ecur[3] + attr(ecur, "match.length")[3] - 1

            pos_endpat <- ecur[1] + c(0, attr(ecur, "match.length")[1] - 1)
            
            ## restore the true type of the bib entry
            bcur <- b[[starts[i]]]

            ## positions of the faketype
            bpos <- bcur[2] + c(0, attr(bcur, "match.length")[2] - 1)
            faketype <- substr(wrk[starts[[i]]], bpos[1], bpos[2])

            ## what is after the end of the truebibtype stuff
            rest <- substring(wrk[ends[[i]]], ecur[3] + 1) 

            begline <- paste0(substr(wrk[starts[[i]]], 1, bpos[1] - 1),
                              truetype,
                              substring(wrk[starts[[i]]], bpos[2] + 1,
                                        pos_truebibtype[1] - 1),
                              substring(wrk[starts[[i]]], pos_endpat[2] + 1)
                       )
            wrk[starts[[i]]] <- begline
        }

        if(collapse && length(wrk) > 1)
            wrk <- paste(c("c(",
                           paste0("  ", wrk, collapse = ",\n\n"),
                           ")\n"), collapse = "\n")
      
    }else if(style == "bibtex"){

               # "^[[:space:]]*@([^\"]+)[[:space:]]*\{.*([[:space:]]*truetype = "
        pat_bibtype <- "^[[:space:]]*@([^{ ]+)"
        pat_truebibtype <- "[[:space:]]+truebibtype = \\{([^}\"]*)\\},?"
        
        wrk <- sapply(wrk,
                      function(be){
                          if(grepl(pat_truebibtype, be)){
                              match_bibtype <- regexec(pat_bibtype, be)
                              ecur <- match_bibtype[[1]]
                              ind_bt <- ecur[2] + c(0, attr(ecur, "match.length")[2] - 1)
                              bt <- substr(be, ind_bt[1], ind_bt[2])
                              
                              match_truebibtype <- regexec(pat_truebibtype, be)
                              ecur <- match_truebibtype[[1]]
                              ind_tbt <- ecur[2] + c(0, attr(ecur, "match.length")[2] - 1)
                              tbt <- substr(be, ind_tbt[1], ind_tbt[2])

                              ## drop field truebibtype
                              be <- paste0(substr(be, 1, match_truebibtype[[1]][1] - 1),
                                           substring(be, match_truebibtype[[1]][1] +
                                                         attr(match_truebibtype[[1]],
                                                              "match.length")[1]))
                              ## replace the internal bib type with the true one.
                              be <- paste0("@", tbt, substring(be, ind_bt[2] + 1))

                              be
                          }else
                              be
                      }
                      )
        wrk <- as.vector(wrk) # drop the attributes (TODO: maybe should leave them, they come
                              # from nextMethod(), so maybe they are there for a reason?
    }

    wrk
}

print.bibentryExtra <- function(x, style = "text", .bibstyle = "JSSextra", ...){
    if(length(x) == 0) {
        cat("This object from class ", class(x)[[1]], " contains no data.\n", sep = "")
    } else {
        wrk <- format(x, style = style, .bibstyle = .bibstyle, ...)
        cat(wrk, sep = "\n\n")
    }
    invisible(x)
}

## These can piggyback on the bibentry methods:
## 
## `$.bibentryExtra`

## utils:::bibentry_attribute_names is not exported
.bibentry_attribute_names <- 
    c("bibtype", "textVersion", "header", "footer", "key")

## utils:::bibentry_list_attribute_names
.bibentry_list_attribute_names <- 
    c("mheader", "mfooter")

`[[.bibentryExtra` <- function(x, i, j, drop = TRUE){

    ## TODO: make this method similar to `[[<-.bibentryExtra` (using a list, instead of 'j') ?
    ##       2023-11-06 TODO: This seems to have been done, see the first 'if' below.

    ## if(!length(x)) return(x)
    
    Narg <- nargs() - !missing(drop)
    j.omitted   <- Narg >= 3  && missing(j)
    j.has.value <- !missing(j)

    if(missing(j) && !j.omitted){
        if(is.list(i)){
            ## this is for symmetry with `[[<-` which can't have argument j
            if(length(i) == 2){ 
                j.has.value <- TRUE
                j <- i[[2]]
                i <- i[[1]]
            }else
                stop("if 'i' is a list it should have length 2")
        }else{
            ## 2023-11-17 now i should be 1 even when passing it to NextMethod()
            if(length(i) != 1)
                stop("length of i should be 1")
            x <- NextMethod()
            return(x)
        }
    }

    if(length(i) != 1)
        stop("length of i should be 1 when j is not missing or omitted")

    res <- unclass(x)

    if(is.character(i)){
        keys <- sapply(res, function(x){
                                key <- attr(x, "key")
                                if(is.null(key)) "" else key})
        i <- which(keys == i) # i is of length 1 here
    }

    res <- res[[i]]
    if(j.has.value){
        if(!is.character(j))
            stop("j mist be character or omitted")
        chind <- intersect(j, names(res))   # !all(j %in% names(res))
        a <- attributes(res)
        res <- res[chind] # empty list if chind is character(0)
        if(!drop){
            ## attr(res, "bibtype") <- a$bibtype
            ## attr(res, "key") <- a$key
            attributes(res)[.bibentry_attribute_names] <- a[.bibentry_attribute_names]
        }
    }

    if(drop && length(res) == 1)
        structure(res[[1]], names = names(res)) # trying to keep the name
    else
        res
}

`[.bibentryExtra` <-
function(x, i, j, drop = TRUE)
{
    mdrop <- missing(drop)
    Narg <- nargs() - !mdrop
    j.omitted <- Narg >= 3  && missing(j)

    ## argument drop is (currently?) used only by the inherited bibentry method
    if(missing(j) && !j.omitted){
        x <- NextMethod()
        return(x)
    }

    cl <- class(x)
    res <- unclass(x)
    if(missing(i))
        i <- seq_along(res)
    ## 2023-11-18 changing after creating names.bibentryExtra, was:
    ## else if(is.character(i) && is.null(names(x))){
    ##     names(res) <- sapply(x$key, function(y) if(is.null(y)) "" else y)
    else if(is.character(i) && is.null(names(res))){
        names(res) <- names(x)
    }
    res <- res[i]

    if(!missing(j)){
        ## (:TODO:) TO CONSIDER:
        ##
        ## The result (bibentryExtra object) may be missing compulsory fields.
        ## Note that interactively printing the result will show informative messages.
        ##
        ## Should this be allowed? -- it enables incrementally building reference(s) and
        ## keeps the key and bibtype.
        ##  
        if(!is.character(j))
            stop("j mist be character or omitted")

        for(ind in seq_along(res)){
            wrk <- res[[ind]]
            chind <- intersect(j, names(wrk))
            ## TODO: more care with attributes?
            a <- attributes(wrk)
            wrk <- wrk[chind] # empty list if chind is character(0)
            if(length(chind) == 0)
                wrk <- add_dummy_field(wrk)
            attributes(wrk)[.bibentry_attribute_names] <- a[.bibentry_attribute_names]
            res[[ind]] <- wrk
        }
    }
    class(res) <- cl
    res
}

add_dummy_field <- function(x) {
    x[[".zzz"]] <- "This is an empty bibliography entry"
    x
}

nulls_to_chars <- function(x) {
    ## assume for now that the non-null elements are character(1),
    ## is unlist necessary under this assumption?
    unlist(sapply(x, function(y) if(is.null(y)) "" else y))
}

## TODO: export after thinking out a better name? Or maybe this is already good?
drop_dummy_bib_entries <- function(x) {
    wrk <- nulls_to_chars(x$.zzz)
    flags <- wrk == ""
    x[flags] 
}

## TODO:export
drop_empty_bib_entries <- function(x) {
    x <- drop_dummy_bib_entries(x)
    flags <- lengths(x) == 0
    x[flags]
}

`$<-.bibentryExtra` <- function(x, name, value){
    cl <- class(x)
    if(name == "bibtype") {
        name <- "truebibtype"
        if(is.character(value))
            value <- as.list(value)
    }
    
    x <- .mangle_nonstandard_types(x)
    x <- NextMethod()
    x <- .unmangle_nonstandard_types(x)
    class(x) <- cl
    invisible(x)
}

`[[<-.bibentryExtra` <- function(x, i, value){

    cl <- class(x)
    res <- unclass(x)

    if(inherits(value, "bibentry")){   # bibentryExtra ?
        if(length(value) != 1)
            stop("value should contain exactly one bib reference")
        if(length(i) != 1)
            stop("i should have length 1")
        
        wrk <- unclass(value)[[1]]  # drop the enclosing list
        res[[i]] <- wrk
        
    }else if(is.list(i)){   # value should be a list of named fields in this case or a
                            # character vector of the same length as i[[2]]
        stopifnot(length(i) == 2)
        target_fields <- i[[2]]
        i <- i[[1]]
        if(length(i) != 1)
            stop("i should have length 1")
        
        if(is.character(target_fields)) {
            fields <- names(value)
            if(length(fields) == 0){
                if(length(target_fields) == length(value) &&
                   !(length(target_fields) == 1 && target_fields == "*")){
                    names(value) <- target_fields
                    fields <- target_fields
                }else
                    stop("unsuitable 'i' and/or 'value'")
            }
            if(length(target_fields) == 1  && target_fields == "*") {
                ## add all fields from 'value'
                for(field in fields){
                    res[[i]][[field]] <- value[[field]] 
                }
            }else{
                ## add only fields in target_fields
                for(field in intersect(target_fields, fields)){
                    res[[i]][[field]] <- value[[field]] 
                }
            }
        }else{
            stop("i[[2]] should be a character vector")
        }
    }else{
        stop("incompatible arguments: 'value' and 'i'")
    }
    
    class(res) <- cl
    res
}

## c.bibentryExtra
## toBibtex.bibentry

## sort.bibentry

## rep.bibentry
## unique.bibentry

c.bibentryExtra <- function (..., recursive = FALSE){
    args <- list(...)
    ## if (!all(vapply(args, inherits, NA, "bibentry"))) 
    ##     warning(gettextf("method is only applicable to %s objects", 
    ##         sQuote("bibentry")), domain = NA)

    args <- lapply(args, function(x){if(inherits(x, "bibentryExtra")){
                                         wrk <- .mangle_nonstandard_types(x)
                                         class(wrk) <- "bibentry"
                                         wrk
                                     } else 
                                         x
                                    })
    res <- do.call(c, c(args, recursive = recursive))
    res <- .unmangle_nonstandard_types(res)
    class(res) <- c("bibentryExtra", "bibentry")
    res
}

toRd.bibentryExtra <- function(obj, style="JSSextra", ...) {
    obj <- .mangle_nonstandard_types(obj)
    class(obj) <- "bibentry"
    res <- NextMethod()
    res
}

names.bibentryExtra <- function(x) {
    if(is.null(attr(x, "names"))) {
        if(length(x) == 0)
            return(character(0))
        ## x$key is portable, doesn't depend on internal structure
        wrk <- x$key
        flags <- sapply(wrk, is.null)
        if(any(flags))
            wrk[flags] <- ""
        unlist(wrk)
    } else {
        attr(x, "names")
    }
}

## from Lamport's book; 'conference' excluded as obsolete even then, and confusing.
bibtex_fields <- list(
    required = list(
        Article       = c("author", "title", "journal", "year"),
        Book          = c("author or editor", "title", "publisher", "year"),
        Booklet       = c("title"),
        InBook        = c("author or editor", "title", "chapter and/or pages", "publisher", "year"),
        InCollection  = c("author", "title", "booktitle", "publisher", "year"),
        InProceedings = c("author", "title", "booktitle", "year"),
        Manual        = c("title"),
        MastersThesis = c("author", "title", "school", "year"),
        Misc          = c(),
        PhdThesis     = c("author", "title", "school", "year"),
        Proceedings   = c("title", "year"),
        TechReport    = c("author", "title", "institution", "year"),
        Unpublished   = c("author", "title", "note")
    ),

    optional = list(
        Article       = c("volume", "number", "pages", "month", "note"),
        Book          = c("volume or number", "series", "address", "edition", "month", "note"),
        Booklet       = c("author", "howpublished", "address", "month", "year", "note"),
        InBook        = c("volume or number", "series", "type", "address", "edition", "month", "note"),
        InCollection  = c("editor", "volume or number", "series", "type", "chapter", "pages", "address", "edition", "month", "note"),
        InProceedings = c("editor", "volume or number", "series", "pages", "address", "month", "organization", "publisher", "note"),
        Manual        = c("author", "organization", "address", "edition", "month", "year", "note"),
        MastersThesis = c("type", "address", "month", "note"),
        Misc          = c("author", "title", "howpublished", "month", "year", "note"),
        PhdThesis     = c("type", "address", "month", "note"),
        Proceedings   = c("editor", "volume or number", "series", "address", "month", "organization", "publisher", "note"),
        TechReport    = c("type", "number", "address", "month", "note"),
        Unpublished   = c("month", "year")
    ),

    other = c("key")
)

verify_bibtex_type_fields <- function(bibtype, fields, nonstandard = TRUE) {
    if(is.null(bibtype))
        return(logical(0))
    stopifnot(length(bibtype) == 1)
    
    if(is.null(fields))
        return(bibtype == "Misc")
    
    switch(bibtype,
           Article       = all(c("author", "title", "journal", "year") %in% fields),
           
           Book          = any(c("author", "editor") %in% fields)  &&
                           all(c("title", "publisher", "year") %in% fields),
           
           Booklet       = "title" %in% fields,

           InBook        = any(c("author", "editor") %in% fields)  &&
                           any(c("chapter", "pages") %in% fields)  &&
                           all(c("title", "publisher", "year") %in% fields),
           
           InCollection  = all(c("author", "title", "booktitle", "publisher", "year") %in% fields),
           InProceedings = all(c("author", "title", "booktitle", "year") %in% fields),
           Manual        = "title" %in% fields,
           MastersThesis = all(c("author", "title", "school", "year") %in% fields),
           Misc          = TRUE,
           PhdThesis     = all(c("author", "title", "school", "year") %in% fields),
           Proceedings   = all(c("title", "year") %in% fields),
           TechReport    = all(c("author", "title", "institution", "year") %in% fields),
           Unpublished   = all(c("author", "title", "note") %in% fields),
           
           default       = nonstandard
           )
}

verify_bibtex_bee <- function(bee) {
    types <- bee$bibtype
    types[is.null(types)] <- ""
    field_names <- lapply_bee(bee, names)
    res <- .mapply(verify_bibtex_type_fields, list(types, field_names), NULL)
    unlist(res)
}

lapply_bee <- function(bee, FUN, ..., null = "") {
    res <- lapply(unclass(bee), FUN, ...)
    res[is.null(res)] <- null
    res
}