.packageName <- "RBioinf"
##taken from OOPSLA paper
    ##let's guess that these lists are character vectors
    ##we start with some helper functions
isHead = function(list, value) {
    if(length(list) == 0 )
        FALSE
    else
        value == list[1]
}

inTail = function(Ilist, value) {
    if(length(Ilist) == 0 )
        FALSE
    else
        value %in% Ilist[-1]
}
isEmpty = function(value) is.null(value) || length(value) == 0
##a candidate must be in the head of at least one list
##and not in the tail of any - return c or FALSE
candidate = function(cl, rI) {
    if( any(sapply(rI, isHead, cl)) &&
       !any(sapply(rI, inTail, cl)) )
        cl
    else
        FALSE
}

##return a candidate or FALSE
candidateDirectSC = function(cl, rI) {
    classL = as.character(superClasses(getClass(cl)))
    ans = sapply(classL, function(x, y) candidate(x, y), rI)
    ans = ans[ans!=FALSE]
    if( length(ans > 0) )
        ans[1]
    else
        FALSE
}

removeNext = function(inList, nval) {
    if(length(inList) == 0 )
        inList
    else if (inList[1] == nval) inList[-1]
    else inList
}

mergeLists = function(revPartialResult, remainingInputs, C3=FALSE) {
    if (all(sapply(remainingInputs, isEmpty)) )
        rev(revPartialResult)
    else {
         if( C3 )
            nvC = sapply(remainingInputs, candidateAtHead,
                          remainingInputs)
        else
            nvC = sapply(revPartialResult, candidateDirectSC,
                          remainingInputs)

        if (!all(nvC == FALSE)) {
            nvC = nvC[nvC!=FALSE][1]
            mergeLists(c(nvC, revPartialResult),
                       sapply(remainingInputs, removeNext, nvC), C3)
        }
        else
            stop("Inconsistent precedence graph")
    }
}

##it seems like this needs to be in the right linearization order to start
OLDcplList = function(c)
    getAllSuperClasses(getClass(c))

cplList = function(c, C3)
    computeClassLinearization(c, C3)



candidateC3 = function(cl, rI) {
## returns c if it can go in the result now,
## otherwise false
    if( !any(sapply(rI, inTail, cl)) )
        cl
    else
        FALSE
}

candidateAtHead = function(inList, rI) {
    ##if( inList[1] == "scrolling-mixin") browser()
    if( !isEmpty(inList) )
        candidateC3(inList[1], rI)
    else
        FALSE
}

LPO = computeClassLinearization = function(inClass, C3 = FALSE) {

    cdirectSC = unlist(as.character(superClasses(getClass(inClass))))

    ans = mergeLists(inClass, c(lapply(cdirectSC, cplList, C3),
                           list(cdirectSC)), C3)
    names(ans) = NULL
    ans
}

 fullyQcName = function(x) {
    pName = attr(x, "package")
    if( is.null(pName) )
        x
    else 
        paste(attr(x, "package"), 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)
 }


 class2Graph = function(class, fullNames=TRUE) {
    if(is(class, "character"))
	class = getClass(class)
    if( !is(class, "classRepresentation") )
        stop("need a character or a classRepresentation")

    cname = as.character(class@className)
    superClasses = getAllSuperClasses(class)
    
    ##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])
       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(rmat, "graphNEL"))
}


##augment the usual help system with a list of choices
##which include all subclasses and all methods for a generic
##optionally those methods satisfying a particular signature
## and those in the location where 

 S4Help = function(name, signature, where...) {
  classList = NULL
  methodList = NULL
  if( isClass(name) ) {
	superC = getAllSuperClasses(getClass(name))
        classList = paste(c(name, superC))
  }

  if( isGeneric(name) )
        methods = getMethods(name)

  cL = paste(classList, c("class", rep("super-class", length(superC))))
  whichone = menu(cL, 
     title="Please Select a Topic\nOr type 0 to cancel\n")
  if( whichone == 0)
    return(NULL)
  do.call("?", list("class", classList[whichone]))
}

##two orderings are consistent if for any a and b, in both
##lists either a < b in both or a>b in both 
consistentOrdering = function(Ord1, Ord2) {
  if( !is.character(Ord1) || !is.character(Ord2))
    stop("must have character strings")
  where = match(Ord2, Ord1)
  where = where[!is.na(where)]
  if(any(diff(where) < 0 ))
    FALSE
  else TRUE
}


 subClassNames = function(x) {
    if (isClassDef(x)) 
        classDef <- x
    else if(is.character(x) )
        classDef <- getClass(x)
    else
        stop("invalid argument")
    ans = names(classDef@subclasses)
    if( length(ans) == 0 )
      character()
    else
      ans
 }

 superClassNames = function(x) {
    if (isClassDef(x)) 
        classDef <- x
    else if(is.character(x) )
        classDef <- getClass(x)
    else
        stop("invalid argument")

    ans = names(classDef@contains)
    if( length(ans) == 0 )
      character()
    else
      ans
 }

asSimpleVector <- function(x, mode = "logical")
{
    if (!(mode %in% c("logical", "integer",
                      "numeric", "double",
                      "complex", "character")))
        stop("invalid mode ", mode)
    Dim <- dim(x)
    nDim <- length(Dim)
    Names <- names(x)
    if (nDim > 0)
        DimNames <- dimnames(x)
    x <- as.vector(x, mode)
    names(x) <- Names
    if (nDim > 0) {
        dim(x) <- Dim
        dimnames(x) <- DimNames
    }
    x
}

subsetAsCharacter <- function(x, i, j)
{
    if (nargs() == 3) {
        if (missing(i)) {
            if (missing(j))
                x <- x[ , ]
            else x <- x[, j]
        } else if (missing(j))
            x <- x[i, ]
        else x <- x[i, j]
    } else if (missing(i)) {
        x <- x[]
    } else {
        x <- x[i]
    }
    asSimpleVector(x, "character")
}

setVNames <- function(x, nm)
{
    names(x) <- nm
    asSimpleVector(x, "numeric")
}

convertMode <- function(from, to)
{
    asSimpleVector(from, mode(to))
}

printWithNumbers = function(f) {
 if( !is.function(f) )
   stop("requires a function argument")

 fform = capture.output(f)
 lnos = as.list(body(f))
 if( lnos[[1]] == '{' )
     lnos[[1]] = "{"
 else
     stop("only set line numbers for functions that use {")
 start = match("{", fform)
 if( is.na(start) )
     stop("problems with {")

 ##set the padding
 nlnos = length(lnos)
 if( nlnos >= 100 ) extras = "    "
 else if( nlnos >= 10 ) extras = "   "
 else extras = "  "

 lni = 1
 for(i in 1:length(fform) ) {
    if(i < start || lni > nlnos ) {
      fform[i] = paste(extras, fform[i], sep="")
      next
    }
    tstr = gsub("^\\s*", "", fform[i])
    if( length(grep(tstr, deparse(lnos[[lni]]), fixed=TRUE)) > 0 ){
      if( nlnos >= 100 ) {
          if( lni < 10 ) spaces = "  "
          else if( lni < 100 ) spaces = " "
          else spaces = ""
      } else if (nlnos >= 10 ) {
          if(lni < 10 ) spaces = " "
          else spaces = ""
      } else
          spaces = ""
      fform[i] = paste(lni, ":", spaces, fform[i], sep="")
      lni = lni + 1
    }
    else
      fform[i] = paste(extras, fform[i], sep="")
 }
 cat(fform, sep="\n")
 invisible(fform)
}


 simpleSort = function(x) 
    .Call("simpleSort", x, PACKAGE="RBioinf")

 simpleRand = function(x, y="notused")
    .Call("simpleRand", x, y, PACKAGE="RBioinf")


 Rcal = function(month, year) {
  pD = function(x) pipe(paste("date \"+%", x, "\"", sep=""))

  if(missing(month))
    month = readLines(pD("m"))
  if(missing(year))
    year = readLines(pD("Y"))

  cat(readLines(pipe(paste("cal ", month, year))), sep="\n")
 }

 simplePVect = function(iV) {
   .C("simplePVect", as.double(iV), as.integer(length(iV)), 
        PACKAGE="RBioinf")
   invisible(NULL)
 }
