search.c

早期freebsd实现

/* String search routines for GNU Emacs.
   Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include "lisp.h"
#include "syntax.h"
#include "buffer.h"
#include "commands.h"
#include "regex.h"

#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))

unsigned char downcase_table[01000] = {0};	/* folds upper to lower case */
	      /* A WHEEL WILL FALL OFF IF, IN A trt, CHARACTER A */
	      /* TRANSLATES INTO CHARACTER B AND CHARACTER B DOES NOT */
	      /* ALSO TRANSLATE INTO CHARACTER B. */ 
/* If that constraint is met, compute_trt_inverse will follow a */
 /* translation table with its inverse.  The inverse of a table */
 /* follows the table at table[0400].  The form of this is that if */
 /* table[a]=b then the chain starting at table[0400+b], linked by */
 /* link(x)=table[0400+x] and ended by b must include a. */

/* At present compute_trt_inverse is blinded and the inverse for this */
 /* particular table is created by a single-purpose loop. */
 /* compute_trt_inverse has been tested on the following cases: */
 /* trt[x]=x, trt[x]=(+ 3 (logand x, 0370)), trt[x]='a', and the */
 /* downcase table. */

/* We compile regexps into this buffer and then use it for searching. */

struct re_pattern_buffer searchbuf;

char search_fastmap[0400];

/* Last regexp we compiled */

Lisp_Object last_regexp;

/* Every call to re_match, etc., must pass &search_regs as the regs argument
 unless you can show it is unnecessary (i.e., if re_match is certainly going
 to be called again before region-around-match can be called).  */

static struct re_registers search_regs;

/* error condition signalled when regexp compile_pattern fails */

Lisp_Object Qinvalid_regexp;

/* Compile a regexp and signal a Lisp error if anything goes wrong.  */

compile_pattern (pattern, bufp, translate)
     Lisp_Object pattern;
     struct re_pattern_buffer *bufp;
     char *translate;
{
  char *val;
  Lisp_Object dummy;

  if (EQ (pattern, last_regexp)
      && translate == bufp->translate)
    return;
  last_regexp = Qnil;
  bufp->translate = translate;
  val = re_compile_pattern (XSTRING (pattern)->data,
			    XSTRING (pattern)->size,
			    bufp);
  if (val)
    {
      dummy = build_string (val);
      while (1)
	Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
    }
  last_regexp = pattern;
  return;
}

/* Error condition used for failing searches */
Lisp_Object Qsearch_failed;

Lisp_Object
signal_failure (arg)
     Lisp_Object arg;
{
  Fsignal (Qsearch_failed, Fcons (arg, Qnil));
  return Qnil;
}

DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
  "t if text after point matches regular expression PAT.")
  (string)
     Lisp_Object string;
{
  Lisp_Object val;
  unsigned char *p1, *p2;
  int s1, s2;
  register int i;

  CHECK_STRING (string, 0);
  compile_pattern (string, &searchbuf,
		   !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);

  immediate_quit = 1;
  QUIT;			/* Do a pending quit right away, to avoid paradoxical behavior */

  /* Get pointers and sizes of the two strings
     that make up the visible portion of the buffer. */

  p1 = BEGV_ADDR;
  s1 = GPT - BEGV;
  p2 = GAP_END_ADDR;
  s2 = ZV - GPT;
  if (s1 < 0)
    {
      p2 = p1;
      s2 = ZV - BEGV;
      s1 = 0;
    }
  if (s2 < 0)
    {
      s1 = ZV - BEGV;
      s2 = 0;
    }
  
  val = (0 <= re_match_2 (&searchbuf, p1, s1, p2, s2,
			  point - BEGV, &search_regs, ZV - BEGV)
	 ? Qt : Qnil);
  for (i = 0; i < RE_NREGS; i++)
    if (search_regs.start[i] >= 0)
      {
	search_regs.start[i] += BEGV;
	search_regs.end[i] += BEGV;
      }
  immediate_quit = 0;
  return val;
}

DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
  "Return index of start of first match for REGEXP in STRING, or nil.\n\
If third arg START is non-nil, start search at that index in STRING.\n\
For index of first char beyond the match, do (match-end 0).\n\
match-end and match-beginning also give indices of substrings\n\
matched by parenthesis constructs in the pattern.")
  (regexp, string, start)
     Lisp_Object regexp, string, start;
{
  int val;
  int s;

  CHECK_STRING (regexp, 0);
  CHECK_STRING (string, 1);

  if (NULL (start))
    s = 0;
  else
    {
      int len = XSTRING (string)->size;

      CHECK_NUMBER (start, 2);
      s = XINT (start);
      if (s < 0 && -s <= len)
	s = len - s;
      else if (0 > s || s > len)
	args_out_of_range (string, start);
    }

  compile_pattern (regexp, &searchbuf,
		   !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);
  immediate_quit = 1;
  val = re_search (&searchbuf, XSTRING (string)->data, XSTRING (string)->size,
			       s, XSTRING (string)->size - s, &search_regs);
  immediate_quit = 0;
  if (val < 0) return Qnil;
  return make_number (val);
}

scan_buffer (target, pos, cnt, shortage)
     int *shortage, pos;
     register int cnt, target;
{
  int lim = ((cnt > 0) ? ZV - 1 : BEGV);
  int direction = ((cnt > 0) ? 1 : -1);
  register int lim0;
  unsigned char *base;
  register unsigned char *cursor, *limit;

  if (shortage != 0)
    *shortage = 0;

  immediate_quit = 1;

  if (cnt > 0)
    while (pos != lim + 1)
      {
	lim0 =  BufferSafeCeiling (pos);
	lim0 = min (lim, lim0);
	limit = &FETCH_CHAR (lim0) + 1;
	base = (cursor = &FETCH_CHAR (pos));
	while (1)
	  {
	    while (*cursor != target && ++cursor != limit)
	      ;
	    if (cursor != limit)
	      {
		if (--cnt == 0)
		  {
		    immediate_quit = 0;
		    return (pos + cursor - base + 1);
		  }
		else
		  if (++cursor == limit)
		    break;
	      }
	    else
	      break;
	  }
	pos += cursor - base;
      }
  else
    {
      pos--;			/* first character we scan */
      while (pos > lim - 1)
	{			/* we WILL scan under pos */
	  lim0 =  BufferSafeFloor (pos);
	  lim0 = max (lim, lim0);
	  limit = &FETCH_CHAR (lim0) - 1;
	  base = (cursor = &FETCH_CHAR (pos));
	  cursor++;
	  while (1)
	    {
	      while (--cursor != limit && *cursor != target)
		;
	      if (cursor != limit)
		{
		  if (++cnt == 0)
		    {
		      immediate_quit = 0;
		      return (pos + cursor - base + 1);
		    }
		}
	      else
		break;
	    }
	  pos += cursor - base;
	}
    }
  immediate_quit = 0;
  if (shortage != 0)
    *shortage = cnt * direction;
  return (pos + ((direction == 1 ? 0 : 1)));
}

int
find_next_newline (from, cnt)
     register int from, cnt;
{
  return (scan_buffer ('\n', from, cnt, (int *) 0));
}

DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
  "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
CHARS is like the inside of a [...] in a regular expression\n\
except that ] is never special and \\ quotes ^, - or \\.\n\
Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
  (string, lim)
     Lisp_Object string, lim;
{
  skip_chars (1, string, lim);
  return Qnil;
}

DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
  "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
See skip-chars-forward for details.")
  (string, lim)
     Lisp_Object string, lim;
{
  skip_chars (0, string, lim);
  return Qnil;
}

skip_chars (forwardp, string, lim)
     int forwardp;
     Lisp_Object string, lim;
{
  register unsigned char *p, *pend;
  register unsigned char c;
  unsigned char fastmap[0400];
  int negate = 0;
  register int i;

  CHECK_STRING (string, 0);

  if (NULL (lim))
    XFASTINT (lim) = forwardp ? ZV : BEGV;
  else
    CHECK_NUMBER_COERCE_MARKER (lim, 1);

  /* In any case, don't allow scan outside bounds of buffer.  */
  if (XFASTINT (lim) > ZV)
    XFASTINT (lim) = ZV;
  if (XFASTINT (lim) < BEGV)
    XFASTINT (lim) = BEGV;

  p = XSTRING (string)->data;
  pend = p + XSTRING (string)->size;
  bzero (fastmap, sizeof fastmap);

  if (p != pend && *p == '^')
    {
      negate = 1; p++;
    }

  /* Find the characters specified and set their elements of fastmap.  */

  while (p != pend)
    {
      c = *p++;
      if (c == '\\')
        {
	  if (p == pend) break;
	  c = *p++;
	}
      if (p != pend && *p == '-')
	{
	  p++;
	  if (p == pend) break;
	  while (c <= *p)
	    {
	      fastmap[c] = 1;
	      c++;
	    }
	  p++;
	}
      else
	fastmap[c] = 1;
    }

  /* If ^ was the first character, complement the fastmap. */

  if (negate)
    for (i = 0; i < sizeof fastmap; i++)
      fastmap[i] ^= 1;

  immediate_quit = 1;
  if (forwardp)
    {
      while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
	SET_PT (point + 1);
    }
  else
    {
      while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
	SET_PT (point - 1);
    }
  immediate_quit = 0;
}

/* Subroutines of Lisp buffer search functions. */

static Lisp_Object
search_command (string, bound, noerror, count, direction, RE)
     Lisp_Object string, bound, noerror, count;
     int direction;
     int RE;
{
  register int np;
  int lim;
  int n = direction;

  if (!NULL (count))
    {
      CHECK_NUMBER (count, 3);
      n *= XINT (count);
    }

  CHECK_STRING (string, 0);
  if (NULL (bound))
    lim = n > 0 ? ZV : BEGV;
  else
    {
      CHECK_NUMBER_COERCE_MARKER (bound, 1);
      lim = XINT (bound);
      if (n > 0 ? lim < point : lim > point)
	error ("Invalid search bound (wrong side of point)");
      if (lim > ZV)
	lim = ZV;
      if (lim < BEGV)
	lim = BEGV;
    }

  np = search_buffer (string, point, lim, n, RE,
		      !NULL (current_buffer->case_fold_search) ? downcase_table : 0);
  if (np <= 0)
    {
      if (NULL (noerror))
	return signal_failure (string);
      if (!EQ (noerror, Qt))
	{
	  if (lim < BEGV || lim > ZV)
	    abort ();
	  SET_PT (lim);
	}
      return Qnil;
    }

  if (np < BEGV || np > ZV)
    abort ();

  SET_PT (np);

  return Qt;
}

/* search for the n'th occurrence of `string' in the current buffer,
   starting at position `from' and stopping at position `lim',
   treating `pat' as a literal string if `RE' is false or as
   a regular expression if `RE' is true.

   If `n' is positive, searching is forward and `lim' must be greater than `from'.