emacs-lisp/package.el: Refactor pre-execute prompt

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 37bf841d6e6d56dc45763fd7b0a06870bfeeecc1..8f51db64f350540aeb1a43a00917bbe8682d30c3 100644 (file)
--- 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 2e6ad99d7051a7fc60a416d14d30b725ea568c78..e7c33db75283b32088cdab19a0ac90e8e068c060 100644 (file)
--- 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 359f3541b4190f31903619201a70e0a38ae3bebb..5fae216ef7d0e082300961281874ab754c81e8ca 100644 (file)
--- 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."