.packageName <- "classGraph"
subClasses <- function(Cl, directOnly = TRUE, complete = TRUE, ...)
{
    ## utility for classTree():
    if (isClassDef(Cl)) {
        cDef <- Cl
        Cl <- cDef@className
    } else { ## need getClass() can give error because sub classes can
        ## be "not defined" (?!)   -- e.g. "iMatrix"
        cDef <- if (complete) getClass(Cl) else getClassDef(Cl)
    }

    subs <- showExtends(cDef@subclasses, printTo = FALSE)
    if(directOnly) subs$what[subs$how == "directly"] else subs$what
}

numOutEdges <- function(g)
{
    ## Purpose: returns a named integer vector giving for each node in g,
    ##		the number of edges *from* the node
    ## ----------------------------------------------------------------------
    ## Arguments: g: graph
    ## ----------------------------------------------------------------------
    ## Author: Martin Maechler, Date:  8 Feb 2007, 22:59
    el <- sapply(edgeL(g), `[[`, "edges")
    sapply(el, length)
}

is.leaf <- function(g) numOutEdges(g) == 0
leaves  <- function(g) nodes(g)[is.leaf(g)]

bGraph <- function(n, root = "Mom",
                   leaves = paste(l.prefix, seq(length=n), sep=""),
                   l.prefix = "D", # for 'D'aughter
                   weights = NULL,
                   mode = c("undirected", "directed"))
{
    ## Purpose: Create a "branch graph", a simple tree with root and
    ##		n branches / leaves
    ## ----------------------------------------------------------------------
    ## Author: Martin Maechler, Date: Aug 2005
    if(!missing(leaves)) {
        stopifnot(is.character(leaves))
        n <- length(leaves)
    } else stopifnot(is.numeric(n), length(n) == 1, n >= 0)

    mode <- match.arg(mode)
    ftM2graphNEL(cbind(root, leaves), W = weights, edgemode = mode)
}

## agopen() has
## layoutType = c("dot","neato","twopi", "circo", "fdp")

abbrMatrixcl <- function(clnames, level = 1) {
    ### Do "Matrixclass" name abbrevation
    doSub <- clnames != "Matrix"
    clnames[doSub] <- sub("Matrix$", "*", clnames[doSub])
    ## sparse
    iSp <- grep("sparse", clnames)
    if(level >= 2)
        clnames[iSp] <- sub("sparse\\*", ".sp.", clnames[iSp])

    ## dense
    iD <- grep("dense", clnames)
    if(level >= 2)
        clnames[iD] <- sub("dense\\*", ".D.", clnames[iD])
    list(clnames = clnames,  iSparse = iSp, iDense = iD)
}


mRagraph <- function(gr, lType,
                     fixedsize = FALSE, ## <---- this is it !
                     fill = c("lightblue", "gray90"),
                     color =c("blue3", "gray60"),
                     labcol = c("blue3","green4","purple"))
{
    ## Produce a layed out graph, an "Ragraph" -- to be plotted
    if (!validGraph(gr))
        stop("The graph to be plotted is not a valid graph structure")
    if (missing(lType))
        lType <- "dot"
    ng <- nodes(gr)
    nonVirtual <- leaves(gr) ## the leaves are *non*-virtual classes

    r <- abbrMatrixcl(ng)

    nAtt <- makeNodeAttrs(gr, label = r$clnames, shape = "ellipse",
                          fixedsize = fixedsize,
                          fillcolor = fill[1], color = color[1],
                          fontcolor = labcol[1])

    nAtt$fontcolor[r$iSparse] <- labcol[2]
    nAtt$fontcolor[r$iDense]  <- labcol[3]

    nAtt$fillcolor[nonVirtual] <- fill[2]
    nAtt $   color[nonVirtual] <- color[2]

    ## but make one exception (for visualization):
    nAtt$fillcolor["pMatrix"] <- "thistle"
    nAtt $   color["pMatrix"] <- "turquoise"

    if(getOption("verbose")) { cat("mplot(): nodeAttrs: "); str(nAtt) }

    ### This is +- ==  method("plot", "graph"):
    agopen(gr, name = "", layout = TRUE, layoutType = lType,
           attrs = list(), nodeAttrs = nAtt, edgeAttrs = list(),
           subGList = list(), recipEdges = "combined")
}

## a bit more than selectMethod("plot", "Ragraph") -- but building on that
.optRagargs <- function(side = 1, adj = 0.05, cex = 0.75, line = 3)
    list(side = side, adj = adj, cex = cex, line = line)

plotRag <- function(ragr, sub, subArgs = .optRagargs(), ...)
{
    stopifnot(is(ragr, "Ragraph"))

    if(missing(sub)) {
	## nEdges <- length(unlist(edgeL(gr), use.names=FALSE))
	sub <- paste(length(ragr@AgNode), "nodes with",
		     length(ragr@AgEdge), "edges")
    }
### BUG in Rgraphviz ----> FIXME: bug report, ...
###    plot(ragr, sub = sub, ...)
### workaround {{but more flexible anyway:
    plot(ragr, ...)
    op <- par(xpd = NA) ; on.exit(par(op))
    do.call(mtext, c(list(text = sub), subArgs))
}


## Now do this recusively

classTree <- function(Cl, all = FALSE, ...)
{
    ## First a check
    if (isClassDef(Cl)) {
        cDef <- Cl
        Cl <- cDef@className
    } else cDef <- getClass(Cl)

    pkg <- cDef@package
    where <- if(pkg == ".GlobalEnv") .GlobalEnv else asNamespace(pkg)

    ## Now define a recursive function that computes the extended subtree
    ## for one class, and uses this for all sub-classes of Cl
    subtree <- function(cl, all) {
        stopifnot(isClassDef(cl))
        clN <- cl@className
        if(getOption('verbose')) cat(" ST",clN,":")
        sc <- subClasses(cl, directOnly = !all)
        if(length(sc) == 0) {
            if(getOption('verbose'))  cat(" is leaf\n")
            ## one node named 'cl':
            g <- new("graphNEL", nodes = clN, edgemode = "dir")
        }
        else {
            if(getOption('verbose'))  cat(" has leaves:\n\t")
            g <- bGraph(root = clN, leaves = sc, mode = "dir")
            for(cc in sc) {
                if(getOption('verbose'))  cat(":: ",clN,"-",cc,sep="")
                st <- subtree(getClass(cc, where = where), all = all)
                ##    -------## recursive
                if(numNodes(st) > 1)
                    g <- join(g, st)
            }
        }
        g
    }

    subtree(cDef, all = all)
}

### This was
## ("/u/maechler/R/Meetings-Kurse-etc/2005-DSC/ S4classes.R")
## BioC (Robert Gentleman): class2Graph() and utilities
##
## but that -- and also the 'graph' package -- had bugs!


###--- 2nd, the 'S4classes' utilites corrections : -------------------------

fullyQcName <- function(x) {
    pName <- attr(x, "package")
    if (is.null(pName)) x else paste(pName, x, sep = ":")
}

superClasses <- function(x) {
    if(!is(x, "classRepresentation") )
        return("must have a class representation object")
    superCs  <- names(x@contains)
    if(length(superCs) == 0 )
        return(character(0))
    directSCs  <- sapply(x@contains,
                         function(x) if(length(x@by) > 0 ) FALSE else TRUE)
    pkgNames  <- sapply(x@contains, function(x) x@package)
    clss  <- superCs[directSCs]
    pkgNames  <- pkgNames[directSCs]
    ans  <- vector("list", length = length(clss))
    for( i in 1:length(clss)) {
        v  <- clss[i]
        attr(v, "package") = pkgNames[i]
        ans[[i]] = v
    }
    return(ans)
}

### FIXME: this must have a bug too,
### ----- since (cg2 <- class2Graph("dtrMatrix", fullNames = FALSE))
### is almost empty;

### No, actually, the culprit is
## >>  getAllSuperClasses(getClass("dtrMatrix"))
## which returns an empty character vector
## even though dtrMatrix does have several superclasses;
## namely "dgeMatrix" `` directly, with explicit coerce ''
## {and 4 more via "dgeMatrix"} : but actually

## MM: use 'package' and  getClass(*, where=.) ! to find private classes
class2Graph <-
    function(class, fullNames = TRUE, simpleOnly = FALSE, bottomUp = FALSE,
             package = class@package)
{
    if(is(class, "character"))
	class <- getClass(class)
    if( !is(class, "classRepresentation") )
        stop("need a character or a classRepresentation")

    cname  <- as.character(class@className)
    where <- asNamespace(package)
    superClasses  <- getAllSuperClasses(class, simpleOnly = simpleOnly)
    ## MM:                                      ^^^^^^^^^^^^^^^^^^^^^ important

    ##handle the one node graph separately
    if( length(superClasses) == 0 ) {
        eL  <- list(numeric(0)); names(eL) = cname
        return(new("graphNEL", edgeL = eL, nodes = cname))
    }
    ##otherwise build a simple incidence matrix
    nN  <- length(superClasses)+1
    rmat  <- matrix(0, nr = nN, nc = nN)
    dimnames(rmat) <-
        list(c(cname, superClasses),
             c(cname, superClasses))
    sCn  <- superClasses(class)
    fNms  <- rep("", nN)
    if( fullNames )
        fNms[1]  <- fullyQcName(class@className)
    rmat[cname, as.character(sCn)] <- 1
    for(i in 1:(nN-1)) {
        tc  <- getClass(superClasses[i], where=where)
        tCn  <- superClasses(tc)
        rmat[superClasses[i], as.character(tCn)] <- 1
        if(fullNames)
            fNms[i+1] <- fullyQcName(tc@className)
    }
    if (fullNames)
        dimnames(rmat) <- list(fNms, fNms)
    return(as(if(bottomUp) t(rmat) else rmat, "graphNEL"))
}
