mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-13 16:38:14 +00:00
Code Issues Releases Activity

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

Browse Source
This commit is contained in:
Artur Malabarba 2015-04-05 22:44:17 +01:00
parent 7436b68132
commit b6610d5547
3 changed files with 56 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/ChangeLog
View File

@ -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)

81
lisp/emacs-lisp/package.el
View File

@ -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)))

23
test/automated/package-test.el
View File

@ -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."