Ejemplo n.º 1
0
/*******************************************************************************
          Name:        PrintChangedFocus
          Description: Update the Focus window
          Arguments:   None
          Returns:
*******************************************************************************/
int PrintChangedFocus()
  {
   void *theEnv = GetCurrentEnvironment();
   void *FocusPtr;
   int n;
   char *buffer;

   /* Clear the old contents */
   n = 0;
   XtSetArg(TheArgs[n],XtNstring,"");n++;
   XtSetValues(focus_text,TheArgs,n);
   XawAsciiSourceFreeString(XawTextGetSource(focus_text));

   /* Print the new focus list */

   FocusPtr = EnvGetNextFocus(theEnv,NULL);
   while(FocusPtr != NULL)
    {
      buffer = EnvGetDefmoduleName(theEnv,((struct focus*)FocusPtr)->theModule);
      EnvPrintRouter(theEnv,"xfocus",buffer);
      EnvPrintRouter(theEnv,"xfocus","\n");
      FocusPtr = EnvGetNextFocus(theEnv,FocusPtr);
    }
   return 0;
}
Ejemplo n.º 2
0
static void GetFocusPPForm(
  void *theEnv,
  char *buffer,
  size_t bufferLength,
  void *vTheFocus)
  {  
   struct focus *theFocus = (struct focus *) vTheFocus;
   strncpy(buffer,EnvGetDefmoduleName(theEnv,theFocus->theModule),bufferLength);
  }
Ejemplo n.º 3
0
static intBool DeleteDefmodule(
  void *theEnv,
  void *theConstruct)
  {
   if (strcmp(EnvGetDefmoduleName(theEnv,theConstruct),"MAIN") == 0)
     { return(DefmoduleData(theEnv)->MainModuleRedefinable); }

   return(FALSE);
  }
Ejemplo n.º 4
0
/*******************************************************************************
          Name:        PrintChangedAgenda
          Description: Update the agenda window
          Arguments:   None
          Returns:      
*******************************************************************************/
int PrintChangedAgenda()
  {
   void *theEnv = GetCurrentEnvironment();
   void *rule_ptr;
   char buffer[MAX_CHAR_IN_BUF];
   char *name, labelBuffer[MAX_CHAR_IN_BUF];
   Window AgendaWin;
   Display *theDisplay;
   struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);

   /*======================================================*/
   /* Change the name of the window to the current module. */
   /*======================================================*/
   
   AgendaWin = XtWindow(agenda);
   theDisplay = XtDisplay(agenda);
   if (theModule  != NULL)
     {
      name = EnvGetDefmoduleName(theEnv,theModule);
      strcpy(labelBuffer,"Agenda Window(");
      strcat(labelBuffer,name);
      strcat(labelBuffer,")");
     }
    else
     {
      strcpy(labelBuffer,"Agenda Window");
     }
   
   XStoreName(theDisplay,AgendaWin,labelBuffer);
   
   /*============================*/
   /* Wipe out the old contents. */
   /*============================*/

   XtSetArg(TheArgs[0], XtNstring, "");
   XtSetValues(agenda_text, TheArgs, 1);
   XawAsciiSourceFreeString(XawTextGetSource(agenda_text));

   /*============================*/
   /* Print the new agenda list. */
   /*============================*/

   rule_ptr = EnvGetNextActivation(theEnv,NULL);
   while (rule_ptr != NULL)
     {
      EnvGetActivationPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,rule_ptr);
      EnvPrintRouter(theEnv,"xagenda",buffer);
      EnvPrintRouter(theEnv,"xagenda", "\n");
      rule_ptr = EnvGetNextActivation(theEnv,rule_ptr);
     }
    
   return 0;
  }
Ejemplo n.º 5
0
/******************************************************
  NAME         : PrintGenericName
  DESCRIPTION  : Prints the name of a gneric function
                 (including the module name if the
                  generic is not in the current module)
  INPUTS       : 1) The logical name of the output
                 2) The generic functions
  RETURNS      : Nothing useful
  SIDE EFFECTS : Generic name printed
  NOTES        : None
 ******************************************************/
globle void PrintGenericName(
  void *theEnv,
  char *logName,
  DEFGENERIC *gfunc)
  {
   if (gfunc->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     {
      EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *)
                        gfunc->header.whichModule->theModule));
      EnvPrintRouter(theEnv,logName,(char*)"::");
     }
   EnvPrintRouter(theEnv,logName,ValueToString((void *) gfunc->header.name));
  }
Ejemplo n.º 6
0
globle void EnvListFocusStack(
  void *theEnv,
  char *logicalName)
  {
   struct focus *theFocus;

   for (theFocus = EngineData(theEnv)->CurrentFocus;
        theFocus != NULL;
        theFocus = theFocus->next)
     {
      EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theFocus->theModule));
      EnvPrintRouter(theEnv,logicalName,"\n");
     }
  }
Ejemplo n.º 7
0
/*******************************************************************************
          Name:        PrintChangedGlobals
          Description: Update the global window
          Arguments:   None
          Returns:
*******************************************************************************/
int PrintChangedGlobals()
  {
   void *theEnv = GetCurrentEnvironment();
   void *dgPtr;
   int n;
   char *buffer;
   char *name,labelBuffer[MAX_CHAR_IN_BUF];
   Window GlobalWin;
   Display *theDisplay;
   struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);


   /* Change the name of the window to the current module */

   GlobalWin = XtWindow(globals);
   theDisplay = XtDisplay(globals);
   if (theModule  != NULL)
     {
      name = EnvGetDefmoduleName(theEnv,theModule);
      strcpy(labelBuffer,"Globals Window(");
      strcat(labelBuffer,name);
      strcat(labelBuffer,")");
     }
    else
     {
      strcpy(labelBuffer,"Globals Window");
     }
    XStoreName(theDisplay,GlobalWin,labelBuffer);

   /* Clear the old contents */

   n = 0;
   XtSetArg(TheArgs[n],XtNstring,"");n++;
   XtSetValues(globals_text,TheArgs,n);
   XawAsciiSourceFreeString(XawTextGetSource(globals_text));

   /* Print the new defglobal list */

   dgPtr = EnvGetNextDefglobal(theEnv,NULL);
   while (dgPtr != NULL)
     {
      buffer = (char *) EnvGetDefglobalPPForm(theEnv,(struct constructHeader *) dgPtr);
      EnvPrintRouter(theEnv,"xglobals",buffer);
      EnvPrintRouter(theEnv,"xglobals","\n");
      dgPtr = EnvGetNextDefglobal(theEnv,dgPtr);
     }
   
   return 0;
  }
Ejemplo n.º 8
0
static void UpdateStatusWndTitle(
  HWND hwnd)
  {  
   void *theEnv = GlobalEnv;
   struct statusWindowData *theData;
   struct defmodule *theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
   char buffer[255];
       
   theData = (struct statusWindowData *) GetWindowLongPtr(hwnd,GWLP_USERDATA);
   
   if (theData == NULL) return; 
   
   sprintf(buffer,"%s (%s)",theData->baseName,EnvGetDefmoduleName(theEnv,theModule));
   SetWindowText(hwnd,buffer);
  }
Ejemplo n.º 9
0
/*******************************************************************************
          Name:        PrintChangedFacts
          Description: Update the fact window
          Arguments:   None
          Returns:      
*******************************************************************************/
int PrintChangedFacts()
  {
   void *theEnv = GetCurrentEnvironment();
  void *fact_ptr;
  char buffer[MAX_CHAR_IN_BUF];
  char *name,labelBuffer[MAX_CHAR_IN_BUF];
  Window FactWin;
  Display *theDisplay;
  struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);


 /* Change the name of the window to the current module */

  FactWin = XtWindow(facts);
  theDisplay = XtDisplay(facts);
  if(theModule  != NULL)
     {
       name = EnvGetDefmoduleName(theEnv,theModule);
       strcpy(labelBuffer,"Fact Window(");
       strcat(labelBuffer,name);
       strcat(labelBuffer,")");
     }
    else
     {
       strcpy(labelBuffer,"Fact Window");
     }
  XStoreName(theDisplay,FactWin,labelBuffer);


  /* Clear the old contents */

  XtSetArg(TheArgs[0], XtNstring, "");
  XtSetValues(facts_text, TheArgs, 1);
  XawAsciiSourceFreeString(XawTextGetSource(facts_text));

  /* Print the new fact list */

  fact_ptr = EnvGetNextFact(theEnv,NULL);
  while (fact_ptr != NULL)
    {
    EnvGetFactPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,fact_ptr);
    EnvPrintRouter(theEnv,"xfacts",buffer);
    EnvPrintRouter(theEnv,"xfacts", "\n");
    fact_ptr = EnvGetNextFact(theEnv,fact_ptr);
    }
  return 0;
  }
Ejemplo n.º 10
0
/******************************************************
  NAME         : PrintClassName
  DESCRIPTION  : Displays a class's name
  INPUTS       : 1) Logical name of output
                 2) The class
                 3) Flag indicating whether to
                    print carriage-return at end
  RETURNS      : Nothing useful
  SIDE EFFECTS : Class name printed (and module name
                 too if class is not in current module)
  NOTES        : None
 ******************************************************/
globle void PrintClassName(
  void *theEnv,
  char *logicalName,
  DEFCLASS *theDefclass,
  intBool linefeedFlag)
  {
   if ((theDefclass->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) &&
       (theDefclass->system == 0))
     {
      EnvPrintRouter(theEnv,logicalName,
                 EnvGetDefmoduleName(theEnv,theDefclass->header.whichModule->theModule));
      EnvPrintRouter(theEnv,logicalName,"::");
     }
   EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name));
   if (linefeedFlag)
     EnvPrintRouter(theEnv,logicalName,"\n");
  }
Ejemplo n.º 11
0
/*******************************************************************************
          Name:        PrintChangedInstances
          Description: Update the instances window
          Arguments:   None
          Returns:
*******************************************************************************/
int PrintChangedInstances()
  {
   void *theEnv = GetCurrentEnvironment();
   int n = 0;
   void *instancePtr;
   char buffer[MAX_CHAR_IN_BUF];
   char *name, labelBuffer[MAX_CHAR_IN_BUF];
   Window InstanceWin;
   Display *theDisplay;
   struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);

   /* Change the name of the window to the current module */

   InstanceWin = XtWindow(instances);
   theDisplay = XtDisplay(instances);
   if (theModule != NULL)
     {
      name = EnvGetDefmoduleName(theEnv,theModule);
      strcpy(labelBuffer,"Instances Window(");
      strcat(labelBuffer,name);
      strcat(labelBuffer,")");
     }
   else
     {
      strcpy(labelBuffer,"Instances Window");
     }
   XStoreName(theDisplay,InstanceWin,labelBuffer);


   /* Clear the old contents */

   XtSetArg(TheArgs[n],XtNstring,"");n++;
   XtSetValues(instances_text,TheArgs,n);
   XawAsciiSourceFreeString(XawTextGetSource(instances_text));
   /* Print the new instance list */
   instancePtr = (void *) EnvGetNextInstance(theEnv,NULL);
   while (instancePtr != NULL)
     {
      EnvGetInstancePPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,instancePtr);
      EnvPrintRouter(theEnv,"xinstances",buffer);
      EnvPrintRouter(theEnv,"xinstances","\n");
      instancePtr = (void *) EnvGetNextInstance(theEnv,instancePtr);
     }
  
   return 0;
  }
Ejemplo n.º 12
0
/***************************************************
  NAME         : WatchDeffunction
  DESCRIPTION  : Displays a message indicating when
                 a deffunction began and ended
                 execution
  INPUTS       : The beginning or end trace string
                 to print when deffunction starts
                 or finishes respectively
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch message printed
  NOTES        : None
 ***************************************************/
static void WatchDeffunction(
  void *theEnv,
  char *tstring)
  {
   EnvPrintRouter(theEnv,WTRACE,"DFN ");
   EnvPrintRouter(theEnv,WTRACE,tstring);
   if (DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     {
      EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
                        DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule));
      EnvPrintRouter(theEnv,WTRACE,"::");
     }
   EnvPrintRouter(theEnv,WTRACE,ValueToString(DeffunctionData(theEnv)->ExecutingDeffunction->header.name));
   EnvPrintRouter(theEnv,WTRACE," ED:");
   PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
   PrintProcParamArray(theEnv,WTRACE);
  }
Ejemplo n.º 13
0
void EnvGetDefmoduleList(
  void *theEnv,
  CLIPSValue *returnValue)
  {
   void *theConstruct;
   unsigned long count = 0;
   struct multifield *theList;

   /*====================================*/
   /* Determine the number of constructs */
   /* of the specified type.             */
   /*====================================*/

   for (theConstruct = EnvGetNextDefmodule(theEnv,NULL);
        theConstruct != NULL;
        theConstruct = EnvGetNextDefmodule(theEnv,theConstruct))
     { count++; }

   /*===========================*/
   /* Create a multifield large */
   /* enough to store the list. */
   /*===========================*/

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,(long) count);
   theList = (struct multifield *) EnvCreateMultifield(theEnv,count);
   SetpValue(returnValue,(void *) theList);

   /*====================================*/
   /* Store the names in the multifield. */
   /*====================================*/

   for (theConstruct = EnvGetNextDefmodule(theEnv,NULL), count = 1;
        theConstruct != NULL;
        theConstruct = EnvGetNextDefmodule(theEnv,theConstruct), count++)
     {
      if (EvaluationData(theEnv)->HaltExecution == true)
        {
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         return;
        }
      SetMFType(theList,count,SYMBOL);
      SetMFValue(theList,count,EnvAddSymbol(theEnv,EnvGetDefmoduleName(theEnv,theConstruct)));
     }
  }
Ejemplo n.º 14
0
globle void EnvListDefmodules(
  void *theEnv,
  char *logicalName)
  {
   void *theModule;
   int count = 0;

   for (theModule = EnvGetNextDefmodule(theEnv,NULL);
        theModule != NULL;
        theModule = EnvGetNextDefmodule(theEnv,theModule))
    {
     EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule));
     EnvPrintRouter(theEnv,logicalName,"\n");
     count++;
    }

   PrintTally(theEnv,logicalName,count,"defmodule","defmodules");
  }
Ejemplo n.º 15
0
globle struct lhsParseNode *CreateInitialFactPattern(
  void *theEnv)
  {
   struct lhsParseNode *topNode;
   struct deftemplate *theDeftemplate;
   int count;
   
   /*==================================*/
   /* If the initial-fact deftemplate  */
   /* doesn't exist, then create it.   */
   /*==================================*/

   theDeftemplate = (struct deftemplate *)
                    FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact",
                                          &count,TRUE,NULL);
   if (theDeftemplate == NULL)
     {
      PrintWarningID(theEnv,"FACTLHS",1,FALSE);
      EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module ");
      EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv)));
      EnvPrintRouter(theEnv,WWARNING,".\n");
      EnvPrintRouter(theEnv,WWARNING,"  You probably want to import this deftemplate from the MAIN module.\n");
      CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);
     }

   /*====================================*/
   /* Create the (initial-fact) pattern. */
   /*====================================*/

   topNode = GetLHSParseNode(theEnv);
   topNode->type = SF_WILDCARD;
   topNode->index = 0;
   topNode->slotNumber = 1;

   topNode->bottom = GetLHSParseNode(theEnv);
   topNode->bottom->type = SYMBOL;
   topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact");

   /*=====================*/
   /* Return the pattern. */
   /*=====================*/

   return(topNode);
  }
Ejemplo n.º 16
0
/**********************************************************************
  NAME         : WatchGeneric
  DESCRIPTION  : Prints out a trace of the beginning or end
                   of the execution of a generic function
  INPUTS       : A string to indicate beginning or end of execution
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the globals CurrentGeneric, ProcParamArraySize and
                   ProcParamArray for other trace info
 **********************************************************************/
static void WatchGeneric(
  void *theEnv,
  const char *tstring)
  {
   EnvPrintRouter(theEnv,WTRACE,"GNC ");
   EnvPrintRouter(theEnv,WTRACE,tstring);
   EnvPrintRouter(theEnv,WTRACE," ");
   if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     {
      EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
                        DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule));
      EnvPrintRouter(theEnv,WTRACE,"::");
     }
   EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name));
   EnvPrintRouter(theEnv,WTRACE," ");
   EnvPrintRouter(theEnv,WTRACE," ED:");
   PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
   PrintProcParamArray(theEnv,WTRACE);
  }
Ejemplo n.º 17
0
/************************************************************
  NAME         : ValidDeffunctionName
  DESCRIPTION  : Determines if a new deffunction of the given
                 name can be defined in the current module
  INPUTS       : The new deffunction name
  RETURNS      : TRUE if OK, FALSE otherwise
  SIDE EFFECTS : Error message printed if not OK
  NOTES        : GetConstructNameAndComment() (called before
                 this function) ensures that the deffunction
                 name does not conflict with one from
                 another module
 ************************************************************/
static BOOLEAN ValidDeffunctionName(
  void *theEnv,
  char *theDeffunctionName)
  {
   struct constructHeader *theDeffunction;
#if DEFGENERIC_CONSTRUCT
   struct defmodule *theModule;
   struct constructHeader *theDefgeneric;
#endif

   /* ============================================
      A deffunction cannot be named the same as a
      construct type, e.g, defclass, defrule, etc.
      ============================================ */
   if (FindConstruct(theEnv,theDeffunctionName) != NULL)
     {
      PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
      return(FALSE);
     }

   /* ============================================
      A deffunction cannot be named the same as a
      pre-defined system function, e.g, watch,
      list-defrules, etc.
      ============================================ */
   if (FindFunction(theEnv,theDeffunctionName) != NULL)
     {
      PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
      return(FALSE);
     }

#if DEFGENERIC_CONSTRUCT
   /* ============================================
      A deffunction cannot be named the same as a
      generic function (either in this module or
      imported from another)
      ============================================ */
   theDefgeneric =
     (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
   if (theDefgeneric != NULL)
     {
      theModule = GetConstructModuleItem(theDefgeneric)->theModule;
      if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
        {
         PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
         EnvPrintRouter(theEnv,WERROR," imported from module ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
         EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
         return(FALSE);
        }
      else
        {
         PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
        }
      return(FALSE);
     }
#endif

   theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName);
   if (theDeffunction != NULL)
     {
      /* ===========================================
         And a deffunction in the current module can
         only be redefined if it is not executing.
         =========================================== */
      if (((DEFFUNCTION *) theDeffunction)->executing)
        {
         PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Deffunction ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
         EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
         return(FALSE);
        }
     }
   return(TRUE);
  }
Ejemplo n.º 18
0
/*******************************************************
  NAME         : DefmessageHandlerWatchSupport
  DESCRIPTION  : Sets or displays handlers specified
  INPUTS       : 1) The calling function name
                 2) The logical output name for displays
                    (can be NULL)
                 4) The new set state (can be -1)
                 5) The print function (can be NULL)
                 6) The trace function (can be NULL)
                 7) The handlers expression list
  RETURNS      : TRUE if all OK,
                 FALSE otherwise
  SIDE EFFECTS : Handler trace flags set or displayed
  NOTES        : None
 *******************************************************/
static unsigned DefmessageHandlerWatchSupport(
  void *theEnv,
  const char *funcName,
  const char *logName,
  int newState,
  void (*printFunc)(void *,const char *,void *,int),
  void (*traceFunc)(void *,int,void *,int),
  EXPRESSION *argExprs)
  {
   struct defmodule *theModule;
   void *theClass;
   const char *theHandlerStr;
   int theType;
   int argIndex = 2;
   DATA_OBJECT tmpData;

   /* ===============================
      If no handlers are specified,
      show the trace for all handlers
      in all handlers
      =============================== */
   if (argExprs == NULL)
     {
      SaveCurrentModule(theEnv);
      theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
      while (theModule != NULL)
        {
         EnvSetCurrentModule(theEnv,(void *) theModule);
         if (traceFunc == NULL)
           {
            EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule));
            EnvPrintRouter(theEnv,logName,":\n");
           }
         theClass = EnvGetNextDefclass(theEnv,NULL);
         while (theClass != NULL)
            {
             if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState,
                                    TRUE,printFunc,traceFunc) == FALSE)
                 return(FALSE);
             theClass = EnvGetNextDefclass(theEnv,theClass);
            }
          theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule);
         }
      RestoreCurrentModule(theEnv);
      return(TRUE);
     }

   /* ================================================
      Set or show the traces for the specified handler
      ================================================ */
   while (argExprs != NULL)
     {
      if (EvaluateExpression(theEnv,argExprs,&tmpData))
        return(FALSE);
      if (tmpData.type != SYMBOL)
        {
         ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
         return(FALSE);
        }
      theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData));
      if (theClass == NULL)
        {
         ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
         return(FALSE);
        }
      if (GetNextArgument(argExprs) != NULL)
        {
         argExprs = GetNextArgument(argExprs);
         argIndex++;
         if (EvaluateExpression(theEnv,argExprs,&tmpData))
           return(FALSE);
         if (tmpData.type != SYMBOL)
           {
            ExpectedTypeError1(theEnv,funcName,argIndex,"handler name");
            return(FALSE);
           }
         theHandlerStr = DOToString(tmpData);
         if (GetNextArgument(argExprs) != NULL)
           {
            argExprs = GetNextArgument(argExprs);
            argIndex++;
            if (EvaluateExpression(theEnv,argExprs,&tmpData))
              return(FALSE);
            if (tmpData.type != SYMBOL)
              {
               ExpectedTypeError1(theEnv,funcName,argIndex,"handler type");
               return(FALSE);
              }
            if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR)
              return(FALSE);
           }
         else
           theType = -1;
        }
      else
        {
         theHandlerStr = NULL;
         theType = -1;
        }
      if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName,
                             newState,FALSE,printFunc,traceFunc) == FALSE)
        {
         ExpectedTypeError1(theEnv,funcName,argIndex,"handler");
         return(FALSE);
        }
      argIndex++;
      argExprs = GetNextArgument(argExprs);
     }
   return(TRUE);
  }
Ejemplo n.º 19
0
globle intBool ParseDefglobal(
  void *theEnv,
  char *readSource)
  {
   int defglobalError = FALSE;
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif

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

   struct token theToken;
   int tokenRead = TRUE;
   struct defmodule *theModule;

   /*=====================================*/
   /* Pretty print buffer initialization. */
   /*=====================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defglobal ");

   /*=================================================*/
   /* Individual defglobal constructs can't be parsed */
   /* while a binary load is in effect.               */
   /*=================================================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defglobal");
      return(TRUE);
     }
#endif

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   GetToken(theEnv,readSource,&theToken);
   if (theToken.type == SYMBOL)
     {
      /*=================================================*/
      /* The optional module name can't contain a module */
      /* separator like other constructs. For example,   */
      /* (defrule X::foo is OK for rules, but the right  */
      /* syntax for defglobals is (defglobal X ?*foo*.   */
      /*=================================================*/

      tokenRead = FALSE;
      if (FindModuleSeparator(ValueToString(theToken.value)))
        {
         SyntaxErrorMessage(theEnv,"defglobal");
         return(TRUE);
        }

      /*=================================*/
      /* Determine if the module exists. */
      /*=================================*/

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value));
         return(TRUE);
        }

      /*=========================================*/
      /* If the module name was OK, then set the */
      /* current module to the specified module. */
      /*=========================================*/

      SavePPBuffer(theEnv," ");
      EnvSetCurrentModule(theEnv,(void *) theModule);
     }

   /*===========================================*/
   /* If the module name wasn't specified, then */
   /* use the current module's name in the      */
   /* defglobal's pretty print representation.  */
   /*===========================================*/

   else
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,theToken.printForm);
     }

   /*======================*/
   /* Parse the variables. */
   /*======================*/

   while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken))
     {
      tokenRead = FALSE;

      FlushPPBuffer(theEnv);
      SavePPBuffer(theEnv,"(defglobal ");
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
     }

#endif

   /*==================================*/
   /* Return the parsing error status. */
   /*==================================*/

   return(defglobalError);
  }
Ejemplo n.º 20
0
globle void ListItemsDriver(
  void *theEnv,
  EXEC_STATUS,
  char *logicalName,
  struct defmodule *theModule,
  char *singleName,
  char *pluralName,
  void *(*nextFunction)(void *,EXEC_STATUS,void *),
  char *(*nameFunction)(void *,EXEC_STATUS),
  void (*printFunction)(void *,EXEC_STATUS,char *,void *),
  int (*doItFunction)(void *,EXEC_STATUS,void *))
  {
   void *constructPtr;
   char *constructName;
   long count = 0;
   int allModules = FALSE;
   int doIt;

   /*==========================*/
   /* Save the current module. */
   /*==========================*/

   SaveCurrentModule(theEnv,execStatus);

   /*======================*/
   /* Print out the items. */
   /*======================*/

   if (theModule == NULL)
     {
      theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
      allModules = TRUE;
     }

   while (theModule != NULL)
     {
      if (allModules)
        {
         EnvPrintRouter(theEnv,execStatus,logicalName,EnvGetDefmoduleName(theEnv,execStatus,theModule));
         EnvPrintRouter(theEnv,execStatus,logicalName,":\n");
        }

      EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
      constructPtr = (*nextFunction)(theEnv,execStatus,NULL);
      while (constructPtr != NULL)
        {
         if (execStatus->HaltExecution == TRUE) return;

         if (doItFunction == NULL) doIt = TRUE;
         else doIt = (*doItFunction)(theEnv,execStatus,constructPtr);

         if (! doIt) {}
         else if (nameFunction != NULL)
           {
            constructName = (*nameFunction)(constructPtr,execStatus);
            if (constructName != NULL)
              {
               if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName,"   ");
               EnvPrintRouter(theEnv,execStatus,logicalName,constructName);
               EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
              }
           }
         else if (printFunction != NULL)
           {
            if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName,"   ");
            (*printFunction)(theEnv,execStatus,logicalName,constructPtr);
            EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
           }

         constructPtr = (*nextFunction)(theEnv,execStatus,constructPtr);
         count++;
        }

      if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule);
      else theModule = NULL;
     }

   /*=================================================*/
   /* Print the tally and restore the current module. */
   /*=================================================*/

   if (singleName != NULL) PrintTally(theEnv,execStatus,logicalName,count,singleName,pluralName);

   RestoreCurrentModule(theEnv,execStatus);
  }
Ejemplo n.º 21
0
globle SYMBOL_HN *GetConstructNameAndComment(
  void *theEnv,
  char *readSource,
  struct token *inputToken,
  char *constructName,
  void *(*findFunction)(void *,char *),
  int (*deleteFunction)(void *,void *),
  char *constructSymbol,
  int fullMessageCR,
  int getComment,
  int moduleNameAllowed)
  {
#if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
   SYMBOL_HN *name, *moduleName;
   int redefining = FALSE;
   void *theConstruct;
   unsigned separatorPosition;
   struct defmodule *theModule;

   /*==========================*/
   /* Next token should be the */
   /* name of the construct.   */
   /*==========================*/

   GetToken(theEnv,readSource,inputToken);
   if (inputToken->type != SYMBOL)
     {
      PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"Missing name for ");
      EnvPrintRouter(theEnv,WERROR,constructName);
      EnvPrintRouter(theEnv,WERROR," construct\n");
      return(NULL);
     }

   name = (SYMBOL_HN *) inputToken->value;

   /*===============================*/
   /* Determine the current module. */
   /*===============================*/

   separatorPosition = FindModuleSeparator(ValueToString(name));
   if (separatorPosition)
     {
      if (moduleNameAllowed == FALSE)
        {
         SyntaxErrorMessage(theEnv,"module specifier");
         return(NULL);
        }

      moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
      if (moduleName == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
         return(NULL);
        }

      EnvSetCurrentModule(theEnv,(void *) theModule);
      name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
      if (name == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }
     }

   /*=====================================================*/
   /* If the module was not specified, record the current */
   /* module name as part of the pretty-print form.       */
   /*=====================================================*/

   else
     {
      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
      if (moduleNameAllowed)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
         SavePPBuffer(theEnv,"::");
         SavePPBuffer(theEnv,ValueToString(name));
        }
     }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
     {
      ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
      return(NULL);
     }
#endif

   /*========================================================*/
   /* Remove the construct if it is already in the knowledge */
   /* base and we're not just checking syntax.               */
   /*========================================================*/

   if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      theConstruct = (*findFunction)(theEnv,ValueToString(name));
      if (theConstruct != NULL)
        {
         redefining = TRUE;
         if (deleteFunction != NULL)
           {
            if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
              {
               PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
               EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
               EnvPrintRouter(theEnv,WERROR,constructName);
               EnvPrintRouter(theEnv,WERROR," ");
               EnvPrintRouter(theEnv,WERROR,ValueToString(name));
               EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
               return(NULL);
              }
           }
        }
     }

   /*=============================================*/
   /* If compilations are being watched, indicate */
   /* that a construct is being compiled.         */
   /*=============================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
       GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      if (redefining) 
        {
         PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,"Defining ");

      EnvPrintRouter(theEnv,WDIALOG,constructName);
      EnvPrintRouter(theEnv,WDIALOG,": ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));

      if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
      else EnvPrintRouter(theEnv,WDIALOG," ");
     }
   else
#endif
     {
      if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
        { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
     }

   /*===============================*/
   /* Get the comment if it exists. */
   /*===============================*/

   GetToken(theEnv,readSource,inputToken);
   if ((inputToken->type == STRING) && getComment)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,inputToken->printForm);
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != RPAREN)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,"\n   ");
         SavePPBuffer(theEnv,inputToken->printForm);
        }
     }
   else if (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,"\n   ");
      SavePPBuffer(theEnv,inputToken->printForm);
     }

   /*===================================*/
   /* Return the name of the construct. */
   /*===================================*/

   return(name);
  }
Ejemplo n.º 22
0
static int ParseImportSpec(
  void *theEnv,
  char *readSource,
  struct token *theToken,
  struct defmodule *newModule)
  {
   struct defmodule *theModule;
   struct portItem *thePort, *oldImportSpec;
   int found, count;

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   SavePPBuffer(theEnv," ");

   GetToken(theEnv,readSource,theToken);

   if (theToken->type != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,"defmodule import specification");
      return(TRUE);
     }

   /*=====================================*/
   /* Verify the existence of the module. */
   /*=====================================*/

   if ((theModule = (struct defmodule *)
                    EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
      return(TRUE);
     }

   /*========================================*/
   /* If the specified module doesn't export */
   /* any constructs, then the import        */
   /* specification is meaningless.          */
   /*========================================*/

   if (theModule->exportList == NULL)
     {
      NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
      return(TRUE);
     }

   /*==============================================*/
   /* Parse the remaining portion of the import    */
   /* specification and return if an error occurs. */
   /*==============================================*/

   oldImportSpec = newModule->importList;
   if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);

   /*========================================================*/
   /* If the ?NONE keyword was used with the import spec,    */
   /* then no constructs were actually imported and the      */
   /* import spec does not need to be checked for conflicts. */
   /*========================================================*/

   if (newModule->importList == oldImportSpec) return(FALSE);

   /*======================================================*/
   /* Check to see if the construct being imported can be  */
   /* by the specified module. This check exported doesn't */
   /* guarantee that a specific named construct actually   */
   /* exists. It just checks that it could be exported if  */
   /* it does exists.                                      */
   /*======================================================*/

   if (newModule->importList->constructType != NULL)
     {
      /*=============================*/
      /* Look for the construct in   */
      /* the module that exports it. */
      /*=============================*/

      found = FALSE;
      for (thePort = theModule->exportList;
           (thePort != NULL) && (! found);
           thePort = thePort->next)
        {
         if (thePort->constructType == NULL) found = TRUE;
         else if (thePort->constructType == newModule->importList->constructType)
           {
            if (newModule->importList->constructName == NULL) found = TRUE;
            else if (thePort->constructName == NULL) found = TRUE;
            else if (thePort->constructName == newModule->importList->constructName)
              { found = TRUE; }
           }
        }

      /*=======================================*/
      /* If it's not exported by the specified */
      /* module, print an error message.       */
      /*=======================================*/

      if (! found)
        {
         if (newModule->importList->constructName == NULL)
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    NULL);
           }
         else
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    ValueToString(newModule->importList->constructName));
           }
         return(TRUE);
        }
     }

   /*======================================================*/
   /* Verify that specific named constructs actually exist */
   /* and can be seen from the module importing them.      */
   /*======================================================*/

   SaveCurrentModule(theEnv);
   EnvSetCurrentModule(theEnv,(void *) newModule);

   for (thePort = newModule->importList;
        thePort != NULL;
        thePort = thePort->next)
     {
      if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
        { continue; }

      theModule = (struct defmodule *)
                  EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
      EnvSetCurrentModule(theEnv,theModule);
      if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
                                ValueToString(thePort->constructName),&count,
                                TRUE,FALSE) == NULL)
        {
         NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                 ValueToString(thePort->constructType),
                                 ValueToString(thePort->constructName));
         RestoreCurrentModule(theEnv);
         return(TRUE);
        }
     }

   RestoreCurrentModule(theEnv);

   /*===============================================*/
   /* The import list has been successfully parsed. */
   /*===============================================*/

   return(FALSE);
  }
Ejemplo n.º 23
0
static int FindMultiImportConflict(
  void *theEnv,
  struct defmodule *theModule)
  {
   struct defmodule *testModule;
   int count;
   struct portConstructItem *thePCItem;
   struct construct *theConstruct;
   void *theCItem;

   /*==========================*/
   /* Save the current module. */
   /*==========================*/

   SaveCurrentModule(theEnv);

   /*============================*/
   /* Loop through every module. */
   /*============================*/

   for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
        testModule != NULL;
        testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule))
     {
      /*========================================*/
      /* Loop through every construct type that */
      /* can be imported/exported by a module.  */
      /*========================================*/

      for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems;
           thePCItem != NULL;
           thePCItem = thePCItem->next)
        {
         EnvSetCurrentModule(theEnv,(void *) testModule);

         /*=====================================================*/
         /* Loop through every construct of the specified type. */
         /*=====================================================*/

         theConstruct = FindConstruct(theEnv,thePCItem->constructName);

         for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL);
              theCItem != NULL;
              theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem))
            {
             /*===============================================*/
             /* Check to see if the specific construct in the */
             /* module can be imported with more than one     */
             /* reference into the module we're examining for */
             /* ambiguous import  specifications.             */
             /*===============================================*/

             EnvSetCurrentModule(theEnv,(void *) theModule);
             FindImportedConstruct(theEnv,thePCItem->constructName,NULL,
                                   ValueToString((*theConstruct->getConstructNameFunction)
                                                 ((struct constructHeader *) theCItem)),
                                   &count,FALSE,NULL);
             if (count > 1)
               {
                ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule),
                                            thePCItem->constructName,
                                            ValueToString((*theConstruct->getConstructNameFunction)
                                                          ((struct constructHeader *) theCItem)));
                RestoreCurrentModule(theEnv);
                return(TRUE);
               }

             EnvSetCurrentModule(theEnv,(void *) testModule);
            }
        }
     }

   /*=============================*/
   /* Restore the current module. */
   /*=============================*/

   RestoreCurrentModule(theEnv);

   /*=======================================*/
   /* Return FALSE to indicate no ambiguous */
   /* references were found.                */
   /*=======================================*/

   return(FALSE);
  }
Ejemplo n.º 24
0
globle void EnvShowDefglobals(
  void *theEnv,
  char *logicalName,
  void *vTheModule)
  {
   struct defmodule *theModule = (struct defmodule *) vTheModule;
   struct constructHeader *constructPtr;
   int allModules = FALSE;
   struct defmoduleItemHeader *theModuleItem;

   /*=======================================*/
   /* If the module specified is NULL, then */
   /* list all constructs in all modules.   */
   /*=======================================*/

   if (theModule == NULL)
     {
      theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
      allModules = TRUE;
     }

   /*======================================================*/
   /* Print out the constructs in the specified module(s). */
   /*======================================================*/

   for (;
        theModule != NULL;
        theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
     {
      /*===========================================*/
      /* Print the module name before every group  */
      /* of defglobals listed if we're listing the */
      /* defglobals from every module.             */
      /*===========================================*/

      if (allModules)
        {
         EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule));
         EnvPrintRouter(theEnv,logicalName,":\n");
        }

      /*=====================================*/
      /* Print every defglobal in the module */
      /* currently being examined.           */
      /*=====================================*/

      theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex);

      for (constructPtr = theModuleItem->firstItem;
           constructPtr != NULL;
           constructPtr = constructPtr->next)
        {
         if (EvaluationData(theEnv)->HaltExecution == TRUE) return;

         if (allModules) EnvPrintRouter(theEnv,logicalName,"   ");
         PrintDefglobalValueForm(theEnv,logicalName,(void *) constructPtr);
         EnvPrintRouter(theEnv,logicalName,"\n");
        }

      /*===================================*/
      /* If we're only listing the globals */
      /* for one module, then return.      */
      /*===================================*/

      if (! allModules) return;
     }
  }