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

[Alan Mackenzie]

Hi, Richard!

On Sun, 21 May 2006, Richard Stallman wrote:

>    >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.

>I don't like having to load it in order for Emacs to start up.
>I am sure this can be implemented some other way.

Oh, you're a hard taskmaster.  ;-)

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

>That is somewhat of an improvement; but given how limited your use
>of these regexps is, can't you construct them without regexp-opt?
>I think that won't really be hard.

You're right.  It wasn't hard.  I've written my own cut down
"regexp-pess" (called list-to-regexp) to take its place.  I had
overlooked the fact that regexp-quote was a primitive function, and hence
available.

So, I think we're there, now.  I don't think an entry in NEWS is
warranted; true, the semantics of after-load-alist have been changed, but
I don't really see that this alist is an "external" structure.  However,
I'll need to amend gnus/mm-util.el around L383, which (rather naughtily,
IMAO) misuses after-load-alist.  But first, would you please comment on
the patch as it now is.  Should I commit it?


2006-05-23  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 list-to-regexp, 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     23 May 2006 14:52:02 -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        23 May 2006 14:52:13 -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,1499 ----
                 t))
       nil))
  
+ (defun list-to-regexp (arg)
+   "Build a regexp that matches any of the elements of ARG, a list of strings."
+   (if arg
+       (let ((regexp "\\("))
+       (mapc (lambda (elt)
+               (setq regexp (concat regexp (regexp-quote elt) "\\|")))
+             arg)
+       (aset regexp (1- (length regexp)) ?\))
+       regexp)
+     ""))
+ 
+ (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)
+             ""
+           ;; Note: regexp-opt can't be used here, since we need to call
+           ;; this before Emacs has been fully started.  2006-05-21
+           (concat (list-to-regexp load-suffixes) "?"))
+         (list-to-regexp 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  23 May 2006 14:52:21 -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 23 May 2006 14:51:57 -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.