textpro.c

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

   if (ArgTypeCheck("toss",1,SYMBOL_OR_STRING,&arg_ptr) == CLIPS_FALSE)
     return (CLIPS_FALSE);
   file = DOToString(arg_ptr);

#if CLP_HELP

    if (help_file != NULL)
      if ((strcmp(file,help_file) == 0) && (HELP_INIT == CLIPS_TRUE))
        {
         rm((VOID *) help_file,(int) strlen(help_file) + 1);
         help_file = NULL;
         HELP_INIT = CLIPS_FALSE;
         DeleteRouter("whelp");
        }

#endif

   return(TextLookupToss(file));
  }

#endif

/******************************************************************************/
/* The following four functions are the router routines for the logical name  */
/* "whelp".  Currently, all they do is direct all accesses to standard I/O.   */
/******************************************************************************/

#if CLP_HELP

static int RecognizeHelpRouters(log_name)
  char *log_name;
  {
   if (strcmp(log_name,"whelp") == 0)
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }

#if IBM_TBC
#pragma argsused
#endif
static int HelpPrint(log_name,str)
  char *log_name, *str;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(log_name)
#endif
   PrintCLIPS("stdout",str);
   return(1);
  }

#if IBM_TBC
#pragma argsused
#endif
static int HelpGetc(log_name)
  char *log_name;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(log_name)
#endif
   return(GetcCLIPS("stdin"));
  }

#if IBM_TBC
#pragma argsused
#endif
static int HelpUngetc(ch, log_name)
  int ch;
  char *log_name;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(log_name)
#endif
   return(UngetcCLIPS(ch,"stdin"));
  }

#endif

/******************************************************************************/
/*============================================================================*/
/*                            INTERNAL ROUTINES                               */
/*============================================================================*/
/******************************************************************************/

/******************************************************************************/
/*FUNCTION CMD_LINE_TOPICS :                                                  */
/* Input : None                                                               */
/* Output : This function builds a linked list of topics requested by the     */
/*          user at the CLIPS level using the CLIPS "stack" routines,         */
/*          num_args() and rstring().  It returns the address of the top of   */
/*          the list or NULL if there were no command line topics.            */
/******************************************************************************/
static struct topics *GetCommandLineTopics()
  {
   int topic_num,         /*Number of topics specified by the user */
       index;             /*Used to loop through the topic list    */
   struct topics *head,   /*Address of the top of the topic list   */
                 *tnode,  /*Address of new topic node              */
                 *tptr;   /*Used to attach new node to the list    */
   DATA_OBJECT val;       /*Unknown-type CLIPS data structure      */

   head = NULL;
   topic_num = RtnArgCount();
   for (index = 1; index <= topic_num; index++)
     {
      tnode = (struct topics *) gm2 ((int) sizeof(struct topics));
      RtnUnknown(index,&val);
      if ((GetType(val) == SYMBOL) || (GetType(val) == STRING))
        strncpy(tnode->name,DOToString(val),NAMESIZE-1);
      else if (GetType(val) == FLOAT)
        strncpy(tnode->name,FloatToString(DOToDouble(val)),NAMESIZE-1);
      else if (GetType(val) == INTEGER)
        strncpy(tnode->name,LongIntegerToString(DOToLong(val)),NAMESIZE-1);
      else
        strncpy(tnode->name,"***ERROR***",NAMESIZE-1);
      tnode->next = NULL;
      tnode->end_list = NULL;
      if (head == NULL)
        head = tnode;
      else
        {
         tptr = head;
         while (tptr->next != NULL)
           tptr = tptr->next;
         tptr->next = tnode;
        }
     }
    return(head);
  }

/******************************************************************************/
/*FUNCTION QUERY_TOPIC :                                                      */
/* Input : 1) The address of the old topic list (this routines writes over    */
/*            previously allocated memory, if available)                      */
/*         2) A buffer holding the name of the current menu in the tree       */
/* Output : This function prompts the user for a new set of topic(s) and      */
/*          displays the name of the current menu.  Each new topic is         */
/*          delineated by white-space, and this function builds a linked list */
/*          of these topics.  It returns the address of the top of this list. */
/******************************************************************************/

#if CLP_HELP

static struct topics *AskForNewHelpTopic(old_list,menu)
  struct topics *old_list;
  char **menu;
  {
   int index, cnt;       /*Indices of the user input buffer and topic name */
   struct topics *main,  /*Address of the top of the topic list            */
                 *tnode, /*Address of the new topic node                   */
                 *tptr;  /*Used to add the new node to the topic list      */
   char list[256],       /*User input buffer                               */
        name[NAMESIZE];  /*Name of the new topic in the list               */

   /*==================================================================*/
   /*Read a line of input from the user (substituting blanks for tabs) */
   /*==================================================================*/
   PrintCLIPS("whelp",*menu);
   PrintCLIPS("whelp"," Topic? ");
   CLIPSInputCount = 0;
   for ( index = 0; 
         ((list[index] = (char) GetcCLIPS("whelp")) != LNFEED) && (index < 254);
         index++ , CLIPSInputCount++)
       {
        if (HaltExecution)
          break;
        if (list[index] == TAB)
          list[index] = BLANK;
        else if ((list[index] == '\b') && (index != 0))
          {
           index -= 2;
           CLIPSInputCount -= 2;
          }
       }
#if VAX_VMS
   PrintCLIPS("whelp","\n");
#endif

   CLIPSInputCount = -1;
   if (HaltExecution)
     {
      PrintCLIPS("whelp","\n");
      old_list->end_list = old_list;
      return(old_list);
     }
   list[index] = BLANK;
   list[index+1] = NULLCHAR;

   /*=======================================*/
   /*Parse user buffer into separate topics */
   /*=======================================*/
   main = old_list;
   index = 0; cnt = 0;
   while (list[index] != NULLCHAR)
     {
      if ((list[index] != BLANK) && (cnt < NAMESIZE))
        name[cnt++] = list[index++];
      else if (cnt > 0)
        {
         while ((list[index] != BLANK) && (list[index] != NULLCHAR))
           index++;
         name[cnt] = NULLCHAR;
         cnt = 0;

         /*==============================================*/
         /*Write over previous topic lists, if available */
         /*==============================================*/
         if (old_list != NULL)
           {
            strcpy(old_list->name,name);
            old_list = old_list->next;
           }
         else
           {
            tnode = (struct topics *) gm2 ((int) sizeof(struct topics));
            strcpy(tnode->name,name);
            tnode->next = NULL;
            tnode->end_list = NULL;
            if (main == NULL)
              main = tnode;
            else
              {
               tptr = main;
               while (tptr->next != NULL)
                 tptr = tptr->next;
               tptr->next = tnode;
              }
           }
        }
      else
        index++;
     }

  /*========================================================================*/
  /*If the new list is shorter than the previous one, we must mark the end. */
  /*========================================================================*/
  main->end_list = old_list;
  return(main);
 }


#endif

/******************************************************************************/
/*FUNCTION FIND_TOPIC :                                                       */
/* Input : 1) File to be searched for topic request                           */
/*         2) Address of topic request list                                   */
/*         3) Buffer for current menu name                                    */
/*         4) Lookup status return code                                       */
/* Output : This function flows through the user topic request path by        */
/*          calling the lookup routines.  When it reaches the last element,   */
/*          it returns a pointer into the stream of the lookup file           */
/*          indicating the beginning of the topic entry.  If any topic in the */
/*          path is not found, the function aborts and returns the address of */
/*          of the current menu in the lookup tree for the file.  The exact   */
/*          nature of the final lookup is indicated in the status buffer.     */
/******************************************************************************/
static FILE *FindTopicInEntries(file,main_topic,menu,status)
  char *file;
  struct topics *main_topic;
  char **menu;
  int *status;
  {
   FILE *fp = NULL;                 /*Input file stream                    */
   struct topics *tptr,             /*Used to loop through the topic list  */
                 *end_list;         /*Address of the end of the topic list */

   if (main_topic != NULL)
     end_list = main_topic->end_list;
   else
     end_list = NULL;
   tptr = main_topic;
   if (tptr != end_list)
     do
       {
        if (fp != NULL)
          fclose(fp);

        /*======================*/
        /*Branch up in the tree */
        /*======================*/
        if (strcmp(tptr->name,"^") == 0)
          fp = GetEntries(file,menu,NULL,status);

        /*=======================================================*/
        /*Return the current main topic menu of the lookup table */
        /*=======================================================*/
        else if ((strcmp(tptr->name,"?") == 0) && (tptr->next == end_list))
          fp = GetCurrentMenu(file,status);

        /*=====================*/
        /*Lookup topic request */
        /*=====================*/
        else
          fp = GetEntries(file,menu,tptr->name,status);

        if ((*status == NO_FILE) || (*status == NO_TOPIC))
          break;
        tptr = tptr->next;
       } while (tptr != end_list);
   else
     /*==================================================================*/
     /*An empty topic request list causes a single branch-up in the tree */
     /*==================================================================*/
     fp = GetEntries(file,menu,NULL,status);

   return(fp);
  }

/*******************************************/
/* HelpFunctionDefinitions:                */
/*******************************************/
globle VOID HelpFunctionDefinitions()
  {
#if ! RUN_TIME
#if CLP_HELP
   DefineFunction2("help",'v',PTIF HelpFunction,"HelpFunction",NULL);
   DefineFunction2("help-path",'v',PTIF HelpPathFunction,"HelpPathFunction","*1k");
#endif

#if CLP_TEXTPRO
   DefineFunction2("fetch",'u', PTIF FetchCommand,"FetchCommand","11k");
   DefineFunction2("toss",'b', PTIF TossCommand,"TossCommand","11k");
   DefineFunction2("print-region",'b', PTIF PrintRegionCommand,"PrintRegionCommand","2**wk");
#endif
#endif
  }

#endif