[Emacs-diffs] master aa33f4a 2/2: * emacs-lisp/package.el: Make package-menu asynchronous.

[Artur Malabarba]

branch: master
commit aa33f4a100e4539aaa04a8e1647d926f972c2673
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    * emacs-lisp/package.el: Make package-menu asynchronous.
    
    (package-menu-async): New variable.  Controls whether
    `list-packages' is asynchronous.
    (list-packages): Now asynchronous by default.
    (package-menu--new-package-list): Always buffer-local.
    (package-menu--post-refresh)
    (package-menu--find-and-notify-upgrades)
    (package-menu--populate-new-package-list): New functions.
---
 lisp/ChangeLog             |    9 ++++
 lisp/emacs-lisp/package.el |   93 +++++++++++++++++++++++++++++---------------
 2 files changed, 71 insertions(+), 31 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index da3cd51..b35c78d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -10,6 +10,15 @@
        (package--post-download-archives-hook): New variable.  Hook run
        after every refresh.
 
+       * emacs-lisp/package.el: Make package-menu asynchronous.
+       (package-menu-async): New variable.  Controls whether
+       `list-packages' is asynchronous.
+       (list-packages): Now asynchronous by default.
+       (package-menu--new-package-list): Always buffer-local.
+       (package-menu--post-refresh)
+       (package-menu--find-and-notify-upgrades)
+       (package-menu--populate-new-package-list): New functions.
+
 2015-03-31  Simen Heggestøyl  <address@hidden>
 
        * textmodes/css-mode.el (css-mode): Derive from `prog-mode'.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 89d9246..490fb45 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2241,7 +2241,7 @@ will be deleted."
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
-(defvar package-menu--new-package-list nil
+(defvar-local package-menu--new-package-list nil
   "List of newly-available packages since `list-packages' was last called.")
 
 (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
@@ -2749,6 +2749,49 @@ Optional argument NOQUERY non-nil means do not ask the 
user to confirm."
   (string< (or (package-desc-archive (car A)) "")
            (or (package-desc-archive (car B)) "")))
 
+(defvar-local package-menu--old-archive-contents nil
+  "`package-archive-contents' before the latest refresh.")
+
+(defun package-menu--populate-new-package-list ()
+  "Decide which packages are new in `package-archives-contents'.
+Store this list in `package-menu--new-package-list'."
+  ;; Find which packages are new.
+  (when package-menu--old-archive-contents
+    (dolist (elt package-archive-contents)
+      (unless (assq (car elt) package-menu--old-archive-contents)
+        (push (car elt) package-menu--new-package-list)))
+    (setq package-menu--old-archive-contents nil)))
+
+(defun package-menu--find-and-notify-upgrades ()
+  "Notify the user of upgradeable packages."
+  (when-let ((upgrades (package-menu--find-upgrades)))
+    (message "%d package%s can be upgraded; type `%s' to mark %s for 
upgrading."
+      (length upgrades)
+      (if (= (length upgrades) 1) "" "s")
+      (substitute-command-keys "\\[package-menu-mark-upgrades]")
+      (if (= (length upgrades) 1) "it" "them"))))
+
+(defun package-menu--post-refresh ()
+  "Function to be called after `package-refresh-contents' is done.
+Checks for new packages, reverts the *Packages* buffer, and
+checks for upgrades.
+This goes in `package--post-download-archives-hook', so that it
+works with async refresh as well."
+  (package-menu--populate-new-package-list)
+  (let ((buf (get-buffer "*Packages*")))
+    (when (buffer-live-p buf)
+      (with-current-buffer buf
+        (revert-buffer nil 'noconfirm))))
+  (package-menu--find-and-notify-upgrades))
+
+(defcustom package-menu-async t
+  "If non-nil, package-menu will use async operations when possible.
+Currently, only the refreshing of archive contents supports
+asynchronous operations.  Package transactions are still done
+synchronously."
+  :type 'boolean
+  :group 'package)
+
 ;;;###autoload
 (defun list-packages (&optional no-fetch)
   "Display a list of packages.
@@ -2760,36 +2803,24 @@ The list is displayed in a buffer named `*Packages*'."
   ;; Initialize the package system if necessary.
   (unless package--initialized
     (package-initialize t))
-  (let (old-archives new-packages)
-    (unless no-fetch
-      ;; Read the locally-cached archive-contents.
-      (package-read-all-archive-contents)
-      (setq old-archives package-archive-contents)
-      ;; Fetch the remote list of packages.
-      (package-refresh-contents)
-      ;; Find which packages are new.
-      (dolist (elt package-archive-contents)
-        (unless (assq (car elt) old-archives)
-          (push (car elt) new-packages))))
-
-    ;; Generate the Package Menu.
-    (let ((buf (get-buffer-create "*Packages*")))
-      (with-current-buffer buf
-        (package-menu-mode)
-        (set (make-local-variable 'package-menu--new-package-list)
-             new-packages)
-        (package-menu--generate nil t))
-      ;; The package menu buffer has keybindings.  If the user types
-      ;; `M-x list-packages', that suggests it should become current.
-      (switch-to-buffer buf))
-
-    (let ((upgrades (package-menu--find-upgrades)))
-      (if upgrades
-          (message "%d package%s can be upgraded; type `%s' to mark %s for 
upgrading."
-                   (length upgrades)
-                   (if (= (length upgrades) 1) "" "s")
-                   (substitute-command-keys "\\[package-menu-mark-upgrades]")
-                   (if (= (length upgrades) 1) "it" "them"))))))
+  ;; Integrate the package-menu with updating the archives.
+  (add-hook 'package--post-download-archives-hook
+            #'package-menu--post-refresh)
+
+  (unless no-fetch
+    (setq package-menu--old-archive-contents package-archive-contents)
+    (setq package-menu--new-package-list nil)
+    ;; Fetch the remote list of packages.
+    (package-refresh-contents package-menu-async))
+
+  ;; Generate the Package Menu.
+  (let ((buf (get-buffer-create "*Packages*")))
+    (with-current-buffer buf
+      (package-menu-mode)
+      (package-menu--generate nil t))
+    ;; The package menu buffer has keybindings.  If the user types
+    ;; `M-x list-packages', that suggests it should become current.
+    (switch-to-buffer buf)))
 
 ;;;###autoload
 (defalias 'package-list-packages 'list-packages)