comparison src/syntax.c @ 56088:a7a676c680d4

Include regex.h. (skip_chars): New arg HANDLE_ISO_CLASSES. Callers changed. If requested, make a list of classes, then check the scanned chars for membership in them. (in_classes): New function. (Fskip_chars_forward): Doc fix.

56087:3d12da599e18

#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "keymap.h"

/* Make syntax table lookup grant data in gl_state.  */
#define SYNTAX_ENTRY_VIA_PROPERTY

#include "syntax.h"

static int find_defun_start P_ ((int, int));
static int back_comment P_ ((int, int, int, int, int, int *, int *));
static int char_quoted P_ ((int, int));
static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object));
static Lisp_Object scan_lists P_ ((int, int, int, int));
static void scan_sexps_forward P_ ((struct lisp_parse_state *,
				    int, int, int, int,
				    int, Lisp_Object, int));


struct gl_state_s gl_state;		/* Global state of syntax parser.  */

INTERVAL interval_of ();

STRING is like the inside of a `[...]' in a regular expression
except that `]' is never special and `\\' quotes `^', `-' or `\\'
 (but not as the end of a range; quoting is never needed there).
Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
With arg "^a-zA-Z", skips nonletters stopping before first letter.
Returns the distance traveled, either zero or positive.
Note that char classes, e.g. `[:alpha:]', are not currently supported;
they will be treated as literals.  */)
     (string, lim)
     Lisp_Object string, lim;
{
  return skip_chars (1, 0, string, lim);
}

DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
       doc: /* Move point backward, stopping after a char not in STRING, or at pos LIM.
See `skip-chars-forward' for details.
Returns the distance traveled, either zero or negative.  */)
     (string, lim)
     Lisp_Object string, lim;
{
  return skip_chars (0, 0, string, lim);
}

DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
       doc: /* Move point forward across chars in specified syntax classes.
SYNTAX is a string of syntax code characters.

If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
This function returns the distance traveled, either zero or positive.  */)
     (syntax, lim)
     Lisp_Object syntax, lim;
{
  return skip_chars (1, 1, syntax, lim);
}

DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
       doc: /* Move point backward across chars in specified syntax classes.
SYNTAX is a string of syntax code characters.

If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
This function returns the distance traveled, either zero or negative.  */)
     (syntax, lim)
     Lisp_Object syntax, lim;
{
  return skip_chars (0, 1, syntax, lim);
}

static Lisp_Object
skip_chars (forwardp, syntaxp, string, lim)
     int forwardp, syntaxp;
     Lisp_Object string, lim;
{
  register unsigned int c;
  unsigned char fastmap[0400];
  /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
     of which codes don't fit in FASTMAP.  In that case, set the

  int multibyte = !NILP (current_buffer->enable_multibyte_characters);
  int string_multibyte;
  int size_byte;
  const unsigned char *str;
  int len;

  CHECK_STRING (string);
  char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
  string_multibyte = STRING_MULTIBYTE (string);
  str = SDATA (string);
  size_byte = SBYTES (string);

  /* Adjust the multibyteness of the string to that of the buffer.  */
  if (multibyte != string_multibyte)
    {
      int nbytes;

      if (syntaxp)
	fastmap[syntax_spec_code[c & 0377]] = 1;
      else
	{
	  if (c == '\\')
	    {
	      if (i_byte == size_byte)
		break;

			break;
		      p = GAP_END_ADDR;
		      stop = endp;
		    }
		  c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
		  if (SINGLE_BYTE_CHAR_P (c))
		    {
		      if (!fastmap[c])
			break;
		    }

			if (c >= char_ranges[i] && c <= char_ranges[i + 1])
			  break;
		      if (!(negate ^ (i < n_char_ranges)))
			break;
		    }
		  p += nbytes, pos++, pos_byte += nbytes;
		}
	    else
	      while (1)
		{

		      if (p >= endp)
			break;
		      p = GAP_END_ADDR;
		      stop = endp;
		    }
		  if (!fastmap[*p])
		    break;
		  p++, pos++;
		}
	  }
	else
	  {

		  PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
		  if (prev_p - p > nbytes)
		    p = prev_p - 1, c = *p, nbytes = 1;
		  else
		    c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
		  if (SINGLE_BYTE_CHAR_P (c))
		    {
		      if (!fastmap[c])
			break;
		    }

			if (c >= char_ranges[i] && c <= char_ranges[i + 1])
			  break;
		      if (!(negate ^ (i < n_char_ranges)))
			break;
		    }
		  pos--, pos_byte -= nbytes;
		}
	    else
	      while (1)
		{

		      if (p <= endp)
			break;
		      p = GPT_ADDR;
		      stop = endp;
		    }
		  if (!fastmap[p[-1]])
		    break;
		  p--, pos--;
		}
	  }
      }

    SET_PT_BOTH (pos, pos_byte);
    immediate_quit = 0;

    return make_number (PT - start_point);
  }
}

/* Jump over a comment, assuming we are at the beginning of one.
   FROM is the current position.
   FROM_BYTE is the bytepos corresponding to FROM.

56088:a7a676c680d4

#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "keymap.h"
#include "regex.h"

/* Make syntax table lookup grant data in gl_state.  */
#define SYNTAX_ENTRY_VIA_PROPERTY

#include "syntax.h"

static int find_defun_start P_ ((int, int));
static int back_comment P_ ((int, int, int, int, int, int *, int *));
static int char_quoted P_ ((int, int));
static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int));
static Lisp_Object scan_lists P_ ((int, int, int, int));
static void scan_sexps_forward P_ ((struct lisp_parse_state *,
				    int, int, int, int,
				    int, Lisp_Object, int));
static int in_classes P_ ((int, Lisp_Object));


struct gl_state_s gl_state;		/* Global state of syntax parser.  */

INTERVAL interval_of ();

STRING is like the inside of a `[...]' in a regular expression
except that `]' is never special and `\\' quotes `^', `-' or `\\'
 (but not as the end of a range; quoting is never needed there).
Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
With arg "^a-zA-Z", skips nonletters stopping before first letter.
Char classes, e.g. `[:alpha:]', are supported.

Returns the distance traveled, either zero or positive.  */)
     (string, lim)
     Lisp_Object string, lim;
{
  return skip_chars (1, 0, string, lim, 1);
}

DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
       doc: /* Move point backward, stopping after a char not in STRING, or at pos LIM.
See `skip-chars-forward' for details.
Returns the distance traveled, either zero or negative.  */)
     (string, lim)
     Lisp_Object string, lim;
{
  return skip_chars (0, 0, string, lim, 1);
}

DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
       doc: /* Move point forward across chars in specified syntax classes.
SYNTAX is a string of syntax code characters.

If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
This function returns the distance traveled, either zero or positive.  */)
     (syntax, lim)
     Lisp_Object syntax, lim;
{
  return skip_chars (1, 1, syntax, lim, 0);
}

DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
       doc: /* Move point backward across chars in specified syntax classes.
SYNTAX is a string of syntax code characters.

If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
This function returns the distance traveled, either zero or negative.  */)
     (syntax, lim)
     Lisp_Object syntax, lim;
{
  return skip_chars (0, 1, syntax, lim, 0);
}

static Lisp_Object
skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes)
     int forwardp, syntaxp;
     Lisp_Object string, lim;
     int handle_iso_classes;
{
  register unsigned int c;
  unsigned char fastmap[0400];
  /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
     of which codes don't fit in FASTMAP.  In that case, set the

  int multibyte = !NILP (current_buffer->enable_multibyte_characters);
  int string_multibyte;
  int size_byte;
  const unsigned char *str;
  int len;
  Lisp_Object iso_classes;

  CHECK_STRING (string);
  char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
  string_multibyte = STRING_MULTIBYTE (string);
  str = SDATA (string);
  size_byte = SBYTES (string);
  iso_classes = Qnil;

  /* Adjust the multibyteness of the string to that of the buffer.  */
  if (multibyte != string_multibyte)
    {
      int nbytes;

      if (syntaxp)
	fastmap[syntax_spec_code[c & 0377]] = 1;
      else
	{
	  if (handle_iso_classes && c == '['
	      && i_byte < size_byte
	      && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':')
	    {
	      const unsigned char *class_beg = str + i_byte + 1;
	      const unsigned char *class_end = class_beg;
	      const unsigned char *class_limit = str + size_byte;
	      /* Leave room for the null.	 */
	      unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
	      re_wctype_t cc;

	      if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
		class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;

	      while (class_end != class_limit
		     && ! (*class_end >= 0200
			   || *class_end <= 040
			   || (*class_end == ':'
			       && class_end[1] == ']')))
		class_end++;

	      if (class_end == class_limit
		  || *class_end >= 0200
		  || *class_end <= 040)
		error ("Invalid ISO C character class");

	      bcopy (class_beg, class_name, class_end - class_beg);
	      class_name[class_end - class_beg] = 0;

	      cc = re_wctype (class_name);
	      if (cc == 0)
		error ("Invalid ISO C character class");

	      iso_classes = Fcons (make_number (cc), iso_classes);

	      i_byte = class_end + 2 - str;
	      continue;
	    }

	  if (c == '\\')
	    {
	      if (i_byte == size_byte)
		break;

			break;
		      p = GAP_END_ADDR;
		      stop = endp;
		    }
		  c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);

		  if (! NILP (iso_classes) && in_classes (c, iso_classes))
		    {
		      if (negate)
			break;
		      else
			goto fwd_ok;
		    }

		  if (SINGLE_BYTE_CHAR_P (c))
		    {
		      if (!fastmap[c])
			break;
		    }

			if (c >= char_ranges[i] && c <= char_ranges[i + 1])
			  break;
		      if (!(negate ^ (i < n_char_ranges)))
			break;
		    }
		fwd_ok:
		  p += nbytes, pos++, pos_byte += nbytes;
		}
	    else
	      while (1)
		{

		      if (p >= endp)
			break;
		      p = GAP_END_ADDR;
		      stop = endp;
		    }

		  if (!NILP (iso_classes) && in_classes (*p, iso_classes))
		    {
		      if (negate)
			break;
		      else
			goto fwd_ok;
		    }

		  if (!fastmap[*p])
		    break;

		fwd_unibyte_ok:
		  p++, pos++;
		}
	  }
	else
	  {

		  PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
		  if (prev_p - p > nbytes)
		    p = prev_p - 1, c = *p, nbytes = 1;
		  else
		    c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);

		  if (! NILP (iso_classes) && in_classes (c, iso_classes))
		    {
		      if (negate)
			break;
		      else
			goto back_ok;
		    }

		  if (SINGLE_BYTE_CHAR_P (c))
		    {
		      if (!fastmap[c])
			break;
		    }

			if (c >= char_ranges[i] && c <= char_ranges[i + 1])
			  break;
		      if (!(negate ^ (i < n_char_ranges)))
			break;
		    }
		back_ok:
		  pos--, pos_byte -= nbytes;
		}
	    else
	      while (1)
		{

		      if (p <= endp)
			break;
		      p = GPT_ADDR;
		      stop = endp;
		    }

		  if (! NILP (iso_classes) && in_classes (p[-1], iso_classes))
		    {
		      if (negate)
			break;
		      else
			goto fwd_ok;
		    }

		  if (!fastmap[p[-1]])
		    break;

		back_unibyte_ok:
		  p--, pos--;
		}
	  }
      }

    SET_PT_BOTH (pos, pos_byte);
    immediate_quit = 0;

    return make_number (PT - start_point);
  }
}

/* Return 1 if character C belongs to one of the ISO classes
   in the list ISO_CLASSES.  Each class is represented by an
   integer which is its type according to re_wctype.  */

static int
in_classes (c, iso_classes)
     int c;
     Lisp_Object iso_classes;
{
  int fits_class = 0;

  while (! NILP (iso_classes))
    {
      Lisp_Object elt;
      elt = XCAR (iso_classes);
      iso_classes = XCDR (iso_classes);

      if (re_iswctype (c, XFASTINT (elt)))
	fits_class = 1;
    }

  return fits_class;
}

/* Jump over a comment, assuming we are at the beginning of one.
   FROM is the current position.
   FROM_BYTE is the bytepos corresponding to FROM.