]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
Version 3.15
[gnu-emacs] / src / lread.c
index 6d082203fe0a2af8d6e71aba40ec5b668516e6ef..bbe421c0eb5c18baf17311a2562aa3105498137a 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp parsing and input streams.
-   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998,
-     1999, 2000, 2001, 2003, 2004  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>
@@ -85,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.  */
@@ -206,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));
@@ -672,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;
@@ -902,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.  */
@@ -954,11 +954,12 @@ Return t if file exists.  */)
 }
 
 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;
 }
@@ -1003,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'.
@@ -1290,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;
@@ -1327,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
        {
@@ -1374,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)
@@ -1429,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;
@@ -1463,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);
 }
@@ -2576,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);
@@ -2826,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
@@ -2848,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);
@@ -3860,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;
 
@@ -3925,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;
@@ -3966,11 +4007,15 @@ 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);