modularize --> internal .isExported(name, pkg) and .maybeUnhideName(n…

…ame, pkg)

git-svn-id: https://svn.r-project.org/R/trunk@87060 00db46b3-68df-0310-9c12-caf00c1e9a41

src/library/methods/R/RMethodUtils.R

@@ -491,6 +491,15 @@ getGeneric <-
  value
 }
 
+##' Is `name` from package `pkg` *exported* from the package namespace ?
+.isExported <- function(name, pkg)
+ pkg == ".GlobalEnv" || isBaseNamespace(ns <- asNamespace(pkg)) ||
+ name %in% names(.getNamespaceInfo(ns, "exports"))
+
+.maybeUnhideName <- function(name, pkg)
+ if(.isExported(name, pkg)) name else paste(pkg, name, sep=":::")
+
+
 ## cache and retrieve generic functions. If the same generic name
 ## appears for multiple packages, a named list of the generics is cached.
 .genericTable <- new.env(TRUE, baseenv())
@@ -740,9 +749,9 @@ getGenerics <- function(where, searchForm = FALSE)
  ## all the packages cached ==? all packages with methods
  ## globally visible. Assertion based on cacheMetaData + setMethod
  fdefs <- as.list(.genericTable, all.names=TRUE, sorted=TRUE)
- fnames <- mapply(function(nm, obj) {
- if (is.list(obj)) names(obj) else nm
- }, names(fdefs), fdefs, SIMPLIFY=FALSE)
+ fnames <- mapply(function(nm, obj) if(is.list(obj)) names(obj) else nm,
+  names(fdefs), fdefs, SIMPLIFY=FALSE)
+### FIXME: at least *optionally* we want to filter (aka "drop") *non*-exported S4 generics
  packages <- lapply(fdefs, .packageForGeneric)
  new("ObjectsWithPackage", unlist(fnames), package=unlist(packages))
  }

src/library/methods/R/show.R

@@ -1,7 +1,7 @@
 # File src/library/methods/R/show.R
 # Part of the R package, https://www.R-project.org
 #
-# Copyright (C) 1995-2020 The R Core Team
+# Copyright (C) 1995-2024 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
@@ -105,13 +105,10 @@ show <- function(object) showDefault(object)
  cat("\n")
  show(object@.Data)
  pkg <- object@package
- exported <- pkg == ".GlobalEnv" || isBaseNamespace(ns <- asNamespace(pkg)) ||
- nam %in% names(.getNamespaceInfo(ns, "exports"))
  qnam <- deparse1(as.name(nam), backtick = TRUE) # was dQuote(nam, NULL)
- showGen <- if(exported) qnam else paste(pkg, qnam, sep=":::")
  cat("Methods may be defined for arguments: ",
  paste0(object@signature, collapse=", "), "\n",
- "Use showMethods(", showGen,
+ "Use showMethods(", .maybeUnhideName(qnam, pkg),
  ") for currently available ones.\n", sep="")
  if(.simpleInheritanceGeneric(object))
  cat("(This generic function excludes non-simple inheritance; see ?setIs)\n")