/****************************************************** NAME : CheckTwoClasses DESCRIPTION : Checks for exactly two class arguments for a H/L function INPUTS : 1) The function name 2) Caller's buffer for first class 3) Caller's buffer for second class RETURNS : TRUE if both found, FALSE otherwise SIDE EFFECTS : Caller's buffers set NOTES : Assumes exactly 2 arguments ******************************************************/ static int CheckTwoClasses( void *theEnv, char *func, DEFCLASS **c1, DEFCLASS **c2) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(FALSE); *c1 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c1 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(FALSE); *c2 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c2 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } return(TRUE); }
/****************************************************** NAME : CheckTwoClasses DESCRIPTION : Checks for exactly two class arguments for a H/L function INPUTS : 1) The function name 2) Caller's buffer for first class 3) Caller's buffer for second class RETURNS : True if both found, false otherwise SIDE EFFECTS : Caller's buffers set NOTES : Assumes exactly 2 arguments ******************************************************/ static bool CheckTwoClasses( UDFContext *context, const char *func, Defclass **c1, Defclass **c2) { UDFValue theArg; Environment *theEnv = context->environment; if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) { return false; } *c1 = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents); if (*c1 == NULL) { ClassExistError(theEnv,func,theArg.lexemeValue->contents); return false; } if (! UDFNextArgument(context,SYMBOL_BIT,&theArg)) { return false; } *c2 = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents); if (*c2 == NULL) { ClassExistError(theEnv,func,theArg.lexemeValue->contents); return false; } return true; }
/************************************************************************************ NAME : MessageHandlerExistPCommand DESCRIPTION : Determines if a message-handler is present in a class INPUTS : None RETURNS : TRUE if the message header is present, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (message-handler-existp <class> <hnd> [<type>]) ************************************************************************************/ globle int MessageHandlerExistPCommand( void *theEnv) { DEFCLASS *cls; SYMBOL_HN *mname; DATA_OBJECT temp; unsigned mtype = MPRIMARY; if (EnvArgTypeCheck(theEnv,"message-handler-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"message-handler-existp",DOToString(temp)); return(FALSE); } if (EnvArgTypeCheck(theEnv,"message-handler-existp",2,SYMBOL,&temp) == FALSE) return(FALSE); mname = (SYMBOL_HN *) GetValue(temp); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"message-handler-existp",3,SYMBOL,&temp) == FALSE) return(FALSE); mtype = HandlerType(theEnv,"message-handler-existp",DOToString(temp)); if (mtype == MERROR) { SetEvaluationError(theEnv,TRUE); return(FALSE); } } if (FindHandlerByAddress(cls,mname,mtype) != NULL) return(TRUE); return(FALSE); }
/**************************************************************** NAME : BrowseClassesCommand DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (browse-classes [<class>]) ****************************************************************/ globle void BrowseClassesCommand( void *theEnv) { register DEFCLASS *cls; if (EnvRtnArgCount(theEnv) == 0) /* ================================================ Find the OBJECT root class (has no superclasses) ================================================ */ cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME); else { DATA_OBJECT tmp; if (EnvArgTypeCheck(theEnv,"browse-classes",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"browse-classes",DOToString(tmp)); return; } } EnvBrowseClasses(theEnv,WDISPLAY,(void *) cls); }
/**************************************************************** NAME : BrowseClassesCommand DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (browse-classes [<class>]) ****************************************************************/ void BrowseClassesCommand( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { Defclass *cls; if (UDFArgumentCount(context) == 0) /* ================================================ Find the OBJECT root class (has no superclasses) ================================================ */ cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME); else { UDFValue theArg; if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return; cls = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents); if (cls == NULL) { ClassExistError(theEnv,"browse-classes",theArg.lexemeValue->contents); return; } } BrowseClasses(cls,STDOUT); }
/***************************************************** NAME : CheckClass DESCRIPTION : Used for to check class name for class accessor functions such as ppdefclass and undefclass INPUTS : 1) The name of the H/L function 2) Name of the class RETURNS : The class address, or NULL if ther was an error SIDE EFFECTS : None NOTES : None ******************************************************/ static DEFCLASS *CheckClass( void *theEnv, char *func, char *cname) { DEFCLASS *cls; cls = LookupDefclassByMdlOrScope(theEnv,cname); if (cls == NULL) ClassExistError(theEnv,func,cname); return(cls); }
/***************************************************** NAME : CheckClass DESCRIPTION : Used for to check class name for class accessor functions such as ppdefclass and undefclass INPUTS : 1) The name of the H/L function 2) Name of the class RETURNS : The class address, or NULL if ther was an error SIDE EFFECTS : None NOTES : None ******************************************************/ static Defclass *CheckClass( Environment *theEnv, const char *func, const char *cname) { Defclass *cls; cls = LookupDefclassByMdlOrScope(theEnv,cname); if (cls == NULL) ClassExistError(theEnv,func,cname); return(cls); }
/********************************************************************* NAME : ClassAbstractPCommand DESCRIPTION : Determines if direct instances of a class can be made INPUTS : None RETURNS : TRUE (1) if class is abstract, FALSE (0) if concrete SIDE EFFECTS : None NOTES : Syntax: (class-abstractp <class>) *********************************************************************/ globle int ClassAbstractPCommand() { DATA_OBJECT tmp; DEFCLASS *cls; if (ArgTypeCheck("class-abstractp",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(DOToString(tmp)); if (cls == NULL) { ClassExistError("class-abstractp",ValueToString(tmp.value)); return(FALSE); } return(ClassAbstractP((void *) cls)); }
/***************************************************************** NAME : ClassReactivePCommand DESCRIPTION : Determines if instances of a class can match rule patterns INPUTS : None RETURNS : TRUE (1) if class is reactive, FALSE (0) if non-reactive SIDE EFFECTS : None NOTES : Syntax: (class-reactivep <class>) *****************************************************************/ globle int ClassReactivePCommand( void *theEnv) { DATA_OBJECT tmp; DEFCLASS *cls; if (EnvArgTypeCheck(theEnv,"class-reactivep",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"class-reactivep",ValueToString(tmp.value)); return(FALSE); } return(EnvClassReactiveP(theEnv,(void *) cls)); }
/****************************************************************************** NAME : UndefmessageHandlerCommand DESCRIPTION : Deletes a handler from a class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Handler deleted if possible NOTES : H/L Syntax: (undefmessage-handler <class> <handler> [<type>]) ******************************************************************************/ globle void UndefmessageHandlerCommand( void *theEnv) { #if RUN_TIME || BLOAD_ONLY PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); #else SYMBOL_HN *mname; const char *tname; DATA_OBJECT tmp; DEFCLASS *cls; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return; } #endif if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE) { ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp)); return; } if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE) return; mname = (SYMBOL_HN *) tmp.value; if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE) return; tname = DOToString(tmp); if (strcmp(tname,"*") == 0) tname = NULL; } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; WildDeleteHandler(theEnv,cls,mname,tname); #endif }
/******************************************************************** NAME : CheckClassAndSlot DESCRIPTION : Checks class and slot argument for various functions INPUTS : 1) Name of the calling function 2) Buffer for class address RETURNS : Slot symbol, NULL on errors SIDE EFFECTS : None NOTES : None ********************************************************************/ globle SYMBOL_HN *CheckClassAndSlot( void *theEnv, const char *func, DEFCLASS **cls) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(NULL); *cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*cls == NULL) { ClassExistError(theEnv,func,DOToString(temp)); return(NULL); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(NULL); return((SYMBOL_HN *) GetValue(temp)); }
/************************************************************************************ NAME : MessageHandlerExistPCommand DESCRIPTION : Determines if a message-handler is present in a class INPUTS : None RETURNS : True if the message header is present, false otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (message-handler-existp <class> <hnd> [<type>]) ************************************************************************************/ void MessageHandlerExistPCommand( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { Defclass *cls; CLIPSLexeme *mname; UDFValue theArg; unsigned mtype = MPRIMARY; if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) { return; } cls = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents); if (cls == NULL) { ClassExistError(theEnv,"message-handler-existp",theArg.lexemeValue->contents); returnValue->lexemeValue = FalseSymbol(theEnv); return; } if (! UDFNextArgument(context,SYMBOL_BIT,&theArg)) { return; } mname = theArg.lexemeValue; if (UDFHasNextArgument(context)) { if (! UDFNextArgument(context,SYMBOL_BIT,&theArg)) { return; } mtype = HandlerType(theEnv,"message-handler-existp",true,theArg.lexemeValue->contents); if (mtype == MERROR) { SetEvaluationError(theEnv,true); returnValue->lexemeValue = FalseSymbol(theEnv); return; } } if (FindHandlerByAddress(cls,mname,mtype) != NULL) { returnValue->lexemeValue = TrueSymbol(theEnv); } else { returnValue->lexemeValue = FalseSymbol(theEnv); } }
/******************************************************************** NAME : PreviewSendCommand DESCRIPTION : Displays a list of the core for a message describing shadows,etc. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Temporary core created and destroyed NOTES : H/L Syntax: (preview-send <class> <msg>) ********************************************************************/ globle void PreviewSendCommand() { DEFCLASS *cls; DATA_OBJECT temp; /* ============================= Get the class for the message ============================= */ if (ArgTypeCheck("preview-send",1,SYMBOL,&temp) == FALSE) return; cls = LookupDefclassByMdlOrScope(DOToString(temp)); if (cls == NULL) { ClassExistError("preview-send",ValueToString(temp.value)); return; } if (ArgTypeCheck("preview-send",2,SYMBOL,&temp) == FALSE) return; PreviewSend(WDISPLAY,(void *) cls,DOToString(temp)); }
/*********************************************************** NAME : ClassInfoFnxArgs DESCRIPTION : Examines arguments for: class-slots, get-defmessage-handler-list, class-superclasses and class-subclasses INPUTS : 1) Name of function 2) A buffer to hold a flag indicating if the inherit keyword was specified RETURNS : Pointer to the class on success, NULL on errors SIDE EFFECTS : inhp flag set error flag set NOTES : None ***********************************************************/ globle void *ClassInfoFnxArgs( void *theEnv, const char *fnx, int *inhp) { void *clsptr; DATA_OBJECT tmp; *inhp = 0; if (EnvRtnArgCount(theEnv) == 0) { ExpectedCountError(theEnv,fnx,AT_LEAST,1); SetEvaluationError(theEnv,TRUE); return(NULL); } if (EnvArgTypeCheck(theEnv,fnx,1,SYMBOL,&tmp) == FALSE) return(NULL); clsptr = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (clsptr == NULL) { ClassExistError(theEnv,fnx,ValueToString(tmp.value)); return(NULL); } if (EnvRtnArgCount(theEnv) == 2) { if (EnvArgTypeCheck(theEnv,fnx,2,SYMBOL,&tmp) == FALSE) return(NULL); if (strcmp(ValueToString(tmp.value),"inherit") == 0) *inhp = 1; else { SyntaxErrorMessage(theEnv,fnx); SetEvaluationError(theEnv,TRUE); return(NULL); } } return(clsptr); }
/************************************************************* NAME : FormChain DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) Name of calling function for error msgs 2) Data object - must be a symbol or a multifield value containing all symbols The symbols must be names of existing classes RETURNS : The query chain, or NULL on errors SIDE EFFECTS : Memory allocated for chain Busy count incremented for all classes NOTES : None *************************************************************/ static QUERY_CLASS *FormChain( void *theEnv, EXEC_STATUS, char *func, DATA_OBJECT *val) { DEFCLASS *cls; QUERY_CLASS *head,*bot,*tmp; register long i,end; /* 6.04 Bug Fix */ char *className; struct defmodule *currentModule; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus)); if (val->type == DEFCLASS_PTR) { IncrementDefclassBusyCount(theEnv,execStatus,(void *) val->value); head = get_struct(theEnv,execStatus,query_class); head->cls = (DEFCLASS *) val->value; if (DefclassInScope(theEnv,execStatus,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == SYMBOL) { /* =============================================== Allow instance-set query restrictions to have a module specifier as part of the class name, but search imported defclasses too if a module specifier is not given =============================================== */ cls = LookupDefclassByMdlOrScope(theEnv,execStatus,DOPToString(val)); if (cls == NULL) { ClassExistError(theEnv,execStatus,func,DOPToString(val)); return(NULL); } IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls); head = get_struct(theEnv,execStatus,query_class); head->cls = cls; if (DefclassInScope(theEnv,execStatus,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == MULTIFIELD) { head = bot = NULL; end = GetpDOEnd(val); for (i = GetpDOBegin(val) ; i <= end ; i++) { if (GetMFType(val->value,i) == SYMBOL) { className = ValueToString(GetMFValue(val->value,i)); cls = LookupDefclassByMdlOrScope(theEnv,execStatus,className); if (cls == NULL) { ClassExistError(theEnv,execStatus,func,className); DeleteQueryClasses(theEnv,execStatus,head); return(NULL); } } else { DeleteQueryClasses(theEnv,execStatus,head); return(NULL); } IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls); tmp = get_struct(theEnv,execStatus,query_class); tmp->cls = cls; if (DefclassInScope(theEnv,execStatus,tmp->cls,currentModule)) tmp->theModule = currentModule; else tmp->theModule = tmp->cls->header.whichModule->theModule; tmp->chain = NULL; tmp->nxt = NULL; if (head == NULL) head = tmp; else bot->chain = tmp; bot = tmp; } return(head); } return(NULL); }