Add an "mark upgradable packages" command to Package Menu mode.
* lisp/emacs-lisp/package.el (package-alist): Fix risky-local-variable declaration. (package--add-to-archive-contents): If there is a duplicate entry with an older version, remove it. (package-menu-mark-delete, package-menu-mark-install) (package-menu-mark-unmark): Make unused args optional. (package-menu-mark-obsolete-for-deletion): Use package-menu-get-status instead of a regexp search. (package-menu-get-status): Use tabulated-list-entry. (package-menu-mark-upgrades): New command. (package-menu-mode-map): Bind it to U. (package-menu-execute): Do installation before deletion. (package-menu-refresh, package-menu-execute): Use derived-mode-p instead of checking major-mode. (package-menu--find-upgrades): New function.
This commit is contained in:
Chong Yidong
parent
d5fdf93f87
commit
25322144fc
2 changed files with 105 additions and 26 deletions
|
|
@ -1,3 +1,21 @@
|
|||
2011-09-15 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* emacs-lisp/package.el (package-alist): Fix risky-local-variable
|
||||
declaration.
|
||||
(package--add-to-archive-contents): If there is a duplicate entry
|
||||
with an older version, remove it.
|
||||
(package-menu-mark-delete, package-menu-mark-install)
|
||||
(package-menu-mark-unmark): Make unused args optional.
|
||||
(package-menu-mark-obsolete-for-deletion): Use
|
||||
package-menu-get-status instead of a regexp search.
|
||||
(package-menu-get-status): Use tabulated-list-entry.
|
||||
(package-menu-mark-upgrades): New command.
|
||||
(package-menu-mode-map): Bind it to U.
|
||||
(package-menu-execute): Do installation before deletion.
|
||||
(package-menu-refresh, package-menu-execute): Use derived-mode-p
|
||||
instead of checking major-mode.
|
||||
(package-menu--find-upgrades): New function.
|
||||
|
||||
2011-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* mail/smtpmail.el (smtpmail-send-command): Don't include AUTH
|
||||
|
|
|
|||
|
|
@ -309,7 +309,7 @@ The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
|
|||
This variable is set automatically by `package-load-descriptor',
|
||||
called via `package-initialize'. To change which packages are
|
||||
loaded and/or activated, customize `package-load-list'.")
|
||||
(put 'package-archive-contents 'risky-local-variable t)
|
||||
(put 'package-alist 'risky-local-variable t)
|
||||
|
||||
(defvar package-activated-list nil
|
||||
"List of the names of currently activated packages.")
|
||||
|
|
@ -820,13 +820,19 @@ If the archive version is too new, signal an error."
|
|||
"Add the PACKAGE from the given ARCHIVE if necessary.
|
||||
Also, add the originating archive to the end of the package vector."
|
||||
(let* ((name (car package))
|
||||
(version (aref (cdr package) 0))
|
||||
(entry (cons (car package)
|
||||
(version (package-desc-vers (cdr package)))
|
||||
(entry (cons name
|
||||
(vconcat (cdr package) (vector archive))))
|
||||
(existing-package (cdr (assq name package-archive-contents))))
|
||||
(when (or (not existing-package)
|
||||
(version-list-< (aref existing-package 0) version))
|
||||
(add-to-list 'package-archive-contents entry))))
|
||||
(existing-package (assq name package-archive-contents)))
|
||||
(cond ((not existing-package)
|
||||
(add-to-list 'package-archive-contents entry))
|
||||
((version-list-< (package-desc-vers (cdr existing-package))
|
||||
version)
|
||||
;; Replace the entry with this one.
|
||||
(setq package-archive-contents
|
||||
(cons entry
|
||||
(delq existing-package
|
||||
package-archive-contents)))))))
|
||||
|
||||
(defun package-download-transaction (package-list)
|
||||
"Download and install all the packages in PACKAGE-LIST.
|
||||
|
|
@ -1269,6 +1275,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
|
|||
(define-key map "\177" 'package-menu-backup-unmark)
|
||||
(define-key map "d" 'package-menu-mark-delete)
|
||||
(define-key map "i" 'package-menu-mark-install)
|
||||
(define-key map "U" 'package-menu-mark-upgrades)
|
||||
(define-key map "r" 'package-menu-refresh)
|
||||
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
|
||||
(define-key map "x" 'package-menu-execute)
|
||||
|
|
@ -1422,7 +1429,7 @@ identifier (NAME . VERSION-LIST)."
|
|||
This fetches the contents of each archive specified in
|
||||
`package-archives', and then refreshes the package menu."
|
||||
(interactive)
|
||||
(unless (eq major-mode 'package-menu-mode)
|
||||
(unless (derived-mode-p 'package-menu-mode)
|
||||
(error "The current buffer is not a Package Menu"))
|
||||
(package-refresh-contents)
|
||||
(package-menu--generate t t))
|
||||
|
|
@ -1437,21 +1444,21 @@ If optional arg BUTTON is non-nil, describe its associated package."
|
|||
(describe-package package))))
|
||||
|
||||
;; fixme numeric argument
|
||||
(defun package-menu-mark-delete (num)
|
||||
(defun package-menu-mark-delete (&optional num)
|
||||
"Mark a package for deletion and move to the next line."
|
||||
(interactive "p")
|
||||
(if (member (package-menu-get-status) '("installed" "obsolete"))
|
||||
(tabulated-list-put-tag "D" t)
|
||||
(forward-line)))
|
||||
|
||||
(defun package-menu-mark-install (num)
|
||||
(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")
|
||||
(tabulated-list-put-tag "I" t)
|
||||
(forward-line)))
|
||||
|
||||
(defun package-menu-mark-unmark (num)
|
||||
(defun package-menu-mark-unmark (&optional num)
|
||||
"Clear any marks on a package and move to the next line."
|
||||
(interactive "p")
|
||||
(tabulated-list-put-tag " " t))
|
||||
|
|
@ -1467,9 +1474,8 @@ If optional arg BUTTON is non-nil, describe its associated package."
|
|||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line 2)
|
||||
(while (not (eobp))
|
||||
(if (looking-at ".*\\s obsolete\\s ")
|
||||
(if (equal (package-menu-get-status) "obsolete")
|
||||
(tabulated-list-put-tag "D" t)
|
||||
(forward-line 1)))))
|
||||
|
||||
|
|
@ -1482,17 +1488,66 @@ If optional arg BUTTON is non-nil, describe its associated package."
|
|||
'package-menu-view-commentary 'package-menu-describe-package "24.1")
|
||||
|
||||
(defun package-menu-get-status ()
|
||||
(save-excursion
|
||||
(if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)")
|
||||
(match-string 1)
|
||||
(let* ((pkg (tabulated-list-get-id))
|
||||
(entry (and pkg (assq pkg tabulated-list-entries))))
|
||||
(if entry
|
||||
(aref (cadr entry) 2)
|
||||
"")))
|
||||
|
||||
(defun package-menu--find-upgrades ()
|
||||
(let (installed available upgrades)
|
||||
;; Build list of installed/available packages in this buffer.
|
||||
(dolist (entry tabulated-list-entries)
|
||||
;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
|
||||
(let ((pkg (car entry))
|
||||
(status (aref (cadr entry) 2))
|
||||
old)
|
||||
(cond ((equal status "installed")
|
||||
(push pkg installed))
|
||||
((equal status "available")
|
||||
(push pkg available)))))
|
||||
;; Loop through list of installed packages, finding upgrades
|
||||
(dolist (pkg installed)
|
||||
(let ((avail-pkg (assq (car pkg) available)))
|
||||
(and avail-pkg
|
||||
(version-list-< (cdr pkg) (cdr avail-pkg))
|
||||
(push avail-pkg upgrades))))
|
||||
upgrades))
|
||||
|
||||
(defun package-menu-mark-upgrades ()
|
||||
"Mark all upgradable packages in the Package Menu.
|
||||
For each installed package with a newer version available, place
|
||||
an (I)nstall flag on the available version and a (D)elete flag on
|
||||
the installed version. A subsequent \\[package-menu-execute]
|
||||
call will upgrade the package."
|
||||
(interactive)
|
||||
(unless (derived-mode-p 'package-menu-mode)
|
||||
(error "The current buffer is not a Package Menu"))
|
||||
(let ((upgrades (package-menu--find-upgrades)))
|
||||
(if (null upgrades)
|
||||
(message "No packages to upgrade.")
|
||||
(widen)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let* ((pkg (tabulated-list-get-id))
|
||||
(upgrade (assq (car pkg) upgrades)))
|
||||
(cond ((null upgrade)
|
||||
(forward-line 1))
|
||||
((equal pkg upgrade)
|
||||
(package-menu-mark-install))
|
||||
(t
|
||||
(package-menu-mark-delete))))))
|
||||
(message "%d package%s marked for upgrading."
|
||||
(length upgrades)
|
||||
(if (= (length upgrades) 1) "" "s")))))
|
||||
|
||||
(defun package-menu-execute ()
|
||||
"Perform marked Package Menu actions.
|
||||
Packages marked for installation are downloaded and installed;
|
||||
packages marked for deletion are removed."
|
||||
(interactive)
|
||||
(unless (eq major-mode 'package-menu-mode)
|
||||
(unless (derived-mode-p 'package-menu-mode)
|
||||
(error "The current buffer is not in Package Menu mode"))
|
||||
(let (install-list delete-list cmd id)
|
||||
(save-excursion
|
||||
|
|
@ -1509,6 +1564,14 @@ packages marked for deletion are removed."
|
|||
((eq cmd ?I)
|
||||
(push (car id) install-list))))
|
||||
(forward-line)))
|
||||
(when install-list
|
||||
(if (yes-or-no-p
|
||||
(if (= (length install-list) 1)
|
||||
(format "Install package `%s'? " (car install-list))
|
||||
(format "Install these %d packages (%s)? "
|
||||
(length install-list)
|
||||
(mapconcat 'symbol-name install-list ", "))))
|
||||
(mapc 'package-install install-list)))
|
||||
;; Delete packages, prompting if necessary.
|
||||
(when delete-list
|
||||
(if (yes-or-no-p
|
||||
|
|
@ -1527,14 +1590,6 @@ packages marked for deletion are removed."
|
|||
(package-delete (car elt) (cdr elt))
|
||||
(error (message (cadr err)))))
|
||||
(error "Aborted")))
|
||||
(when install-list
|
||||
(if (yes-or-no-p
|
||||
(if (= (length install-list) 1)
|
||||
(format "Install package `%s'? " (car install-list))
|
||||
(format "Install these %d packages (%s)? "
|
||||
(length install-list)
|
||||
(mapconcat 'symbol-name install-list ", "))))
|
||||
(mapc 'package-install install-list)))
|
||||
;; If we deleted anything, regenerate `package-alist'. This is done
|
||||
;; automatically if we installed a package.
|
||||
(and delete-list (null install-list)
|
||||
|
|
@ -1597,7 +1652,13 @@ The list is displayed in a buffer named `*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)))
|
||||
(switch-to-buffer buf))
|
||||
(let ((upgrades (package-menu--find-upgrades)))
|
||||
(if upgrades
|
||||
(message "%d package%s can be upgraded; type `%s' to mark them for upgrading."
|
||||
(length upgrades)
|
||||
(if (= (length upgrades) 1) "" "s")
|
||||
(substitute-command-keys "\\[package-menu-mark-upgrades]")))))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'package-list-packages 'list-packages)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue