The R Project SVN R

Rev

Rev 26016 | Rev 26089 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 26016 Rev 26082
Line 857... Line 857...
857 
R_stdGen_ptr_t R_get_standardGeneric_ptr()
 857 
R_stdGen_ptr_t R_get_standardGeneric_ptr()
858 
{
 858 
{
859 
    return R_standardGeneric_ptr;
 859 
    return R_standardGeneric_ptr;
860 
}
 860 
}
861 
 
 861 
 
- 
 
 862 
SEXP R_MethodsNamespace;
862 
R_stdGen_ptr_t R_set_standardGeneric_ptr(R_stdGen_ptr_t val)
 863 
R_stdGen_ptr_t R_set_standardGeneric_ptr(R_stdGen_ptr_t val, SEXP envir)
863 
{
 864 
{
864 
    R_stdGen_ptr_t old = R_standardGeneric_ptr;
 865 
    R_stdGen_ptr_t old = R_standardGeneric_ptr;
865 
    R_standardGeneric_ptr = val;
 866 
    R_standardGeneric_ptr = val;
- 
 
 867 
    if(envir && !isNull(envir))
- 
 
 868 
	R_MethodsNamespace = envir;
- 
 
 869 
    /* just in case ... */
- 
 
 870 
    if(!R_MethodsNamespace)
- 
 
 871 
	R_MethodsNamespace = R_GlobalEnv;
866 
    return old;
 872 
    return old;
867 
}
 873 
}
868 
 
 874 
 
869 
SEXP R_isMethodsDispatchOn(SEXP onOff) {
 875 
SEXP R_isMethodsDispatchOn(SEXP onOff) {
870 
    SEXP value = allocVector(LGLSXP, 1);
 876 
    SEXP value = allocVector(LGLSXP, 1);
Line 872... Line 878...
872 
    R_stdGen_ptr_t old = R_get_standardGeneric_ptr();
 878 
    R_stdGen_ptr_t old = R_get_standardGeneric_ptr();
873 
    LOGICAL(value)[0] = !NOT_METHODS_DISPATCH_PTR(old);
 879 
    LOGICAL(value)[0] = !NOT_METHODS_DISPATCH_PTR(old);
874 
    if(length(onOff) > 0) {
 880 
    if(length(onOff) > 0) {
875 
	    onOffValue = asLogical(onOff);
 881 
	    onOffValue = asLogical(onOff);
876 
	    if(onOffValue == FALSE)
 882 
	    if(onOffValue == FALSE)
877 
		    R_set_standardGeneric_ptr(0);
 883 
		    R_set_standardGeneric_ptr(0, 0);
878 
	    else if(NOT_METHODS_DISPATCH_PTR(old)) {
 884 
	    else if(NOT_METHODS_DISPATCH_PTR(old)) {
879 
		    SEXP call;
 885 
		    SEXP call;
880 
		    PROTECT(call = allocList(2));
 886 
		    PROTECT(call = allocList(2));
881 
		    SETCAR(call, install("initMethodsDispatch"));
 887 
		    SETCAR(call, install("initMethodsDispatch"));
882 
		    eval(call, R_GlobalEnv); /* only works with
 888 
		    eval(call, R_GlobalEnv); /* only works with
Line 941... Line 947...
941 
 
 947 
 
942 
#ifdef UNUSED
 948 
#ifdef UNUSED
943 
static void load_methods_package()
 949 
static void load_methods_package()
944 
{
 950 
{
945 
    SEXP e;
 951 
    SEXP e;
946 
    R_set_standardGeneric_ptr(dispatchNonGeneric);
 952 
    R_set_standardGeneric_ptr(dispatchNonGeneric, NULL);
947 
    PROTECT(e = allocVector(LANGSXP, 2));
 953 
    PROTECT(e = allocVector(LANGSXP, 2));
948 
    SETCAR(e, install("library"));
 954 
    SETCAR(e, install("library"));
949 
    SETCAR(CDR(e), install("methods"));
 955 
    SETCAR(CDR(e), install("methods"));
950 
    eval(e, R_GlobalEnv);
 956 
    eval(e, R_GlobalEnv);
951 
    UNPROTECT(1);
 957 
    UNPROTECT(1);
Line 957... Line 963...
957 
SEXP do_standardGeneric(SEXP call, SEXP op, SEXP args, SEXP env)
 963 
SEXP do_standardGeneric(SEXP call, SEXP op, SEXP args, SEXP env)
958 
{
 964 
{
959 
    SEXP arg, value, fdef; R_stdGen_ptr_t ptr = R_get_standardGeneric_ptr();
 965 
    SEXP arg, value, fdef; R_stdGen_ptr_t ptr = R_get_standardGeneric_ptr();
960 
    if(!ptr) {
 966 
    if(!ptr) {
961 
	warning("standardGeneric called without methods dispatch enabled (will be ignored)");
 967 
	warning("standardGeneric called without methods dispatch enabled (will be ignored)");
962 
	R_set_standardGeneric_ptr(dispatchNonGeneric);
 968 
	R_set_standardGeneric_ptr(dispatchNonGeneric, NULL);
963 
	ptr = R_get_standardGeneric_ptr();
 969 
	ptr = R_get_standardGeneric_ptr();
964 
    }
 970 
    }
965 
    PROTECT(args);
 971 
    PROTECT(args);
966 
    PROTECT(arg = CAR(args));
 972 
    PROTECT(arg = CAR(args));
967 
    if(!isValidStringF(arg))
 973 
    if(!isValidStringF(arg))