search.c

早期freebsd实现

Optional third argument, if t, means if fail just return nil (no error).\n\
  If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.")
  (string, bound, noerror, count)
     Lisp_Object string, bound, noerror, count;
{
  return search_command (string, bound, noerror, count, 1, 0);
}

DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
  "sWord search backward: ",
  "Search backward from point for STRING, ignoring differences in punctuation.\n\
Set point to the beginning of the occurrence found, and return t.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend before that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
  If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.")
  (string, bound, noerror, count)
     Lisp_Object string, bound, noerror, count;
{
  return search_command (wordify (string), bound, noerror, count, -1, 1);
}

DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
  "sWord search: ",
  "Search forward from point for STRING, ignoring differences in punctuation.\n\
Set point to the end of the occurrence found, and return t.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend after that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
  If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.")
  (string, bound, noerror, count)
     Lisp_Object string, bound, noerror, count;
{
  return search_command (wordify (string), bound, noerror, count, 1, 1);
}

DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
  "sRE search backward: ",
  "Search backward from point for match for regular expression REGEXP.\n\
Set point to the beginning of the match, and return t.\n\
The match found is the one starting last in the buffer\n\
and yet ending before the place the origin of the search.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must start at or after that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
  If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.\n\
See also the functions match-beginning and match-end and replace-match.")
  (string, bound, noerror, count)
     Lisp_Object string, bound, noerror, count;
{
  return search_command (string, bound, noerror, count, -1, 1);
}

DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
  "sRE search: ",
  "Search forward from point for regular expression REGEXP.\n\
Set point to the end of the occurrence found, and return t.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend after that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
  If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.\n\
See also the functions match-beginning and match-end and replace-match.")
  (string, bound, noerror, count)
     Lisp_Object string, bound, noerror, count;
{
  return search_command (string, bound, noerror, count, 1, 1);
}

DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0,
  "Replace text matched by last search with NEWTEXT.\n\
If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
Otherwise convert to all caps or cap initials, like replaced text.\n\
If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
Otherwise treat \\ as special:\n\
  \\& in NEWTEXT means substitute original matched text,\n\
  \\N means substitute match for \\(...\\) number N,\n\
  \\\\ means insert one \\.\n\
Leaves point at end of replacement text.")
  (string, fixedcase, literal)
     Lisp_Object string, fixedcase, literal;
{
  enum { nochange, all_caps, cap_initial } case_action;
  register int pos, last;
  int some_multiletter_word;
  int some_letter = 0;
  register int c, prevc;
  int inslen;

  CHECK_STRING (string, 0);

  case_action = nochange;	/* We tried an initialization */
				/* but some C compilers blew it */
  if (search_regs.start[0] < BEGV
      || search_regs.start[0] > search_regs.end[0]
      || search_regs.end[0] > ZV)
    args_out_of_range(make_number (search_regs.start[0]),
		      make_number (search_regs.end[0]));

  if (NULL (fixedcase))
    {
      /* Decide how to casify by examining the matched text. */

      last = search_regs.end[0];
      prevc = '\n';
      case_action = all_caps;

      /* some_multiletter_word is set nonzero if any original word
	 is more than one letter long. */
      some_multiletter_word = 0;

      for (pos = search_regs.start[0]; pos < last; pos++)
	{
	  c = FETCH_CHAR (pos);
	  if (LOWERCASEP (c))
	    {
	      /* Cannot be all caps if any original char is lower case */

	      case_action = cap_initial;
	      if (SYNTAX (prevc) != Sword)
		{
		  /* Cannot even be cap initials
		     if some original initial is lower case */
		  case_action = nochange;
		  break;
		}
	      else
		some_multiletter_word = 1;
	    }
	  else if (!NOCASEP (c))
	    {
	      some_letter = 1;
	      if (!some_multiletter_word && SYNTAX (prevc) == Sword)
		some_multiletter_word = 1;
	    }

	  prevc = c;
	}

      /* Do not make new text all caps
	 if the original text contained only single letter words. */
      if (case_action == all_caps && !some_multiletter_word)
	case_action = cap_initial;

      if (!some_letter) case_action = nochange;
    }

  SET_PT (search_regs.end[0]);
  if (!NULL (literal))
    Finsert (1, &string);
  else
    {
      struct gcpro gcpro1;
      GCPRO1 (string);
      for (pos = 0; pos < XSTRING (string)->size; pos++)
	{
	  c = XSTRING (string)->data[pos];
	  if (c == '\\')
	    {
	      c = XSTRING (string)->data[++pos];
	      if (c == '&')
		Finsert_buffer_substring (Fcurrent_buffer (),
					  make_number (search_regs.start[0]),
					  make_number (search_regs.end[0]));
	      else if (c >= '1' && c <= RE_NREGS + '0')
		{
		  if (search_regs.start[c - '0'] >= 1)
		    Finsert_buffer_substring (Fcurrent_buffer (),
					      make_number (search_regs.start[c - '0']),
					      make_number (search_regs.end[c - '0']));
		}
	      else
		insert_char (c);
	    }
	  else
	    insert_char (c);
	}
      UNGCPRO;
    }

  inslen = point - (search_regs.end[0]);
  del_range (search_regs.start[0], search_regs.end[0]);

  if (case_action == all_caps)
    Fupcase_region (make_number (point - inslen), make_number (point));
  else if (case_action == cap_initial)
    upcase_initials_region (make_number (point - inslen), make_number (point));
  return Qnil;
}

static Lisp_Object
match_limit (num, beginningp)
     Lisp_Object num;
     int beginningp;
{
  register int n;

  CHECK_NUMBER (num, 0);
  n = XINT (num);
  if (n < 0 || n >= RE_NREGS)
    args_out_of_range (num, make_number (RE_NREGS));
  if (search_regs.start[n] < 0)
    return Qnil;
  return (make_number ((beginningp) ? search_regs.start[n]
		                    : search_regs.end[n]));
}

DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
  "Return the character number of start of text matched by last regexp searched for.\n\
ARG, a number, specifies which parenthesized expression in the last regexp.\n\
 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
Zero means the entire text matched by the whole regexp.")
  (num)
     Lisp_Object num;
{
  return match_limit (num, 1);
}

DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
  "Return the character number of end of text matched by last regexp searched for.\n\
ARG, a number, specifies which parenthesized expression in the last regexp.\n\
 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
Zero means the entire text matched by the whole regexp.")
  (num)
     Lisp_Object num;
{
  return match_limit (num, 0);
} 

DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
  "Return list containing all info on what the last search matched.\n\
Element 2N is (match-beginning N); element 2N + 1 is (match-end N).\n\
All the elements are normally markers, or nil if the Nth pair didn't match.\n\
0 is also possible, when matching was done with `string-match',\n\
if a match began at index 0 in the string.")
  ()
{
  Lisp_Object data[2 * RE_NREGS];
  int i, len;

  len = -1;
  for (i = 0; i < RE_NREGS; i++)
    {
      int start = search_regs.start[i];
      if (start >= 0)
	{
	  if (start == 0)
	    data[2 * i] = 0;
	  else
	    {
	      data[2 * i] = Fmake_marker ();
	      Fset_marker (data[2 * i], make_number (start), Qnil);
	    }

	  if (search_regs.end[i] == 0)
	    data[2 * i + 1] = 0;
	  else
	    {
	      data[2 * i + 1] = Fmake_marker ();
	      Fset_marker (data[2 * i + 1],
			   make_number (search_regs.end[i]), Qnil);
	    }
	  len = i;
	}
      else
	data[2 * i] = data [2 * i + 1] = Qnil;
    }
  return Flist (2 * len + 2, data);
}


DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0,
  "Set internal data on last search match from elements of LIST.\n\
LIST should have been created by calling match-data previously.")
  (list)
     register Lisp_Object list;
{
  register int i;
  register Lisp_Object marker;

  if (!CONSP (list) && !NULL (list))
    list = wrong_type_argument (Qconsp, list, 0);

  for (i = 0; i < RE_NREGS; i++)
    {
      marker = Fcar (list);
      if (NULL (marker))
	{
	  search_regs.start[i] = -1;
	  list = Fcdr (list);
	}
      else
	{
	  if (XTYPE (marker) == Lisp_Marker
	      && XMARKER (marker)->buffer == 0)
	    XFASTINT (marker) = 0;

	  CHECK_NUMBER_COERCE_MARKER (marker, 0);
	  search_regs.start[i] = XINT (marker);
	  list = Fcdr (list);

	  marker = Fcar (list);
	  if (XTYPE (marker) == Lisp_Marker
	      && XMARKER (marker)->buffer == 0)
	    XFASTINT (marker) = 0;

	  CHECK_NUMBER_COERCE_MARKER (marker, 0);
	  search_regs.end[i] = XINT (marker);
	}
      list = Fcdr (list);
    }

  return Qnil;  
}

/* Quote a string to inactivate reg-expr chars */

DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
  "Return a regexp string which matches exactly STRING and nothing else.")
  (str)
     Lisp_Object str;
{
  register unsigned char *in, *out, *end;
  register unsigned char *temp;

  CHECK_STRING (str, 0);

  temp = (unsigned char *) alloca (XSTRING (str)->size * 2);

  /* Now copy the data into the new string, inserting escapes. */

  in = XSTRING (str)->data;
  end = in + XSTRING (str)->size;
  out = temp; 

  for (; in != end; in++)
    {
      if (*in == '[' || *in == ']'
	  || *in == '*' || *in == '.' || *in == '\\'
	  || *in == '?' || *in == '+'
	  || *in == '^' || *in == '$')
	*out++ = '\\';
      *out++ = *in;
    }

  return make_string (temp, out - temp);
}

/* This code should be unzapped when there comes to be multiple */
 /* translation tables.  It has been certified on various cases. */
/*
void
compute_trt_inverse (trt)
     register unsigned char *trt;
{
  register int i = 0400;
  register unsigned char c, q;

  while (i--)
    trt[0400+i] = i;
  i = 0400;
  while (i--)
    {
      if ((q = trt[i]) != (unsigned char) i)
	{
	  c = trt[q + 0400];
	  trt[q + 0400] = i;
	  trt[0400 + i] = c;
	}
    }
}
*/
  
syms_of_search ()
{
  register int i;

  for (i = 0; i < 0400; i++)
    {
      downcase_table[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i;
/* We do this instead of using compute_trt_inverse to save space. */
 /* Does it? */
      downcase_table[0400+i]
	= ((i >= 'A' && i <= 'Z')
	   ? i + ('a' - 'A')
	   : ((i >= 'a' && i <= 'z')
	      ? i + ('A' - 'a')
	      : i));
    }
/* Use this instead when there come to be multiple translation tables. 
  compute_trt_inverse (downcase_table);    */

  searchbuf.allocated = 100;
  searchbuf.buffer = (char *) malloc (searchbuf.allocated);
  searchbuf.fastmap = search_fastmap;

  Qsearch_failed = intern ("search-failed");
  staticpro (&Qsearch_failed);
  Qinvalid_regexp = intern ("invalid-regexp");
  staticpro (&Qinvalid_regexp);

  Fput (Qsearch_failed, Qerror_conditions,
	Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
  Fput (Qsearch_failed, Qerror_message,
	build_string ("Search failed"));

  Fput (Qinvalid_regexp, Qerror_conditions,
	Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
  Fput (Qinvalid_regexp, Qerror_message,
	build_string ("Invalid regexp"));

  last_regexp = Qnil;
  staticpro (&last_regexp);

  defsubr (&Sstring_match);
  defsubr (&Slooking_at);
  defsubr (&Sskip_chars_forward);
  defsubr (&Sskip_chars_backward);
  defsubr (&Ssearch_forward);
  defsubr (&Ssearch_backward);
  defsubr (&Sword_search_forward);
  defsubr (&Sword_search_backward);
  defsubr (&Sre_search_forward);
  defsubr (&Sre_search_backward);
  defsubr (&Sreplace_match);
  defsubr (&Smatch_beginning);
  defsubr (&Smatch_end);
  defsubr (&Smatch_data);
  defsubr (&Sstore_match_data);
  defsubr (&Sregexp_quote);
}