19
19
clDef <- getClass(cl <- class(object), .Force=TRUE)
20
20
cl <- classLabel(cl)
21
if(!is.null(clDef) && is.na(match(clDef@className, .BasicClasses)) &&
22
!extends(clDef, "oldClass")) {
21
if(!is.null(clDef) && isS4(object) && is.na(match(clDef@className, .BasicClasses)) ) {
23
22
cat("An object of class ", cl, "\n", sep="")
24
23
slots <- slotNames(clDef)
25
24
if(!is.na(match(".Data", slots))) {
40
else if(isClass(clDef) && extends(clDef, "oldClass") &&
41
length(slotNames(clDef)) > 0) {
42
## print the old-style object
43
cat("An object of class ", cl, "\n", sep="")
44
for( cl2 in rev(extends(clDef)))
45
if(!.identC(cl2, "oldClass") && extends(cl2, "oldClass")) {
46
print(as(object, cl2), useS4 = FALSE) # see comment NBB below
49
for(what in slotNames(clDef)) {
50
cat("Slot \"",what, "\":\n", sep="")
51
print(slot(object, what))
39
## else if(isS4(object) && isClass(clDef) && extends(clDef, "oldClass") &&
40
## length(slotNames(clDef)) > 0) {
41
## ## print the old-style object
42
## cat("An object of class ", cl, "\n", sep="")
43
## slots <- slotNames(clDef)
44
## i <- match(".S3Class", slots)
45
## if(is.na(i)) { } # but should not happen with new objects
47
## S3Class <- classLabel(object@.S3Class)
48
## slots <- slots[! slots %in% names(slotsFromS3(object))]
49
## if(!identical(cl, S3Class)) {
50
## if(length(S3Class) > 1)
51
## cat(" (S3 class: c(", paste('"', S3Class, '"', sep="", collapse = ", "), "))\n", sep="")
53
## cat(" (S3 class: \"",S3Class, "\")\n", sep = "")
56
## for( cl2 in rev(extends(clDef)))
57
## if(!.identC(cl2, "oldClass") && extends(cl2, "oldClass")) {
58
## print(as(object, cl2), useS4 = FALSE) # see comment NBB below
61
## for(what in slots) {
62
## cat("Slot \"",what, "\":\n", sep="")
63
## print(slot(object, what))
56
68
## NBB: This relies on the delicate fact (as of version 1.7 at least)
57
69
## that print will NOT recursively call show if it gets more than one argument!
66
78
.InitShowMethods <- function(envir) {
67
79
if(!isGeneric("show", envir))
68
setGeneric("show", where = envir)
80
setGeneric("show", where = envir, simpleInheritanceOnly = TRUE)
69
81
setMethod("show", "MethodDefinition",
71
83
cl <- class(object)
104
116
paste(object@signature, collapse=", "), "\n",
105
117
"Use showMethods(\"", object@generic,
106
118
"\") for currently available ones.\n", sep="")
119
if(.simpleInheritanceGeneric(object))
120
cat("(This generic function excludes non-simple inheritance; see ?setIs)\n");
109
123
setMethod("show", "classRepresentation",