edmisc.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.24  06/05/06           */
   /*                                                     */
   /*                                                     */
   /*******************************************************/
   
/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Changed name of variable log to logName        */
/*            because of Unix compiler warnings of shadowed  */
/*            definitions.                                   */
/*                                                           */
/*      6.24: Corrected code generating compilation          */
/*            warnings.                                      */
/*                                                           */
/*************************************************************/

/*
 * 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_GCC
#include        <dos.h>
#endif

#if     UNIX_7 || UNIX_V
/*
extern void sleep(int);
*/
#include        <unistd.h>
#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(
  void *theEnv,
  int f,
  int 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(theEnv);
   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) */

   EnvAddRouter(theEnv,"emacs_region",90,region_fnd,
		NULL,region_getc,region_ungetc,NULL);

   /* COMPILE */

   if (get_compile(theEnv,"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(
  void *theEnv,
  int f,
  int 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)  */

   EnvAddRouter(theEnv,"emacs_file",90,buffer_fnd,
		NULL,buffer_getc,buffer_ungetc,NULL);

   /*   COMPILE   */

   if (get_compile(theEnv,"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(
  void *theEnv,
  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(theEnv,CompileBufferp) != TRUE)         /* Blow old text away   */
     return (0);
   CompileLineIndex = 0;
   CompileLine[0] = '\0';

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

   genstrcpy(CompileBufferp->b_fname, "");
   if (CompileBufferp->b_nwnd == 0) {          /* Not on screen yet.   */
           if ((wp=wpopup(theEnv)) == 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(
  void *theEnv,
  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(
  void *theEnv,
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(
  void *theEnv,
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(
  void *theEnv,
  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(
  void *theEnv,
  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(
  void *theEnv,
  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(
  void *theEnv,
  char *logName)
{
   if((strcmp(logName,"wdialog") == 0) ||
      (strcmp(logName,"wtrace")  == 0) ||
      (strcmp(logName,"wwarning")  == 0) ||
      (strcmp(logName,"werror")  == 0))
       return(TRUE);
   else
       return(FALSE);
}

globle int print_cmp(
  void *theEnv,
  char *logName, 
  char *str)
  {
   register int i;

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

globle void init_cmp_router(
  void *theEnv)
  {
   EnvAddRouter(theEnv,"cmp_router",
	      20,
	      query_cmp,
	      print_cmp,
	      NULL,
	      NULL,
	      NULL
	      );
  }

globle void kill_cmp_router(
  void *theEnv)
  {
   EnvDeleteRouter(theEnv,"cmp_router");
  }

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

/*
 * Set fill column to n.
 */
#if IBM_TBC
#pragma argsused
#endif
globle int setfillcol(
  void *theEnv,
  int f,
  int 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(
  void *theEnv,
  int f,
  int 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(
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;