]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
Version 3.15
[gnu-emacs] / src / lread.c
index e4663e0eb89db1dba7c64b232a32bbf7349ef660..bbe421c0eb5c18baf17311a2562aa3105498137a 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp parsing and input streams.
-   Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
-      Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
+                 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,8 +17,8 @@ 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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
@@ -61,6 +62,9 @@ Boston, MA 02111-1307, USA.  */
 #include <locale.h>
 #endif /* HAVE_SETLOCALE */
 
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
 #ifndef O_RDONLY
 #define O_RDONLY 0
 #endif
@@ -82,11 +86,12 @@ Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist
 Lisp_Object Qascii_character, Qload, Qload_file_name;
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 Lisp_Object Qinhibit_file_name_operation;
+Lisp_Object Qeval_buffer_list, Veval_buffer_list;
 
 extern Lisp_Object Qevent_symbol_element_mask;
 extern Lisp_Object Qfile_exists_p;
 
-/* non-zero if inside `load' */
+/* non-zero iff inside `load' */
 int load_in_progress;
 
 /* Directory in which the sources were found.  */
@@ -203,6 +208,7 @@ static Lisp_Object Vbytecomp_version_regexp;
 static void to_multibyte P_ ((char **, char **, int *));
 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
                              Lisp_Object (*) (), int,
+                             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));
@@ -319,6 +325,7 @@ readchar (readcharfun)
       /* Interrupted reads have been observed while reading over the network */
       while (c == EOF && ferror (instream) && errno == EINTR)
        {
+         QUIT;
          clearerr (instream);
          c = getc (instream);
        }
@@ -668,7 +675,6 @@ Return t if file exists.  */)
 {
   register FILE *stream;
   register int fd = -1;
-  register Lisp_Object lispstream;
   int count = SPECPDL_INDEX ();
   Lisp_Object temp;
   struct gcpro gcpro1;
@@ -898,17 +904,15 @@ Return t if file exists.  */)
     }
 
   GCPRO1 (file);
-  lispstream = Fcons (Qnil, Qnil);
-  XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
-  XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
-  record_unwind_protect (load_unwind, lispstream);
+  record_unwind_protect (load_unwind, make_save_value (stream, 0));
   record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
   specbind (Qload_file_name, found);
   specbind (Qinhibit_file_name_operation, Qnil);
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
-  readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
+  readevalloop (Qget_file_char, stream, file, Feval,
+               0, Qnil, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
   /* Run any load-hooks for this file.  */
@@ -941,15 +945,21 @@ Return t if file exists.  */)
        message_with_string ("Loading %s...done", file, 1);
     }
 
+  if (!NILP (Fequal (build_string ("obsolete"),
+                    Ffile_name_nondirectory
+                    (Fdirectory_file_name (Ffile_name_directory (found))))))
+    message_with_string ("Package %s is obsolete", file, 1);
+
   return Qt;
 }
 
 static Lisp_Object
-load_unwind (stream)  /* used as unwind-protect function in load */
-     Lisp_Object stream;
+load_unwind (arg)  /* used as unwind-protect function in load */
+     Lisp_Object arg;
 {
-  fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
-                   | XFASTINT (XCDR (stream))));
+  FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
+  if (stream != NULL)
+    fclose (stream);
   if (--load_in_progress < 0) load_in_progress = 0;
   return Qnil;
 }
@@ -994,6 +1004,7 @@ complete_filename_p (pathname)
 
 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
        doc: /* Search for FILENAME through PATH.
+Returns the file's name in absolute form, or nil if not found.
 If SUFFIXES is non-nil, it should be a list of suffixes to append to
 file name when searching.
 If non-nil, PREDICATE is used instead of `file-readable-p'.
@@ -1049,6 +1060,8 @@ openp (path, str, suffixes, storeptr, predicate)
   Lisp_Object string, tail, encoded_fn;
   int max_suffix_len = 0;
 
+  CHECK_STRING (str);
+
   for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
     {
       CHECK_STRING_CAR (tail);
@@ -1279,16 +1292,19 @@ end_of_file_error ()
 
 /* UNIBYTE specifies how to set load_convert_to_unibyte
    for this invocation.
-   READFUN, if non-nil, is used instead of `read'.  */
+   READFUN, if non-nil, is used instead of `read'.
+   START, END is region in current buffer (from eval-region).  */
 
 static void
-readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun)
+readevalloop (readcharfun, stream, sourcename, evalfun,
+             printflag, unibyte, readfun, start, end)
      Lisp_Object readcharfun;
      FILE *stream;
      Lisp_Object sourcename;
      Lisp_Object (*evalfun) ();
      int printflag;
      Lisp_Object unibyte, readfun;
+     Lisp_Object start, end;
 {
   register int c;
   register Lisp_Object val;
@@ -1316,28 +1332,41 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
   continue_reading_p = 1;
   while (continue_reading_p)
     {
+      int count1 = SPECPDL_INDEX ();
+
       if (b != 0 && NILP (b->name))
        error ("Reading from killed buffer");
 
+      if (!NILP (start))
+       {
+         record_unwind_protect (save_excursion_restore, save_excursion_save ());
+         record_unwind_protect (save_restriction_restore, save_restriction_save ());
+         Fgoto_char (start);
+         Fnarrow_to_region (make_number (BEGV), end);
+       }
+
       instream = stream;
+    read_next:
       c = READCHAR;
       if (c == ';')
        {
          while ((c = READCHAR) != '\n' && c != -1);
-         continue;
+         goto read_next;
+       }
+      if (c < 0)
+       {
+         unbind_to (count1, Qnil);
+         break;
        }
-      if (c < 0) break;
 
       /* Ignore whitespace here, so we can detect eof.  */
       if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
-       continue;
+       goto read_next;
 
       if (!NILP (Vpurify_flag) && c == '(')
        {
-         int count1 = SPECPDL_INDEX ();
          record_unwind_protect (unreadpure, Qnil);
          val = read_list (-1, readcharfun);
-         unbind_to (count1, Qnil);
        }
       else
        {
@@ -1363,6 +1392,10 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
            val = read_internal_start (readcharfun, Qnil, Qnil);
        }
 
+      if (!NILP (start) && continue_reading_p)
+       start = Fpoint_marker ();
+      unbind_to (count1, Qnil);
+
       val = (*evalfun) (val);
 
       if (printflag)
@@ -1418,10 +1451,12 @@ This function preserves the position of point.  */)
   if (NILP (filename))
     filename = XBUFFER (buf)->filename;
 
+  specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
   specbind (Qstandard_output, tem);
   record_unwind_protect (save_excursion_restore, save_excursion_save ());
   BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
-  readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil);
+  readevalloop (buf, 0, filename, Feval,
+               !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
   return Qnil;
@@ -1452,16 +1487,12 @@ This function does not move point.  */)
   else
     tem = printflag;
   specbind (Qstandard_output, tem);
+  specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
 
-  if (NILP (printflag))
-    record_unwind_protect (save_excursion_restore, save_excursion_save ());
-  record_unwind_protect (save_restriction_restore, save_restriction_save ());
-
-  /* This both uses start and checks its type.  */
-  Fgoto_char (start);
-  Fnarrow_to_region (make_number (BEGV), end);
+  /* readevalloop calls functions which check the type of start and end.  */
   readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
-               !NILP (printflag), Qnil, read_function);
+               !NILP (printflag), Qnil, read_function,
+               start, end);
 
   return unbind_to (count, Qnil);
 }
@@ -1983,8 +2014,9 @@ read1 (readcharfun, pch, first_in_list)
          if (c == '"')
            {
              Lisp_Object tmp, val;
-             int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1)
-                                  / BITS_PER_CHAR);
+             int size_in_chars
+               = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+                  / BOOL_VECTOR_BITS_PER_CHAR);
 
              UNREAD (c);
              tmp = read1 (readcharfun, pch, first_in_list);
@@ -1993,7 +2025,7 @@ read1 (readcharfun, pch, first_in_list)
                     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) * BITS_PER_CHAR))
+                       == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
                Fsignal (Qinvalid_read_syntax,
                         Fcons (make_string ("#&...", 5), Qnil));
 
@@ -2001,9 +2033,9 @@ read1 (readcharfun, pch, first_in_list)
              bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
                     size_in_chars);
              /* Clear the extraneous bits in the last byte.  */
-             if (XINT (length) != size_in_chars * BITS_PER_CHAR)
+             if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
                XBOOL_VECTOR (val)->data[size_in_chars - 1]
-                 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;
+                 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
              return val;
            }
          Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
@@ -2278,16 +2310,18 @@ read1 (readcharfun, pch, first_in_list)
            UNREAD (next_next_char);
 
            ok = (next_next_char <= 040
-                 || index ("\"';([#?", next_next_char)
-                 || (!first_in_list && next_next_char == '`')
-                 || (new_backquote_flag && next_next_char == ','));
+                 || (next_next_char < 0200
+                     && (index ("\"';([#?", next_next_char)
+                         || (!first_in_list && next_next_char == '`')
+                         || (new_backquote_flag && next_next_char == ','))));
          }
        else
          {
            ok = (next_char <= 040
-                 || index ("\"';()[]#?", next_char)
-                 || (!first_in_list && next_char == '`')
-                 || (new_backquote_flag && next_char == ','));
+                 || (next_char < 0200
+                     && (index ("\"';()[]#?", next_char)
+                         || (!first_in_list && next_char == '`')
+                         || (new_backquote_flag && next_char == ','))));
          }
        UNREAD (next_char);
        if (!ok)
@@ -2445,9 +2479,10 @@ read1 (readcharfun, pch, first_in_list)
        UNREAD (next_char);
 
        if (next_char <= 040
-           || index ("\"';([#?", next_char)
-           || (!first_in_list && next_char == '`')
-           || (new_backquote_flag && next_char == ','))
+           || (next_char < 0200
+               && (index ("\"';([#?", next_char)
+                   || (!first_in_list && next_char == '`')
+                   || (new_backquote_flag && next_char == ','))))
          {
            *pch = c;
            return Qnil;
@@ -2468,9 +2503,10 @@ read1 (readcharfun, pch, first_in_list)
          char *end = read_buffer + read_buffer_size;
 
          while (c > 040
-                && !index ("\"';()[]#", c)
-                && !(!first_in_list && c == '`')
-                && !(new_backquote_flag && c == ','))
+                && (c >= 0200
+                    || (!index ("\"';()[]#", c)
+                        && !(!first_in_list && c == '`')
+                        && !(new_backquote_flag && c == ','))))
            {
              if (end - p < MAX_MULTIBYTE_LENGTH)
                {
@@ -2560,6 +2596,23 @@ read1 (readcharfun, pch, first_in_list)
                    break;
                  case 'N':
                    value = zero / zero;
+
+                   /* If that made a "negative" NaN, negate it.  */
+
+                   {
+                     int i;
+                     union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+
+                     u_data.d = value;
+                     u_minus_zero.d = - 0.0;
+                     for (i = 0; i < sizeof (double); i++)
+                       if (u_data.c[i] & u_minus_zero.c[i])
+                         {
+                           value = - value;
+                           break;
+                         }
+                   }
+                   /* Now VALUE is a positive NaN.  */
                    break;
                  default:
                    value = atof (read_buffer + negative);
@@ -2810,7 +2863,7 @@ read_vector (readcharfun, bytecodeflag)
          if (i == COMPILED_BYTECODE)
            {
              if (!STRINGP (item))
-               error ("invalid byte code");
+               error ("Invalid byte code");
 
              /* Delay handling the bytecode slot until we know whether
                 it is lazily-loaded (we can tell by whether the
@@ -2832,7 +2885,7 @@ read_vector (readcharfun, bytecodeflag)
 
                  item = Fread (bytestr);
                  if (!CONSP (item))
-                   error ("invalid byte code");
+                   error ("Invalid byte code");
 
                  otem = XCONS (item);
                  bytestr = XCAR (item);
@@ -3261,7 +3314,7 @@ oblookup (obarray, ptr, size, size_byte)
   hash %= obsize;
   bucket = XVECTOR (obarray)->contents[hash];
   oblookup_last_bucket_number = hash;
-  if (XFASTINT (bucket) == 0)
+  if (EQ (bucket, make_number (0)))
     ;
   else if (!SYMBOLP (bucket))
     error ("Bad data in guts of obarray"); /* Like CADR error message */
@@ -3481,7 +3534,6 @@ defvar_per_buffer (namestring, address, type, doc)
 {
   Lisp_Object sym, val;
   int offset;
-  extern struct buffer buffer_local_symbols;
 
   sym = intern (namestring);
   val = allocate_misc ();
@@ -3663,11 +3715,15 @@ init_lread ()
     }
 #endif
 
-#ifndef WINDOWSNT
+#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
   /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
      almost never correct, thereby causing a warning to be printed out that
      confuses users.  Since PATH_LOADSEARCH is always overridden by the
-     EMACSLOADPATH environment variable below, disable the warning on NT.  */
+     EMACSLOADPATH environment variable below, disable the warning on NT.
+     Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
+     the "standard" paths may not exist and would be overridden by
+     EMACSLOADPATH as on NT.  Since this depends on how the executable
+     was build and packaged, turn off the warnings in general */
 
   /* Warn if dirs in the *standard* path don't exist.  */
   if (!turn_off_warning)
@@ -3689,7 +3745,7 @@ init_lread ()
            }
        }
     }
-#endif /* WINDOWSNT */
+#endif /* !(WINDOWSNT || HAVE_CARBON) */
 
   /* If the EMACSLOADPATH environment variable is set, use its value.
      This doesn't apply if we're dumping.  */
@@ -3827,10 +3883,10 @@ when the corresponding call to `provide' is made.  */);
 Each alist element is a list that starts with a file name,
 except for one element (optional) that starts with nil and describes
 definitions evaluated from buffers not visiting files.
-The remaining elements of each list are symbols defined as functions,
+The remaining elements of each list are symbols defined as variables
 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
-`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
-An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
+`(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
+An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
 and means that SYMBOL was an autoload before this file redefined it
 as a function.  */);
   Vload_history = Qnil;
@@ -3841,8 +3897,8 @@ as a function.  */);
 
   DEFVAR_LISP ("user-init-file", &Vuser_init_file,
               doc: /* File name, including directory, of user's initialization file.
-If the file loaded had extension `.elc' and there was a corresponding `.el'
-file, this variable contains the name of the .el file, suitable for use
+If the file loaded had extension `.elc', and the corresponding source file
+exists, this variable contains the name of source file, suitable for use
 by functions like `custom-save-all' which edit the init file.  */);
   Vuser_init_file = Qnil;
 
@@ -3906,6 +3962,10 @@ to load.  See also `load-dangerous-libraries'.  */);
   Vbytecomp_version_regexp
     = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
 
+  DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
+              doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'.  */);
+  Veval_buffer_list = Qnil;
+
   /* Vsource_directory was initialized in init_lread.  */
 
   load_descriptor_list = Qnil;
@@ -3947,12 +4007,19 @@ to load.  See also `load-dangerous-libraries'.  */);
   Qload_file_name = intern ("load-file-name");
   staticpro (&Qload_file_name);
 
+  Qeval_buffer_list = intern ("eval-buffer-list");
+  staticpro (&Qeval_buffer_list);
+
   staticpro (&dump_path);
 
   staticpro (&read_objects);
   read_objects = Qnil;
   staticpro (&seen_list);
+  seen_list = Qnil;
 
   Vloads_in_progress = Qnil;
   staticpro (&Vloads_in_progress);
 }
+
+/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
+   (do not change this comment) */