[Emacs-diffs] Changes to emacs/src/lread.c

[Alan Mackenzie]

Index: emacs/src/lread.c
diff -u emacs/src/lread.c:1.351 emacs/src/lread.c:1.352
--- emacs/src/lread.c:1.351     Fri May 12 02:08:16 2006
+++ emacs/src/lread.c   Wed May 24 13:24:21 2006
@@ -87,6 +87,7 @@
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 Lisp_Object Qinhibit_file_name_operation;
 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
+Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
 extern Lisp_Object Qevent_symbol_element_mask;
 extern Lisp_Object Qfile_exists_p;
@@ -718,8 +719,8 @@
   register int fd = -1;
   int count = SPECPDL_INDEX ();
   Lisp_Object temp;
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object found, efound;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object found, efound, hist_file_name;
   /* 1 means we printed the ".el is newer" message.  */
   int newer = 0;
   /* 1 means we are loading a compiled file.  */
@@ -727,6 +728,7 @@
   Lisp_Object handler;
   int safe_p = 1;
   char *fmode = "r";
+  Lisp_Object tmp[2];
 #ifdef DOS_NT
   fmode = "rt";
 #endif /* DOS_NT */
@@ -743,7 +745,7 @@
      the need to gcpro noerror, nomessage and nosuffix.
      (Below here, we care only whether they are nil or not.)
      The presence of this call is the result of a historical accident:
-     it used to be in every file-operations and when it got removed
+     it used to be in every file-operation and when it got removed
      everywhere, it accidentally stayed here.  Since then, enough people
      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
      that it seemed risky to remove.  */
@@ -763,7 +765,6 @@
   if (SCHARS (file) > 0)
     {
       int size = SBYTES (file);
-      Lisp_Object tmp[2];
 
       found = Qnil;
       GCPRO2 (file, found);
@@ -847,6 +848,13 @@
     Vloads_in_progress = Fcons (found, Vloads_in_progress);
   }
 
+  /* Get the name for load-history. */
+  hist_file_name = (! NILP (Vpurify_flag)
+                    ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
+                                   tmp[1] = Ffile_name_nondirectory (found),
+                                   tmp))
+                    : found) ;
+
   if (!bcmp (SDATA (found) + SBYTES (found) - 4,
             ".elc", 4))
     /* Load .elc files directly, but not when they are
@@ -857,7 +865,7 @@
          struct stat s1, s2;
          int result;
 
-         GCPRO2 (file, found);
+         GCPRO3 (file, found, hist_file_name);
 
          if (!safe_to_load_p (fd))
            {
@@ -911,14 +919,14 @@
 
          if (fd >= 0)
            emacs_close (fd);
-         val = call4 (Vload_source_file_function, found, file,
+         val = call4 (Vload_source_file_function, found, hist_file_name,
                       NILP (noerror) ? Qnil : Qt,
                       NILP (nomessage) ? Qnil : Qt);
          return unbind_to (count, val);
        }
     }
 
-  GCPRO2 (file, found);
+  GCPRO3 (file, found, hist_file_name);
 
 #ifdef WINDOWSNT
   emacs_close (fd);
@@ -957,14 +965,15 @@
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
-  readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found),
+  readevalloop (Qget_file_char, stream, hist_file_name,
                Feval, 0, Qnil, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
-  /* Run any load-hooks for this file.  */
-  temp = Fassoc (file, Vafter_load_alist);
-  if (!NILP (temp))
-    Fprogn (Fcdr (temp));
+  /* Run any eval-after-load forms for this file */
+  if (NILP (Vpurify_flag)
+      && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
+    call1 (Qdo_after_load_evaluation, hist_file_name) ;
+
   UNGCPRO;
 
   if (saved_doc_string)
@@ -1391,6 +1400,12 @@
 
   GCPRO4 (sourcename, readfun, start, end);
 
+  /* Try to ensure sourcename is a truename, except whilst preloading. */
+  if (NILP (Vpurify_flag)
+      && !NILP (sourcename) && Ffile_name_absolute_p (sourcename)
+      && (!NILP (Ffboundp (Qfile_truename))))
+    sourcename = call1 (Qfile_truename, sourcename) ;
+
   LOADHIST_ATTACH (sourcename);
 
   continue_reading_p = 1;
@@ -3971,16 +3986,17 @@
 
   DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
               doc: /* An alist of expressions to be evalled when particular 
files are loaded.
-Each element looks like (FILENAME FORMS...).
-When `load' is run and the file-name argument is FILENAME,
-the FORMS in the corresponding element are executed at the end of loading.
-
-FILENAME must match exactly!  Normally FILENAME is the name of a library,
-with no directory specified, since that is how `load' is normally called.
-An error in FORMS does not undo the load,
-but does prevent execution of the rest of the FORMS.
-FILENAME can also be a symbol (a feature) and FORMS are then executed
-when the corresponding call to `provide' is made.  */);
+Each element looks like (REGEXP-OR-FEATURE FORMS...).
+
+REGEXP-OR-FEATURE is either a regular expression to match file names, or
+a symbol \(a feature name).
+
+When `load' is run and the file-name argument matches an element's
+REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
+REGEXP-OR-FEATURE, the FORMS in the element are executed.
+
+An error in FORMS does not undo the load, but does prevent execution of
+the rest of the FORMS.  */);
   Vafter_load_alist = Qnil;
 
   DEFVAR_LISP ("load-history", &Vload_history,
@@ -3988,6 +4004,10 @@
 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 file name is absolute and is the true file name (i.e. it doesn't
+contain symbolic links) of the loaded file.
+
 The remaining elements of each list are symbols defined as variables
 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
@@ -4118,6 +4138,12 @@
   Qeval_buffer_list = intern ("eval-buffer-list");
   staticpro (&Qeval_buffer_list);
 
+  Qfile_truename = intern ("file-truename");
+  staticpro (&Qfile_truename) ;
+
+  Qdo_after_load_evaluation = intern ("do-after-load-evaluation");
+  staticpro (&Qdo_after_load_evaluation) ;
+
   staticpro (&dump_path);
 
   staticpro (&read_objects);