"promptClass" <-
function (clName, filename = NULL, type = "class",
          keywords = "classes", where = topenv(parent.frame()))
{
    if(is.null(filename))
        filename <- paste(topicName(type, clName), ".Rd", sep = "")

    classesInSig <- function(g, where) {
    # given a generic g, obtain list of all classes
    # named among its signatures
        mlist <- getMethods(g, where)
        if(is.null(mlist))
            return(NULL)
        tmp <- listFromMlist(mlist)
        if (length(tmp[[1]]) == 0)
            NULL
        else if ((lt <- length(tmp[[1]])) == 1)
            unlist(tmp[[1]])
        else {
            o <- list()
            for (i in seq(length = lt))
                o[[i]] <- unlist(tmp[[1]][[i]])
            o
        }
    }
    genWithClass <- function(cl, where) {
    # given a class cl
    # obtain list of all generics with cl in
    # one of its signatures
        allgen <- getGenerics(where=where)
        o <- list()
        for (i in seq(along=allgen)) o[[allgen[i]]] <- classesInSig(allgen[i],
            where)
        genl <- NULL
        nmok <- names(o)
        for (i in seq(along = o)) {
            if (!all(is.na(match(unlist(o[[i]]), cl))))
                genl <- c(genl, nmok[i])
        }
        genl
    }

    sigsMatrix <- function (g, where)
    # given a generic g, obtain matrix
    # with one row per signature
    # it assumes at present that signatures for a given generic
    # are all of the same length.
    #
    # it would be simple to jettison the matrix construct
    # replace it by a list
    {
        tmp <- listFromMlist(getMethods(g, where))
        if (length(tmp[[1]]) == 0)
            NULL
        else if ((lt <- length(tmp[[1]])) == 1)
            matrix(unlist(tmp[[1]]), nr = 1)
        else {
            o <- matrix(" ", nc = length(tmp[[1]][[1]]), nr = length(tmp[[1]]))
            for (i in 1:lt) o[i, ] <- unlist(tmp[[1]][[i]])
            o
        }
    }

    sigsList <- function (g, where)
    # given a generic g, obtain list
    # with one element per signature
    #
    {
        tmp <- listFromMlist(getMethods(g, where))
        if (length(tmp[[1]]) == 0)
            NULL
        else
            tmp[[1]]
    }
    slotClassWithSource <- function(clname) {
        clDef <- getClassDef(clname)
        extds <- names(clDef@contains)
        allslots <- getSlots(clDef) ## establishes all slots, in the right order
        for(j in rev(seq(along=extds))) {
            i <- extds[[j]]
            slotsi <- getSlots(getClass(i))
            if(length(slotsi)>0)
                allslots[names(slotsi)] <- paste0("\"", as.character(slotsi),
                                                  "\", from class \"", i, "\"")
        }
        slotsi <- getSlots(clDef)
        if(length(slotsi)>0)
            allslots[names(slotsi)] <- paste0("\"", as.character(slotsi),"\"")
        allslots
    }
    paste0 <- function(...) paste(..., sep = "")
    pastePar <- function(x) {
        xn <- names(x); x <- as.character(x)
        if(length(xn) == length(x))
            xn <- paste(xn, "= ")
        else
            xn <- ""
        paste("(", paste(xn, "\"", x, "\"", sep="", collapse = ", "),
        ")", sep = "")
    }
    whereClass <- find(classMetaName(clName))
    if(length(whereClass) == 0)
        stop(paste0("No definition of class \"", clName,"\" found"))
    else if(length(whereClass) > 1) {
        if(identical(where, topenv(parent.frame()))) {
            whereClass <- whereClass[[1]]
            warning("Multiple definitions of \"", clName, "\" found; using the one on ",
                    whereClass)
        }
        else {
            if(exists(classMetaName(clName), where, inherits = FALSE))
                whereClass <- where
            else
                stop("No definition of class \"", clName, "\" in the specified position, ",
                     where, "; definition(s) on :", paste(whereClass, collapse = ", "))
        }
    }
    fullName <- utils::topicName("class", clName)
    clDef <- getClass(clName)
    .name <- paste0("\\name{", fullName, "}")
    .type <- paste0("\\docType{", type, "}")
    .alias <- paste0("\\alias{", fullName, "}")
    .title <- paste0("\\title{Class \"", clName, "\" ~~~ }")
    .desc <- paste0("\\description{", "  ~~ A concise (1-5 lines) description of what the class is.  ~~",
        "}")
    slotclasses <- getSlots(getClass(clName))
    slotnames <- names(slotclasses)
    slotclasses <- as.character(slotclasses)
    nslots <- length(slotclasses)
    .usage <- "\\section{Objects from the Class}"
    if(isVirtualClass(clName)) {
        .usage <- paste0(.usage, "{A virtual Class: No objects may be created from it.}")
    }
    else {
        initMethod <- unRematchDefinition(selectMethod("initialize", clName))
        argNames <- formalArgs(initMethod)
        ## but for new() the first argument is the class name
        argNames[[1]] <- paste0('"', clName, '"')
        .usage <- c(paste0(.usage,"{"),
                    paste0("Objects can be created by calls of the form \\code{", .makeCallString(initMethod, "new", argNames), "}."),
                    "    ~~ describe objects here ~~ ", "}")
    }
    if (nslots > 0) {
        slotclasses <- slotClassWithSource(clName)
        slotnames <- names(slotclasses)
        .slots.head <- c("\\section{Slots}{", "  \\describe{")
        .slots.body <-  paste0("    \\item{\\code{", slotnames,
                "}:}", "{Object of class \\code{", slotclasses, "} ~~ }")
        .slots.tail <- c("  }","}")
        .slots <- c(.slots.head,  .slots.body,  .slots.tail)
    }
    else
        .slots <- character()
    .extends <- clDef@contains
    if(length(.extends)>0) {
        .extends <- showExtends(.extends, print=FALSE)
        .extends <-
            c("\\section{Extends}{",
              paste("Class \\code{\"",
                    .extends$what,
                    "\"}, ",
                    ## Add Rd markup to 'by class "CLASS"' results
                    gsub("^(by class) (\".*\")$", "\\1 \\\\code{\\2}",
                         .extends$how),
                    ".",
                    sep = ""),
              "}")
    }
    else
        .extends <- character()
    nmeths <- length(methnms <- genWithClass(clName, where=whereClass))
    .meths.head <- "\\section{Methods}{"
    .methAliases <- ""
    if (nmeths > 0) {
        .meths.body <- "  \\describe{"
        for (i in 1:nmeths) {
            .sigmat <- sigsList(methnms[i], where)
            for (j in seq(along = .sigmat)) {
                if (!all(is.na(match(.sigmat[[j]],clName)))) {
                .meths.body <- c(.meths.body, paste0("    \\item{",
                  methnms[i], "}{\\code{signature", pastePar(.sigmat[[j]]), "}: ... }"))

                  cur <- paste(.sigmat[[j]], collapse = ",")
                  .methAliases <- paste(.methAliases, "\\alias{",
                    methnms[i], ",", cur, "-method}\n", sep = "")
                 }
            }
        }
        .meths.body <- c(.meths.body, "  }")
    }
    else {
        .meths.head <- "\\section{Methods}{"
        .meths.body <- paste0("No methods defined with class \"", clName,
                              "\" in the signature.")
    }
    .meths.tail <- "}"
    .keywords <- paste("\\keyword{", keywords, "}", sep = "")

    Rdtxt <-
        list(name = .name,
             type = .type,
             aliases = .alias,
        methAliases = .methAliases,
             title = .title,
             description = .desc,
             "section{Objects from the Class}" = .usage,
             "section{Slots}" = .slots,
             "section{Extends}" = .extends,
             "section{Methods}" =
             c(.meths.head, .meths.body, .meths.tail),
             references = paste("\\references{ ~put references to the",
             "literature/web site here ~ }"),
             author = "\\author{ ~~who you are~~ }",
             note = c("\\note{ ~~further notes~~ }",
             "",
             paste(" ~Make other sections like Warning with",
                   "\\section{Warning }{....} ~"),
             ""),
             seealso = c("\\seealso{",
             paste("  ~~objects to See Also as",
                   "\\code{\\link{~~fun~~}}, ~~~"),
             paste("  or \\code{\\link{CLASSNAME-class}}",
                   "for links to other classes"),
             "}"),
             examples = c("\\examples{",
             "##---- Should be DIRECTLY executable !! ----",
             "}"),
             keywords = .keywords)

    if(is.na(filename)) return(Rdtxt)

    cat(unlist(Rdtxt), file = filename, sep = "\n")
    if(is.character(filename)) {
        what <- if(nchar(filename))
            paste(" to the file", sQuote(filename))
        else
            " to the standard output connection"
    }
    else if(inherits(filename, "connection"))
        what <- paste(" to the connection",
                      sQuote(summary(filename)$description))
    else
        what <- ""                      # what, indeed?
    message("A shell of class documentation has been written",what,".\n")
    invisible(filename)
}


.makeCallString <- function (def, name = substitute(def), args = formalArgs(def))
{
#
# need this for experimentation because the function is not exported
#
    if (is.character(def)) {
        if (missing(name))
            name <- def
        def <- getFunction(def)
    }
    if (is(def, "function"))
        paste(name, "(", paste(args, collapse = ", "), ")", sep = "")
    else ""
}
