/***************************************************
NAME : EnvIsDefmessageHandlerDeletable
DESCRIPTION : Determines if a message-handler
can be deleted
INPUTS : 1) Address of the handler's class
2) Index of the handler
RETURNS : TRUE if deletable, FALSE otherwise
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle int EnvIsDefmessageHandlerDeletable(
void *theEnv,
void *ptr,
unsigned theIndex)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,ptr,theIndex)
#endif
#if BLOAD_ONLY || RUN_TIME
return(FALSE);
#else
DEFCLASS *cls;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
return(FALSE);
#endif
cls = (DEFCLASS *) ptr;
if (cls->handlers[theIndex-1].system == 1)
return(FALSE);
return((HandlersExecuting(cls) == FALSE) ? TRUE : FALSE);
#endif
}
/***********************************************************
NAME : EnvUndefmessageHandler
DESCRIPTION : Deletes a handler from a class
INPUTS : 1) Class address (Can be NULL)
2) Handler index (can be 0)
RETURNS : 1 if successful, 0 otherwise
SIDE EFFECTS : Handler deleted if possible
NOTES : None
***********************************************************/
globle int EnvUndefmessageHandler(
void *theEnv,
void *vptr,
unsigned mhi)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(vptr)
#pragma unused(mhi)
#endif
#if RUN_TIME || BLOAD_ONLY
PrintErrorID(theEnv,"MSGCOM",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
return(0);
#else
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(0);
}
#endif
if (vptr == NULL)
{
if (mhi != 0)
{
PrintErrorID(theEnv,"MSGCOM",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Incomplete message-handler specification for deletion.\n");
return(0);
}
return(WildDeleteHandler(theEnv,NULL,NULL,NULL));
}
if (mhi == 0)
return(WildDeleteHandler(theEnv,(DEFCLASS *) vptr,NULL,NULL));
cls = (DEFCLASS *) vptr;
if (HandlersExecuting(cls))
{
HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls));
return(0);
}
cls->handlers[mhi-1].mark = 1;
DeallocateMarkedHandlers(theEnv,cls);
return(1);
#endif
}
/***************************************************
NAME : EnvIsDefmessageHandlerDeletable
DESCRIPTION : Determines if a message-handler
can be deleted
INPUTS : 1) Address of the handler's class
2) Index of the handler
RETURNS : TRUE if deletable, FALSE otherwise
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle int EnvIsDefmessageHandlerDeletable(
void *theEnv,
void *ptr,
int theIndex)
{
DEFCLASS *cls;
if (! ConstructsDeletable(theEnv))
{ return FALSE; }
cls = (DEFCLASS *) ptr;
if (cls->handlers[theIndex-1].system == 1)
return(FALSE);
#if (! BLOAD_ONLY) && (! RUN_TIME)
return((HandlersExecuting(cls) == FALSE) ? TRUE : FALSE);
#else
return FALSE;
#endif
}
/*********************************************************************
NAME : DeleteHandler
DESCRIPTION : Deletes one or more message-handlers
from a class definition
INPUTS : 1) The class address
2) The message-handler name
(if this is * and there is no handler
called *, then the delete operations
will be applied to all handlers matching the type
3) The message-handler type
(if this is -1, then the delete operations will be
applied to all handlers matching the name
4) A flag saying whether to print error messages when
handlers are not found meeting specs
RETURNS : 1 if successful, 0 otherwise
SIDE EFFECTS : Handlers deleted
NOTES : If any handlers for the class are
currently executing, this routine
will fail
**********************************************************************/
globle int DeleteHandler(
void *theEnv,
EXEC_STATUS,
DEFCLASS *cls,
SYMBOL_HN *mname,
int mtype,
int indicate_missing)
{
long i;
HANDLER *hnd;
int found,success = 1;
if (cls->handlerCount == 0)
{
if (indicate_missing)
{
HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls));
return(0);
}
return(1);
}
if (HandlersExecuting(cls))
{
HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls));
return(0);
}
if (mtype == -1)
{
found = FALSE;
for (i = MAROUND ; i <= MAFTER ; i++)
{
hnd = FindHandlerByAddress(cls,mname,(unsigned) i);
if (hnd != NULL)
{
found = TRUE;
if (hnd->system == 0)
hnd->mark = 1;
else
{
PrintErrorID(theEnv,execStatus,"MSGPSR",3,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"System message-handlers may not be modified.\n");
success = 0;
}
}
}
if ((found == FALSE) ? (strcmp(ValueToString(mname),"*") == 0) : FALSE)
{
for (i = 0 ; i < cls->handlerCount ; i++)
if (cls->handlers[i].system == 0)
cls->handlers[i].mark = 1;
}
}
else
{
hnd = FindHandlerByAddress(cls,mname,(unsigned) mtype);
if (hnd == NULL)
{
if (strcmp(ValueToString(mname),"*") == 0)
{
for (i = 0 ; i < cls->handlerCount ; i++)
if ((cls->handlers[i].type == (unsigned) mtype) &&
(cls->handlers[i].system == 0))
cls->handlers[i].mark = 1;
}
else
{
if (indicate_missing)
HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls));
success = 0;
}
}
else if (hnd->system == 0)
hnd->mark = 1;
else
{
if (indicate_missing)
{
PrintErrorID(theEnv,execStatus,"MSGPSR",3,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"System message-handlers may not be modified.\n");
}
success = 0;
}
}
DeallocateMarkedHandlers(theEnv,execStatus,cls);
return(success);
}
/***********************************************************************
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);
}
