/************************************************************************************ 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 : WildDeleteHandler DESCRIPTION : Deletes a handler from a class INPUTS : 1) Class address (Can be NULL) 2) Message Handler Name (Can be NULL) 3) Type name ("primary", etc.) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handler deleted if possible NOTES : None ************************************************************/ static int WildDeleteHandler( void *theEnv, DEFCLASS *cls, SYMBOL_HN *msym, const char *tname) { int mtype; if (msym == NULL) msym = (SYMBOL_HN *) EnvAddSymbol(theEnv,"*"); if (tname != NULL) { mtype = (int) HandlerType(theEnv,"undefmessage-handler",tname); if (mtype == MERROR) return(0); } else mtype = -1; if (cls == NULL) { int success = 1; for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) if (DeleteHandler(theEnv,cls,msym,mtype,FALSE) == 0) success = 0; return(success); } return(DeleteHandler(theEnv,cls,msym,mtype,TRUE)); }
/******************************************************************************* NAME : PPDefmessageHandlerCommand DESCRIPTION : Displays the pretty-print form (if any) for a handler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>]) *******************************************************************************/ globle void PPDefmessageHandlerCommand( void *theEnv) { DATA_OBJECT temp; SYMBOL_HN *csym,*msym; const char *tname; DEFCLASS *cls = NULL; unsigned mtype; HANDLER *hnd; if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE) return; csym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE) return; msym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE) return; tname = DOToString(temp); } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; mtype = HandlerType(theEnv,"ppdefmessage-handler",tname); if (mtype == MERROR) { EnvSetEvaluationError(theEnv,TRUE); return; } if (csym != NULL) cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym)); if (((cls == NULL) || (msym == NULL)) ? TRUE : ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL)) { PrintErrorID(theEnv,"MSGCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(msym)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," for class "); EnvPrintRouter(theEnv,WERROR,ValueToString(csym)); EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n"); EnvSetEvaluationError(theEnv,TRUE); return; } if (hnd->ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,hnd->ppForm); }
/************************************************************************************ 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 : FindDefmessageHandler DESCRIPTION : Determines the index of a specfied message-handler INPUTS : 1) A pointer to the class 2) Name-string of the handler 3) Handler-type: "around","before", "primary", or "after" RETURNS : The index of the handler (0 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned FindDefmessageHandler( void *ptr, char *hname, char *htypestr) { int htype; SYMBOL_HN *hsym; DEFCLASS *cls; int index; htype = HandlerType("handler-lookup",htypestr); if (htype == MERROR) return(0); hsym = FindSymbol(hname); if (hsym == NULL) return(0); cls = (DEFCLASS *) ptr; index = FindHandlerByIndex(cls,hsym,(unsigned) htype); return((unsigned) (index+1)); }
/*************************************************** NAME : EnvFindDefmessageHandler DESCRIPTION : Determines the index of a specfied message-handler INPUTS : 1) A pointer to the class 2) Name-string of the handler 3) Handler-type: "around","before", "primary", or "after" RETURNS : The index of the handler (0 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned EnvFindDefmessageHandler( void *theEnv, void *ptr, const char *hname, const char *htypestr) { unsigned htype; SYMBOL_HN *hsym; DEFCLASS *cls; int theIndex; htype = HandlerType(theEnv,"handler-lookup",htypestr); if (htype == MERROR) return(0); hsym = FindSymbolHN(theEnv,hname); if (hsym == NULL) return(0); cls = (DEFCLASS *) ptr; theIndex = FindHandlerByIndex(cls,hsym,(unsigned) htype); return((unsigned) (theIndex+1)); }
/******************************************************* NAME : DefmessageHandlerWatchSupport DESCRIPTION : Sets or displays handlers specified INPUTS : 1) The calling function name 2) The logical output name for displays (can be NULL) 4) The new set state (can be -1) 5) The print function (can be NULL) 6) The trace function (can be NULL) 7) The handlers expression list RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler trace flags set or displayed NOTES : None *******************************************************/ static unsigned DefmessageHandlerWatchSupport( void *theEnv, const char *funcName, const char *logName, int newState, void (*printFunc)(void *,const char *,void *,int), void (*traceFunc)(void *,int,void *,int), EXPRESSION *argExprs) { struct defmodule *theModule; void *theClass; const char *theHandlerStr; int theType; int argIndex = 2; DATA_OBJECT tmpData; /* =============================== If no handlers are specified, show the trace for all handlers in all handlers =============================== */ if (argExprs == NULL) { SaveCurrentModule(theEnv); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); if (traceFunc == NULL) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } theClass = EnvGetNextDefclass(theEnv,NULL); while (theClass != NULL) { if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState, TRUE,printFunc,traceFunc) == FALSE) return(FALSE); theClass = EnvGetNextDefclass(theEnv,theClass); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } RestoreCurrentModule(theEnv); return(TRUE); } /* ================================================ Set or show the traces for the specified handler ================================================ */ while (argExprs != NULL) { if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData)); if (theClass == NULL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler name"); return(FALSE); } theHandlerStr = DOToString(tmpData); if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler type"); return(FALSE); } if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR) return(FALSE); } else theType = -1; } else { theHandlerStr = NULL; theType = -1; } if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName, newState,FALSE,printFunc,traceFunc) == FALSE) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler"); return(FALSE); } argIndex++; argExprs = GetNextArgument(argExprs); } return(TRUE); }
/*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler <class> <name> [<type>] [<comment>] (<params>) <action>*) <params> ::= <var>* | <var>* $?<name> ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); #if ! IMPERATIVE_MESSAGE_HANDLERS if (mtype == MAROUND) return(TRUE); #endif GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n")); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = min; hnd->maxParams = max; hnd->localVarCount = lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); }