1# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2setGeneric( "setCMethod", function(f, sig, body, ...) standardGeneric("setCMethod") )
3
4# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
5setMethod( "setCMethod", signature(f="character", sig="list", body="list"),
6  function(f, sig, body, includes="", otherdefs="",
7           language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"),
8           verbose=FALSE, convention=c(".Call", ".C", ".Fortran"),
9           where=topenv(.GlobalEnv), ...) {
10    if ( length(f) != length(sig) || length(sig) != length(body) )
11      stop("number of signatures does not correspond to the number of code chunks")
12
13    names(sig) <- f
14    fns <- cfunction(sig, body, includes, otherdefs, language, verbose, convention)
15
16    if ( verbose )
17      cat("\nThe following methods are now defined:\n")
18    ## Let's try to create generics
19    for ( i in 1:length(f) ) {
20      generic <- paste( "setGeneric(\"", f[i], "\", function(",
21                        paste(names(sig[[i]]),collapse=", "), ") standardGeneric(\"",
22                        f[i], "\"),where=where )", sep="")
23      eval(parse(text=generic))
24      setMethod(f[i], sig[[i]], fns[[i]], where=where)
25      if ( verbose ) showMethods(f[i])
26    }
27  }
28)
29
30# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
31setMethod( "setCMethod", signature(f="character", sig="character", body="character"),
32  function(f, sig, body, includes="", otherdefs="", language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"),
33                      verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), where=topenv(.GlobalEnv), ...)
34    setCMethod(f, list(sig), list(body), includes, otherdefs, language, verbose, convention, where=topenv(.GlobalEnv), ...)
35)
36
37