edmisc.c

NASA 开发使用的一个专家系统

/*   CLIPS Version 6.05  04/09/97 */

/*
 * This file contains the command processing functions for a number of
 * commands, including the search, spawn, and compile functions.
 */

#include "setup.h"

#if  EMACS_EDITOR && ! RUN_TIME

#define _EDMISC_SOURCE_
#include "ed.h"
#include "cstrcpsr.h"

static int     tabsize;                        /* Tab size (0: use real tabs)  */

/* -----------------------------
 *  Spawn function setups
 * -----------------------------
 */

#if     VAX_VMS
#define EFN     0                               /* Event flag.          */

#include        <ssdef.h>                       /* Random headers.      */
#include        <stsdef.h>
#include        <descrip.h>
#include        <iodef.h>

extern  int     oldmode[2];                      /* In "termio.c"        */
extern  int     newmode[2];                      /* In "termio.c"        */
extern  short   iochan;                          /* In "termio.c"        */
#endif

#if     IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC
#include        <dos.h>
#endif

#if     UNIX_7 || UNIX_V
#if ANSI_COMPILER
extern VOID sleep(int);
#else
extern VOID sleep();
#endif

#include        <signal.h>
#endif

/* =========================================================================
 *                        COMPILE CLIPS RULES FUNCTIONS
 * =========================================================================
 */

#define MAX_COMPILE_LINE 161

static int cur_col;
static long region_size;
static LINE *linep;
static int loffs;
static int CompileSuccess = 1;
static char CompileLine[MAX_COMPILE_LINE];
static int CompileLineIndex = 0;

/********************************************************/
/*    compile a region of a file 			*/
/********************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int compile_region(f,n)
int f,n;
{
    register int    s;
    REGION   region;

   if (curbp == CompileBufferp)
     {
      mlwrite("Cannot compile this region!");
      return(0);
     }
   cur_col = 20;

   /* Mark the region   */

   if (( s = getregion(&region)) != TRUE)
      return(s);
   if ((lastflag&CFKILL) == 0)
     kdelete();
   thisflag |= CFKILL;
   linep = region.r_linep;
   loffs = region.r_offset;
   region_size =  region.r_size;
   if (region_size == 0)
    {
     mlwrite(" Region is empty ");
     return(0);
    }

   mlwrite("Compiling Region...");

   /* Create IO router for the region (CLIPS.C) */

   AddRouter("emacs_region",90,region_fnd,
		NULL,region_getc,region_ungetc,NULL);

   /* COMPILE */

   if (get_compile("emacs_region","Emacs_region") == 0)
     mlwrite("Error while forming compilation buffer!");
   else
     mlwrite("Compilation done.");
   return (TRUE);
}


/*****************************************************
 *  This function will compile a file form emacs     *
 *****************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int compile_file(f,n)
int f,n;
{
   if (curbp == CompileBufferp)
     {
      mlwrite("Cannot compile this buffer!");
      return(0);
     }

   cur_col = 27;
   mlwrite("Compiling Current Buffer...");
   linep = lforw(curbp->b_linep);
   loffs = 0;

   /*  Create a IO router for the file   (CLIPS.C)  */

   AddRouter("emacs_file",90,buffer_fnd,
		NULL,buffer_getc,buffer_ungetc,NULL);

   /*   COMPILE   */

   if (get_compile("emacs_file","Emacs_buffer") == 0)
     mlwrite("Error while forming compilation buffer!");
   else
     mlwrite("Compilation done.");
   return (TRUE);
}


/**********************************************************
 *  Compiles the whole buffer or just a region of a buffer*
 **********************************************************/
globle int get_compile(str1,str2)
char *str1;
char *str2;
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
   register WINDOW *wp;
   register BUFFER *bp;

   CompileSuccess = 1;
   CompileBufferp->b_flag &= ~BFCHG;           /* Don't complain!      */
   if (bclear(CompileBufferp) != TRUE)         /* Blow old text away   */
     return (0);
   CompileLineIndex = 0;
   CompileLine[0] = '\0';

   ActivateRouter(str1);	
   ActivateRouter("cmp_router");
   SetPrintWhileLoading(TRUE);
   LoadConstructsFromLogicalName(str2);
   DestroyPPBuffer();
   /* Flush last diagnostic line (if any) to buffer */
   if (CompileLineIndex != 0)
     addline(CompileBufferp,CompileLine);
   DeactivateRouter(str1);	
   DeactivateRouter("cmp_router");
   SetPrintWhileLoading(FALSE);
   DeleteRouter(str1);

   strcpy(CompileBufferp->b_fname, "");
   if (CompileBufferp->b_nwnd == 0) {          /* Not on screen yet.   */
           if ((wp=wpopup()) == NULL)
                   return (0);
           bp = wp->w_bufp;
           if (--bp->b_nwnd == 0) {
                   bp->b_dotp  = wp->w_dotp;
                   bp->b_doto  = wp->w_doto;
                   bp->b_markp = wp->w_markp;
                   bp->b_marko = wp->w_marko;
           }
           wp->w_bufp  = CompileBufferp;
           ++CompileBufferp->b_nwnd;
   }
   wp = wheadp;
   while (wp != NULL) {
           if (wp->w_bufp == CompileBufferp) {
                   wp->w_linep = lforw(CompileBufferp->b_linep);
                   wp->w_dotp  = lforw(CompileBufferp->b_linep);
                   wp->w_doto  = 0;
                   wp->w_markp = NULL;
                   wp->w_marko = 0;
                   wp->w_flag |= WFMODE|WFHARD;
           }
           wp = wp->w_wndp;
   }
   return(CompileSuccess);
#else
   return(0);
#endif		
}

/****************************************************************
 *  This function will compare the logical name with names in 	*
 *  the IO Router list						*
 ****************************************************************/

globle int region_fnd(log_name)
char *log_name;
{
    if(strcmp("Emacs_region",log_name)== 0)
	return(TRUE);
    return(FALSE);

}

/****************************************************************
 *   This function will return a character from the file which  *
 *   is referenced by the logical name				*
 ****************************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int region_getc(log_name)
char *log_name;
{
  int c;

  if (region_size <= 0)		   /* If end of region then EXIT */
       return(EOF);
  if (loffs == llength(linep))     /* End of line  */
       {
	  c = '\n';		   /* go to next line */
	  linep = lforw(linep);
	  loffs = 0;
       }
  else
       c = lgetc(linep,loffs++);   /* If everything is OK then get a character
					from the file */
  region_size--;
  return(c);
}

/*******************************************************
 * This function will move the cursor back one charater*
 *******************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int region_ungetc(c,log_name)
int c;
char *log_name;

{
     if (c == EOF)
       return(1);
     if (loffs <= 0)
       {
	 linep = lback(linep);
	 loffs = llength(linep);
       }
     else
	loffs--;
     region_size++;
     return(1);
}

/**************************************************************
 * this function will search through the IO router list and   *
 * find a name that matches with the logical name,which       *
 * represents the buffer to be compiled	.		      *
 **************************************************************/

globle int buffer_fnd(log_name)
char *log_name;
{
    if(strcmp("Emacs_buffer",log_name)== 0)
    	return(TRUE);
    return(FALSE);
 }


/****************************************************************
 *   This function will return a character from the file which  *
 * is referred by the logical name				*
 ****************************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int buffer_getc(log_name)
char *log_name;
{
  int c;
  if (linep == curbp->b_linep)       /* End of file */
    return(EOF);
  if (loffs == llength(linep))       /* End of line */
     {
	linep = lforw(linep);        /* Move to next line */
	if (linep == curbp->b_linep) /* and if end of file then exit */
            return(EOF);	     /* else reset the cursor */
        loffs = 0;
        c = '\n';
     }
  else

        c = lgetc(linep,loffs++);    /* if everything is OK then get a character
					from the file */
  return(c);
}

/*************************************************************
 * this function will move the cursor back to one character  *
 *************************************************************/

#if IBM_TBC
#pragma argsused
#endif
globle int buffer_ungetc(c,logical_name)
int    c;
char  *logical_name;
{
    if (c == EOF)
      return(1);
    if (loffs == 0)
      {
	linep = lback(linep);
        loffs = llength(linep);
      }
    else
	loffs--;
    return(1);
}

globle int query_cmp(log)
char *log;
{
   if((strcmp(log,"wdialog") == 0) ||
      (strcmp(log,"wtrace")  == 0) ||
      (strcmp(log,"wwarning")  == 0) ||
      (strcmp(log,"werror")  == 0))
       return(TRUE);
   else
       return(FALSE);
}

globle int print_cmp(log, str)
  char *log, *str;
  {
   register int i;

   if (CompileSuccess == 0)
     return(1);
   for (i = 0 ; str[i] != '\0' ; i++)
     {
      if ((str[i] == '\n') || (str[i] == '\r'))
        {
         addline(CompileBufferp,CompileLine);
         CompileLineIndex = 0;
         CompileLine[0] = '\0';
        }
      else if (CompileLineIndex < (MAX_COMPILE_LINE-1))
        {
         CompileLine[CompileLineIndex++] = str[i];
         CompileLine[CompileLineIndex] = '\0';
        }
      else
        {
         addline(CompileBufferp,CompileLine);
         CompileLineIndex = 1;
         CompileLine[0] = str[i];
         CompileLine[1] = '\0';
        }
     }
   return(1);
  }

globle VOID init_cmp_router()
{
   AddRouter("cmp_router",
	      20,
	      query_cmp,
	      print_cmp,
	      NULL,
	      NULL,
	      NULL
	      );
}

globle VOID kill_cmp_router()
{
   DeleteRouter("cmp_router");
}

/* =========================================================================
 *                              MISC FUNCTIONS
 * =========================================================================
 */

/*
 * Set fill column to n.
 */
#if IBM_TBC
#pragma argsused
#endif
globle int setfillcol(f, n)
int f,n;
{
        fillcol = n;
        return(TRUE);
}

/*
 * Display the current position of the cursor; the current
 * column, the current line and the total number of lines in the file.
 * Bound to "C-X =".      CJC, 8-1-86
 */
#if IBM_TBC
#pragma argsused
#endif
globle int showcpos(f, n)
int f,n;
{
        register int    cline;
        register int    col;
        register int    tline;

        col   = getccol(FALSE);                 /* Get real column.     */
        cline = getcline();                     /* Get real line #      */
        tline = cntlines();                     /* Get total # lines    */
        mlwrite("MicroEMACS Version %s   col: %d  line: %d of %d"
                ,VERSION_NUM, col+1, cline, tline);
        return (TRUE);
}

/*
 * Return current column.  Stop at first non-blank given TRUE argument.
 */
globle int getccol(bflg)
int bflg;
{
        register int c, i, col;
        col = 0;
        for (i=0; i< curwp->w_doto; ++i) {
                c = lgetc(curwp->w_dotp, i);
                if (c!=' ' && c!='\t' && bflg)
                        break;
                if (c == '\t')
                        col |= 0x07;
                else if (c<0x20 || c==0x7F)
                        ++col;
                ++col;
        }
        return(col);
}

/*
 *  Return current line number in file
 */
globle int getcline()
{
   int i;
   struct LINE *clp;

   i = 0;
   clp = curbp->b_linep;
   while(clp != curwp->w_dotp) {
        i++;
        clp = lforw(clp);
        }
   if (i == 0)