/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
   Copyright (C) 1985 Richard M. Stallman.

This file is part of GNU Emacs.

GNU Emacs is distributed in the hope that it will be useful,
but without any warranty.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.

Everyone is granted permission to copy, modify and redistribute
GNU Emacs, but only under the conditions described in the
document "GNU Emacs copying permission notice".   An exact copy
of the document is supposed to have been given to you along with
GNU Emacs so that you can know how you may redistribute it all.
It should be in a file named COPYING.  Among other things, the
copyright notice and this notice must be preserved on all copies.  */


#include "config.h"
#include <ctype.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "syntax.h"

Lisp_Object Qsyntax_table_p, Vstandard_syntax_table;

/* There is an alist of syntax tables: names (strings) vs obarrays. */

DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
  "Return t if ARG is a syntax table.\n\
Any vector of 256 elements will do.")
  (obj)
     Lisp_Object obj;
{
  if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400)
    return Qt;
  return Qnil;
}

DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
  "Return the current syntax table.\n\
This is the one specified by the current buffer.")
  ()
{
  Lisp_Object vector;
  XSETTYPE (vector, Lisp_Vector);
  XSETVECTOR (vector, bf_cur->syntax_table_v);
  return vector;
}

DEFUN ("standard-syntax-table", Fstandard_syntax_table,
   Sstandard_syntax_table, 0, 0, 0,
  "Return the standard syntax table.\n\
This is the one used for new buffers.")
  ()
{
  return Vstandard_syntax_table;
}

DEFUN ("make-syntax-table", Fmake_syntax_table, Smake_syntax_table, 0, 0, 0,
  "Construct a new syntax table and return it.\n\
It is a copy of the standard syntax table's current contents.")
  ()
{
  Lisp_Object size, val;
  XFASTINT (size) = 0400;
  XFASTINT (val) = 0;
  val = Fmake_vector (size, val);
  if (!NULL (Vstandard_syntax_table))
    bcopy (XVECTOR (Vstandard_syntax_table)->contents,
	   XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object));
  return val;
}

DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1,
  "sSet syntax table: ",
  "Select a new syntax table for the current buffer.\n\
One argument, a syntax table.")
  (table)
     Lisp_Object table;
{
  Lisp_Object tem;

  tem = Fsyntax_table_p (table);
  if (NULL (tem))
    wrong_type_argument (Qsyntax_table_p, table, 0);

  bf_cur->syntax_table_v = XVECTOR (table);
  return table;
}

/* Convert a letter which signifies a syntax code
 into the code it signifies.
 This is used by modify-syntax-entry, and other things. */

char syntax_spec_code[0400] =
  { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    (char) Swhitespace, 0377, (char) Sstring, 0377,
        (char) Smath, 0377, 0377, (char) Squote,
    (char) Sopen, (char) Sclose, 0377, 0377,
	0377, (char) Swhitespace, 0377, (char) Scharquote,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377,
	(char) Scomment, 0377, (char) Sendcomment, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* @, A, ... */
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
    0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* `, a, ... */
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
    0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
  };

/* Indexed by syntax code, give the letter that describes it. */

char syntax_code_spec[12] =
  {
    ' ', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
  };

DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
  "Return the syntax code of CHAR, described by a character.\n\
For example, if CHAR is a word constituent, ?w is returned.\n\
The characters that correspond to various syntax codes\n\
are listed in the documentation of  modify-syntax-entry.")
  (ch)
     Lisp_Object ch;
{
  CHECK_NUMBER (ch, 0);
  return make_number (syntax_code_spec[(int) SYNTAX (XINT (ch))]);
}

DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 2,
  "cSet syntax for character: \nsSet syntax for %s to: ",
  0 /* See auxdoc.c */)
  (c, newentry)
     Lisp_Object c, newentry;
{
  register unsigned char *p, match;
  register enum syntaxcode code;
  Lisp_Object val;

  CHECK_NUMBER (c, 0);
  CHECK_STRING (newentry, 1);

  p = XSTRING (newentry)->data;
  code = (enum syntaxcode) syntax_spec_code[*p++];
  if (((int) code & 0377) == 0377)
    error ("invalid syntax description letter", c);

  match = *p++;
  if (match == ' ') match = 0;

  XFASTINT (val) = (match << 8) + (int) code;
  while (*p)
    switch (*p++)
      {
      case '1':
	XFASTINT (val) += 1 << 16;
	break;

      case '2':
	XFASTINT (val) += 1 << 17;
	break;

      case '3':
	XFASTINT (val) += 1 << 18;
	break;

      case '4':
	XFASTINT (val) += 1 << 19;
	break;
      }
	
  bf_cur->syntax_table_v->contents[XINT (c)] = val;

  return Qnil;
}

/* Dump syntax table to buffer in human-readable format */

Lisp_Object
describe_syntax (value)
    Lisp_Object value;
{
  register enum syntaxcode code;
  char desc, match, start1, start2, end1, end2;
  char str[2];

  if (XTYPE (value) != Lisp_Int)
    {
      InsStr ("invalid");
      return;
    }

  code = (enum syntaxcode) (XINT (value) & 0377);
  match = (XINT (value) >> 8) & 0377;
  start1 = (XINT (value) >> 16) & 1;
  start2 = (XINT (value) >> 17) & 1;
  end1 = (XINT (value) >> 18) & 1;
  end2 = (XINT (value) >> 19) & 1;

  if ((int) code < 0 || (int) code >= (int) Smax)
    {
      InsStr ("invalid");
      return;
    }
  desc = syntax_code_spec[(int) code];

  str[0] = desc, str[1] = 0;
  InsCStr (str, 1);

  str[0] = match ? match : ' ';
  InsCStr (str, 1);


  if (start1)
    InsCStr ("1", 1);
  if (start2)
    InsCStr ("2", 1);

  if (end1)
    InsCStr ("3", 1);
  if (end2)
    InsCStr ("4", 1);

  InsStr ("\twhich means: ");

  switch (code)
    {
    case Swhitespace:
      InsStr ("whitespace"); break;
    case Sword:
      InsStr ("word"); break;
    case Ssymbol:
      InsStr ("symbol"); break;
    case Sopen:
      InsStr ("open"); break;
    case Sclose:
      InsStr ("close"); break;
    case Squote:
      InsStr ("quote"); break;
    case Sstring:
      InsStr ("string"); break;
    case Smath:
      InsStr ("math"); break;
    case Sescape:
      InsStr ("escape"); break;
    case Scharquote:
      InsStr ("charquote"); break;
    case Scomment:
      InsStr ("comment"); break;
    case Sendcomment:
      InsStr ("endcomment"); break;
    default:
      InsStr ("invalid");
      return;
    }

  if (match)
    {
      InsStr (", matches ");
      
      str[0] = match, str[1] = 0;
      InsCStr (str, 1);
    }

  if (start1)
    InsStr (",\n\t  is the first character of a comment-start sequence");
  if (start2)
    InsStr (",\n\t  is the second character of a comment-start sequence");

  if (end1)
    InsStr (",\n\t  is the first character of a comment-end sequence");
  if (end2)
    InsStr (",\n\t  is the second character of a comment-end sequence");
  return Qnil;
}

describe_syntax_1 (vector)
     Lisp_Object vector;
{
  struct buffer *old = bf_cur;
  SetBfp (XBUFFER (Vstandard_output));
  describe_vector (vector, Qnil, describe_syntax);
  SetBfp (old);
}

DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "",
  "Describe the syntax specifications in the syntax table.\n\
The descriptions are inserted in a buffer, which is selected so you can see it.")
  ()
{
  Lisp_Object vector;

  XSETVECTOR (vector, bf_cur->syntax_table_v);
  XSETTYPE (vector, Lisp_Vector);
  internal_with_output_to_temp_buffer
     (" *Syntax table*", describe_syntax_1, vector);

  return Qnil;
}

/* Return the position across `count' words from `from'.
   If that many words cannot be found before the end of the buffer, return 0.
   `count' negative means scan backward and stop at word beginning.  */

scan_words (from, count)
     register int from, count;
{
  register int beg = FirstCharacter;
  register int end = NumCharacters + 1;

  immediate_quit = 1;

  while (count > 0)
    {
      while (1)
	{
	  if (from == end) return 0;
	  if (SYNTAX(CharAt (from)) == Sword)
	    break;
	  from++;
	}
      while (1)
	{
	  if (from == end) break;
	  if (SYNTAX(CharAt (from)) != Sword)
	    break;
	  from++;
	}
      count--;
    }
  while (count < 0)
    {
      while (1)
	{
	  if (from == beg) return 0;
	  if (SYNTAX(CharAt (from - 1)) == Sword)
	    break;
	  from--;
	}
      while (1)
	{
	  if (from == beg) break;
	  if (SYNTAX(CharAt (from - 1)) != Sword)
	    break;
	  from--;
	}
      count++;
    }

  immediate_quit = 0;

  return from;
}

DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p",
  "Move dot forward ARG words (backward if ARG is negative).\n\
Normally returns t.\n\
If an edge of the buffer is reached, dot is left there\n\
and nil is returned.")
  (count)
     Lisp_Object count;
{
  int val;
  CHECK_NUMBER (count, 0);

  if (!(val = scan_words (dot, XINT (count))))
    {
      SetDot (XINT (count) > 0 ? NumCharacters + 1 : FirstCharacter);
      return Qnil;
    }
  SetDot (val);
  return Qt;
}

int parse_sexp_ignore_comments;

Lisp_Object
scan_lists (from, count, depth, sexpflag)
     register int from;
     int count, depth, sexpflag;
{
  Lisp_Object val;
  register int stop;
  register int c;
  char stringterm;
  int quoted;
  int mathexit;
  register enum syntaxcode code;
  int min_depth = depth;    /* Err out if depth gets less than this. */

  if (depth > 0) min_depth = 0;

  immediate_quit = 1;

  while (count > 0)
    {
      stop = NumCharacters + 1;
      while (from < stop)
	{
	  c = CharAt (from);
	  code = SYNTAX(c);
	  from++;
	  if (from < stop && SYNTAX_COMSTART_FIRST (c)
	      && SYNTAX_COMSTART_SECOND (CharAt (from))
	      && parse_sexp_ignore_comments)
	    code = Scomment, from++;

	  switch (code)
	    {
	    case Sescape:
	    case Scharquote:
	      if (from == stop) goto lose;
	      from++;
	      /* treat following character as a word constituent */
	    case Sword:
	    case Ssymbol:
	      if (depth || !sexpflag) break;
	      /* This word counts as a sexp; return at end of it. */
	      while (from < stop)
		{
		  switch (SYNTAX(CharAt (from)))
		    {
		    case Scharquote:
		    case Sescape:
		      from++;
		      if (from == stop) goto lose;
		      break;
		    case Sword:
		    case Ssymbol:
		      break;
		    default:
		      goto done;
		    }
		  from++;
		}
	      goto done;

	    case Scomment:
	      if (!parse_sexp_ignore_comments) break;
	      while (1)
		{
		  if (from == stop) goto done;
		  if (SYNTAX (c = CharAt (from)) == Sendcomment)
		    break;
		  from++;
		  if (from < stop && SYNTAX_COMEND_FIRST (c)
		       && SYNTAX_COMEND_SECOND (CharAt (from)))
		    { from++; break; }
		}
	      break;

	    case Sopen:
	      if (!++depth) goto done;
	      break;

	    case Sclose:
	      if (!--depth) goto done;
	      if (depth < min_depth)
		error ("Containing expression ends prematurely");
	      break;

	    case Sstring:
	      stringterm = CharAt (from - 1);
	      while (1)
		{
		  if (from >= stop) goto lose;
		  if (CharAt (from) == stringterm) break;
		  switch (SYNTAX(CharAt (from)))
		    {
		    case Scharquote:
		    case Sescape:
		      from++;
		    }
		  from++;
		}
	      from++;
	      if (!depth && sexpflag) goto done;
	      break;

	    case Smath:
	      if (mathexit) goto done;
	      if (sexpflag)
		mathexit = 1;
	      break;
	    }
	}

      /* Reached end of buffer.  Error if within object, return nil if between */
      if (depth) goto lose;

      immediate_quit = 0;
      return Qnil;

      /* End of object reached */
    done:
      count--;
    }

  while (count < 0)
    {
      stop = FirstCharacter;
      while (from > stop)
	{
	  from--;
	  if (quoted = char_quoted (from))
	    from--;
	  c = CharAt (from);
	  code = SYNTAX (c);
	  if (from > stop && SYNTAX_COMEND_SECOND (c)
	      && SYNTAX_COMEND_FIRST (CharAt (from - 1))
	      && !char_quoted (from - 1)
	      && parse_sexp_ignore_comments)
	    code = Sendcomment, from--;

	  switch (quoted ? Sword : code)
	    {
	    case Sword:
	    case Ssymbol:
	      if (depth || !sexpflag) break;
	      /* This word counts as a sexp; count object finished after passing it. */
	      while (from > stop)
		{
		  if (quoted = char_quoted (from - 1))
		    from--;
		  if (! (quoted || SYNTAX(CharAt (from - 1)) == Sword ||
			 SYNTAX(CharAt (from - 1)) == Ssymbol))
            	    goto done2;
		  from--;
		}
	      goto done2;

	    case Sclose:
	      if (!++depth) goto done2;
	      break;

	    case Sopen:
	      if (!--depth) goto done2;
	      if (depth < min_depth)
		error ("Containing expression ends prematurely");
	      break;

	    case Sendcomment:
	      if (!parse_sexp_ignore_comments) break;
	      while (1)
		{
		  if (from == stop) goto done;
		  if (SYNTAX (c = CharAt (from)) == Scomment)
		    break;
		  from--;
		  if (from > stop && SYNTAX_COMSTART_SECOND (c)
		       && SYNTAX_COMSTART_FIRST (CharAt (from))
		      && !char_quoted (from))
		    { from--; break; }
		}
	      break;

	    case Sstring:
	      stringterm = CharAt (from);
	      while (1)
		{
		  if (from == stop) goto lose;
		  if (!char_quoted (from - 1)
		      && stringterm == CharAt (from - 1))
		    break;
		  from--;
		}
	      from--;
	      if (!depth && sexpflag) goto done2;
	      break;

	    case Smath:
	      if (mathexit) goto done2;
	      if (sexpflag)
		mathexit = 1;
	      break;
	    }
	}

      /* Reached start of buffer.  Error if within object, return nil if between */
      if (depth) goto lose;

      immediate_quit = 0;
      return Qnil;

    done2:
      count++;
    }


  immediate_quit = 0;
  XFASTINT (val) = from;
  return val;

 lose:
  error ("Unbalanced parentheses");
}

char_quoted (pos)
     register int pos;
{
  register enum syntaxcode code;
  register int beg = FirstCharacter;
  register int quoted = 0;

  while (pos > beg &&
	 ((code = SYNTAX (CharAt (pos - 1))) == Scharquote
	  || code == Sescape))
    pos--, quoted = !quoted;
  return quoted;
}

DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
  "Scan from character number FROM by COUNT lists.\n\
Returns the character number of the position thus found.\n\
\n\
If DEPTH is nonzero, paren depth begins counting from that value,\n\
only places where the depth in parentheses becomes zero\n\
are candidates for stopping; COUNT such places are counted.\n\
Thus, a positive value for DEPTH means go out levels.\n\
\n\
Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
\n\
If the beginning or end of (the visible part of) the buffer is reached\n\
and the depth is wrong, an error is signaled.\n\
If the depth is right but the count is not used up, nil is returned.")
  (from, count, depth)
     Lisp_Object from, count, depth;
{
  CHECK_NUMBER (from, 0);
  CHECK_NUMBER (count, 1);
  CHECK_NUMBER (depth, 2);

  return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
}

DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
  "Scan from character number FROM by COUNT balanced expressions.\n\
Returns the character number of the position thus found.\n\
\n\
Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
\n\
If the beginning or end of (the visible part of) the buffer is reached\n\
in the middle of a parenthetical grouping, an error is signaled.\n\
If the beginning or end is reached between groupings but before count is used up,\n\
nil is returned.")
  (from, count)
     Lisp_Object from, count;
{
  CHECK_NUMBER (from, 0);
  CHECK_NUMBER (count, 1);

  return scan_lists (XINT (from), XINT (count), 0, 1);
}

DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
  0, 0, 0,
  "Move dot backward over any number of chars with syntax \"prefix\".")
  ()
{
  int beg = FirstCharacter;
  int pos = dot;

  while (pos > beg && !char_quoted (pos - 1) && SYNTAX (CharAt (pos - 1)) == Squote)
    pos--;

  SetDot (pos);

  return Qnil;
}

struct lisp_parse_state
  {
    int depth;		/* Depth at end of parsing */
    int instring;	/* -1 if not within string, else desired terminator. */
    int incomment;	/* Nonzero if within a comment at end of parsing */
    int quoted;		/* Nonzero if just after an escape char at end of parsing */
    int thislevelstart;	/* Char number of most recent start-of-expression at current level */
    int prevlevelstart; /* Char number of start of containing expression */
    int location;	/* Char number at which parsing stopped. */
  };

/* Parse forward from `from' to `end', assuming that `from'
is the start of a function, and return a description of the state of the parse at `end'. */

struct lisp_parse_state
scan_sexps_forward (from, end, targetdepth, stopbefore, oldstate)
     register int from;
     int end, targetdepth, stopbefore;
     Lisp_Object oldstate;
{
  struct lisp_parse_state state;

  register enum syntaxcode code;
  struct level { int last, prev; };
  struct level levelstart[100];
  register struct level *curlevel = levelstart;
  struct level *endlevel = levelstart + 100;
  char prev;
  register int depth;	/* Paren depth of current scanning location.
			   level - levelstart equals this except
			   when the depth becomes negative.  */
  Lisp_Object tem;

  immediate_quit = 1;

  if (NULL (oldstate))
    {
      depth = 0;
      state.instring = -1;
      state.incomment = 0;
      state.quoted = 0;
    }
  else
    {
      tem = Fcar (oldstate);
      if (!NULL (tem))
	depth = XINT (tem);
      else
	depth = 0;

      oldstate = Fcdr (oldstate);
      oldstate = Fcdr (oldstate);
      oldstate = Fcdr (oldstate);
      tem = Fcar (oldstate);
      state.instring = !NULL (tem) ? XINT (tem) : -1;

      oldstate = Fcdr (oldstate);
      tem = Fcar (oldstate);
      state.incomment = !NULL (tem);

      oldstate = Fcdr (oldstate);
      tem = Fcar (oldstate);
      state.quoted = !NULL (tem);
    }

  curlevel->prev = -1;

  /* Enter the loop at a place appropriate for initial state. */

  if (state.incomment) goto startincomment;
  if (state.instring >= 0)
    {
      if (state.quoted) goto startquotedinstring;
      goto startinstring;
    }
  if (state.quoted) goto startquoted;

  while (from < end)
    {
      code = SYNTAX(CharAt (from));
      from++;
      if (from < end && SYNTAX_COMSTART_FIRST (CharAt (from - 1))
	   && SYNTAX_COMSTART_SECOND (CharAt (from)))
	code = Scomment, from++;
      switch (code)
	{
	case Sescape:
	case Scharquote:
	  if (stopbefore) goto stop;  /* this arg means stop at sexp start */
	  curlevel->last = from - 1;
	startquoted:
	  if (from == end) goto endquoted;
	  from++;
	  goto symstarted;
	  /* treat following character as a word constituent */
	case Sword:
	case Ssymbol:
	  if (stopbefore) goto stop;  /* this arg means stop at sexp start */
	  curlevel->last = from - 1;
	symstarted:
	  while (from < end)
	    {
	      switch (SYNTAX(CharAt (from)))
		{
		case Scharquote:
		case Sescape:
		  from++;
		  if (from == end) goto endquoted;
		  break;
		case Sword:
		case Ssymbol:
		  break;
		default:
		  goto symdone;
		}
	      from++;
	    }
	symdone:
	  curlevel->prev = curlevel->last;
	  break;

	case Scomment:
	  state.incomment = 1;
	startincomment:
	  while (1)
	    {
	      if (from == end) goto done;
	      if (SYNTAX (prev = CharAt (from)) == Sendcomment)
		break;
	      from++;
	      if (from < end && SYNTAX_COMEND_FIRST (prev)
		   && SYNTAX_COMEND_SECOND (CharAt (from)))
		{ from++; break; }
	    }
	  state.incomment = 0;
	  break;

	case Sopen:
	  if (stopbefore) goto stop;  /* this arg means stop at sexp start */
	  depth++;
	  curlevel++->last = from - 1;
	  if (curlevel == endlevel)
	    error ("Nesting too deep for parser");
	  curlevel->prev = -1;
	  curlevel->last = -1;
	  if (!--targetdepth) goto done;
	  break;

	case Sclose:
	  depth--;
	  if (curlevel != levelstart)
	    curlevel--;
	  curlevel->prev = curlevel->last;
	  if (!++targetdepth) goto done;
	  break;

	case Sstring:
	  if (stopbefore) goto stop;  /* this arg means stop at sexp start */
	  curlevel->last = from - 1;
	  state.instring = CharAt (from - 1);
	startinstring:
	  while (1)
	    {
	      if (from >= end) goto done;
	      if (CharAt (from) == state.instring) break;
	      switch (SYNTAX(CharAt (from)))
		{
		case Scharquote:
		case Sescape:
		  if (from >= end) goto endquoted;
		startquotedinstring:
		  from++;
		}
	      from++;
	    }
	  state.instring = -1;
	  curlevel->prev = curlevel->last;
	  from++;
	  break;

	case Smath:
	  break;
	}
    }
  goto done;

 stop:   /* Here if stopping before start of sexp. */
  from--;    /* We have just fetched the char that starts it; */
  goto done; /* but return the position before it. */

 endquoted:
  state.quoted = 1;
 done:
  state.depth = depth;
  state.thislevelstart = curlevel->prev;
  state.prevlevelstart
    = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
  state.location = from;
  immediate_quit = 0;
  return state;
}

DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 5, 0,
  0 /* See auxdoc.c */)
  (from, to, targetdepth, stopbefore, oldstate)
     Lisp_Object from, to, targetdepth, stopbefore, oldstate;
{
  struct lisp_parse_state state;
  int target;

  if (!NULL (targetdepth))
    {
      CHECK_NUMBER (targetdepth, 3);
      target = XINT (targetdepth);
    }
  else
    target = -100000;		/* We won't reach this depth */

  validate_region (&from, &to);
  state = scan_sexps_forward (XINT (from), XINT (to),
			      target, !NULL (stopbefore), oldstate);

  SetDot (state.location);
  
  return Fcons (make_number (state.depth),
	   Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
	     Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
	       Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil,
		 Fcons (state.incomment ? Qt : Qnil,
		   Fcons (state.quoted ? Qt : Qnil, Qnil))))));
}

init_syntax_once ()
{
  register int i;
  register struct Lisp_Vector *v;

  /* Set this now, so first buffer creation can refer to it. */
  /* Make it nil before calling make-syntax-table
    so that make-syntax-table will know not to try to copy from garbage */
  Vstandard_syntax_table = Qnil;
  Vstandard_syntax_table = Fmake_syntax_table ();

  v = XVECTOR (Vstandard_syntax_table);

  for (i = 'a'; i <= 'z'; i++)
    XFASTINT (v->contents[i]) = (int) Sword;
  for (i = 'A'; i <= 'Z'; i++)
    XFASTINT (v->contents[i]) = (int) Sword;
  for (i = '0'; i <= '9'; i++)
    XFASTINT (v->contents[i]) = (int) Sword;
  XFASTINT (v->contents['$']) = (int) Sword;
  XFASTINT (v->contents['%']) = (int) Sword;

  XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8);
  XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8);
  XFASTINT (v->contents['"']) = (int) Sstring;
  XFASTINT (v->contents['\\']) = (int) Sescape;

  XFASTINT (v->contents['_']) = (int) Ssymbol;
  XFASTINT (v->contents['-']) = (int) Ssymbol;
  XFASTINT (v->contents['+']) = (int) Ssymbol;
  XFASTINT (v->contents['*']) = (int) Ssymbol;
  XFASTINT (v->contents['/']) = (int) Ssymbol;
  XFASTINT (v->contents['<']) = (int) Ssymbol;
  XFASTINT (v->contents['>']) = (int) Ssymbol;
  XFASTINT (v->contents['=']) = (int) Ssymbol;
}

syms_of_syntax ()
{
  Qsyntax_table_p = intern ("syntax-table-p");
  staticpro (&Qsyntax_table_p);

/* Mustn't let user clobber this!
  DefLispVar ("standard-syntax-table", &Vstandard_syntax_table,
    "The syntax table used by buffers that don't specify another.");
 */
  staticpro (&Vstandard_syntax_table);

  DefBoolVar ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
    "Non-nil means forward-sexp, etc., should treat comments as whitespace.\n\
Non-nil works only when the comment terminator is something like *\/,\n\
and appears only when it ends a comment.\n\
If comments are terminated by newlines,\n\
you must make this variable nil.");

  defsubr (&Ssyntax_table_p);
  defsubr (&Ssyntax_table);
  defsubr (&Sstandard_syntax_table);
  defsubr (&Smake_syntax_table);
  defsubr (&Sset_syntax_table);
  defsubr (&Schar_syntax);
  defsubr (&Smodify_syntax_entry);
  defsubr (&Sdescribe_syntax);

  defsubr (&Sforward_word);

  defsubr (&Sscan_lists);
  defsubr (&Sscan_sexps);
  defsubr (&Sbackward_prefix_chars);
  defsubr (&Sparse_partial_sexp);
}
