GNU bug report logs - #19390
25.0.50; `package-activate' is too slow

Previous Next

Full log

Message #59 received at 19390 <at> debbugs.gnu.org (full text, mbox):

From: Dmitry Gutov <dgutov <at> yandex.ru>
To: bruce.connor.am <at> gmail.com, Stefan Monnier <monnier <at> iro.umontreal.ca>
Cc: 19390 <at> debbugs.gnu.org
Subject: Re: bug#19390: 25.0.50; `package-activate' is too slow
Date: Wed, 17 Dec 2014 04:41:49 +0200

Speaking of non-radical optimizations, this takes the packages 
activation time of 2.1 s (after the last small patch) down to 300 ms.

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 60beebd..30b5fb2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -527,7 +527,7 @@ Return the max version (as a string) if the package 
is held at a lower version."
     (let* ((old-lp load-path)
            (autoloads-file (expand-file-name
                             (format "%s-autoloads" name) pkg-dir))
-           (loaded-files-list (package--list-loaded-files pkg-dir)))
+           (loaded-files-list (package--list-loaded-files name pkg-dir)))
       (with-demoted-errors (format "Error loading %s: %%s" name)
         (load autoloads-file nil t))
       (when (and (eq old-lp load-path)
@@ -555,36 +555,36 @@ Return the max version (as a string) if the 
package is held at a lower version."
     ;; Don't return nil.
     t))

-(defun package--list-loaded-files (dir)
+(defun package--list-loaded-files (name dir)
   "Recursively list all files in DIR which correspond to loaded features.
 Returns the `file-name-sans-extension' of each file, relative to
 DIR, sorted by most recently loaded last."
-  (let* ((history (mapcar (lambda (x) (file-name-sans-extension (car x)))
-                    load-history))
-         (dir (file-truename dir))
-         ;; List all files that have already been loaded.
-         (list-of-conflicts
-          (remove
-           nil
-           (mapcar
-               (lambda (x) (let* ((file (file-relative-name x dir))
-                             ;; Previously loaded file, if any.
-                             (previous
-                              (ignore-errors
-                                (file-name-sans-extension
-                                 (file-truename (find-library-name 
file)))))
-                             (pos (when previous (member previous 
history))))
-                        ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
-                        (when pos
-                          (cons (file-name-sans-extension file) (length 
pos)))))
-             (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
-    ;; Turn the list of (FILENAME . POS) back into a list of features. 
 Files in
-    ;; subdirectories are returned relative to DIR (so not actually 
features).
-    (let ((default-directory (file-name-as-directory dir)))
-      (mapcar (lambda (x) (file-truename (car x)))
-        (sort list-of-conflicts
-              ;; Sort the files by ascending HISTORY-POSITION.
-              (lambda (x y) (< (cdr x) (cdr y))))))))
+  (let* ((old-dir-re (concat "\\`"
+                             (regexp-quote (file-truename 
package-user-dir))
+                             "/" (regexp-quote (symbol-name name))))
+         (filtered-history (cl-loop for entry in load-history
+                                    for file = (car entry)
+                                    when (string-match-p old-dir-re file)
+                                    collect (file-name-sans-extension 
file)))
+         (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
+         (files-re (concat "/"
+                           (regexp-opt
+                            (mapcar (lambda (x)
+                                      (file-name-sans-extension
+                                       (file-relative-name x dir)))
+                                    files))
+                           "\\'"))
+         list-of-conflicts)
+    ;; List all the matching files from the load history, in
+    ;; historical order.
+    (dolist (file filtered-history)
+      (when (string-match files-re file)
+        (cl-pushnew (substring (match-string 0 file) 1)
+                    list-of-conflicts
+                    :test #'equal)))
+    ;; Files in subdirectories are returned relative to DIR (so not
+    ;; actually features).
+    list-of-conflicts))

 (defun package-built-in-p (package &optional min-version)
   "Return true if PACKAGE is built-in to Emacs.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.