src/clipsrules/core/classcom.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.24  06/02/06          */
00005    /*                                                     */
00006    /*                  CLASS COMMANDS MODULE              */
00007    /*******************************************************/
00008 
00009 /**************************************************************/
00010 /* Purpose: Kernel Interface Commands for Object System       */
00011 /*                                                            */
00012 /* Principal Programmer(s):                                   */
00013 /*      Brian L. Dantes                                       */
00014 /*                                                            */
00015 /* Contributing Programmer(s):                                */
00016 /*                                                            */
00017 /* Revision History:                                          */
00018 /*      6.23: Corrected compilation errors for files          */
00019 /*            generated by constructs-to-c. DR0861            */
00020 /*                                                            */
00021 /*            Changed name of variable log to logName         */
00022 /*            because of Unix compiler warnings of shadowed   */
00023 /*            definitions.                                    */
00024 /*                                                            */
00025 /*      6.24: Renamed BOOLEAN macro type to intBool.          */
00026 /*                                                            */
00027 /*            Added pragmas to remove compilation warnings.   */
00028 /*                                                            */
00029 /**************************************************************/
00030 
00031 /* =========================================
00032    *****************************************
00033                EXTERNAL DEFINITIONS
00034    =========================================
00035    ***************************************** */
00036 
00037 #include <string.h>
00038 
00039 #include "setup.h"
00040 
00041 #if OBJECT_SYSTEM
00042 
00043 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
00044 #include "bload.h"
00045 #endif
00046 
00047 #include "argacces.h"
00048 #include "classfun.h"
00049 #include "classini.h"
00050 #include "envrnmnt.h"
00051 #include "modulutl.h"
00052 #include "msgcom.h"
00053 #include "router.h"
00054 
00055 #define _CLASSCOM_SOURCE_
00056 #include "classcom.h"
00057 
00058 /* =========================================
00059    *****************************************
00060       INTERNALLY VISIBLE FUNCTION HEADERS
00061    =========================================
00062    ***************************************** */
00063 
00064 #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS
00065 static void SaveDefclass(void *,struct constructHeader *,void *);
00066 #endif
00067 static char *GetClassDefaultsModeName(unsigned short);
00068 
00069 /* =========================================
00070    *****************************************
00071           EXTERNALLY VISIBLE FUNCTIONS
00072    =========================================
00073    ***************************************** */
00074 
00075 /*******************************************************************
00076   NAME         : EnvFindDefclass
00077   DESCRIPTION  : Looks up a specified class in the class hash table
00078                  (Only looks in current or specified module)
00079   INPUTS       : The name-string of the class (including module)
00080   RETURNS      : The address of the found class, NULL otherwise
00081   SIDE EFFECTS : None
00082   NOTES        : None
00083  ******************************************************************/
00084 globle void *EnvFindDefclass(
00085   void *theEnv,
00086   char *classAndModuleName)
00087   {
00088    SYMBOL_HN *classSymbol = NULL;
00089    DEFCLASS *cls;
00090    struct defmodule *theModule = NULL;
00091    char *className;
00092 
00093    SaveCurrentModule(theEnv);
00094    className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
00095    if (className != NULL)
00096      {
00097       classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName));
00098       theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
00099      }
00100    RestoreCurrentModule(theEnv);
00101 
00102    if (classSymbol == NULL)
00103      return(NULL);
00104    cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
00105    while (cls != NULL)
00106      {
00107       if (cls->header.name == classSymbol)
00108         {
00109          if (cls->system || (cls->header.whichModule->theModule == theModule))
00110            return(cls->installed ? (void *) cls : NULL);
00111         }
00112       cls = cls->nxtHash;
00113      }
00114    return(NULL);
00115   }
00116 
00117 /***************************************************
00118   NAME         : LookupDefclassByMdlOrScope
00119   DESCRIPTION  : Finds a class anywhere (if module
00120                  is specified) or in current or
00121                  imported modules
00122   INPUTS       : The class name
00123   RETURNS      : The class (NULL if not found)
00124   SIDE EFFECTS : Error message printed on
00125                   ambiguous references
00126   NOTES        : Assumes no two classes of the same
00127                  name are ever in the same scope
00128  ***************************************************/
00129 globle DEFCLASS *LookupDefclassByMdlOrScope(
00130   void *theEnv,
00131   char *classAndModuleName)
00132   {
00133    DEFCLASS *cls;
00134    char *className;
00135    SYMBOL_HN *classSymbol;
00136    struct defmodule *theModule;
00137 
00138    if (FindModuleSeparator(classAndModuleName) == FALSE)
00139      return(LookupDefclassInScope(theEnv,classAndModuleName));
00140 
00141    SaveCurrentModule(theEnv);
00142    className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
00143    theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
00144    RestoreCurrentModule(theEnv);
00145    if(className == NULL)
00146      return(NULL);
00147    if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
00148      return(NULL);
00149    cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
00150    while (cls != NULL)
00151      {
00152       if ((cls->header.name == classSymbol) &&
00153           (cls->header.whichModule->theModule == theModule))
00154         return(cls->installed ? cls : NULL);
00155       cls = cls->nxtHash;
00156      }
00157    return(NULL);
00158   }
00159 
00160 /****************************************************
00161   NAME         : LookupDefclassInScope
00162   DESCRIPTION  : Finds a class in current or imported
00163                    modules (module specifier
00164                    is not allowed)
00165   INPUTS       : The class name
00166   RETURNS      : The class (NULL if not found)
00167   SIDE EFFECTS : Error message printed on
00168                   ambiguous references
00169   NOTES        : Assumes no two classes of the same
00170                  name are ever in the same scope
00171  ****************************************************/
00172 globle DEFCLASS *LookupDefclassInScope(
00173   void *theEnv,
00174   char *className)
00175   {
00176    DEFCLASS *cls;
00177    SYMBOL_HN *classSymbol;
00178 
00179    if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
00180      return(NULL);
00181    cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
00182    while (cls != NULL)
00183      {
00184       if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL))
00185         return(cls->installed ? cls : NULL);
00186       cls = cls->nxtHash;
00187      }
00188    return(NULL);
00189   }
00190 
00191 /******************************************************
00192   NAME         : LookupDefclassAnywhere
00193   DESCRIPTION  : Finds a class in specified
00194                  (or any) module
00195   INPUTS       : 1) The module (NULL if don't care)
00196                  2) The class name (module specifier
00197                     in name not allowed)
00198   RETURNS      : The class (NULL if not found)
00199   SIDE EFFECTS : None
00200   NOTES        : Does *not* generate an error if
00201                  multiple classes of the same name
00202                  exist as do the other lookup functions
00203  ******************************************************/
00204 globle DEFCLASS *LookupDefclassAnywhere(
00205   void *theEnv,
00206   struct defmodule *theModule,
00207   char *className)
00208   {
00209    DEFCLASS *cls;
00210    SYMBOL_HN *classSymbol;
00211 
00212    if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
00213      return(NULL);
00214    cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
00215    while (cls != NULL)
00216      {
00217       if ((cls->header.name == classSymbol) &&
00218           ((theModule == NULL) ||
00219            (cls->header.whichModule->theModule == theModule)))
00220         return(cls->installed ? cls : NULL);
00221       cls = cls->nxtHash;
00222      }
00223    return(NULL);
00224   }
00225 
00226 /***************************************************
00227   NAME         : DefclassInScope
00228   DESCRIPTION  : Determines if a defclass is in
00229                  scope of the given module
00230   INPUTS       : 1) The defclass
00231                  2) The module (NULL for current
00232                     module)
00233   RETURNS      : TRUE if in scope,
00234                  FALSE otherwise
00235   SIDE EFFECTS : None
00236   NOTES        : None
00237  ***************************************************/
00238 #if WIN_BTC && (! DEFMODULE_CONSTRUCT)
00239 #pragma argsused
00240 #endif
00241 globle intBool DefclassInScope(
00242   void *theEnv,
00243   DEFCLASS *theDefclass,
00244   struct defmodule *theModule)
00245   {
00246 #if DEFMODULE_CONSTRUCT
00247    int moduleID;
00248    char *scopeMap;
00249 
00250    scopeMap = (char *) ValueToBitMap(theDefclass->scopeMap);
00251    if (theModule == NULL)
00252      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
00253    moduleID = (int) theModule->bsaveID;
00254    return(TestBitMap(scopeMap,moduleID) ? TRUE : FALSE);
00255 #else
00256 #if MAC_MCW || WIN_MCW || MAC_XCD
00257 #pragma unused(theEnv,theDefclass,theModule)
00258 #endif
00259    return(TRUE);
00260 #endif
00261   }
00262 
00263 /***********************************************************
00264   NAME         : EnvGetNextDefclass
00265   DESCRIPTION  : Finds first or next defclass
00266   INPUTS       : The address of the current defclass
00267   RETURNS      : The address of the next defclass
00268                    (NULL if none)
00269   SIDE EFFECTS : None
00270   NOTES        : If ptr == NULL, the first defclass
00271                     is returned.
00272  ***********************************************************/
00273 globle void *EnvGetNextDefclass(
00274   void *theEnv,
00275   void *ptr)
00276   {
00277    return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefclassData(theEnv)->DefclassModuleIndex));
00278   }
00279 
00280 /***************************************************
00281   NAME         : EnvIsDefclassDeletable
00282   DESCRIPTION  : Determines if a defclass
00283                    can be deleted
00284   INPUTS       : Address of the defclass
00285   RETURNS      : TRUE if deletable,
00286                  FALSE otherwise
00287   SIDE EFFECTS : None
00288   NOTES        : None
00289  ***************************************************/
00290 globle intBool EnvIsDefclassDeletable(
00291   void *theEnv,
00292   void *ptr)
00293   {
00294    DEFCLASS *cls;
00295 
00296    if (! ConstructsDeletable(theEnv))
00297      { return FALSE; }
00298 
00299    cls = (DEFCLASS *) ptr;
00300    if (cls->system == 1)
00301      return(FALSE);
00302    
00303 #if (! BLOAD_ONLY) && (! RUN_TIME)
00304    return((IsClassBeingUsed(cls) == FALSE) ? TRUE : FALSE);
00305 #else
00306    return FALSE;
00307 #endif
00308   }
00309 
00310 /*************************************************************
00311   NAME         : UndefclassCommand
00312   DESCRIPTION  : Deletes a class and its subclasses, as
00313                  well as their associated instances
00314   INPUTS       : None
00315   RETURNS      : Nothing useful
00316   SIDE EFFECTS : None
00317   NOTES        : Syntax : (undefclass <class-name> | *)
00318  *************************************************************/
00319 globle void UndefclassCommand(
00320   void *theEnv)
00321   {
00322    UndefconstructCommand(theEnv,"undefclass",DefclassData(theEnv)->DefclassConstruct);
00323   }
00324 
00325 /********************************************************
00326   NAME         : EnvUndefclass
00327   DESCRIPTION  : Deletes the named defclass
00328   INPUTS       : None
00329   RETURNS      : TRUE if deleted, or FALSE
00330   SIDE EFFECTS : Defclass and handlers removed
00331   NOTES        : Interface for AddConstruct()
00332  ********************************************************/
00333 globle intBool EnvUndefclass(
00334   void *theEnv,
00335   void *theDefclass)
00336   {
00337 #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
00338 #pragma unused(theEnv,theDefclass)
00339 #endif
00340 
00341 #if RUN_TIME || BLOAD_ONLY
00342    return(FALSE);
00343 #else
00344    DEFCLASS *cls;
00345 
00346    cls = (DEFCLASS *) theDefclass;
00347 #if BLOAD || BLOAD_AND_BSAVE
00348    if (Bloaded(theEnv))
00349      return(FALSE);
00350 #endif
00351    if (cls == NULL)
00352      return(RemoveAllUserClasses(theEnv));
00353    return(DeleteClassUAG(theEnv,cls));
00354 #endif
00355   }
00356 
00357 
00358 #if DEBUGGING_FUNCTIONS
00359 
00360 /*********************************************************
00361   NAME         : PPDefclassCommand
00362   DESCRIPTION  : Displays the pretty print form of
00363                  a class to the wdialog router.
00364   INPUTS       : None
00365   RETURNS      : Nothing useful
00366   SIDE EFFECTS : None
00367   NOTES        : Syntax : (ppdefclass <class-name>)
00368  *********************************************************/
00369 globle void PPDefclassCommand(
00370   void *theEnv)
00371   {   
00372    PPConstructCommand(theEnv,"ppdefclass",DefclassData(theEnv)->DefclassConstruct);
00373   }
00374 
00375 /***************************************************
00376   NAME         : ListDefclassesCommand
00377   DESCRIPTION  : Displays all defclass names
00378   INPUTS       : None
00379   RETURNS      : Nothing useful
00380   SIDE EFFECTS : Defclass names printed
00381   NOTES        : H/L Interface
00382  ***************************************************/
00383 globle void ListDefclassesCommand(
00384   void *theEnv)
00385   {
00386    ListConstructCommand(theEnv,"list-defclasses",DefclassData(theEnv)->DefclassConstruct);
00387   }
00388 
00389 /***************************************************
00390   NAME         : EnvListDefclasses
00391   DESCRIPTION  : Displays all defclass names
00392   INPUTS       : 1) The logical name of the output
00393                  2) The module
00394   RETURNS      : Nothing useful
00395   SIDE EFFECTS : Defclass names printed
00396   NOTES        : C Interface
00397  ***************************************************/
00398 globle void EnvListDefclasses(
00399   void *theEnv,
00400   char *logicalName,
00401   struct defmodule *theModule)
00402   {
00403    ListConstruct(theEnv,DefclassData(theEnv)->DefclassConstruct,logicalName,theModule);
00404   }
00405 
00406 /*********************************************************
00407   NAME         : EnvGetDefclassWatchInstances
00408   DESCRIPTION  : Determines if deletions/creations of
00409                  instances of this class will generate
00410                  trace messages or not
00411   INPUTS       : A pointer to the class
00412   RETURNS      : TRUE if a trace is active,
00413                  FALSE otherwise
00414   SIDE EFFECTS : None
00415   NOTES        : None
00416  *********************************************************/
00417 #if WIN_BTC
00418 #pragma argsused
00419 #endif
00420 globle unsigned EnvGetDefclassWatchInstances(
00421   void *theEnv,
00422   void *theClass)
00423   {
00424 #if MAC_MCW || WIN_MCW || MAC_XCD
00425 #pragma unused(theEnv)
00426 #endif
00427 
00428    return(((DEFCLASS *) theClass)->traceInstances);
00429   }
00430 
00431 /*********************************************************
00432   NAME         : EnvSetDefclassWatchInstances
00433   DESCRIPTION  : Sets the trace to ON/OFF for the
00434                  creation/deletion of instances
00435                  of the class
00436   INPUTS       : 1) TRUE to set the trace on,
00437                     FALSE to set it off
00438                  2) A pointer to the class
00439   RETURNS      : Nothing useful
00440   SIDE EFFECTS : Watch flag for the class set
00441   NOTES        : None
00442  *********************************************************/
00443 #if WIN_BTC
00444 #pragma argsused
00445 #endif
00446 globle void EnvSetDefclassWatchInstances(
00447   void *theEnv,
00448   unsigned newState,
00449   void *theClass)
00450   {
00451 #if MAC_MCW || WIN_MCW || MAC_XCD
00452 #pragma unused(theEnv)
00453 #endif
00454 
00455    if (((DEFCLASS *) theClass)->abstract)
00456      return;
00457    ((DEFCLASS *) theClass)->traceInstances = newState;
00458   }
00459 
00460 /*********************************************************
00461   NAME         : EnvGetDefclassWatchSlots
00462   DESCRIPTION  : Determines if changes to slots of
00463                  instances of this class will generate
00464                  trace messages or not
00465   INPUTS       : A pointer to the class
00466   RETURNS      : TRUE if a trace is active,
00467                  FALSE otherwise
00468   SIDE EFFECTS : None
00469   NOTES        : None
00470  *********************************************************/
00471 #if WIN_BTC
00472 #pragma argsused
00473 #endif
00474 globle unsigned EnvGetDefclassWatchSlots(
00475   void *theEnv,
00476   void *theClass)
00477   {
00478 #if MAC_MCW || WIN_MCW || MAC_XCD
00479 #pragma unused(theEnv)
00480 #endif
00481 
00482    return(((DEFCLASS *) theClass)->traceSlots);
00483   }
00484 
00485 /**********************************************************
00486   NAME         : EnvSetDefclassWatchSlots
00487   DESCRIPTION  : Sets the trace to ON/OFF for the
00488                  changes to slots of instances of the class
00489   INPUTS       : 1) TRUE to set the trace on,
00490                     FALSE to set it off
00491                  2) A pointer to the class
00492   RETURNS      : Nothing useful
00493   SIDE EFFECTS : Watch flag for the class set
00494   NOTES        : None
00495  **********************************************************/
00496 #if WIN_BTC
00497 #pragma argsused
00498 #endif
00499 globle void EnvSetDefclassWatchSlots(
00500   void *theEnv,
00501   unsigned newState,
00502   void *theClass)
00503   {
00504 #if MAC_MCW || WIN_MCW || MAC_XCD
00505 #pragma unused(theEnv)
00506 #endif
00507 
00508    ((DEFCLASS *) theClass)->traceSlots = newState;
00509   }
00510 
00511 /******************************************************************
00512   NAME         : DefclassWatchAccess
00513   DESCRIPTION  : Parses a list of class names passed by
00514                  AddWatchItem() and sets the traces accordingly
00515   INPUTS       : 1) A code indicating which trace flag is to be set
00516                     0 - Watch instance creation/deletion
00517                     1 - Watch slot changes to instances
00518                  2) The value to which to set the trace flags
00519                  3) A list of expressions containing the names
00520                     of the classes for which to set traces
00521   RETURNS      : TRUE if all OK, FALSE otherwise
00522   SIDE EFFECTS : Watch flags set in specified classes
00523   NOTES        : Accessory function for AddWatchItem()
00524  ******************************************************************/
00525 globle unsigned DefclassWatchAccess(
00526   void *theEnv,
00527   int code,
00528   unsigned newState,
00529   EXPRESSION *argExprs)
00530   {
00531    if (code)
00532      return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs,
00533                                     EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots));
00534    else
00535      return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs,
00536                                     EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances));
00537   }
00538 
00539 /***********************************************************************
00540   NAME         : DefclassWatchPrint
00541   DESCRIPTION  : Parses a list of class names passed by
00542                  AddWatchItem() and displays the traces accordingly
00543   INPUTS       : 1) The logical name of the output
00544                  2) A code indicating which trace flag is to be examined
00545                     0 - Watch instance creation/deletion
00546                     1 - Watch slot changes to instances
00547                  3) A list of expressions containing the names
00548                     of the classes for which to examine traces
00549   RETURNS      : TRUE if all OK, FALSE otherwise
00550   SIDE EFFECTS : Watch flags displayed for specified classes
00551   NOTES        : Accessory function for AddWatchItem()
00552  ***********************************************************************/
00553 globle unsigned DefclassWatchPrint(
00554   void *theEnv,
00555   char *logName,
00556   int code,
00557   EXPRESSION *argExprs)
00558   {
00559    if (code)
00560      return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,
00561                                       EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots));
00562    else
00563      return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,
00564                                       EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances));
00565   }
00566 
00567 #endif
00568 
00569 /*********************************************************
00570   NAME         : GetDefclassListFunction
00571   DESCRIPTION  : Groups names of all defclasses into
00572                    a multifield variable
00573   INPUTS       : A data object buffer
00574   RETURNS      : Nothing useful
00575   SIDE EFFECTS : Multifield set to list of classes
00576   NOTES        : None
00577  *********************************************************/
00578 globle void GetDefclassListFunction(
00579   void *theEnv,
00580   DATA_OBJECT_PTR returnValue)
00581   {
00582    GetConstructListFunction(theEnv,"get-defclass-list",returnValue,DefclassData(theEnv)->DefclassConstruct);
00583   }
00584 
00585 /***************************************************************
00586   NAME         : EnvGetDefclassList
00587   DESCRIPTION  : Groups all defclass names into
00588                  a multifield list
00589   INPUTS       : 1) A data object buffer to hold
00590                     the multifield result
00591                  2) The module from which to obtain defclasses
00592   RETURNS      : Nothing useful
00593   SIDE EFFECTS : Multifield allocated and filled
00594   NOTES        : External C access
00595  ***************************************************************/
00596 globle void EnvGetDefclassList(
00597   void *theEnv,
00598   DATA_OBJECT *returnValue,
00599   struct defmodule *theModule)
00600   {
00601    GetConstructList(theEnv,returnValue,DefclassData(theEnv)->DefclassConstruct,theModule);
00602   }
00603 
00604 /*****************************************************
00605   NAME         : HasSuperclass
00606   DESCRIPTION  : Determines if class-2 is a superclass
00607                    of class-1
00608   INPUTS       : 1) Class-1
00609                  2) Class-2
00610   RETURNS      : TRUE if class-2 is a superclass of
00611                    class-1, FALSE otherwise
00612   SIDE EFFECTS : None
00613   NOTES        : None
00614  *****************************************************/
00615 globle int HasSuperclass(
00616   DEFCLASS *c1,
00617   DEFCLASS *c2)
00618   {
00619    long i;
00620 
00621    for (i = 1 ; i < c1->allSuperclasses.classCount ; i++)
00622      if (c1->allSuperclasses.classArray[i] == c2)
00623        return(TRUE);
00624    return(FALSE);
00625   }
00626 
00627 /********************************************************************
00628   NAME         : CheckClassAndSlot
00629   DESCRIPTION  : Checks class and slot argument for various functions
00630   INPUTS       : 1) Name of the calling function
00631                  2) Buffer for class address
00632   RETURNS      : Slot symbol, NULL on errors
00633   SIDE EFFECTS : None
00634   NOTES        : None
00635  ********************************************************************/
00636 globle SYMBOL_HN *CheckClassAndSlot(
00637    void *theEnv,
00638    char *func,
00639    DEFCLASS **cls)
00640   {
00641    DATA_OBJECT temp;
00642 
00643    if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE)
00644      return(NULL);
00645    *cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));
00646    if (*cls == NULL)
00647      {
00648       ClassExistError(theEnv,func,DOToString(temp));
00649       return(NULL);
00650      }
00651    if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE)
00652      return(NULL);
00653    return((SYMBOL_HN *) GetValue(temp));
00654   }
00655 
00656 #if (! BLOAD_ONLY) && (! RUN_TIME)
00657 
00658 /***************************************************
00659   NAME         : SaveDefclasses
00660   DESCRIPTION  : Prints pretty print form of
00661                    defclasses to specified output
00662   INPUTS       : The  logical name of the output
00663   RETURNS      : Nothing useful
00664   SIDE EFFECTS : None
00665   NOTES        : None
00666  ***************************************************/
00667 #if WIN_BTC && (! DEBUGGING_FUNCTIONS)
00668 #pragma argsused
00669 #endif
00670 globle void SaveDefclasses(
00671   void *theEnv,
00672   void *theModule,
00673   char *logName)
00674   {
00675 #if DEBUGGING_FUNCTIONS
00676    DoForAllConstructsInModule(theEnv,theModule,SaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) logName);
00677 #else
00678 #if MAC_MCW || WIN_MCW || MAC_XCD
00679 #pragma unused(theEnv,theModule,logName)
00680 #endif
00681 #endif
00682   }
00683 
00684 #endif
00685 
00686 /* =========================================
00687    *****************************************
00688           INTERNALLY VISIBLE FUNCTIONS
00689    =========================================
00690    ***************************************** */
00691 
00692 #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS
00693 
00694 /***************************************************
00695   NAME         : SaveDefclass
00696   DESCRIPTION  : Writes out the pretty-print forms
00697                  of a class and all its handlers
00698   INPUTS       : 1) The class
00699                  2) The logical name of the output
00700   RETURNS      : Nothing useful
00701   SIDE EFFECTS : Class and handlers written
00702   NOTES        : None
00703  ***************************************************/
00704 static void SaveDefclass(
00705   void *theEnv,
00706   struct constructHeader *theDefclass,
00707   void *userBuffer)
00708   {
00709    char *logName = (char *) userBuffer;
00710    unsigned hnd;
00711    char *ppForm;
00712 
00713    ppForm = EnvGetDefclassPPForm(theEnv,(void *) theDefclass);
00714    if (ppForm != NULL)
00715      {
00716       PrintInChunks(theEnv,logName,ppForm);
00717       EnvPrintRouter(theEnv,logName,"\n");
00718       hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,0);
00719       while (hnd != 0)
00720         {
00721          ppForm = EnvGetDefmessageHandlerPPForm(theEnv,(void *) theDefclass,hnd);
00722          if (ppForm != NULL)
00723            {
00724             PrintInChunks(theEnv,logName,ppForm);
00725             EnvPrintRouter(theEnv,logName,"\n");
00726            }
00727          hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,hnd);
00728         }
00729      }
00730   }
00731 
00732 #endif
00733 
00734 /***********************************************/
00735 /* EnvSetClassDefaultsMode: Allows the setting */
00736 /*    of the class defaults mode.              */
00737 /***********************************************/
00738 globle unsigned short EnvSetClassDefaultsMode(
00739   void *theEnv,
00740   unsigned short value)
00741   {
00742    unsigned short ov;
00743 
00744    ov = DefclassData(theEnv)->ClassDefaultsMode;
00745    DefclassData(theEnv)->ClassDefaultsMode = value;
00746    return(ov);
00747   }
00748 
00749 /****************************************/
00750 /* EnvGetClassDefaultsMode: Returns the */
00751 /*    value of the class defaults mode. */
00752 /****************************************/
00753 globle unsigned short EnvGetClassDefaultsMode(
00754   void *theEnv)
00755   {
00756    return(DefclassData(theEnv)->ClassDefaultsMode);
00757   }
00758   
00759 /***************************************************/
00760 /* GetClassDefaultsModeCommand: H/L access routine */
00761 /*   for the get-class-defaults-mode command.      */
00762 /***************************************************/
00763 globle void *GetClassDefaultsModeCommand(
00764   void *theEnv)
00765   {
00766    EnvArgCountCheck(theEnv,"get-class-defaults-mode",EXACTLY,0);
00767 
00768    return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv))));
00769   }
00770 
00771 /***************************************************/
00772 /* SetClassDefaultsModeCommand: H/L access routine */
00773 /*   for the set-class-defaults-mode command.      */
00774 /***************************************************/
00775 globle void *SetClassDefaultsModeCommand(
00776   void *theEnv)
00777   {
00778    DATA_OBJECT argPtr;
00779    char *argument;
00780    unsigned short oldMode;
00781    
00782    oldMode = DefclassData(theEnv)->ClassDefaultsMode;
00783 
00784    /*=====================================================*/
00785    /* Check for the correct number and type of arguments. */
00786    /*=====================================================*/
00787 
00788    if (EnvArgCountCheck(theEnv,"set-class-defaults-mode",EXACTLY,1) == -1)
00789      { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); }
00790 
00791    if (EnvArgTypeCheck(theEnv,"set-class-defaults-mode",1,SYMBOL,&argPtr) == FALSE)
00792      { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); }
00793 
00794    argument = DOToString(argPtr);
00795 
00796    /*=============================================*/
00797    /* Set the strategy to the specified strategy. */
00798    /*=============================================*/
00799 
00800    if (strcmp(argument,"conservation") == 0)
00801      { EnvSetClassDefaultsMode(theEnv,CONSERVATION_MODE); }
00802    else if (strcmp(argument,"convenience") == 0)
00803      { EnvSetClassDefaultsMode(theEnv,CONVENIENCE_MODE); }
00804    else
00805      {
00806       ExpectedTypeError1(theEnv,"set-class-defaults-mode",1,
00807       "symbol with value conservation or convenience");
00808       return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv))));
00809      }
00810 
00811    /*===================================*/
00812    /* Return the old value of the mode. */
00813    /*===================================*/
00814 
00815    return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(oldMode)));
00816   }
00817 
00818 /*******************************************************************/
00819 /* GetClassDefaultsModeName: Given the integer value corresponding */
00820 /*   to a specified class defaults mode, return a character string */
00821 /*   of the class defaults mode's name.                            */
00822 /*******************************************************************/
00823 static char *GetClassDefaultsModeName(
00824   unsigned short mode)
00825   {
00826    char *sname;
00827 
00828    switch (mode)
00829      {
00830       case CONSERVATION_MODE:
00831         sname = "conservation";
00832         break;
00833       case CONVENIENCE_MODE:
00834         sname = "convenience";
00835         break;
00836       default:
00837         sname = "unknown";
00838         break;
00839      }
00840 
00841    return(sname);
00842   }
00843 
00844 #endif