aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorArtur Malabarba2015-05-21 08:57:31 +0100
committerArtur Malabarba2015-05-21 09:59:45 +0100
commit35514815fa34a5ecf14ffd9f96d8b9ddb905e142 (patch)
tree43958a272363add89ab8d43925ed7c4f420ce962
parent0060c0d7b15ed1510583eb738baa0c9bf9f02721 (diff)
downloademacs-35514815fa34a5ecf14ffd9f96d8b9ddb905e142.tar.gz
emacs-35514815fa34a5ecf14ffd9f96d8b9ddb905e142.zip
* lisp/emacs-lisp/package.el: Better transaction messages
(package-menu--partition-transaction): New function. (package-menu--prompt-transaction-p, package-menu-execute): Use it. (package-menu--perform-transaction): Don't do any messaging.
-rw-r--r--lisp/emacs-lisp/package.el79
1 files changed, 50 insertions, 29 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index cdb58811691..95882ee3069 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2895,25 +2895,36 @@ prompt (see `package-menu--prompt-transaction-p')."
2895 (t (format "package `%s'" 2895 (t (format "package `%s'"
2896 (package-desc-full-name (car packages)))))) 2896 (package-desc-full-name (car packages))))))
2897 2897
2898(defun package-menu--prompt-transaction-p (install delete) 2898(defun package-menu--prompt-transaction-p (delete install upgrade)
2899 "Prompt the user about installing INSTALL and deleting DELETE. 2899 "Prompt the user about DELETE, INSTALL, and UPGRADE.
2900INSTALL and DELETE are lists of `package-desc'. Either may be 2900DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects.
2901nil, but not both." 2901Either may be nil, but not all."
2902 (y-or-n-p
2903 (concat
2904 (when delete "Delete ")
2905 (package-menu--list-to-prompt delete)
2906 (when (and delete install)
2907 (if upgrade "; " "; and "))
2908 (when install "Install ")
2909 (package-menu--list-to-prompt install)
2910 (when (and upgrade (or install delete)) "; and ")
2911 (when upgrade "Upgrade ")
2912 (package-menu--list-to-prompt upgrade)
2913 "? ")))
2914
2915(defun package-menu--partition-transaction (install delete)
2916 "Return an alist describing an INSTALL DELETE transaction.
2917Alist contains three entries, upgrade, delete, and install, each
2918with a list of package names.
2919
2920The upgrade entry contains any `package-desc' objects in INSTALL
2921whose name coincides with an object in DELETE. The delete and
2922the install entries are the same as DELETE and INSTALL with such
2923objects removed."
2902 (let* ((upg (cl-intersection install delete :key #'package-desc-name)) 2924 (let* ((upg (cl-intersection install delete :key #'package-desc-name))
2903 (ins (cl-set-difference install upg :key #'package-desc-name)) 2925 (ins (cl-set-difference install upg :key #'package-desc-name))
2904 (del (cl-set-difference delete upg :key #'package-desc-name))) 2926 (del (cl-set-difference delete upg :key #'package-desc-name)))
2905 (y-or-n-p 2927 `((delete . ,del) (install . ,ins) (upgrade . ,upg))))
2906 (concat
2907 (when del "Delete ")
2908 (package-menu--list-to-prompt del)
2909 (when (and del ins)
2910 (if upg "; " "; and "))
2911 (when ins "Install ")
2912 (package-menu--list-to-prompt ins)
2913 (when (and upg (or ins del)) "; and ")
2914 (when upg "Upgrade ")
2915 (package-menu--list-to-prompt upg)
2916 "? "))))
2917 2928
2918(defun package-menu--perform-transaction (install-list delete-list) 2929(defun package-menu--perform-transaction (install-list delete-list)
2919 "Install packages in INSTALL-LIST and delete DELETE-LIST." 2930 "Install packages in INSTALL-LIST and delete DELETE-LIST."
@@ -2931,14 +2942,7 @@ nil, but not both."
2931 (condition-case-unless-debug err 2942 (condition-case-unless-debug err
2932 (let ((inhibit-message t)) 2943 (let ((inhibit-message t))
2933 (package-delete elt)) 2944 (package-delete elt))
2934 (error (message (cadr err))))) 2945 (error (message (cadr err)))))))
2935 (message "Transaction done")
2936 (when package-selected-packages
2937 (when-let ((removable (package--removable-packages)))
2938 (message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)"
2939 (length removable)
2940 (mapconcat #'symbol-name removable ", "))))
2941 (package-menu--post-refresh)))
2942 2946
2943(defun package-menu-execute (&optional noquery) 2947(defun package-menu-execute (&optional noquery)
2944 "Perform marked Package Menu actions. 2948 "Perform marked Package Menu actions.
@@ -2963,11 +2967,28 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
2963 (forward-line))) 2967 (forward-line)))
2964 (unless (or delete-list install-list) 2968 (unless (or delete-list install-list)
2965 (user-error "No operations specified")) 2969 (user-error "No operations specified"))
2966 (when (or noquery 2970 (let-alist (package-menu--partition-transaction install-list delete-list)
2967 (package-menu--prompt-transaction-p install-list delete-list)) 2971 (when (or noquery
2968 (message "Transaction started") 2972 (package-menu--prompt-transaction-p .delete .install .upgrade))
2969 ;; This calls `package-menu--generate' after everything's done. 2973 (let ((message-template
2970 (package-menu--perform-transaction install-list delete-list)))) 2974 (concat "Package menu: Operation %s ["
2975 (when .delete (format "Delet__ %s" (length .delete)))
2976 (when (and .delete .install) "; ")
2977 (when .install (format "Install__ %s" (length .install)))
2978 (when (and .upgrade (or .install .delete)) "; ")
2979 (when .upgrade (format "Upgrad__ %s" (length .upgrade)))
2980 "]")))
2981 (message (replace-regexp-in-string "__" "ing" message-template) "started")
2982 (package-menu--perform-transaction install-list delete-list)
2983 (when package-selected-packages
2984 (if-let ((removable (package--removable-packages)))
2985 (message "Package menu: Operation finished. %d packages %s"
2986 (length removable)
2987 "are no longer needed, type `M-x package-autoremove' to remove them")
2988 (message (replace-regexp-in-string "__" "ed" message-template)
2989 "finished"))))
2990 ;; This calls `package-menu--generate'.
2991 (package-menu--post-refresh)))))
2971 2992
2972(defun package-menu--version-predicate (A B) 2993(defun package-menu--version-predicate (A B)
2973 (let ((vA (or (aref (cadr A) 1) '(0))) 2994 (let ((vA (or (aref (cadr A) 1) '(0)))