src/clipsrules/core/msgcom.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.24  06/02/06          */
00005    /*                                                     */
00006    /*                OBJECT MESSAGE COMMANDS              */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:                                                  */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /* Revision History:                                         */
00018 /*      6.23: Changed name of variable log to logName        */
00019 /*            because of Unix compiler warnings of shadowed  */
00020 /*            definitions.                                   */
00021 /*                                                           */
00022 /*      6.24: Removed IMPERATIVE_MESSAGE_HANDLERS            */
00023 /*                    compilation flag.                      */
00024 /*                                                           */
00025 /*            Corrected code to remove run-time program      */
00026 /*            compiler warnings.                             */
00027 /*                                                           */
00028 /*************************************************************/
00029 
00030 /* =========================================
00031    *****************************************
00032                EXTERNAL DEFINITIONS
00033    =========================================
00034    ***************************************** */
00035 #include "setup.h"
00036 
00037 #if OBJECT_SYSTEM
00038 
00039 #include <string.h>
00040 
00041 #include "argacces.h"
00042 #include "classcom.h"
00043 #include "classfun.h"
00044 #include "classinf.h"
00045 #include "envrnmnt.h"
00046 #include "insfun.h"
00047 #include "insmoddp.h"
00048 #include "msgfun.h"
00049 #include "msgpass.h"
00050 #include "memalloc.h"
00051 #include "prccode.h"
00052 #include "router.h"
00053 
00054 #if BLOAD || BLOAD_AND_BSAVE
00055 #include "bload.h"
00056 #endif
00057 
00058 #if ! RUN_TIME
00059 #include "extnfunc.h"
00060 #endif
00061 
00062 #if (! BLOAD_ONLY) && (! RUN_TIME)
00063 #include "constrct.h"
00064 #include "msgpsr.h"
00065 #endif
00066 
00067 #if DEBUGGING_FUNCTIONS
00068 #include "watch.h"
00069 #endif
00070 
00071 #define _MSGCOM_SOURCE_
00072 #include "msgcom.h"
00073 
00074 /* =========================================
00075    *****************************************
00076       INTERNALLY VISIBLE FUNCTION HEADERS
00077    =========================================
00078    ***************************************** */
00079 
00080 #if ! RUN_TIME
00081 static void CreateSystemHandlers(void *);
00082 #endif
00083 
00084 #if (! BLOAD_ONLY) && (! RUN_TIME)
00085 static int WildDeleteHandler(void *,DEFCLASS *,SYMBOL_HN *,char *);
00086 #endif
00087 
00088 #if DEBUGGING_FUNCTIONS
00089 static unsigned DefmessageHandlerWatchAccess(void *,int,unsigned,EXPRESSION *);
00090 static unsigned DefmessageHandlerWatchPrint(void *,char *,int,EXPRESSION *);
00091 static unsigned DefmessageHandlerWatchSupport(void *,char *,char *,int,
00092                                               void (*)(void *,char *,void *,int),
00093                                               void (*)(void *,int,void *,int),
00094                                               EXPRESSION *);
00095 static unsigned WatchClassHandlers(void *,void *,char *,int,char *,int,int,
00096                                   void (*)(void *,char *,void *,int),
00097                                   void (*)(void *,int,void *,int));
00098 static void PrintHandlerWatchFlag(void *,char *,void *,int);
00099 #endif
00100 
00101 static void DeallocateMessageHandlerData(void *);
00102   
00103 /* =========================================
00104    *****************************************
00105           EXTERNALLY VISIBLE FUNCTIONS
00106    =========================================
00107    ***************************************** */
00108 
00109 /***************************************************
00110   NAME         : SetupMessageHandlers
00111   DESCRIPTION  : Sets up internal symbols and
00112                  fucntion definitions pertaining to
00113                  message-handlers.  Also creates
00114                  system handlers
00115   INPUTS       : None
00116   RETURNS      : Nothing useful
00117   SIDE EFFECTS : Functions and data structures
00118                  initialized
00119   NOTES        : Should be called before
00120                  SetupInstanceModDupCommands() in
00121                  INSMODDP.C
00122  ***************************************************/
00123 globle void SetupMessageHandlers(
00124   void *theEnv)
00125   {
00126    ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1,
00127                                         PrintHandlerSlotGetFunction,
00128                                         PrintHandlerSlotGetFunction,NULL,
00129                                         HandlerSlotGetFunction,
00130                                         NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },
00131 
00132                  handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1,
00133                                         PrintHandlerSlotPutFunction,
00134                                         PrintHandlerSlotPutFunction,NULL,
00135                                         HandlerSlotPutFunction,
00136                                         NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
00137 
00138    AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),DeallocateMessageHandlerData);
00139    memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord));   
00140    memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord));   
00141 
00142    MessageHandlerData(theEnv)->hndquals[0] = "around";
00143    MessageHandlerData(theEnv)->hndquals[1] = "before";
00144    MessageHandlerData(theEnv)->hndquals[2] = "primary";
00145    MessageHandlerData(theEnv)->hndquals[3] = "after";
00146 
00147    InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET);
00148    InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT);
00149 
00150 #if ! RUN_TIME
00151    MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING);
00152    IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL);
00153 
00154    MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING);
00155    IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL);
00156    
00157    MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING);
00158    IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL);
00159    
00160    EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100);
00161 
00162 #if ! BLOAD_ONLY
00163    MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING);
00164    IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL);
00165 
00166    AddConstruct(theEnv,"defmessage-handler","defmessage-handlers",
00167                 ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
00168    EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand,
00169                   "UndefmessageHandlerCommand","23w");
00170 
00171 #endif
00172 
00173    EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw");
00174 
00175 #if DEBUGGING_FUNCTIONS
00176    EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w");
00177 
00178    EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand,
00179                   "PPDefmessageHandlerCommand","23w");
00180    EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand,
00181                   "ListDefmessageHandlersCommand","02w");
00182 #endif
00183 
00184    EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00");
00185    FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE);
00186    EnvDefineFunction2(theEnv,"call-next-handler",'u',
00187                   PTIEF CallNextHandler,"CallNextHandler","00");
00188    FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE);
00189    EnvDefineFunction2(theEnv,"override-next-handler",'u',
00190                   PTIEF CallNextHandler,"CallNextHandler",NULL);
00191    FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE);
00192 
00193    EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
00194    EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
00195    EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
00196    EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
00197 #endif
00198 
00199 #if DEBUGGING_FUNCTIONS
00200    AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL);
00201    AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35,
00202                 DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint);
00203 #endif
00204   }
00205 
00206 /*******************************************************/
00207 /* DeallocateMessageHandlerData: Deallocates environment */
00208 /*    data for the message handler functionality.        */
00209 /******************************************************/
00210 static void DeallocateMessageHandlerData(
00211   void *theEnv)
00212   {
00213    HANDLER_LINK *tmp, *mhead, *chead;
00214     
00215    mhead = MessageHandlerData(theEnv)->TopOfCore;
00216    while (mhead != NULL)
00217      { 
00218       tmp = mhead;
00219       mhead = mhead->nxt;
00220       rtn_struct(theEnv,messageHandlerLink,tmp);
00221      }
00222      
00223    chead = MessageHandlerData(theEnv)->OldCore;
00224    while (chead != NULL)
00225      { 
00226       mhead = chead;
00227       chead = chead->nxtInStack;
00228       
00229       while (mhead != NULL)
00230         {
00231          tmp = mhead;
00232          mhead = mhead->nxt;
00233          rtn_struct(theEnv,messageHandlerLink,tmp);
00234         }
00235      }
00236   }
00237 
00238 /*****************************************************
00239   NAME         : EnvGetDefmessageHandlerName
00240   DESCRIPTION  : Gets the name of a message-handler
00241   INPUTS       : 1) Pointer to a class
00242                  2) Array index of handler in class's
00243                     message-handler array (+1)
00244   RETURNS      : Name-string of message-handler
00245   SIDE EFFECTS : None
00246   NOTES        : None
00247  *****************************************************/
00248 #if WIN_BTC
00249 #pragma argsused
00250 #endif
00251 char *EnvGetDefmessageHandlerName(
00252   void *theEnv,
00253   void *ptr,
00254   int theIndex)
00255   {
00256 #if MAC_MCW || WIN_MCW || MAC_XCD
00257 #pragma unused(theEnv)
00258 #endif
00259 
00260    return(ValueToString(((DEFCLASS *) ptr)->handlers[theIndex-1].name));
00261   }
00262 
00263 /*****************************************************
00264   NAME         : EnvGetDefmessageHandlerType
00265   DESCRIPTION  : Gets the type of a message-handler
00266   INPUTS       : 1) Pointer to a class
00267                  2) Array index of handler in class's
00268                     message-handler array (+1)
00269   RETURNS      : Type-string of message-handler
00270   SIDE EFFECTS : None
00271   NOTES        : None
00272  *****************************************************/
00273 globle char *EnvGetDefmessageHandlerType(
00274   void *theEnv,
00275   void *ptr,
00276   int theIndex)
00277   {
00278    return(MessageHandlerData(theEnv)->hndquals[((DEFCLASS *) ptr)->handlers[theIndex-1].type]);
00279   }
00280 
00281 /**************************************************************
00282   NAME         : EnvGetNextDefmessageHandler
00283   DESCRIPTION  : Finds first or next handler for a class
00284   INPUTS       : 1) The address of the handler's class
00285                  2) The array index of the current handler (+1)
00286   RETURNS      : The array index (+1) of the next handler, or 0
00287                    if there is none
00288   SIDE EFFECTS : None
00289   NOTES        : If index == 0, the first handler array index
00290                  (i.e. 1) returned
00291  **************************************************************/
00292 #if WIN_BTC
00293 #pragma argsused
00294 #endif
00295 globle int EnvGetNextDefmessageHandler(
00296   void *theEnv,
00297   void *ptr,
00298   int theIndex)
00299   {
00300    DEFCLASS *cls;
00301 #if MAC_MCW || WIN_MCW || MAC_XCD
00302 #pragma unused(theEnv)
00303 #endif
00304 
00305    cls = (DEFCLASS *) ptr;
00306    if (theIndex == 0)
00307      return((cls->handlers != NULL) ? 1 : 0);
00308    if (theIndex == cls->handlerCount)
00309      return(0);
00310    return(theIndex+1);
00311   }
00312 
00313 /*****************************************************
00314   NAME         : GetDefmessageHandlerPointer
00315   DESCRIPTION  : Returns a pointer to a handler
00316   INPUTS       : 1) Pointer to a class
00317                  2) Array index of handler in class's
00318                     message-handler array (+1)
00319   RETURNS      : Pointer to the handler.
00320   SIDE EFFECTS : None
00321   NOTES        : None
00322  *****************************************************/
00323 globle HANDLER *GetDefmessageHandlerPointer(
00324   void *ptr,
00325   int theIndex)
00326   {
00327    return(&((DEFCLASS *) ptr)->handlers[theIndex-1]);
00328   }
00329 
00330 #if DEBUGGING_FUNCTIONS
00331 
00332 /*********************************************************
00333   NAME         : EnvGetDefmessageHandlerWatch
00334   DESCRIPTION  : Determines if trace messages for calls
00335                  to this handler will be generated or not
00336   INPUTS       : 1) A pointer to the class
00337                  2) The index of the handler
00338   RETURNS      : TRUE if a trace is active,
00339                  FALSE otherwise
00340   SIDE EFFECTS : None
00341   NOTES        : None
00342  *********************************************************/
00343 #if WIN_BTC
00344 #pragma argsused
00345 #endif
00346 globle unsigned EnvGetDefmessageHandlerWatch(
00347   void *theEnv,
00348   void *theClass,
00349   int theIndex)
00350   {
00351 #if MAC_MCW || WIN_MCW || MAC_XCD
00352 #pragma unused(theEnv)
00353 #endif
00354 
00355    return(((DEFCLASS *) theClass)->handlers[theIndex-1].trace);
00356   }
00357 
00358 /*********************************************************
00359   NAME         : EnvSetDefmessageHandlerWatch
00360   DESCRIPTION  : Sets the trace to ON/OFF for the
00361                  calling of the handler
00362   INPUTS       : 1) TRUE to set the trace on,
00363                     FALSE to set it off
00364                  2) A pointer to the class
00365                  3) The index of the handler
00366   RETURNS      : Nothing useful
00367   SIDE EFFECTS : Watch flag for the handler set
00368   NOTES        : None
00369  *********************************************************/
00370 #if WIN_BTC
00371 #pragma argsused
00372 #endif
00373 globle void EnvSetDefmessageHandlerWatch(
00374   void *theEnv,
00375   int newState,
00376   void *theClass,
00377   int theIndex)
00378   {
00379 #if MAC_MCW || WIN_MCW || MAC_XCD
00380 #pragma unused(theEnv)
00381 #endif
00382 
00383    ((DEFCLASS *) theClass)->handlers[theIndex-1].trace = newState;
00384   }
00385 
00386 #endif
00387 
00388 /***************************************************
00389   NAME         : EnvFindDefmessageHandler
00390   DESCRIPTION  : Determines the index of a specfied
00391                   message-handler
00392   INPUTS       : 1) A pointer to the class
00393                  2) Name-string of the handler
00394                  3) Handler-type: "around","before",
00395                     "primary", or "after"
00396   RETURNS      : The index of the handler
00397                    (0 if not found)
00398   SIDE EFFECTS : None
00399   NOTES        : None
00400  ***************************************************/
00401 globle unsigned EnvFindDefmessageHandler(
00402   void *theEnv,
00403   void *ptr,
00404   char *hname,
00405   char *htypestr)
00406   {
00407    unsigned htype;
00408    SYMBOL_HN *hsym;
00409    DEFCLASS *cls;
00410    int theIndex;
00411 
00412    htype = HandlerType(theEnv,"handler-lookup",htypestr);
00413    if (htype == MERROR)
00414      return(0);
00415    hsym = FindSymbolHN(theEnv,hname);
00416    if (hsym == NULL)
00417      return(0);
00418    cls = (DEFCLASS *) ptr;
00419    theIndex = FindHandlerByIndex(cls,hsym,(unsigned) htype);
00420    return((unsigned) (theIndex+1));
00421   }
00422 
00423 /***************************************************
00424   NAME         : EnvIsDefmessageHandlerDeletable
00425   DESCRIPTION  : Determines if a message-handler
00426                    can be deleted
00427   INPUTS       : 1) Address of the handler's class
00428                  2) Index of the handler
00429   RETURNS      : TRUE if deletable, FALSE otherwise
00430   SIDE EFFECTS : None
00431   NOTES        : None
00432  ***************************************************/
00433 globle int EnvIsDefmessageHandlerDeletable(
00434   void *theEnv,
00435   void *ptr,
00436   int theIndex)
00437   {
00438    DEFCLASS *cls;
00439 
00440    if (! ConstructsDeletable(theEnv))
00441      { return FALSE; }
00442 
00443    cls = (DEFCLASS *) ptr;
00444    if (cls->handlers[theIndex-1].system == 1)
00445      return(FALSE);
00446 
00447 #if (! BLOAD_ONLY) && (! RUN_TIME)
00448    return((HandlersExecuting(cls) == FALSE) ? TRUE : FALSE);
00449 #else
00450    return FALSE;
00451 #endif
00452   }
00453 
00454 /******************************************************************************
00455   NAME         : UndefmessageHandlerCommand
00456   DESCRIPTION  : Deletes a handler from a class
00457   INPUTS       : None
00458   RETURNS      : Nothing useful
00459   SIDE EFFECTS : Handler deleted if possible
00460   NOTES        : H/L Syntax: (undefmessage-handler <class> <handler> [<type>])
00461  ******************************************************************************/
00462 globle void UndefmessageHandlerCommand(
00463   void *theEnv)
00464   {
00465 #if RUN_TIME || BLOAD_ONLY
00466    PrintErrorID(theEnv,"MSGCOM",3,FALSE);
00467    EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
00468 #else
00469    SYMBOL_HN *mname;
00470    char *tname;
00471    DATA_OBJECT tmp;
00472    DEFCLASS *cls;
00473 
00474 #if BLOAD || BLOAD_AND_BSAVE
00475    if (Bloaded(theEnv))
00476      {
00477       PrintErrorID(theEnv,"MSGCOM",3,FALSE);
00478       EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
00479       return;
00480      }
00481 #endif
00482    if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE)
00483      return;
00484    cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));
00485    if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE)
00486      {
00487       ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp));
00488       return;
00489      }
00490    if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE)
00491      return;
00492    mname = (SYMBOL_HN *) tmp.value;
00493    if (EnvRtnArgCount(theEnv) == 3)
00494      {
00495       if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE)
00496         return;
00497       tname = DOToString(tmp);
00498       if (strcmp(tname,"*") == 0)
00499         tname = NULL;
00500      }
00501    else
00502      tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
00503    WildDeleteHandler(theEnv,cls,mname,tname);
00504 #endif
00505   }
00506 
00507 /***********************************************************
00508   NAME         : EnvUndefmessageHandler
00509   DESCRIPTION  : Deletes a handler from a class
00510   INPUTS       : 1) Class address    (Can be NULL)
00511                  2) Handler index (can be 0)
00512   RETURNS      : 1 if successful, 0 otherwise
00513   SIDE EFFECTS : Handler deleted if possible
00514   NOTES        : None
00515  ***********************************************************/
00516 globle int EnvUndefmessageHandler(
00517   void *theEnv,
00518   void *vptr,
00519   int mhi)
00520   {
00521 #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
00522 #pragma unused(vptr)
00523 #pragma unused(mhi)
00524 #endif
00525 
00526 #if RUN_TIME || BLOAD_ONLY
00527    PrintErrorID(theEnv,"MSGCOM",3,FALSE);
00528    EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
00529    return(0);
00530 #else
00531    DEFCLASS *cls;
00532 
00533 #if BLOAD || BLOAD_AND_BSAVE
00534    if (Bloaded(theEnv))
00535      {
00536       PrintErrorID(theEnv,"MSGCOM",3,FALSE);
00537       EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
00538       return(0);
00539      }
00540 #endif
00541    if (vptr == NULL)
00542      {
00543       if (mhi != 0)
00544         {
00545          PrintErrorID(theEnv,"MSGCOM",1,FALSE);
00546          EnvPrintRouter(theEnv,WERROR,"Incomplete message-handler specification for deletion.\n");
00547          return(0);
00548         }
00549       return(WildDeleteHandler(theEnv,NULL,NULL,NULL));
00550      }
00551    if (mhi == 0)
00552      return(WildDeleteHandler(theEnv,(DEFCLASS *) vptr,NULL,NULL));
00553    cls = (DEFCLASS *) vptr;
00554    if (HandlersExecuting(cls))
00555      {
00556       HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls));
00557       return(0);
00558      }
00559    cls->handlers[mhi-1].mark = 1;
00560    DeallocateMarkedHandlers(theEnv,cls);
00561    return(1);
00562 #endif
00563   }
00564 
00565 #if DEBUGGING_FUNCTIONS
00566 
00567 /*******************************************************************************
00568   NAME         : PPDefmessageHandlerCommand
00569   DESCRIPTION  : Displays the pretty-print form (if any) for a handler
00570   INPUTS       : None
00571   RETURNS      : Nothing useful
00572   SIDE EFFECTS : None
00573   NOTES        : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>])
00574  *******************************************************************************/
00575 globle void PPDefmessageHandlerCommand(
00576   void *theEnv)
00577   {
00578    DATA_OBJECT temp;
00579    SYMBOL_HN *csym,*msym;
00580    char *tname;
00581    DEFCLASS *cls = NULL;
00582    unsigned mtype;
00583    HANDLER *hnd;
00584 
00585    if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE)
00586      return;
00587    csym = FindSymbolHN(theEnv,DOToString(temp));
00588    if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE)
00589      return;
00590    msym = FindSymbolHN(theEnv,DOToString(temp));
00591    if (EnvRtnArgCount(theEnv) == 3)
00592      {
00593       if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE)
00594         return;
00595       tname = DOToString(temp);
00596      }
00597    else
00598      tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
00599    mtype = HandlerType(theEnv,"ppdefmessage-handler",tname);
00600    if (mtype == MERROR)
00601      {
00602       SetEvaluationError(theEnv,TRUE);
00603       return;
00604      }
00605    if (csym != NULL)
00606      cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym));
00607    if (((cls == NULL) || (msym == NULL)) ? TRUE :
00608        ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL))
00609      {
00610       PrintErrorID(theEnv,"MSGCOM",2,FALSE);
00611       EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler ");
00612       EnvPrintRouter(theEnv,WERROR,ValueToString(msym));
00613       EnvPrintRouter(theEnv,WERROR," ");
00614       EnvPrintRouter(theEnv,WERROR,tname);
00615       EnvPrintRouter(theEnv,WERROR," for class ");
00616       EnvPrintRouter(theEnv,WERROR,ValueToString(csym));
00617       EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n");
00618       SetEvaluationError(theEnv,TRUE);
00619       return;
00620      }
00621    if (hnd->ppForm != NULL)
00622      PrintInChunks(theEnv,WDISPLAY,hnd->ppForm);
00623   }
00624 
00625 /*****************************************************************************
00626   NAME         : ListDefmessageHandlersCommand
00627   DESCRIPTION  : Depending on arguments, does lists handlers which
00628                    match restrictions
00629   INPUTS       : None
00630   RETURNS      : Nothing useful
00631   SIDE EFFECTS : None
00632   NOTES        : H/L Syntax: (list-defmessage-handlers [<class> [inherit]]))
00633  *****************************************************************************/
00634 globle void ListDefmessageHandlersCommand(
00635   void *theEnv)
00636   {
00637    int inhp;
00638    void *clsptr;
00639 
00640    if (EnvRtnArgCount(theEnv) == 0)
00641      EnvListDefmessageHandlers(theEnv,WDISPLAY,NULL,0);
00642    else
00643      {
00644       clsptr = ClassInfoFnxArgs(theEnv,"list-defmessage-handlers",&inhp);
00645       if (clsptr == NULL)
00646         return;
00647       EnvListDefmessageHandlers(theEnv,WDISPLAY,clsptr,inhp);
00648      }
00649   }
00650 
00651 /********************************************************************
00652   NAME         : PreviewSendCommand
00653   DESCRIPTION  : Displays a list of the core for a message describing
00654                    shadows,etc.
00655   INPUTS       : None
00656   RETURNS      : Nothing useful
00657   SIDE EFFECTS : Temporary core created and destroyed
00658   NOTES        : H/L Syntax: (preview-send <class> <msg>)
00659  ********************************************************************/
00660 globle void PreviewSendCommand(
00661   void *theEnv)
00662   {
00663    DEFCLASS *cls;
00664    DATA_OBJECT temp;
00665 
00666    /* =============================
00667       Get the class for the message
00668       ============================= */
00669    if (EnvArgTypeCheck(theEnv,"preview-send",1,SYMBOL,&temp) == FALSE)
00670      return;
00671    cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));
00672    if (cls == NULL)
00673      {
00674       ClassExistError(theEnv,"preview-send",ValueToString(temp.value));
00675       return;
00676      }
00677 
00678    if (EnvArgTypeCheck(theEnv,"preview-send",2,SYMBOL,&temp) == FALSE)
00679      return;
00680    EnvPreviewSend(theEnv,WDISPLAY,(void *) cls,DOToString(temp));
00681   }
00682 
00683 /********************************************************
00684   NAME         : EnvGetDefmessageHandlerPPForm
00685   DESCRIPTION  : Gets a message-handler pretty print form
00686   INPUTS       : 1) Address of the handler's class
00687                  2) Index of the handler
00688   RETURNS      : TRUE if printable, FALSE otherwise
00689   SIDE EFFECTS : None
00690   NOTES        : None
00691  ********************************************************/
00692 #if WIN_BTC
00693 #pragma argsused
00694 #endif
00695 globle char *EnvGetDefmessageHandlerPPForm(
00696   void *theEnv,
00697   void *ptr,
00698   int theIndex)
00699   {
00700 #if MAC_MCW || WIN_MCW || MAC_XCD
00701 #pragma unused(theEnv)
00702 #endif
00703 
00704    return(((DEFCLASS *) ptr)->handlers[theIndex-1].ppForm);
00705   }
00706 
00707 /*******************************************************************
00708   NAME         : EnvListDefmessageHandlers
00709   DESCRIPTION  : Lists message-handlers for a class
00710   INPUTS       : 1) The logical name of the output
00711                  2) Class name (NULL to display all handlers)
00712                  3) A flag indicating whether to list inherited
00713                     handlers or not
00714   RETURNS      : Nothing useful
00715   SIDE EFFECTS : None
00716   NOTES        : None
00717  *******************************************************************/
00718 globle void EnvListDefmessageHandlers(
00719   void *theEnv,
00720   char *logName,
00721   void *vptr,
00722   int inhp)
00723   {
00724    DEFCLASS *cls;
00725    long cnt;
00726    PACKED_CLASS_LINKS plinks;
00727 
00728    if (vptr != NULL)
00729      {
00730       cls = (DEFCLASS *) vptr;
00731       if (inhp)
00732         cnt = DisplayHandlersInLinks(theEnv,logName,&cls->allSuperclasses,0);
00733       else
00734         {
00735          plinks.classCount = 1;
00736          plinks.classArray = &cls;
00737          cnt = DisplayHandlersInLinks(theEnv,logName,&plinks,0);
00738         }
00739      }
00740    else
00741      {
00742       plinks.classCount = 1;
00743       cnt = 0L;
00744       for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ;
00745            cls != NULL ;
00746            cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
00747         {
00748          plinks.classArray = &cls;
00749          cnt += DisplayHandlersInLinks(theEnv,logName,&plinks,0);
00750         }
00751      }
00752    PrintTally(theEnv,logName,cnt,"message-handler","message-handlers");
00753   }
00754 
00755 /********************************************************************
00756   NAME         : EnvPreviewSend
00757   DESCRIPTION  : Displays a list of the core for a message describing
00758                    shadows,etc.
00759   INPUTS       : 1) Logical name of output
00760                  2) Class pointer
00761                  3) Message name-string
00762   RETURNS      : Nothing useful
00763   SIDE EFFECTS : Temporary core created and destroyed
00764   NOTES        : None
00765  ********************************************************************/
00766 globle void EnvPreviewSend(
00767   void *theEnv,
00768   char *logicalName,
00769   void *clsptr,
00770   char *msgname)
00771   {
00772    HANDLER_LINK *core;
00773    SYMBOL_HN *msym;
00774 
00775    msym = FindSymbolHN(theEnv,msgname);
00776    if (msym == NULL)
00777      return;
00778    core = FindPreviewApplicableHandlers(theEnv,(DEFCLASS *) clsptr,msym);
00779    if (core != NULL)
00780      {
00781       DisplayCore(theEnv,logicalName,core,0);
00782       DestroyHandlerLinks(theEnv,core);
00783      }
00784   }
00785 
00786 /****************************************************
00787   NAME         : DisplayHandlersInLinks
00788   DESCRIPTION  : Recursively displays all handlers
00789                   for an array of classes
00790   INPUTS       : 1) The logical name of the output
00791                  2) The packed class links
00792                  3) The index to print from the links
00793   RETURNS      : The number of handlers printed
00794   SIDE EFFECTS : None
00795   NOTES        : Used by DescribeClass()
00796  ****************************************************/
00797 globle long DisplayHandlersInLinks(
00798   void *theEnv,
00799   char *logName,
00800   PACKED_CLASS_LINKS *plinks,
00801   int theIndex)
00802   {
00803    long i;
00804    long cnt;
00805 
00806    cnt = (long) plinks->classArray[theIndex]->handlerCount;
00807    if (((int) theIndex) < (plinks->classCount - 1))
00808      cnt += DisplayHandlersInLinks(theEnv,logName,plinks,theIndex + 1);
00809    for (i = 0 ; i < plinks->classArray[theIndex]->handlerCount ; i++)
00810      PrintHandler(theEnv,logName,&plinks->classArray[theIndex]->handlers[i],TRUE);
00811    return(cnt);
00812   }
00813 
00814 #endif
00815 
00816 /* =========================================
00817    *****************************************
00818           INTERNALLY VISIBLE FUNCTIONS
00819    =========================================
00820    ***************************************** */
00821 
00822 #if ! RUN_TIME
00823 
00824 /**********************************************************
00825   NAME         : CreateSystemHandlers
00826   DESCRIPTION  : Attachess the system message-handlers
00827                  after a (clear)
00828   INPUTS       : None
00829   RETURNS      : Nothing useful
00830   SIDE EFFECTS : System handlers created
00831   NOTES        : Must be called after CreateSystemClasses()
00832  **********************************************************/
00833 static void CreateSystemHandlers(
00834   void *theEnv)
00835   {
00836    NewSystemHandler(theEnv,USER_TYPE_NAME,INIT_STRING,"init-slots",0);
00837    NewSystemHandler(theEnv,USER_TYPE_NAME,DELETE_STRING,"delete-instance",0);
00838    NewSystemHandler(theEnv,USER_TYPE_NAME,CREATE_STRING,"(create-instance)",0);
00839 
00840 #if DEBUGGING_FUNCTIONS
00841    NewSystemHandler(theEnv,USER_TYPE_NAME,PRINT_STRING,"ppinstance",0);
00842 #endif
00843 
00844    NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_MODIFY_STRING,"(direct-modify)",1);
00845    NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_MODIFY_STRING,"(message-modify)",1);
00846    NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_DUPLICATE_STRING,"(direct-duplicate)",2);
00847    NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_DUPLICATE_STRING,"(message-duplicate)",2);
00848   }
00849 
00850 #endif
00851 
00852 #if (! BLOAD_ONLY) && (! RUN_TIME)
00853 
00854 /************************************************************
00855   NAME         : WildDeleteHandler
00856   DESCRIPTION  : Deletes a handler from a class
00857   INPUTS       : 1) Class address (Can be NULL)
00858                  2) Message Handler Name (Can be NULL)
00859                  3) Type name ("primary", etc.)
00860   RETURNS      : 1 if successful, 0 otherwise
00861   SIDE EFFECTS : Handler deleted if possible
00862   NOTES        : None
00863  ************************************************************/
00864 static int WildDeleteHandler(
00865   void *theEnv,
00866   DEFCLASS *cls,
00867   SYMBOL_HN *msym,
00868   char *tname)
00869   {
00870    int mtype;
00871 
00872    if (msym == NULL)
00873      msym = (SYMBOL_HN *) EnvAddSymbol(theEnv,"*");
00874    if (tname != NULL)
00875      {
00876       mtype = (int) HandlerType(theEnv,"undefmessage-handler",tname);
00877       if (mtype == MERROR)
00878         return(0);
00879      }
00880    else
00881      mtype = -1;
00882    if (cls == NULL)
00883      {
00884       int success = 1;
00885 
00886       for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ;
00887            cls != NULL ;
00888            cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
00889         if (DeleteHandler(theEnv,cls,msym,mtype,FALSE) == 0)
00890           success = 0;
00891       return(success);
00892      }
00893    return(DeleteHandler(theEnv,cls,msym,mtype,TRUE));
00894   }
00895 
00896 #endif
00897 
00898 #if DEBUGGING_FUNCTIONS
00899 
00900 /******************************************************************
00901   NAME         : DefmessageHandlerWatchAccess
00902   DESCRIPTION  : Parses a list of class names passed by
00903                  AddWatchItem() and sets the traces accordingly
00904   INPUTS       : 1) A code indicating which trace flag is to be set
00905                     0 - Watch instance creation/deletion
00906                     1 - Watch slot changes to instances
00907                  2) The value to which to set the trace flags
00908                  3) A list of expressions containing the names
00909                     of the classes for which to set traces
00910   RETURNS      : TRUE if all OK, FALSE otherwise
00911   SIDE EFFECTS : Watch flags set in specified classes
00912   NOTES        : Accessory function for AddWatchItem()
00913  ******************************************************************/
00914 #if WIN_BTC
00915 #pragma argsused
00916 #endif
00917 static unsigned DefmessageHandlerWatchAccess(
00918   void *theEnv,
00919   int code,
00920   unsigned newState,
00921   EXPRESSION *argExprs)
00922   {
00923 #if MAC_MCW || WIN_MCW || MAC_XCD
00924 #pragma unused(code)
00925 #endif
00926    if (newState)
00927      return(DefmessageHandlerWatchSupport(theEnv,"watch",NULL,newState,
00928                                         NULL,EnvSetDefmessageHandlerWatch,argExprs));
00929    else
00930      return(DefmessageHandlerWatchSupport(theEnv,"unwatch",NULL,newState,
00931                                         NULL,EnvSetDefmessageHandlerWatch,argExprs));
00932   }
00933 
00934 /***********************************************************************
00935   NAME         : DefmessageHandlerWatchPrint
00936   DESCRIPTION  : Parses a list of class names passed by
00937                  AddWatchItem() and displays the traces accordingly
00938   INPUTS       : 1) The logical name of the output
00939                  2) A code indicating which trace flag is to be examined
00940                     0 - Watch instance creation/deletion
00941                     1 - Watch slot changes to instances
00942                  3) A list of expressions containing the names
00943                     of the classes for which to examine traces
00944   RETURNS      : TRUE if all OK, FALSE otherwise
00945   SIDE EFFECTS : Watch flags displayed for specified classes
00946   NOTES        : Accessory function for AddWatchItem()
00947  ***********************************************************************/
00948 #if WIN_BTC
00949 #pragma argsused
00950 #endif
00951 static unsigned DefmessageHandlerWatchPrint(
00952   void *theEnv,
00953   char *logName,
00954   int code,
00955   EXPRESSION *argExprs)
00956   {
00957 #if MAC_MCW || WIN_MCW || MAC_XCD
00958 #pragma unused(code)
00959 #endif
00960    return(DefmessageHandlerWatchSupport(theEnv,"list-watch-items",logName,-1,
00961                                         PrintHandlerWatchFlag,NULL,argExprs));
00962   }
00963 
00964 /*******************************************************
00965   NAME         : DefmessageHandlerWatchSupport
00966   DESCRIPTION  : Sets or displays handlers specified
00967   INPUTS       : 1) The calling function name
00968                  2) The logical output name for displays
00969                     (can be NULL)
00970                  4) The new set state (can be -1)
00971                  5) The print function (can be NULL)
00972                  6) The trace function (can be NULL)
00973                  7) The handlers expression list
00974   RETURNS      : TRUE if all OK,
00975                  FALSE otherwise
00976   SIDE EFFECTS : Handler trace flags set or displayed
00977   NOTES        : None
00978  *******************************************************/
00979 static unsigned DefmessageHandlerWatchSupport(
00980   void *theEnv,
00981   char *funcName,
00982   char *logName,
00983   int newState,
00984   void (*printFunc)(void *,char *,void *,int),
00985   void (*traceFunc)(void *,int,void *,int),
00986   EXPRESSION *argExprs)
00987   {
00988    struct defmodule *theModule;
00989    void *theClass;
00990    char *theHandlerStr;
00991    int theType;
00992    int argIndex = 2;
00993    DATA_OBJECT tmpData;
00994 
00995    /* ===============================
00996       If no handlers are specified,
00997       show the trace for all handlers
00998       in all handlers
00999       =============================== */
01000    if (argExprs == NULL)
01001      {
01002       SaveCurrentModule(theEnv);
01003       theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
01004       while (theModule != NULL)
01005         {
01006          EnvSetCurrentModule(theEnv,(void *) theModule);
01007          if (traceFunc == NULL)
01008            {
01009             EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule));
01010             EnvPrintRouter(theEnv,logName,":\n");
01011            }
01012          theClass = EnvGetNextDefclass(theEnv,NULL);
01013          while (theClass != NULL)
01014             {
01015              if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState,
01016                                     TRUE,printFunc,traceFunc) == FALSE)
01017                  return(FALSE);
01018              theClass = EnvGetNextDefclass(theEnv,theClass);
01019             }
01020           theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule);
01021          }
01022       RestoreCurrentModule(theEnv);
01023       return(TRUE);
01024      }
01025 
01026    /* ================================================
01027       Set or show the traces for the specified handler
01028       ================================================ */
01029    while (argExprs != NULL)
01030      {
01031       if (EvaluateExpression(theEnv,argExprs,&tmpData))
01032         return(FALSE);
01033       if (tmpData.type != SYMBOL)
01034         {
01035          ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
01036          return(FALSE);
01037         }
01038       theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData));
01039       if (theClass == NULL)
01040         {
01041          ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
01042          return(FALSE);
01043         }
01044       if (GetNextArgument(argExprs) != NULL)
01045         {
01046          argExprs = GetNextArgument(argExprs);
01047          argIndex++;
01048          if (EvaluateExpression(theEnv,argExprs,&tmpData))
01049            return(FALSE);
01050          if (tmpData.type != SYMBOL)
01051            {
01052             ExpectedTypeError1(theEnv,funcName,argIndex,"handler name");
01053             return(FALSE);
01054            }
01055          theHandlerStr = DOToString(tmpData);
01056          if (GetNextArgument(argExprs) != NULL)
01057            {
01058             argExprs = GetNextArgument(argExprs);
01059             argIndex++;
01060             if (EvaluateExpression(theEnv,argExprs,&tmpData))
01061               return(FALSE);
01062             if (tmpData.type != SYMBOL)
01063               {
01064                ExpectedTypeError1(theEnv,funcName,argIndex,"handler type");
01065                return(FALSE);
01066               }
01067             if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR)
01068               return(FALSE);
01069            }
01070          else
01071            theType = -1;
01072         }
01073       else
01074         {
01075          theHandlerStr = NULL;
01076          theType = -1;
01077         }
01078       if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName,
01079                              newState,FALSE,printFunc,traceFunc) == FALSE)
01080         {
01081          ExpectedTypeError1(theEnv,funcName,argIndex,"handler");
01082          return(FALSE);
01083         }
01084       argIndex++;
01085       argExprs = GetNextArgument(argExprs);
01086      }
01087    return(TRUE);
01088   }
01089 
01090 /*******************************************************
01091   NAME         : WatchClassHandlers
01092   DESCRIPTION  : Sets or displays handlers specified
01093   INPUTS       : 1) The class
01094                  2) The handler name (or NULL wildcard)
01095                  3) The handler type (or -1 wildcard)
01096                  4) The logical output name for displays
01097                     (can be NULL)
01098                  5) The new set state (can be -1)
01099                  6) The print function (can be NULL)
01100                  7) The trace function (can be NULL)
01101   RETURNS      : TRUE if all OK,
01102                  FALSE otherwise
01103   SIDE EFFECTS : Handler trace flags set or displayed
01104   NOTES        : None
01105  *******************************************************/
01106 static unsigned WatchClassHandlers(
01107   void *theEnv,
01108   void *theClass,
01109   char *theHandlerStr,
01110   int theType,
01111   char *logName,
01112   int newState,
01113   int indentp,
01114   void (*printFunc)(void *,char *,void *,int),
01115   void (*traceFunc)(void *,int,void *,int))
01116   {
01117    unsigned theHandler;
01118    int found = FALSE;
01119 
01120    theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,0);
01121    while (theHandler != 0)
01122      {
01123       if ((theType == -1) ? TRUE :
01124           (theType == (int) ((DEFCLASS *) theClass)->handlers[theHandler-1].type))
01125         {
01126          if ((theHandlerStr == NULL) ? TRUE :
01127              (strcmp(theHandlerStr,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler)) == 0))
01128             {
01129              if (traceFunc != NULL)
01130                (*traceFunc)(theEnv,newState,theClass,theHandler);
01131              else
01132                {
01133                 if (indentp)
01134                   EnvPrintRouter(theEnv,logName,"   ");
01135                 (*printFunc)(theEnv,logName,theClass,theHandler);
01136                }
01137              found = TRUE;
01138             }
01139         }
01140       theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,theHandler);
01141      }
01142    if ((theHandlerStr != NULL) && (theType != -1) && (found == FALSE))
01143      return(FALSE);
01144    return(TRUE);
01145   }
01146 
01147 /***************************************************
01148   NAME         : PrintHandlerWatchFlag
01149   DESCRIPTION  : Displays trace value for handler
01150   INPUTS       : 1) The logical name of the output
01151                  2) The class
01152                  3) The handler index
01153   RETURNS      : Nothing useful
01154   SIDE EFFECTS : None
01155   NOTES        : None
01156  ***************************************************/
01157 static void PrintHandlerWatchFlag(
01158   void *theEnv,
01159   char *logName,
01160   void *theClass,
01161   int theHandler)
01162   {
01163    EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,theClass));
01164    EnvPrintRouter(theEnv,logName," ");
01165    EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler));
01166    EnvPrintRouter(theEnv,logName," ");
01167    EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerType(theEnv,theClass,theHandler));
01168    
01169    if (EnvGetDefmessageHandlerWatch(theEnv,theClass,theHandler))
01170      EnvPrintRouter(theEnv,logName," = on\n");
01171    else
01172      EnvPrintRouter(theEnv,logName," = off\n");
01173   }
01174 
01175 #endif /* DEBUGGING_FUNCTIONS */
01176 #endif
01177