classcom.c

clips源代码

#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   return(((DEFCLASS *) theClass)->traceInstances);
  }

/*********************************************************
  NAME         : EnvSetDefclassWatchInstances
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 creation/deletion of instances
                 of the class
  INPUTS       : 1) TRUE to set the trace on,
                    FALSE to set it off
                 2) A pointer to the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch flag for the class set
  NOTES        : None
 *********************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle void EnvSetDefclassWatchInstances(
  void *theEnv,
  unsigned newState,
  void *theClass)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   if (((DEFCLASS *) theClass)->abstract)
     return;
   ((DEFCLASS *) theClass)->traceInstances = newState;
  }

/*********************************************************
  NAME         : EnvGetDefclassWatchSlots
  DESCRIPTION  : Determines if changes to slots of
                 instances of this class will generate
                 trace messages or not
  INPUTS       : A pointer to the class
  RETURNS      : TRUE if a trace is active,
                 FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle unsigned EnvGetDefclassWatchSlots(
  void *theEnv,
  void *theClass)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   return(((DEFCLASS *) theClass)->traceSlots);
  }

/**********************************************************
  NAME         : EnvSetDefclassWatchSlots
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 changes to slots of instances of the class
  INPUTS       : 1) TRUE to set the trace on,
                    FALSE to set it off
                 2) A pointer to the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch flag for the class set
  NOTES        : None
 **********************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle void EnvSetDefclassWatchSlots(
  void *theEnv,
  unsigned newState,
  void *theClass)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   ((DEFCLASS *) theClass)->traceSlots = newState;
  }

/******************************************************************
  NAME         : DefclassWatchAccess
  DESCRIPTION  : Parses a list of class names passed by
                 AddWatchItem() and sets the traces accordingly
  INPUTS       : 1) A code indicating which trace flag is to be set
                    0 - Watch instance creation/deletion
                    1 - Watch slot changes to instances
                 2) The value to which to set the trace flags
                 3) A list of expressions containing the names
                    of the classes for which to set traces
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : Watch flags set in specified classes
  NOTES        : Accessory function for AddWatchItem()
 ******************************************************************/
globle unsigned DefclassWatchAccess(
  void *theEnv,
  int code,
  unsigned newState,
  EXPRESSION *argExprs)
  {
   if (code)
     return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs,
                                    EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots));
   else
     return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs,
                                    EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances));
  }

/***********************************************************************
  NAME         : DefclassWatchPrint
  DESCRIPTION  : Parses a list of class names passed by
                 AddWatchItem() and displays the traces accordingly
  INPUTS       : 1) The logical name of the output
                 2) A code indicating which trace flag is to be examined
                    0 - Watch instance creation/deletion
                    1 - Watch slot changes to instances
                 3) A list of expressions containing the names
                    of the classes for which to examine traces
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : Watch flags displayed for specified classes
  NOTES        : Accessory function for AddWatchItem()
 ***********************************************************************/
globle unsigned DefclassWatchPrint(
  void *theEnv,
  char *logName,
  int code,
  EXPRESSION *argExprs)
  {
   if (code)
     return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,
                                      EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots));
   else
     return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,
                                      EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances));
  }

#endif

/*********************************************************
  NAME         : GetDefclassListFunction
  DESCRIPTION  : Groups names of all defclasses into
                   a multifield variable
  INPUTS       : A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield set to list of classes
  NOTES        : None
 *********************************************************/
globle void GetDefclassListFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   GetConstructListFunction(theEnv,"get-defclass-list",returnValue,DefclassData(theEnv)->DefclassConstruct);
  }

/***************************************************************
  NAME         : EnvGetDefclassList
  DESCRIPTION  : Groups all defclass names into
                 a multifield list
  INPUTS       : 1) A data object buffer to hold
                    the multifield result
                 2) The module from which to obtain defclasses
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : External C access
 ***************************************************************/
globle void EnvGetDefclassList(
  void *theEnv,
  DATA_OBJECT *returnValue,
  struct defmodule *theModule)
  {
   GetConstructList(theEnv,returnValue,DefclassData(theEnv)->DefclassConstruct,theModule);
  }

/*****************************************************
  NAME         : HasSuperclass
  DESCRIPTION  : Determines if class-2 is a superclass
                   of class-1
  INPUTS       : 1) Class-1
                 2) Class-2
  RETURNS      : TRUE if class-2 is a superclass of
                   class-1, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************/
globle int HasSuperclass(
  DEFCLASS *c1,
  DEFCLASS *c2)
  {
   long i;

   for (i = 1 ; i < c1->allSuperclasses.classCount ; i++)
     if (c1->allSuperclasses.classArray[i] == c2)
       return(TRUE);
   return(FALSE);
  }

/********************************************************************
  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,
   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));
  }

#if (! BLOAD_ONLY) && (! RUN_TIME)

/***************************************************
  NAME         : SaveDefclasses
  DESCRIPTION  : Prints pretty print form of
                   defclasses to specified output
  INPUTS       : The  logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
#if IBM_TBC && (! DEBUGGING_FUNCTIONS)
#pragma argsused
#endif
globle void SaveDefclasses(
  void *theEnv,
  void *theModule,
  char *logName)
  {
#if DEBUGGING_FUNCTIONS
   DoForAllConstructsInModule(theEnv,theModule,SaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) logName);
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv,theModule,logName)
#endif
#endif
  }

#endif

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS

/***************************************************
  NAME         : SaveDefclass
  DESCRIPTION  : Writes out the pretty-print forms
                 of a class and all its handlers
  INPUTS       : 1) The class
                 2) The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : Class and handlers written
  NOTES        : None
 ***************************************************/
static void SaveDefclass(
  void *theEnv,
  struct constructHeader *theDefclass,
  void *userBuffer)
  {
   char *logName = (char *) userBuffer;
   unsigned hnd;
   char *ppForm;

   ppForm = EnvGetDefclassPPForm(theEnv,(void *) theDefclass);
   if (ppForm != NULL)
     {
      PrintInChunks(theEnv,logName,ppForm);
      EnvPrintRouter(theEnv,logName,"\n");
      hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,0);
      while (hnd != 0)
        {
         ppForm = EnvGetDefmessageHandlerPPForm(theEnv,(void *) theDefclass,hnd);
         if (ppForm != NULL)
           {
            PrintInChunks(theEnv,logName,ppForm);
            EnvPrintRouter(theEnv,logName,"\n");
           }
         hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,hnd);
        }
     }
  }

#endif

/***********************************************/
/* EnvSetClassDefaultsMode: Allows the setting */
/*    of the class defaults mode.              */
/***********************************************/
globle unsigned short EnvSetClassDefaultsMode(
  void *theEnv,
  unsigned short value)
  {
   unsigned short ov;

   ov = DefclassData(theEnv)->ClassDefaultsMode;
   DefclassData(theEnv)->ClassDefaultsMode = value;
   return(ov);
  }

/****************************************/
/* EnvGetClassDefaultsMode: Returns the */
/*    value of the class defaults mode. */
/****************************************/
globle unsigned short EnvGetClassDefaultsMode(
  void *theEnv)
  {
   return(DefclassData(theEnv)->ClassDefaultsMode);
  }
  
/***************************************************/
/* GetClassDefaultsModeCommand: H/L access routine */
/*   for the get-class-defaults-mode command.      */
/***************************************************/
globle void *GetClassDefaultsModeCommand(
  void *theEnv)
  {
   EnvArgCountCheck(theEnv,"get-class-defaults-mode",EXACTLY,0);

   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv))));
  }

/***************************************************/
/* SetClassDefaultsModeCommand: H/L access routine */
/*   for the set-class-defaults-mode command.      */
/***************************************************/
globle void *SetClassDefaultsModeCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   unsigned short oldMode;
   
   oldMode = DefclassData(theEnv)->ClassDefaultsMode;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   if (EnvArgCountCheck(theEnv,"set-class-defaults-mode",EXACTLY,1) == -1)
     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); }

   if (EnvArgTypeCheck(theEnv,"set-class-defaults-mode",1,SYMBOL,&argPtr) == FALSE)
     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); }

   argument = DOToString(argPtr);

   /*=============================================*/
   /* Set the strategy to the specified strategy. */
   /*=============================================*/

   if (strcmp(argument,"conservation") == 0)
     { EnvSetClassDefaultsMode(theEnv,CONSERVATION_MODE); }
   else if (strcmp(argument,"convenience") == 0)
     { EnvSetClassDefaultsMode(theEnv,CONVENIENCE_MODE); }
   else
     {
      ExpectedTypeError1(theEnv,"set-class-defaults-mode",1,
      "symbol with value conservation or convenience");
      return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv))));
     }

   /*===================================*/
   /* Return the old value of the mode. */
   /*===================================*/

   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(oldMode)));
  }

/*******************************************************************/
/* GetClassDefaultsModeName: Given the integer value corresponding */
/*   to a specified class defaults mode, return a character string */
/*   of the class defaults mode's name.                            */
/*******************************************************************/
static char *GetClassDefaultsModeName(
  unsigned short mode)
  {
   char *sname;

   switch (mode)
     {
      case CONSERVATION_MODE:
        sname = "conservation";
        break;
      case CONVENIENCE_MODE:
        sname = "convenience";
        break;
      default:
        sname = "unknown";
        break;
     }

   return(sname);
  }

#endif