diff options
| author | Artur Malabarba | 2015-05-21 08:57:31 +0100 |
|---|---|---|
| committer | Artur Malabarba | 2015-05-21 09:59:45 +0100 |
| commit | 35514815fa34a5ecf14ffd9f96d8b9ddb905e142 (patch) | |
| tree | 43958a272363add89ab8d43925ed7c4f420ce962 | |
| parent | 0060c0d7b15ed1510583eb738baa0c9bf9f02721 (diff) | |
| download | emacs-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.el | 79 |
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. |
| 2900 | INSTALL and DELETE are lists of `package-desc'. Either may be | 2900 | DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects. |
| 2901 | nil, but not both." | 2901 | Either 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. | ||
| 2917 | Alist contains three entries, upgrade, delete, and install, each | ||
| 2918 | with a list of package names. | ||
| 2919 | |||
| 2920 | The upgrade entry contains any `package-desc' objects in INSTALL | ||
| 2921 | whose name coincides with an object in DELETE. The delete and | ||
| 2922 | the install entries are the same as DELETE and INSTALL with such | ||
| 2923 | objects 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))) |