comparison src/lread.c @ 83533:02e39decdc84

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-351 Update from CVS * [e-mail]/emacs--devo--0--patch-352 Update from CVS * [e-mail]/emacs--devo--0--patch-353 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-354 Update from CVS * [e-mail]/emacs--devo--0--patch-355 Update from CVS * [e-mail]/emacs--devo--0--patch-356 Update from CVS * [e-mail]/emacs--devo--0--patch-357 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-358 Update from CVS * [e-mail]/emacs--devo--0--patch-359 Update from CVS * [e-mail]/emacs--devo--0--patch-360 Update from CVS * [e-mail]/emacs--devo--0--patch-361 Update from CVS * [e-mail]/emacs--devo--0--patch-362 Update from CVS * [e-mail]/emacs--devo--0--patch-363 Update from CVS * [e-mail]/emacs--devo--0--patch-364 Update from CVS * [e-mail]/emacs--devo--0--patch-365 Update from CVS * [e-mail]/emacs--devo--0--patch-366 Update from CVS * [e-mail]/emacs--devo--0--patch-367 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-368 Update from CVS * [e-mail]/emacs--devo--0--patch-369 Update from CVS * [e-mail]/emacs--devo--0--patch-370 Update from CVS * [e-mail]/gnus--rel--5.10--patch-115 Update from CVS * [e-mail]/gnus--rel--5.10--patch-116 Update from CVS * [e-mail]/gnus--rel--5.10--patch-117 Update from CVS * [e-mail]/gnus--rel--5.10--patch-118 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-119 Update from CVS * [e-mail]/gnus--rel--5.10--patch-120 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-573

83532:b19aaf4ab0ee

			      Lisp_Object, Lisp_Object,
			      Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));


/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again.

static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));


/* Get a character from the tty.  */

extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *));

/* Read input events until we get one that's acceptable for our purposes.

   If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
   until we get a character we like, and then stuffed into
   unread_switch_frame.

   get isn't an ASCII character with modifiers.  If it's zero but
   ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
   character.

   If INPUT_METHOD is nonzero, we invoke the current input method
   if the character warrants that.  */

Lisp_Object
read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
		     input_method)
     int no_switch_frame, ascii_required, error_nonascii, input_method;
{
  Lisp_Object val, delayed_switch_frame;

#ifdef HAVE_WINDOW_SYSTEM
  if (display_hourglass_p)
    cancel_hourglass ();
#endif

  delayed_switch_frame = Qnil;

  /* Read until we get an acceptable event.  */
 retry:
  do 
    val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0);
  while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */

  if (BUFFERP (val))
    goto retry;

    {
      delayed_switch_frame = val;
      goto retry;
    }

  if (ascii_required)
    {
      /* Convert certain symbols to their ASCII equivalents.  */
      if (SYMBOLP (val))
	{
	  Lisp_Object tem, tem1;

#endif

  return val;
}

DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
If the user generates an event which is not a character (i.e. a mouse
click or function key event), `read-char' signals an error.  As an
exception, switch-frame events are put off until non-ASCII events can

`read-event' or `read-char-exclusive' instead.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.  */)
     (prompt, inherit_input_method)
     Lisp_Object prompt, inherit_input_method;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method));
}

DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0,
       doc: /* Read an event object from the input stream.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.  */)
     (prompt, inherit_input_method)
     Lisp_Object prompt, inherit_input_method;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method));
}

DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0,
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.  Non-character events are ignored.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.  */)
     (prompt, inherit_input_method)
     Lisp_Object prompt, inherit_input_method;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method));
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
       doc: /* Don't use this yourself.  */)
     ()

    }

  if (fd == -1)
    {
      if (NILP (noerror))
	Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
				     Fcons (file, Qnil)));
      else
	return Qnil;
    }

  /* Tell startup.el whether or not we found the user's init file.  */
  if (EQ (Qt, Vuser_init_file))
    Vuser_init_file = found;

	count++;
    if (count > 3)
      {
	if (fd >= 0)
	  emacs_close (fd);
	Fsignal (Qerror, Fcons (build_string ("Recursive load"),
				Fcons (found, Vloads_in_progress)));
      }
    record_unwind_protect (record_load_unwind, Vloads_in_progress);
    Vloads_in_progress = Fcons (found, Vloads_in_progress);
  }

end_of_file_error ()
{
  Lisp_Object data;

  if (STRINGP (Vload_file_name))
    data = Fcons (Vload_file_name, Qnil);
  else
    data = Qnil;

  Fsignal (Qend_of_file, data);
}

/* UNIBYTE specifies how to set load_convert_to_unibyte
   for this invocation.
   READFUN, if non-nil, is used instead of `read'.

      || EQ (Vread_with_symbol_positions, stream))
    Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
  return retval;
}

/* Use this for recursive reads, in contexts where internal tokens
   are not allowed. */

static Lisp_Object
read0 (readcharfun)

{
  register Lisp_Object val;
  int c;

  val = read1 (readcharfun, &c, 0);
  if (c)
    Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
							make_number (c)),
					  Qnil));

  return val;
}

static int read_buffer_size;
static char *read_buffer;

	c = read_multibyte (c, readcharfun);
      return c;
    }
}


/* Read an integer in radix RADIX using READCHARFUN to read
   characters.  RADIX must be in the interval [2..36]; if it isn't, a
   read error is signaled .  Value is the integer read.  Signals an
   error if encountering invalid read syntax or if RADIX is out of
   range.  */

  if (ndigits == 0 || invalid_p)
    {
      char buf[50];
      sprintf (buf, "integer, radix %d", radix);
      Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
    }

  return make_number (sign * number);
}

		    error ("Invalid size char-table");
		  XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
		  XCHAR_TABLE (tmp)->top = Qnil;
		  return tmp;
		}
	      Fsignal (Qinvalid_read_syntax,
		       Fcons (make_string ("#^^", 3), Qnil));
	    }
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
	}
      if (c == '&')
	{
	  Lisp_Object length;
	  length = read1 (readcharfun, pch, first_in_list);

		  /* We used to print 1 char too many
		     when the number of bits was a multiple of 8.
		     Accept such input in case it came from an old version.  */
		  && ! (XFASTINT (length)
			== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
		Fsignal (Qinvalid_read_syntax,
			 Fcons (make_string ("#&...", 5), Qnil));

	      val = Fmake_bool_vector (length, Qnil);
	      bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
		     size_in_chars);
	      /* Clear the extraneous bits in the last byte.  */
	      if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
		XBOOL_VECTOR (val)->data[size_in_chars - 1]
		  &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
	      return val;
	    }
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
						Qnil));
	}
      if (c == '[')
	{
	  /* Accept compiled functions at read-time so that we don't have to
	     build them using function calls.  */

	  int ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch, 0);
	  if (ch != 0 || !STRINGP (tmp))
	    Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      if (ch == 0)
		end = read1 (readcharfun, &ch, 0);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch, 0);
	      if (ch)
		Fsignal (Qinvalid_read_syntax,
			 Fcons (build_string ("invalid string property list"),
				Qnil));
	      Fset_text_properties (beg, end, plist, tmp);
	    }
	  UNGCPRO;
	  return tmp;
	}

	return read_integer (readcharfun, 8);
      else if (c == 'b' || c == 'B')
	return read_integer (readcharfun, 2);

      UNREAD (c);
      Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));

    case ';':
      while ((c = READCHAR) >= 0 && c != '\n');
      goto retry;

		      && (index ("\"';()[]#?", next_char)
			  || (!first_in_list && next_char == '`')
			  || (new_backquote_flag && next_char == ','))));
	  }
	UNREAD (next_char);
	if (!ok)
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));

	return make_number (c);
      }

    case '"':
      {
	char *p = read_buffer;

	{
	  if (flag > 0)
	    {
	      if (ch == ']')
		return val;
	      Fsignal (Qinvalid_read_syntax,
		       Fcons (make_string (") or . in a vector", 18), Qnil));
	    }
	  if (ch == ')')
	    return val;
	  if (ch == '.')
	    {

			return get_doc_string (val, 0, 0);
		    }

		  return val;
		}
	      return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
	    }
	  return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
	}
      tem = (read_pure && flag <= 0
	     ? pure_cons (elt, Qnil)
	     : Fcons (elt, Qnil));
      if (!NILP (tail))

83533:02e39decdc84

			      Lisp_Object, Lisp_Object,
			      Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));

static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
static void end_of_file_error P_ (()) NO_RETURN;


/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again.

static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));


/* Get a character from the tty.  */

/* Read input events until we get one that's acceptable for our purposes.

   If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
   until we get a character we like, and then stuffed into
   unread_switch_frame.

   get isn't an ASCII character with modifiers.  If it's zero but
   ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
   character.

   If INPUT_METHOD is nonzero, we invoke the current input method
   if the character warrants that.

   If SECONDS is a number, we wait that many seconds for input, and
   return Qnil if no input arrives within that time.  */

Lisp_Object
read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
		     input_method, seconds)
     int no_switch_frame, ascii_required, error_nonascii, input_method;
     Lisp_Object seconds;
{
  Lisp_Object val, delayed_switch_frame;
  EMACS_TIME end_time;

#ifdef HAVE_WINDOW_SYSTEM
  if (display_hourglass_p)
    cancel_hourglass ();
#endif

  delayed_switch_frame = Qnil;

  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
      EMACS_TIME wait_time;
      int sec, usec;
      double duration = extract_float (seconds);

      sec  = (int) duration;
      usec = (duration - sec) * 1000000;
      EMACS_GET_TIME (end_time);
      EMACS_SET_SECS_USECS (wait_time, sec, usec);
      EMACS_ADD_TIME (end_time, end_time, wait_time);
    }

/* Read until we get an acceptable event.  */
 retry:
  do 
    val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
		     NUMBERP (seconds) ? &end_time : NULL);
  while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */

  if (BUFFERP (val))
    goto retry;

    {
      delayed_switch_frame = val;
      goto retry;
    }

  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
    {
      /* Convert certain symbols to their ASCII equivalents.  */
      if (SYMBOLP (val))
	{
	  Lisp_Object tem, tem1;

#endif

  return val;
}

DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
If the user generates an event which is not a character (i.e. a mouse
click or function key event), `read-char' signals an error.  As an
exception, switch-frame events are put off until non-ASCII events can

`read-event' or `read-char-exclusive' instead.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
     (prompt, inherit_input_method, seconds)
     Lisp_Object prompt, inherit_input_method, seconds;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
}

DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
       doc: /* Read an event object from the input stream.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
     (prompt, inherit_input_method, seconds)
     Lisp_Object prompt, inherit_input_method, seconds;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
}

DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.  Non-character events are ignored.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
     (prompt, inherit_input_method, seconds)
     Lisp_Object prompt, inherit_input_method, seconds;
{
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
  return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
       doc: /* Don't use this yourself.  */)
     ()

    }

  if (fd == -1)
    {
      if (NILP (noerror))
	xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
      return Qnil;
    }

  /* Tell startup.el whether or not we found the user's init file.  */
  if (EQ (Qt, Vuser_init_file))
    Vuser_init_file = found;

	count++;
    if (count > 3)
      {
	if (fd >= 0)
	  emacs_close (fd);
	signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
      }
    record_unwind_protect (record_load_unwind, Vloads_in_progress);
    Vloads_in_progress = Fcons (found, Vloads_in_progress);
  }

end_of_file_error ()
{
  Lisp_Object data;

  if (STRINGP (Vload_file_name))
    xsignal1 (Qend_of_file, Vload_file_name);

  xsignal0 (Qend_of_file);
}

/* UNIBYTE specifies how to set load_convert_to_unibyte
   for this invocation.
   READFUN, if non-nil, is used instead of `read'.

      || EQ (Vread_with_symbol_positions, stream))
    Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
  return retval;
}


/* Signal Qinvalid_read_syntax error.
   S is error string of length N (if > 0)  */

static void
invalid_syntax (s, n)
     const char *s;
     int n;
{
  if (!n)
    n = strlen (s);
  xsignal1 (Qinvalid_read_syntax, make_string (s, n));
}


/* Use this for recursive reads, in contexts where internal tokens
   are not allowed. */

static Lisp_Object
read0 (readcharfun)

{
  register Lisp_Object val;
  int c;

  val = read1 (readcharfun, &c, 0);
  if (!c)
    return val;

  xsignal1 (Qinvalid_read_syntax,
	    Fmake_string (make_number (1), make_number (c)));
}

static int read_buffer_size;
static char *read_buffer;

	c = read_multibyte (c, readcharfun);
      return c;
    }
}

/* Read an integer in radix RADIX using READCHARFUN to read
   characters.  RADIX must be in the interval [2..36]; if it isn't, a
   read error is signaled .  Value is the integer read.  Signals an
   error if encountering invalid read syntax or if RADIX is out of
   range.  */

  if (ndigits == 0 || invalid_p)
    {
      char buf[50];
      sprintf (buf, "integer, radix %d", radix);
      invalid_syntax (buf, 0);
    }

  return make_number (sign * number);
}

		    error ("Invalid size char-table");
		  XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
		  XCHAR_TABLE (tmp)->top = Qnil;
		  return tmp;
		}
	      invalid_syntax ("#^^", 3);
	    }
	  invalid_syntax ("#^", 2);
	}
      if (c == '&')
	{
	  Lisp_Object length;
	  length = read1 (readcharfun, pch, first_in_list);

		  /* We used to print 1 char too many
		     when the number of bits was a multiple of 8.
		     Accept such input in case it came from an old version.  */
		  && ! (XFASTINT (length)
			== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
		invalid_syntax ("#&...", 5);

	      val = Fmake_bool_vector (length, Qnil);
	      bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
		     size_in_chars);
	      /* Clear the extraneous bits in the last byte.  */
	      if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
		XBOOL_VECTOR (val)->data[size_in_chars - 1]
		  &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
	      return val;
	    }
	  invalid_syntax ("#&...", 5);
	}
      if (c == '[')
	{
	  /* Accept compiled functions at read-time so that we don't have to
	     build them using function calls.  */

	  int ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch, 0);
	  if (ch != 0 || !STRINGP (tmp))
	    invalid_syntax ("#", 1);
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      if (ch == 0)
		end = read1 (readcharfun, &ch, 0);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch, 0);
	      if (ch)
		invalid_syntax ("Invalid string property list", 0);
	      Fset_text_properties (beg, end, plist, tmp);
	    }
	  UNGCPRO;
	  return tmp;
	}

	return read_integer (readcharfun, 8);
      else if (c == 'b' || c == 'B')
	return read_integer (readcharfun, 2);

      UNREAD (c);
      invalid_syntax ("#", 1);

    case ';':
      while ((c = READCHAR) >= 0 && c != '\n');
      goto retry;

		      && (index ("\"';()[]#?", next_char)
			  || (!first_in_list && next_char == '`')
			  || (new_backquote_flag && next_char == ','))));
	  }
	UNREAD (next_char);
	if (ok)
	  return make_number (c);

	invalid_syntax ("?", 1);
      }

    case '"':
      {
	char *p = read_buffer;

	{
	  if (flag > 0)
	    {
	      if (ch == ']')
		return val;
	      invalid_syntax (") or . in a vector", 18);
	    }
	  if (ch == ')')
	    return val;
	  if (ch == '.')
	    {

			return get_doc_string (val, 0, 0);
		    }

		  return val;
		}
	      invalid_syntax (". in wrong context", 18);
	    }
	  invalid_syntax ("] in a list", 11);
	}
      tem = (read_pure && flag <= 0
	     ? pure_cons (elt, Qnil)
	     : Fcons (elt, Qnil));
      if (!NILP (tail))