diff options
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 81 | ||||
| -rw-r--r-- | test/automated/package-test.el | 23 |
3 files changed, 56 insertions, 51 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 37bf841d6e6..8f51db64f35 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -84,6 +84,9 @@ (package-install, package-install-from-buffer): Use it. (package-download-transaction, package-install-from-archive): Add ASYNC and CALLBACK arguments. + (package-menu--prompt-transaction-p): New function. + (package-menu-execute): Use it to prompt the user about operations + to be executed. 2015-04-05 Pete Williamson <petewil@chromium.org> (tiny-change) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2e6ad99d705..e7c33db7528 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2697,6 +2697,31 @@ call will upgrade the package." (length upgrades) (if (= (length upgrades) 1) "" "s"))))) +(defun package-menu--prompt-transaction-p (ins del) + "Prompt the user about installing INS and deleting DEL. +INS and DEL are lists of `package-desc'. Either may be nil, but +not both." + (y-or-n-p + (concat + (when ins + (let ((lins (length ins))) + (if (= lins 1) + (format "INSTALL package `%s'" + (package-desc-full-name (car ins))) + (format "INSTALL these %d packages (%s)" + lins + (mapconcat #'package-desc-full-name ins ", "))))) + (when (and del ins) " and ") + (when del + (let ((ldel (length del))) + (if (= ldel 1) + (format "DELETE package `%s'" + (package-desc-full-name (car del))) + (format "DELETE these %d packages (%s)" + ldel + (mapconcat #'package-desc-full-name del ", "))))) + "? "))) + (defun package-menu-execute (&optional noquery) "Perform marked Package Menu actions. Packages marked for installation are downloaded and installed; @@ -2718,43 +2743,21 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ((eq cmd ?I) (push pkg-desc install-list)))) (forward-line))) - (when install-list - (if (or - noquery - (yes-or-no-p - (if (= (length install-list) 1) - (format "Install package `%s'? " - (package-desc-full-name (car install-list))) - (format "Install these %d packages (%s)? " - (length install-list) - (mapconcat #'package-desc-full-name - install-list ", "))))) - (mapc (lambda (p) - ;; Don't mark as selected if it's a new version of - ;; an installed package. - (package-install p (and (not (package-installed-p p)) - (package-installed-p - (package-desc-name p))))) - install-list))) - ;; Delete packages, prompting if necessary. - (when delete-list - (if (or - noquery - (yes-or-no-p - (if (= (length delete-list) 1) - (format "Delete package `%s'? " - (package-desc-full-name (car delete-list))) - (format "Delete these %d packages (%s)? " - (length delete-list) - (mapconcat #'package-desc-full-name - delete-list ", "))))) - (dolist (elt (package--sort-by-dependence delete-list)) - (condition-case-unless-debug err - (package-delete elt) - (error (message (cadr err))))) - (error "Aborted"))) - (if (not (or delete-list install-list)) - (message "No operations specified.") + (unless (or delete-list install-list) + (user-error "No operations specified")) + (when (or noquery + (package-menu--prompt-transaction-p install-list delete-list)) + ;; Don't mark as selected if it's a new version of an installed + ;; package. + (mapc (lambda (p) (package-install p (and (not (package-installed-p p)) + (package-installed-p + (package-desc-name p))))) + install-list) + ;; Delete packages. + (dolist (elt (package--sort-by-dependence delete-list)) + (condition-case-unless-debug err + (package-delete elt) + (error (message (cadr err))))) (when package-selected-packages (let ((removable (package--removable-packages))) (when (and removable @@ -2764,8 +2767,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (mapconcat #'symbol-name removable ", ")))) ;; We know these are removable, so we can use force instead of sorting them. (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave)) - removable)))) - (package-menu--generate t t)))) + removable))))) + (package-menu--generate t t))) (defun package-menu--version-predicate (A B) (let ((vA (or (aref (cadr A) 1) '(0))) diff --git a/test/automated/package-test.el b/test/automated/package-test.el index 359f3541b41..5fae216ef7d 100644 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -113,7 +113,6 @@ process-environment)) (package-user-dir package-test-user-dir) (package-archives `(("gnu" . ,package-test-data-dir))) - (old-yes-no-defn (symbol-function 'yes-or-no-p)) (default-directory package-test-file-dir) abbreviated-home-dir package--initialized @@ -128,25 +127,25 @@ (unwind-protect (progn ,(if basedir `(cd ,basedir)) - (setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t)) (unless (file-directory-p package-user-dir) (mkdir package-user-dir)) - ,@(when install - `((package-initialize) - (package-refresh-contents) - (mapc 'package-install ,install))) - (with-temp-buffer - ,(if file - `(insert-file-contents ,file)) - ,@body)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest r) t)) + ((symbol-function 'y-or-n-p) (lambda (&rest r) t))) + ,@(when install + `((package-initialize) + (package-refresh-contents) + (mapc 'package-install ,install))) + (with-temp-buffer + ,(if file + `(insert-file-contents ,file)) + ,@body))) (when (file-directory-p package-test-user-dir) (delete-directory package-test-user-dir t)) (when (and (boundp 'package-test-archive-upload-base) (file-directory-p package-test-archive-upload-base)) - (delete-directory package-test-archive-upload-base t)) - (setf (symbol-function 'yes-or-no-p) old-yes-no-defn)))) + (delete-directory package-test-archive-upload-base t))))) (defmacro with-fake-help-buffer (&rest body) "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." |