Re: FIXED!! Re: Clarification of eval-after-load [was: Problem mit symlinks, locate-library and load-history]

[Alan Mackenzie]

Happy Sunday, Richard!

On Mon, 15 May 2006, Richard Stallman wrote:

>What is the motive for computing the truename in Fload?

So that the file names recorded in load-history are consistently true
names.  Previously, "M-x load-file ~/emacs/emacs/lisp/progmodes/cc-mode"
had put these inconsistent entries into load history:

"/home/acm/emacs/emacs/lisp/progmodes/cc-mode.elc"
"/mnt/hda7/emacs/lisp/progmodes/cc-fonts.elc"

, where both files are in the same directory (/home/acm/emacs being a
symlink to /mnt/hda7).  This is bad in and of itself, but additionally it
would screw up on

(eval-after-load "/mnt/hda7/emacs/lisp/progmodes/cc-mode" ....).

#########################################################################

>I don't like the use of regexp-opt.  Can you get rid of that?

I'm not quite sure exactly what you don't like about it.  Given that I'm
doing regexp matches on the filenames, it's not practical to eliminate
it.  I'm guessing that you didn't like the way it was called for EVERY
element of after-load-alist, and called repeatedly for EVERY file that
was loaded.  Also, that you didn't like regexp-opt having to be
preloaded, thus forcing BASE_PURESIZE to be increased.

I've changed tactics now, so that after-load-alist contains the regexps
rather than the file names.  i.e., an after-load-alist element which used
to be this:

    ("help-mode" (define-key help-mode-map "\356" 'clone-buffer))

is now this:

    ("\\<help-mode\\(?:\\.elc?\\)?\\(\\.gz\\)?\\'"
      (define-key help-mode-map "\356" 'clone-buffer))

.  Thus this regexp is now only built once for each eval-after-load call,
and regexp-opt.elc doesn't need to be preloaded.

HOWEVER, regexp-opt.elc WASN'T BEING LOADED AT emacs START UP, thus
causing an error, because .../lisp/emacs-lisp isn't on load-path at emacs
start up.  I have worked around this by moving regexp-opt.{el,elc} from
.../lisp/emacs-lisp to ..../lisp.  (Though this isn't in the patch
below).

You might not like this relocation of regexp-opt.{el,elc}.  I don't know
what impact it might have on other things, but I can't see any problems
right now. 

Possibilities are:
(i) Move regexp-opt.elc into the main lisp directory.
(ii) Add ..../lisp/emacs-lisp to the virgin load-path.
(iii) Postpone the regexpification of preload eval-after-load filenames
until `command-line' (in startup.el), much like the way preload
load-history filenames are fleshed out to absolute names there.

My personal preference would be for (i).  (iii) would be the least work,
I think.

#########################################################################

>The function loaded-filename does not seem very useful,
>and is easy to get rid of, so would you please do so?

DONE.

>    !     Lisp_Object Qdo_after_load_evaluation
>    !       = intern ("do-after-load-evaluation") ;

>That symbol should be file-scope, and initialized in
>syms_of_lread, in the normal way.

>    !      else
>    !        Fsignal (Qerror,
>    !                 Fcons (make_string
>    !                        ("Fload: can't find do-after-load-evaluation",
>    !                         42), Qnil)) ;
>    !   }

Sorry about these.  They're now fixed.

>It should do nothing, not signal an error.

FIXED.

>    +       Lisp_Object Qfile_truename = intern ("file-truename") ;

>Likewise here.

LIKEWISE FIXED.

#########################################################################

Here then is the amended patch.  Note again that regexp-opt.elc must be
in ..../emacs/lisp for Emacs to start up properly.


2006-05-21  Alan Mackenzie  <address@hidden>

        * startup.el (command-line): For names of preloaded files, don't
        append ".elc" (now done in Fload), and call file-truename on the
        lisp directory.

        * subr.el (eval-after-load): Fix the doc-string.  Allow FILE to
        match ANY loaded file with the right name, not just those in
        load-path.  Put a regexp matching the file name into
        after-load-alist, rather than the name itself.

        * subr.el: New functions load-history-regexp,
        load-history-filename-element, get-after-load-alist-matches,
        do-after-load-evaluation.

        * international/mule.el (load-with-code-conversion): Do the
        eval-after-load stuff by calling do-after-load-evaluation.

Index: lisp/startup.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/startup.el,v
retrieving revision 1.407
diff -c -r1.407 startup.el
*** lisp/startup.el     5 May 2006 14:05:54 -0000       1.407
--- lisp/startup.el     20 May 2006 22:18:49 -0000
***************
*** 644,661 ****
  
    ;; Convert preloaded file names to absolute.
    (let ((lisp-dir
!        (file-name-directory
!         (locate-file "simple" load-path
!                      (get-load-suffixes)))))
  
      (setq load-history
          (mapcar (lambda (elt)
                    (if (and (stringp (car elt))
                             (not (file-name-absolute-p (car elt))))
                        (cons (concat lisp-dir
!                                     (car elt)
!                                     (if (string-match "[.]el$" (car elt))
!                                         "" ".elc"))
                              (cdr elt))
                      elt))
                  load-history)))
--- 644,660 ----
  
    ;; Convert preloaded file names to absolute.
    (let ((lisp-dir
!        (file-truename
!         (file-name-directory
!          (locate-file "simple" load-path
!                       (get-load-suffixes))))))
  
      (setq load-history
          (mapcar (lambda (elt)
                    (if (and (stringp (car elt))
                             (not (file-name-absolute-p (car elt))))
                        (cons (concat lisp-dir
!                                     (car elt))
                              (cdr elt))
                      elt))
                  load-history)))
Index: lisp/subr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/subr.el,v
retrieving revision 1.507
diff -c -r1.507 subr.el
*** lisp/subr.el        7 May 2006 20:49:01 -0000       1.507
--- lisp/subr.el        20 May 2006 22:19:00 -0000
***************
*** 1385,1416 ****
                 t))
       nil))
  
  (defun eval-after-load (file form)
    "Arrange that, if FILE is ever loaded, FORM will be run at that time.
- This makes or adds to an entry on `after-load-alist'.
  If FILE is already loaded, evaluate FORM right now.
! It does nothing if FORM is already on the list for FILE.
! FILE must match exactly.  Normally FILE is the name of a library,
! with no directory or extension specified, since that is how `load'
! is normally called.
! FILE can also be a feature (i.e. a symbol), in which case FORM is
! evaluated whenever that feature is `provide'd."
!   (let ((elt (assoc file after-load-alist)))
!     ;; Make sure there is an element for FILE.
!     (unless elt (setq elt (list file)) (push elt after-load-alist))
!     ;; Add FORM to the element if it isn't there.
      (unless (member form (cdr elt))
!       (nconc elt (list form))
!       ;; If the file has been loaded already, run FORM right away.
!       (if (if (symbolp file)
!             (featurep file)
!           ;; Make sure `load-history' contains the files dumped with
!           ;; Emacs for the case that FILE is one of them.
!           ;; (load-symbol-file-load-history)
!           (when (locate-library file)
!             (assoc (locate-library file) load-history)))
!         (eval form))))
!   form)
  
  (defun eval-next-after-load (file)
    "Read the following input sexp, and run it whenever FILE is loaded.
--- 1385,1486 ----
                 t))
       nil))
  
+ (defun load-history-regexp (file)
+   "Form a regexp to find FILE in load-history.
+ FILE, a string, is described in eval-after-load's doc-string."
+   (if (file-name-absolute-p file)
+       (setq file (file-truename file)))
+   (concat (if (file-name-absolute-p file) "\\`" "\\<")
+         (regexp-quote file)
+         (if (file-name-extension file)
+             ""
+           (regexp-opt (cons "" load-suffixes)))
+         "\\(" (regexp-opt jka-compr-load-suffixes) "\\)?\\'"))
+ 
+ (defun load-history-filename-element (regexp)
+   "Get the first element of load-history whose first element \(a file
+ name) matches REGEXP.  Return nil if there isn't one."
+   (let* ((loads load-history)
+        (load-elt (and loads (car loads))))
+     (save-match-data
+       (while (and loads
+                 (or (null (car load-elt))
+                     (not (string-match regexp (car load-elt)))))
+       (setq loads (cdr loads)
+             load-elt (and loads (car loads)))))
+     load-elt))
+ 
  (defun eval-after-load (file form)
    "Arrange that, if FILE is ever loaded, FORM will be run at that time.
  If FILE is already loaded, evaluate FORM right now.
! 
! If a matching file is loaded again, FORM will be evaluated again.
! 
! If FILE is a string, it may be either an absolute or a relative file
! name, and may have an extension \(e.g. \".el\") or may lack one, and
! additionally may or may not have an extension denoting a compressed
! format \(e.g. \".gz\").
! 
! When FILE is absolute, it is first converted to a true name by chasing
! out symbolic links.  Only a file of this name \(see next paragraph for
! extensions) will trigger the evaluation of FORM.  When FILE is relative,
! a file whose absolute true name ends in FILE will trigger evaluation.
! 
! When FILE lacks an extension, a file name with any extension will trigger
! evaluation.  Otherwise, its extension must match FILE's.  A further
! extension for a compressed format \(e.g. \".gz\") on FILE will not affect
! this name matching.
! 
! Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
! is evaluated whenever that feature is `provide'd.
! 
! Usually FILE is just a library name like \"font-lock\" or a feature name
! like 'font-lock.
! 
! This function makes or adds to an entry on `after-load-alist'."
!   ;; Add this FORM into after-load-alist (regardless of whether we'll be
!   ;; evaluating it now).
!   (let* ((regexp-or-feature
!         (if (stringp file) (load-history-regexp file) file))
!        (elt (assoc regexp-or-feature after-load-alist)))
!     (unless elt
!       (setq elt (list regexp-or-feature))
!       (push elt after-load-alist))
!     ;; Add FORM to the element unless it's already there.
      (unless (member form (cdr elt))
!       (nconc elt (list form)))
! 
!     ;; Is there an already loaded file whose name (or `provide' name)
!     ;; matches FILE?
!     (if (if (stringp file)
!           (load-history-filename-element regexp-or-feature)
!         (featurep file))
!       (eval form))))
! 
! (defun get-after-load-alist-matches (abs-file)
!   "Get all the matches in after-load-alist for the file name ABS-FILE.
! ABS-FILE, a string, should be the absolute true name of a file just loaded."
!   (let ((elements after-load-alist)
!       element result)
!     (while elements
!       (setq element (car elements))
!       (if (and (stringp (car element))
!              (string-match (car element) abs-file))
!         (push element result))
!       (setq elements (cdr elements)))
!     (nreverse result)))
! 
! (defun do-after-load-evaluation (abs-file)
!   "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
! ABS-FILE, a string, should be the absolute true name of a file just loaded."
!   (let ((file-elements (get-after-load-alist-matches abs-file))
!       file-element form)
!     (while file-elements
!       (setq file-element (car file-elements)
!           file-elements (cdr file-elements))
!       (while (setq file-element (cdr file-element)) ; discard the file name.
!       (setq form (car file-element))
!       (eval form)))))
  
  (defun eval-next-after-load (file)
    "Read the following input sexp, and run it whenever FILE is loaded.
Index: lisp/international/mule.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/international/mule.el,v
retrieving revision 1.234
diff -c -r1.234 mule.el
*** lisp/international/mule.el  21 Apr 2006 12:22:24 -0000      1.234
--- lisp/international/mule.el  20 May 2006 22:19:08 -0000
***************
*** 98,106 ****
                         ))
        (let (kill-buffer-hook kill-buffer-query-functions)
          (kill-buffer buffer)))
!       (let ((hook (assoc file after-load-alist)))
!       (when hook
!         (mapcar (function eval) (cdr hook))))
        (unless (or nomessage noninteractive)
        (if source
            (message "Loading %s (source)...done" file)
--- 98,106 ----
                         ))
        (let (kill-buffer-hook kill-buffer-query-functions)
          (kill-buffer buffer)))
!       (unless purify-flag
!       (do-after-load-evaluation fullname))
!       
        (unless (or nomessage noninteractive)
        (if source
            (message "Loading %s (source)...done" file)



2006-05-21  Alan Mackenzie  <address@hidden>

        * lread.c (Vload_history): Enhance doc-string to say that the file
        is the absolute truename of the loaded file.

        * lread.c (Vafter_load_alist): doc-string: state that an element
        now has a regexp to match file names, not a file name as such.

        * lread.c (readevalloop): Call file-truename on the name for
        load-history, except at preloading time.

        * lread.c (Fload): At preloading time, preserve the extension of
        the filename which goes into load-history.  New variable
        hist_file_name.

        * lread.c (Fload): Do eval-after-load stuff by calling the lisp
        function do-after-load-evaluation.

Index: src/lread.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lread.c,v
retrieving revision 1.350
diff -c -r1.350 lread.c
*** src/lread.c 27 Feb 2006 02:04:35 -0000      1.350
--- src/lread.c 20 May 2006 22:18:43 -0000
***************
*** 87,92 ****
--- 87,93 ----
  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,725 ****
    register int fd = -1;
    int count = SPECPDL_INDEX ();
    Lisp_Object temp;
!   struct gcpro gcpro1, gcpro2;
!   Lisp_Object found, efound;
    /* 1 means we printed the ".el is newer" message.  */
    int newer = 0;
    /* 1 means we are loading a compiled file.  */
--- 719,726 ----
    register int fd = -1;
    int count = SPECPDL_INDEX ();
    Lisp_Object temp;
!   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,732 ****
--- 728,734 ----
    Lisp_Object handler;
    int safe_p = 1;
    char *fmode = "r";
+   Lisp_Object tmp[2];
  #ifdef DOS_NT
    fmode = "rt";
  #endif /* DOS_NT */
***************
*** 743,749 ****
       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
       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.  */
--- 745,751 ----
       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-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,769 ****
    if (SCHARS (file) > 0)
      {
        int size = SBYTES (file);
-       Lisp_Object tmp[2];
  
        found = Qnil;
        GCPRO2 (file, found);
--- 765,770 ----
***************
*** 847,852 ****
--- 848,860 ----
      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,863 ****
          struct stat s1, s2;
          int result;
  
!         GCPRO2 (file, found);
  
          if (!safe_to_load_p (fd))
            {
--- 865,871 ----
          struct stat s1, s2;
          int result;
  
!         GCPRO3 (file, found, hist_file_name);
  
          if (!safe_to_load_p (fd))
            {
***************
*** 911,924 ****
  
          if (fd >= 0)
            emacs_close (fd);
!         val = call4 (Vload_source_file_function, found, file,
                       NILP (noerror) ? Qnil : Qt,
                       NILP (nomessage) ? Qnil : Qt);
          return unbind_to (count, val);
        }
      }
  
!   GCPRO2 (file, found);
  
  #ifdef WINDOWSNT
    emacs_close (fd);
--- 919,932 ----
  
          if (fd >= 0)
            emacs_close (fd);
!         val = call4 (Vload_source_file_function, found, hist_file_name,
                       NILP (noerror) ? Qnil : Qt,
                       NILP (nomessage) ? Qnil : Qt);
          return unbind_to (count, val);
        }
      }
  
!   GCPRO3 (file, found, hist_file_name);
  
  #ifdef WINDOWSNT
    emacs_close (fd);
***************
*** 957,970 ****
    load_descriptor_list
      = Fcons (make_number (fileno (stream)), load_descriptor_list);
    load_in_progress++;
!   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.  */
!   temp = Fassoc (file, Vafter_load_alist);
!   if (!NILP (temp))
!     Fprogn (Fcdr (temp));
    UNGCPRO;
  
    if (saved_doc_string)
--- 965,979 ----
    load_descriptor_list
      = Fcons (make_number (fileno (stream)), load_descriptor_list);
    load_in_progress++;
!   readevalloop (Qget_file_char, stream, hist_file_name,
                Feval, 0, Qnil, Qnil, Qnil, Qnil);
    unbind_to (count, Qnil);
  
!   /* 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)
***************
*** 1385,1390 ****
--- 1394,1405 ----
  
    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;
***************
*** 3965,3980 ****
  
    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.  */);
    Vafter_load_alist = Qnil;
  
    DEFVAR_LISP ("load-history", &Vload_history,
--- 3980,3996 ----
  
    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 (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,
***************
*** 3982,3987 ****
--- 3998,4007 ----
  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)'.
***************
*** 4112,4117 ****
--- 4132,4143 ----
    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);



-- 
Alan.