bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#19390: 25.0.50; `package-activate' is too slow


From: Dmitry Gutov
Subject: bug#19390: 25.0.50; `package-activate' is too slow
Date: Wed, 17 Dec 2014 04:41:49 +0200
User-agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.3.0

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.







reply via email to

[Prev in Thread] Current Thread [Next in Thread]