~showard314/ubuntu/karmic/r-base/remove_start_comments

« back to all changes in this revision

Viewing changes to src/library/methods/R/show.R

  • Committer: Bazaar Package Importer
  • Author(s): Dirk Eddelbuettel
  • Date: 2009-01-19 12:40:24 UTC
  • mfrom: (5.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090119124024-abxsf4e0y7713w9m
Tags: 2.8.1-2
debian/control: Add another Build-Depends: exclusion for the 
'kfreebsd-i386 kfreebsd-amd64 hurd-i386' architecture to openjdk-6-jdk.
Thanks to Petr Salinger for the heads-up.               (Closes: 512324)

Show diffs side-by-side

added added

removed removed

Lines of Context:
18
18
{
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))) {
37
36
            cat("\n")
38
37
        }
39
38
    }
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
47
 
                break
48
 
            }
49
 
        for(what in slotNames(clDef)) {
50
 
            cat("Slot \"",what, "\":\n", sep="")
51
 
            print(slot(object, what))
52
 
            cat("\n")
53
 
        }
54
 
    }
 
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
 
46
##         else {
 
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="")
 
52
##                 else
 
53
##                   cat("  (S3 class: \"",S3Class, "\")\n", sep = "")
 
54
##             }
 
55
##         }
 
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
 
59
##                 break
 
60
##             }
 
61
##         for(what in slots) {
 
62
##             cat("Slot \"",what, "\":\n", sep="")
 
63
##             print(slot(object, what))
 
64
##             cat("\n")
 
65
##         }
 
66
##     }
55
67
    else
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!
65
77
 
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",
70
82
              function(object) {
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");
107
121
              },
108
122
              where = envir)
109
123
    setMethod("show", "classRepresentation",