src/library/utils/R/apropos.R

#  File src/library/utils/R/apropos.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2016 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

## a list from base-internal.Rd
.dot_internals <- c(".subset", ".subset2", ".getRequiredPackages",
                    ".getRequiredPackages2", ".isMethodsDispatchOn",
                    ".row_names_info", ".set_row_names", ".ArgsEnv",
                    ".genericArgsEnv", ".TAOCP1997init", ".gt",
                    ".gtn", ".primTrace", ".primUntrace",
                    ".POSIXct", ".POSIXlt", ".cache_class",
                    ".Firstlib_as_onload", ".methodsNamespace",
                    ".popath", ".mapply", ".detach", ".maskedMsg")


apropos <- function (what, where = FALSE, ignore.case = TRUE, mode = "any")
{
    stopifnot(is.character(what))
    x <- character(0L)
    check.mode <- mode != "any"
    for (i in seq_along(sp <- search())) {
	li <-
	    if(ignore.case)
		grep(what, ls(pos = i, all.names = TRUE),
		     ignore.case = TRUE, value = TRUE)
	    else ls(pos = i, pattern = what, all.names = TRUE)

        ## Treat anything starting with .__, .C_R or .F_ as internal
        li <- grep("^[.](__|C_|F_)", li, invert = TRUE, value = TRUE)
        if(sp[i] == "package:base") li <- li[! li %in% .dot_internals]

	if(length(li)) {
	    if(check.mode)
		li <- li[vapply(li, exists, NA, where = i,
				mode = mode, inherits = FALSE)]
	    x <- c(x, if(where) structure(li, names = rep.int(i, length(li))) else li)
	}
    }
    sort(x)
}

find <- function(what, mode = "any", numeric = FALSE, simple.words=TRUE)
{
    stopifnot(is.character(what))
    if(length(what) > 1L) {
        warning("elements of 'what' after the first will be ignored")
        what <- what[1L]
    }
    len.s <- length(sp <- search())
    ind <- logical(len.s)
    check.mode <- mode != "any"
    for (i in 1L:len.s) {
        if(simple.words) {
            found <- what %in% ls(pos = i, all.names = TRUE)
            if(found && check.mode)
                found <- exists(what, where = i, mode = mode, inherits=FALSE)
            ind[i] <- found
        } else {
            li <- ls(pos = i, pattern = what, all.names = TRUE)
            ## Treat anything starting with .__, .C_R or .F_ as internal
            li <- grep("^[.](__|C_|F_)", li, invert = TRUE, value = TRUE)
            if(sp[i] == "package:base") li <- li[! li %in% .dot_internals]
            ll <- length(li)
            if(ll > 0 && check.mode) {
                mode.ok <- vapply(li, exists, NA, where = i, mode = mode,
                                  inherits = FALSE)
                ll <- sum(mode.ok)
                if(ll >= 2) # some languages have multiple plurals
                    warning(sprintf(ngettext(ll,
                                             "%d occurrence in %s",
                                             "%d occurrences in %s"), ll, sp[i]),
                            domain = NA)
            }
            ind[i] <- ll > 0L
        }
    }
    ## found name in  search()[ ind ]
    if(numeric) structure(which(ind), names=sp[ind]) else sp[ind]
}