]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
(struct image): New member `corners'.
[gnu-emacs] / src / lread.c
index cb455ebbb002d8d1ea5f23b199a9b5bde09c5fdb..892c102c58f61d2abf49a040d13a0a6f86a8eacb 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, 2005  Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
+                 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -97,7 +98,7 @@ int load_in_progress;
 Lisp_Object Vsource_directory;
 
 /* Search path and suffixes for files to be loaded. */
-Lisp_Object Vload_path, Vload_suffixes, default_suffixes;
+Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
 
 /* File name of user's init file.  */
 Lisp_Object Vuser_init_file;
@@ -652,23 +653,64 @@ load_error_handler (data)
   return Qnil;
 }
 
+DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
+       doc: /* Return the suffixes that `load' should try if a suffix is \
+required.
+This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
+     ()
+{
+  Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
+  while (CONSP (suffixes))
+    {
+      Lisp_Object exts = Vload_file_rep_suffixes;
+      suffix = XCAR (suffixes);
+      suffixes = XCDR (suffixes);
+      while (CONSP (exts))
+       {
+         ext = XCAR (exts);
+         exts = XCDR (exts);
+         lst = Fcons (concat2 (suffix, ext), lst);
+       }
+    }
+  return Fnreverse (lst);
+}
+
 DEFUN ("load", Fload, Sload, 1, 5, 0,
        doc: /* Execute a file of Lisp code named FILE.
 First try FILE with `.elc' appended, then try with `.el',
- then try FILE unmodified (the exact suffixes are determined by
-`load-suffixes').  Environment variable references in FILE
- are replaced with their values by calling `substitute-in-file-name'.
+then try FILE unmodified (the exact suffixes in the exact order are
+determined by  `load-suffixes').  Environment variable references in
+FILE are replaced with their values by calling `substitute-in-file-name'.
 This function searches the directories in `load-path'.
+
 If optional second arg NOERROR is non-nil,
- report no error if FILE doesn't exist.
+report no error if FILE doesn't exist.
 Print messages at start and end of loading unless
- optional third arg NOMESSAGE is non-nil.
+optional third arg NOMESSAGE is non-nil.
 If optional fourth arg NOSUFFIX is non-nil, don't try adding
- suffixes `.elc' or `.el' to the specified name FILE.
+suffixes `.elc' or `.el' to the specified name FILE.
 If optional fifth arg MUST-SUFFIX is non-nil, insist on
- the suffix `.elc' or `.el'; don't accept just FILE unless
- it ends in one of those suffixes or includes a directory name.
-Return t if file exists.  */)
+the suffix `.elc' or `.el'; don't accept just FILE unless
+it ends in one of those suffixes or includes a directory name.
+
+If this function fails to find a file, it may look for different
+representations of that file before trying another file.
+It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
+to the file name.  Emacs uses this feature mainly to find compressed
+versions of files when Auto Compression mode is enabled.
+
+The exact suffixes that this function tries out, in the exact order,
+are given by the value of the variable `load-file-rep-suffixes' if
+NOSUFFIX is non-nil and by the return value of the function
+`get-load-suffixes' if MUST-SUFFIX is non-nil.  If both NOSUFFIX and
+MUST-SUFFIX are nil, this function first tries out the latter suffixes
+and then the former.
+
+Loading a file records its definitions, and its `provide' and
+`require' calls, in an element of `load-history' whose
+car is the file name loaded.  See `load-history'.
+
+Return t if the file exists and loads successfully.  */)
      (file, noerror, nomessage, nosuffix, must_suffix)
      Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
 {
@@ -676,7 +718,7 @@ Return t if file exists.  */)
   register int fd = -1;
   int count = SPECPDL_INDEX ();
   Lisp_Object temp;
-  struct gcpro gcpro1;
+  struct gcpro gcpro1, gcpro2;
   Lisp_Object found, efound;
   /* 1 means we printed the ".el is newer" message.  */
   int newer = 0;
@@ -723,7 +765,8 @@ Return t if file exists.  */)
       int size = SBYTES (file);
       Lisp_Object tmp[2];
 
-      GCPRO1 (file);
+      found = Qnil;
+      GCPRO2 (file, found);
 
       if (! NILP (must_suffix))
        {
@@ -742,9 +785,9 @@ Return t if file exists.  */)
 
       fd = openp (Vload_path, file,
                  (!NILP (nosuffix) ? Qnil
-                  : !NILP (must_suffix) ? Vload_suffixes
-                  : Fappend (2, (tmp[0] = Vload_suffixes,
-                                 tmp[1] = default_suffixes,
+                  : !NILP (must_suffix) ? Fget_load_suffixes ()
+                  : Fappend (2, (tmp[0] = Fget_load_suffixes (),
+                                 tmp[1] = Vload_file_rep_suffixes,
                                  tmp))),
                  &found, Qnil);
       UNGCPRO;
@@ -794,8 +837,12 @@ Return t if file exists.  */)
       if (!NILP (Fequal (found, XCAR (tem))))
        count++;
     if (count > 3)
-      Fsignal (Qerror, Fcons (build_string ("Recursive load"),
-                             Fcons (found, Vloads_in_progress)));
+      {
+       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);
   }
@@ -810,6 +857,8 @@ Return t if file exists.  */)
          struct stat s1, s2;
          int result;
 
+         GCPRO2 (file, found);
+
          if (!safe_to_load_p (fd))
            {
              safe_p = 0;
@@ -826,7 +875,6 @@ Return t if file exists.  */)
 
          compiled = 1;
 
-         GCPRO1 (efound);
          efound = ENCODE_FILE (found);
 
 #ifdef DOS_NT
@@ -836,7 +884,6 @@ Return t if file exists.  */)
          SSET (efound, SBYTES (efound) - 1, 0);
          result = stat ((char *)SDATA (efound), &s2);
          SSET (efound, SBYTES (efound) - 1, 'c');
-         UNGCPRO;
 
          if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
            {
@@ -846,12 +893,13 @@ Return t if file exists.  */)
              /* If we won't print another message, mention this anyway.  */
              if (!NILP (nomessage))
                {
-                 Lisp_Object file;
-                 file = Fsubstring (found, make_number (0), make_number (-1));
+                 Lisp_Object msg_file;
+                 msg_file = Fsubstring (found, make_number (0), make_number (-1));
                  message_with_string ("Source file `%s' newer than byte-compiled file",
-                                      file, 1);
+                                      msg_file, 1);
                }
            }
+         UNGCPRO;
        }
     }
   else
@@ -870,12 +918,12 @@ Return t if file exists.  */)
        }
     }
 
+  GCPRO2 (file, found);
+
 #ifdef WINDOWSNT
   emacs_close (fd);
-  GCPRO1 (efound);
   efound = ENCODE_FILE (found);
   stream = fopen ((char *) SDATA (efound), fmode);
-  UNGCPRO;
 #else  /* not WINDOWSNT */
   stream = fdopen (fd, fmode);
 #endif /* not WINDOWSNT */
@@ -902,7 +950,6 @@ Return t if file exists.  */)
        message_with_string ("Loading %s...", file, 1);
     }
 
-  GCPRO1 (file);
   record_unwind_protect (load_unwind, make_save_value (stream, 0));
   record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
   specbind (Qload_file_name, found);
@@ -910,8 +957,8 @@ Return t if file exists.  */)
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
-  readevalloop (Qget_file_char, stream, file, Feval,
-               0, Qnil, Qnil, Qnil, Qnil);
+  readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found),
+               Feval, 0, Qnil, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
   /* Run any load-hooks for this file.  */
@@ -953,12 +1000,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;
 {
-  struct Lisp_Save_Value *p = XSAVE_VALUE (stream);
-
-  fclose ((FILE *) p->pointer);
+  FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
+  if (stream != NULL)
+    fclose (stream);
   if (--load_in_progress < 0) load_in_progress = 0;
   return Qnil;
 }
@@ -1068,7 +1115,7 @@ openp (path, str, suffixes, storeptr, predicate)
                            SBYTES (XCAR (tail)));
     }
 
-  string = filename = Qnil;
+  string = filename = encoded_fn = Qnil;
   GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
 
   if (storeptr)
@@ -1098,7 +1145,7 @@ openp (path, str, suffixes, storeptr, predicate)
        fn = (char *) alloca (fn_size = 100 + want_size);
 
       /* Loop over suffixes.  */
-      for (tail = NILP (suffixes) ? default_suffixes : suffixes;
+      for (tail = NILP (suffixes) ? Fcons (build_string (""), Qnil) : suffixes;
           CONSP (tail); tail = XCDR (tail))
        {
          int lsuffix = SBYTES (XCAR (tail));
@@ -1191,33 +1238,34 @@ openp (path, str, suffixes, storeptr, predicate)
 \f
 /* Merge the list we've accumulated of globals from the current input source
    into the load_history variable.  The details depend on whether
-   the source has an associated file name or not. */
+   the source has an associated file name or not.
+
+   FILENAME is the file name that we are loading from.
+   ENTIRE is 1 if loading that entire file, 0 if evaluating part of it.  */
 
 static void
-build_load_history (stream, source)
-     FILE *stream;
-     Lisp_Object source;
+build_load_history (filename, entire)
+     Lisp_Object filename;
+     int entire;
 {
   register Lisp_Object tail, prev, newelt;
   register Lisp_Object tem, tem2;
-  register int foundit, loading;
-
-  loading = stream || !NARROWED;
+  register int foundit = 0;
 
   tail = Vload_history;
   prev = Qnil;
-  foundit = 0;
+
   while (CONSP (tail))
     {
       tem = XCAR (tail);
 
       /* Find the feature's previous assoc list... */
-      if (!NILP (Fequal (source, Fcar (tem))))
+      if (!NILP (Fequal (filename, Fcar (tem))))
        {
          foundit = 1;
 
-         /*  If we're loading, remove it. */
-         if (loading)
+         /*  If we're loading the entire file, remove old data. */
+         if (entire)
            {
              if (NILP (prev))
                Vload_history = XCDR (tail);
@@ -1249,10 +1297,10 @@ build_load_history (stream, source)
       QUIT;
     }
 
-  /* If we're loading, cons the new assoc onto the front of load-history,
-     the most-recently-loaded position.  Also do this if we didn't find
-     an existing member for the current source.  */
-  if (loading || !foundit)
+  /* If we're loading an entire file, cons the new assoc onto the
+     front of load-history, the most-recently-loaded position.  Also
+     do this if we didn't find an existing member for the file.  */
+  if (entire || !foundit)
     Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
                           Vload_history);
 }
@@ -1308,23 +1356,34 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
   register int c;
   register Lisp_Object val;
   int count = SPECPDL_INDEX ();
-  struct gcpro gcpro1;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   struct buffer *b = 0;
+  int bpos;
   int continue_reading_p;
+  /* Nonzero if reading an entire buffer.  */
+  int whole_buffer = 0;
+  /* 1 on the first time around.  */
+  int first_sexp = 1;
+
+  if (MARKERP (readcharfun))
+    {
+      if (NILP (start))
+       start = readcharfun;    
+    }
 
   if (BUFFERP (readcharfun))
     b = XBUFFER (readcharfun);
   else if (MARKERP (readcharfun))
     b = XMARKER (readcharfun)->buffer;
 
-  specbind (Qstandard_input, readcharfun);
+  specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun.  */
   specbind (Qcurrent_load_list, Qnil);
   record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
   load_convert_to_unibyte = !NILP (unibyte);
 
   readchar_backlog = -1;
 
-  GCPRO1 (sourcename);
+  GCPRO4 (sourcename, readfun, start, end);
 
   LOADHIST_ATTACH (sourcename);
 
@@ -1338,12 +1397,32 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
 
       if (!NILP (start))
        {
+         /* Switch to the buffer we are reading from.  */
+         record_unwind_protect (save_excursion_restore, save_excursion_save ());
+         set_buffer_internal (b);
+
+         /* Save point in it.  */
          record_unwind_protect (save_excursion_restore, save_excursion_save ());
+         /* Save ZV in it.  */
          record_unwind_protect (save_restriction_restore, save_restriction_save ());
+         /* Those get unbound after we read one expression.  */
+
+         /* Set point and ZV around stuff to be read.  */
          Fgoto_char (start);
-         Fnarrow_to_region (make_number (BEGV), end);
+         if (!NILP (end))
+           Fnarrow_to_region (make_number (BEGV), end);
+
+         /* Just for cleanliness, convert END to a marker
+            if it is an integer.  */
+         if (INTEGERP (end))
+           end = Fpoint_max_marker ();
        }
 
+      /* On the first cycle, we can easily test here
+        whether we are reading the whole buffer.  */
+      if (b && first_sexp)
+       whole_buffer = (PT == BEG && ZV == Z);
+
       instream = stream;
     read_next:
       c = READCHAR;
@@ -1393,8 +1472,11 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
 
       if (!NILP (start) && continue_reading_p)
        start = Fpoint_marker ();
+
+      /* Restore saved point and BEGV.  */
       unbind_to (count1, Qnil);
 
+      /* Now eval what we just read.  */
       val = (*evalfun) (val);
 
       if (printflag)
@@ -1405,9 +1487,13 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
          else
            Fprint (val, Qnil);
        }
+
+      first_sexp = 0;
     }
 
-  build_load_history (stream, sourcename);
+  build_load_history (sourcename, 
+                     stream || whole_buffer);
+
   UNGCPRO;
 
   unbind_to (count, Qnil);
@@ -1727,13 +1813,12 @@ read_escape (readcharfun, stringp, byterep)
       return c | alt_modifier;
 
     case 's':
-      if (stringp)
-       return ' ';
       c = READCHAR;
-      if (c != '-') {
-       UNREAD (c);
-       return ' ';
-      }
+      if (c != '-')
+       {
+         UNREAD (c);
+         return ' ';
+       }
       c = READCHAR;
       if (c == '\\')
        c = read_escape (readcharfun, 0, byterep);
@@ -3791,6 +3876,7 @@ syms_of_lread ()
   defsubr (&Sintern);
   defsubr (&Sintern_soft);
   defsubr (&Sunintern);
+  defsubr (&Sget_load_suffixes);
   defsubr (&Sload);
   defsubr (&Seval_buffer);
   defsubr (&Seval_region);
@@ -3852,13 +3938,27 @@ Initialized based on EMACSLOADPATH environment variable, if any,
 otherwise to default specified by file `epaths.h' when Emacs was built.  */);
 
   DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
-              doc: /* *List of suffixes to try for files to load.
-This list should not include the empty string.  */);
+              doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
+This list should not include the empty string.
+`load' and related functions try to append these suffixes, in order,
+to the specified file name if a Lisp suffix is allowed or required.  */);
   Vload_suffixes = Fcons (build_string (".elc"),
                          Fcons (build_string (".el"), Qnil));
+  DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
+              doc: /* List of suffixes that indicate representations of \
+the same file.
+This list should normally start with the empty string.
+
+Enabling Auto Compression mode appends the suffixes in
+`jka-compr-load-suffixes' to this list and disabling Auto Compression
+mode removes them again.  `load' and related functions use this list to
+determine whether they should look for compressed versions of a file
+and, if so, which suffixes they should try to append to the file name
+in order to do so.  However, if you want to customize which suffixes
+the loading functions recognize as compression suffixes, you should
+customize `jka-compr-load-suffixes' rather than the present variable.  */);
   /* We don't use empty_string because it's not initialized yet.  */
-  default_suffixes = Fcons (build_string (""), Qnil);
-  staticpro (&default_suffixes);
+  Vload_file_rep_suffixes = Fcons (build_string (""), Qnil);
 
   DEFVAR_BOOL ("load-in-progress", &load_in_progress,
               doc: /* Non-nil iff inside of `load'.  */);
@@ -3878,7 +3978,7 @@ when the corresponding call to `provide' is made.  */);
   Vafter_load_alist = Qnil;
 
   DEFVAR_LISP ("load-history", &Vload_history,
-              doc: /* Alist mapping source file names to symbols and features.
+              doc: /* Alist mapping file names to symbols and features.
 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.
@@ -3887,7 +3987,10 @@ and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
 `(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.  */);
+as a function.
+
+During preloading, the file name recorded is relative to the main Lisp
+directory.  These file names are converted to absolute at startup.  */);
   Vload_history = Qnil;
 
   DEFVAR_LISP ("load-file-name", &Vload_file_name,