edbasic.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.21  06/15/03           */
   /*                                                     */
   /*                                                     */
   /*******************************************************/

#include "setup.h"

#if EMACS_EDITOR && ! RUN_TIME

#define _EDBASIC_SOURCE_
#include "ed.h"

/* -----------------------
 *  Terminal setup stuff
 * -----------------------
 */

#if VAX_VMS
#include	<stsdef.h>
#include	<ssdef.h>
#include	<descrip.h>
#include	<iodef.h>
#include	<ttdef.h>
#include        <tt2def.h>

#define NIBUF	128	    /* Input buffer size		*/
#define NOBUF	1024	/* MM says big buffers win!	*/
#define EFN	0			/* Event flag			*/
#define ESC     '\033'
#define TERM    '~'

static char	obuf[NOBUF];	/* Output buffer		*/
static int	nobuf;		 	/* # of bytes in above	  	*/
static char	ibuf[NIBUF];	/* Input buffer		 	*/
static int	nibuf;			/* # of bytes in above		*/
static int	ibufi;			/* Read index			*/
static int	oldmode[3];		/* Old TTY mode bits		*/
static int	newmode[3];		/* New TTY mode bits		*/
static short	iochan;		 	/* TTY I/O channel		*/
#endif

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

#if     UNIX_7 || UNIX_V
#include <sys/ioctl.h>
#include	<sgtty.h>		/* for stty/gtty functions */
static struct  sgttyb  ostate;		        /* saved tty state */
static struct  sgttyb  nstate;		        /* values for editor mode */
#endif

/* =======================================================================
 *                     CURSOR MOVEMENT FUNCTIONS
 * =======================================================================
 */

/*
 * The routines in this section move the cursor around on the screen. They
 * compute a new value for the cursor, then adjust ".". The display code
 * always updates the cursor location, so only moves between lines, or
 * functions that adjust the top line in the window and invalidate the
 * framing, are hard.
 */

/*
 * Move the cursor to the
 * beginning of the current line.
 * Trivial.
 */
#if IBM_TBC
#pragma argsused
#endif
globle int gotobol(
  void *theEnv,
  int f,
  int n)
  {
   curwp->w_doto  = 0;
   return (TRUE);
  }

/*
 * Move the cursor backwards by "n" characters. If "n" is less than zero call
 * "forwchar" to actually do the move. Otherwise compute the new cursor
 * location. Error if you try and move out of the buffer. Set the flag if the
 * line pointer for dot changes.
 */
globle int backchar(
  void *theEnv,
  int f,
  int n)
  {
   register LINE   *lp;

   if (n < 0)
     return (forwchar(theEnv,f, -n));
   while (n--)
     {
      if (curwp->w_doto == 0) 
        {
         if ((lp=lback(curwp->w_dotp)) == curbp->b_linep)
           { return (FALSE); }
         curwp->w_dotp  = lp;
         curwp->w_doto  = llength(lp);
         curwp->w_flag |= WFMOVE;
        }
      else
        { curwp->w_doto--; }
     }
   return (TRUE);
  }

/*
 * Move the cursor to the end of the current line. Trivial. No errors.
 */
#if IBM_TBC
#pragma argsused
#endif
globle int gotoeol(
  void *theEnv,
  int f,
  int n)
  {
   curwp->w_doto  = llength(curwp->w_dotp);
   return (TRUE);
  }

/*
 * Move the cursor forwwards by "n" characters. If "n" is less than zero call
 * "backchar" to actually do the move. Otherwise compute the new cursor
 * location, and move ".". Error if you try and move off the end of the
 * buffer. Set the flag if the line pointer for dot changes.
 */
globle int forwchar(
  void *theEnv,
  int f,
  int n)
  {
        if (n < 0)
                return (backchar(theEnv,f, -n));
        while (n--) {
                if (curwp->w_doto == llength(curwp->w_dotp)) {
                        if (curwp->w_dotp == curbp->b_linep)
                                return (FALSE);
                        curwp->w_dotp  = lforw(curwp->w_dotp);
                        curwp->w_doto  = 0;
                        curwp->w_flag |= WFMOVE;
                } else
                        curwp->w_doto++;
        }
        return (TRUE);
   }

/*
 * Goto the beginning of the buffer. Massive adjustment of dot. This is
 * considered to be hard motion; it really isn't if the original value of dot
 * is the same as the new value of dot. Normally bound to "M-<".
 */
#if IBM_TBC
#pragma argsused
#endif
globle int gotobob(
  void *theEnv,
  int f,
  int n)
  {
   curwp->w_dotp  = lforw(curbp->b_linep);
   curwp->w_doto  = 0;
   curwp->w_flag |= WFHARD;
   return (TRUE);
  }

/*
 * Move to the end of the buffer. Dot is always put at the end of the file
 * (ZJ). The standard screen code does most of the hard parts of update.
 * Bound to "M->".
 */
#if IBM_TBC
#pragma argsused
#endif
globle int gotoeob(
  void *theEnv,
  int f,
  int n)
  {
   curwp->w_dotp  = curbp->b_linep;
   curwp->w_doto  = 0;
   curwp->w_flag |= WFHARD;
   return (TRUE);
  }

/*
 * Move forward by full lines. If the number of lines to move is less than
 * zero, call the backward line function to actually do it. The last command
 * controls how the goal column is set. Bound to "C-N". No errors are
 * possible.
 */
globle int forwline(
  void *theEnv,
  int f,
  int n)
  {
        register LINE   *dlp;

        if (n < 0)
                return (backline(theEnv,f, -n));
        if ((lastflag&CFCPCN) == 0)             /* Reset goal if last   */
                curgoal = curcol;               /* not C-P or C-N       */
        thisflag |= CFCPCN;
        dlp = curwp->w_dotp;
        while (n-- && dlp!=curbp->b_linep)
                dlp = lforw(dlp);
        curwp->w_dotp  = dlp;
        curwp->w_doto  = getgoal(dlp);
        curwp->w_flag |= WFMOVE;
        return (TRUE);
  }

/*
 * This function is like "forwline", but goes backwards. The scheme is exactly
 * the same. Check for arguments that are less than zero and call your
 * alternate. Figure out the new line and call "movedot" to perform the
 * motion. No errors are possible. Bound to "C-P".
 */
globle int backline(
  void *theEnv,
  int f,
  int n)
  {
        register LINE   *dlp;

        if (n < 0)
                return (forwline(theEnv,f, -n));
        if ((lastflag&CFCPCN) == 0)             /* Reset goal if the    */
                curgoal = curcol;               /* last isn't C-P, C-N  */
        thisflag |= CFCPCN;
        dlp = curwp->w_dotp;
        while (n-- && lback(dlp)!=curbp->b_linep)
                dlp = lback(dlp);
        curwp->w_dotp  = dlp;
        curwp->w_doto  = getgoal(dlp);
        curwp->w_flag |= WFMOVE;
        return (TRUE);
  }

/*
 * This routine, given a pointer to a LINE, and the current cursor goal
 * column, return the best choice for the offset. The offset is returned.
 * Used by "C-N" and "C-P".
 */
globle int getgoal(
LINE   *dlp)
{
        register int    c;
        register int    col;
        register int    newcol;
        register int    dbo;

        col = 0;
        dbo = 0;
        while (dbo != llength(dlp)) {
                c = lgetc(dlp, dbo);
                newcol = col;
                if (c == '\t')
                        newcol |= 0x07;
                else if (c<0x20 || c==0x7F)
                        ++newcol;
                ++newcol;
                if (newcol > curgoal)
                        break;
                col = newcol;
                ++dbo;
        }
        return (dbo);
}

/*
 * Scroll forward by a specified number of lines, or by a full page if no
 * argument. Bound to "C-V". The "2" in the arithmetic on the window size is
 * the overlap; this value is the default overlap value in ITS EMACS. Because
 * this zaps the top line in the display window, we have to do a hard update.
 */
globle int forwpage(
  void *theEnv,
  int f,
  int n)
  {
        register LINE   *lp;

        if (f == FALSE) {
                n = curwp->w_ntrows - 2;        /* Default scroll.      */
                if (n <= 0)                     /* Forget the overlap   */
                        n = 1;                  /* if tiny window.      */
        } else if (n < 0)
                return (backpage(theEnv,f, -n));
#if     CVMVAS
        else                                    /* Convert from pages   */
                n *= curwp->w_ntrows;           /* to lines.            */
#endif
        lp = curwp->w_linep;
        while (n-- && lp!=curbp->b_linep)
                lp = lforw(lp);
        curwp->w_linep = lp;
        curwp->w_dotp  = lp;
        curwp->w_doto  = 0;
        curwp->w_flag |= WFHARD;
        return (TRUE);
  }

/*
 * This command is like "forwpage", but it goes backwards. The "2", like
 * above, is the overlap between the two windows. The value is from the ITS
 * EMACS manual. Bound to "M-V". We do a hard update for exactly the same
 * reason.
 */
globle int backpage(
  void *theEnv,
  int f,
  int n)
  {
        register LINE   *lp;

        if (f == FALSE) {
                n = curwp->w_ntrows - 2;        /* Default scroll.      */
                if (n <= 0)                     /* Don't blow up if the */
                        n = 1;                  /* window is tiny.      */
        } else if (n < 0)
                return (forwpage(theEnv,f, -n));
#if     CVMVAS
        else                                    /* Convert from pages   */
                n *= curwp->w_ntrows;           /* to lines.            */
#endif
        lp = curwp->w_linep;
        while (n-- && lback(lp)!=curbp->b_linep)
                lp = lback(lp);
        curwp->w_linep = lp;
        curwp->w_dotp  = lp;
        curwp->w_doto  = 0;
        curwp->w_flag |= WFHARD;
        return (TRUE);
  }

/*
 * Set the mark in the current window to the value of "." in the window. No
 * errors are possible. Bound to "M-.".
 */
#if IBM_TBC
#pragma argsused
#endif
globle int setmark(
  void *theEnv,
  int f,
  int n)
  {
   curwp->w_markp = curwp->w_dotp;
   curwp->w_marko = curwp->w_doto;
   mlwrite("[Mark set]");
   return (TRUE);
  }

/*
 * Swap the values of "." and "mark" in the current window. This is pretty
 * easy, bacause all of the hard work gets done by the standard routine
 * that moves the mark about. The only possible error is "no mark". Bound to
 * "C-X C-X".
 */
#if IBM_TBC
#pragma argsused
#endif
globle int swapmark(
  void *theEnv,
  int f,
  int n)
  {
   register LINE   *odotp;
   register int    odoto;

   if (curwp->w_markp == NULL) 
     {
      mlwrite("No mark in this window");
      return (FALSE);
     }

   odotp = curwp->w_dotp;
   odoto = curwp->w_doto;
   curwp->w_dotp  = curwp->w_markp;
   curwp->w_doto  = curwp->w_marko;
   curwp->w_markp = odotp;
   curwp->w_marko = odoto;
   curwp->w_flag |= WFMOVE;
   return (TRUE);
  }

/* =======================================================================
 *                            WORD FUNCTIONS
 * =======================================================================
 */

/*
 * The routines in this section implement commands that work word at a time.
 * There are all sorts of word mode commands.
 */

/* Word wrap on n-spaces. Back-over whatever precedes the point on the current
 * line and stop on the first word-break or the beginning of the line. If we
 * reach the beginning of the line, jump back to the end of the word and start
 * a new line.  Otherwise, break the line at the word-break, eat it, and jump
 * back to the end of the word.
 *      NOTE:  This function may leaving trailing blanks.
 * Returns TRUE on success, FALSE on errors.
 */
#if IBM_TBC
#pragma argsused
#endif
globle int wrapword(
  void *theEnv)
  {
        register int cnt, oldp;
        oldp = (int) curwp->w_dotp;
        cnt = -1;
        do {
                cnt++;
                if (! backchar(theEnv,0, 1))
                        return(FALSE);
        }
        while (! inword());
        if (! backword(theEnv,0, 1))
                return(FALSE);
        if (oldp == (int) (curwp->w_dotp && curwp->w_doto)) {
                if (! backdel(theEnv,0, 1))
                        return(FALSE);
                if (! newline(theEnv,0, 1))
                        return(FALSE);
        }