[Emacs-diffs] /srv/bzr/emacs/trunk r108588: In the Package Menu, indicate packages that are newly-available.

[Chong Yidong]

------------------------------------------------------------
revno: 108588
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Wed 2012-06-13 15:33:38 +0800
message:
  In the Package Menu, indicate packages that are newly-available.
  
  * lisp/emacs-lisp/package.el (list-packages): Compute a list of
  packages that are newly-available since the last list-packages
  invocation.
  (package-menu--new-package-list): New var.
  (package-menu--generate, package-menu--print-info)
  (package-menu--status-predicate, package-menu-mark-install):
  Handle new status label "new".
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/emacs-lisp/package.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-06-12 04:35:14 +0000
+++ b/etc/NEWS  2012-06-13 07:33:38 +0000
@@ -299,6 +299,11 @@
 The function `notifications-get-capabilities' returns the supported
 server properties.
 
+** Package Menu
+
+*** Newly-available packages are listed in the Package Menu as "new",
+and sorted above the other "available" packages by default.
+
 ** Tabulated List and packages derived from it
 
 *** New command `tabulated-list-sort', bound to `S', sorts the column

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-06-12 18:10:34 +0000
+++ b/lisp/ChangeLog    2012-06-13 07:33:38 +0000
@@ -1,3 +1,13 @@
+2012-06-13  Chong Yidong  <address@hidden>
+
+       * emacs-lisp/package.el (list-packages): Compute a list of
+       packages that are newly-available since the last list-packages
+       invocation.
+       (package-menu--new-package-list): New var.
+       (package-menu--generate, package-menu--print-info)
+       (package-menu--status-predicate, package-menu-mark-install):
+       Handle new status label "new".
+
 2012-06-12  Stefan Monnier  <address@hidden>
 
        * emacs-lisp/cl-macs.el (cl-remf): Fix error in recent

=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el        2012-05-09 03:06:08 +0000
+++ b/lisp/emacs-lisp/package.el        2012-06-13 07:33:38 +0000
@@ -1362,6 +1362,9 @@
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
+(defvar 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"
   "Major mode for browsing a list of packages.
 Letters do not insert themselves; instead, they are commands.
@@ -1415,9 +1418,10 @@
       (when (or (eq packages t) (memq name packages))
        (let ((hold (assq name package-load-list)))
          (package--push name (cdr elt)
-                        (if (and hold (null (cadr hold)))
-                            "disabled"
-                          "available")
+                        (cond
+                         ((and hold (null (cadr hold))) "disabled")
+                         ((memq name package-menu--new-package-list) "new")
+                         (t "available"))
                         info-list))))
 
     ;; Obsolete packages:
@@ -1442,6 +1446,7 @@
         (face (cond
                ((string= status "built-in")  'font-lock-builtin-face)
                ((string= status "available") 'default)
+               ((string= status "new") 'bold)
                ((string= status "held")      'font-lock-constant-face)
                ((string= status "disabled")  'font-lock-warning-face)
                ((string= status "installed") 'font-lock-comment-face)
@@ -1487,7 +1492,7 @@
 (defun package-menu-mark-install (&optional _num)
   "Mark a package for installation and move to the next line."
   (interactive "p")
-  (if (string-equal (package-menu-get-status) "available")
+  (if (member (package-menu-get-status) '("available" "new"))
       (tabulated-list-put-tag "I" t)
     (forward-line)))
 
@@ -1536,7 +1541,7 @@
            (status (aref (cadr entry) 2)))
        (cond ((equal status "installed")
               (push pkg installed))
-             ((equal status "available")
+             ((member status '("available" "new"))
               (push pkg available)))))
     ;; Loop through list of installed packages, finding upgrades
     (dolist (pkg installed)
@@ -1642,16 +1647,18 @@
        (sB (aref (cadr B) 2)))
     (cond ((string= sA sB)
           (package-menu--name-predicate A B))
-         ((string= sA  "available") t)
+         ((string= sA "new") t)
+         ((string= sB "new") nil)
+         ((string= sA "available") t)
          ((string= sB "available") nil)
-         ((string= sA  "installed") t)
+         ((string= sA "installed") t)
          ((string= sB "installed") nil)
-         ((string= sA  "held") t)
+         ((string= sA "held") t)
          ((string= sB "held") nil)
-         ((string= sA  "built-in") t)
+         ((string= sA "built-in") t)
          ((string= sB "built-in") nil)
-         ((string= sA  "obsolete") t)
-         ((string= sB  "obsolete") nil)
+         ((string= sA "obsolete") t)
+         ((string= sB "obsolete") nil)
          (t (string< sA sB)))))
 
 (defun package-menu--description-predicate (A B)
@@ -1676,22 +1683,36 @@
   ;; Initialize the package system if necessary.
   (unless package--initialized
     (package-initialize t))
-  (unless no-fetch
-    (package-refresh-contents))
-  (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))
-  (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")))))
+  (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"))))))
 
 ;;;###autoload
 (defalias 'package-list-packages 'list-packages)