Subject: bug#78794: [PATCH] Pretiffy package-menu

From: Elijah Gabe Pérez <[email-masked]>
Date: Wed, 18 Jun 2025 19:31:57 -0600

Eli Zaretskii <[email-masked]> writes:

>> From: Elijah Gabe Pérez <[email-masked]>
>> Cc: Eli Zaretskii <[email-masked]>,  [email-masked]
>> Date: Mon, 16 Jun 2025 13:52:32 -0600
>> 
>> Philip Kaludercic <[email-masked]> writes:
>> 
>> >>> +(defcustom package-menu-marks-indicators
>> >>> +  '((install . "I")
>> >>> +    (delete . "D"))
>> >>> +  "Alist indicators to indicate a package is marked to install or delete.
>> >>> +The value of each list must be in the formt: '(KIND . MARK) where KIND
>> >>> +is the kind mark performed (`install' or `delete') in package-menu and
>> >>> +MARK a string to use for mark the packages.  This currently support
>> >>> +marks for install and delete."
>> >
>> > What is the reason we would want to customise this in the first place?
>> 
>> IMO, the I and D characters looks somewhat ugly to me, making them
>> customizable allows to change them to an Unicode/Emoji icon (or any
>> other character), making them more recognizable according to the user's
>> preferences (e.g. 🗑️/♻️ and ✅).
>
> I hear you, but AFAIR we don't provide such customizations in any
> other clients of tabulated-list-mode, so why do it here?

Fine, then I've removed the option/feature here, to avoid making this
thread longer.

>From 7e3a5cb8de886a57315b1326134b44456d2e8390 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= <[email-masked]>
Date: Thu, 12 Jun 2025 22:23:52 -0600
Subject: [PATCH] Pretiffy package-menu (Bug#78794)

Add package-menu mode-line which displays information about:
total number of packages installed, total number of packages
from all the packages archive, total number of packages to
upgrade and total number of new packages available.

Highlight packages marked for installation or deletion.

* etc/NEWS: Announce changes.
* lisp/emacs-lisp/package.el (package-menu-mode): Add package-menu
mode-line format to 'mode-line-misc-info'.
(package-mark-install-line, package-mark-delete-line): New faces.
(package-menu--overlay-line, package-menu--remove-overlay)
(package-menu--set-mode-line-format): New functions.
(package-menu-mark-delete, package-menu-mark-install)
(package-menu-mark-unmark, package-menu-backup-unmark)
(package-menu-mark-obsolete-for-deletion): Tweak for set/unset the
overlays.
(package-menu-mode-line-format, package-menu-mode-line-info): New
buffer-local variables.
(list-packages): Add 'package-menu--set-mode-line-format' to
'package--post-download-archives-hook'.
---
 etc/NEWS                   |   8 +++
 lisp/emacs-lisp/package.el | 112 ++++++++++++++++++++++++++++++++++++-
 2 files changed, 117 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 0c66ac38105..787e2aef472 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1900,6 +1900,14 @@ the command will only copy those files.
 +++
 *** package-x.el is now obsolete.
 
+---
+*** Package menu now highlights packages marked for installation or deletion.
+
+*** Package menu now displays the total number of the package type.
+Package menu now displays in the mode line the total number of packages
+installed, total number of packages from all the package archives, total
+number of packages to upgrade and total number of new packages
+available.
 
 ** RCIRC
 
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 82fcf439a11..57cfb0e66a0 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -3236,6 +3236,10 @@ package-menu-mode
   (setq mode-line-process '((package--downloads-in-progress ":Loading")
                             (package-menu--transaction-status
                              package-menu--transaction-status)))
+  (setq-local mode-line-misc-info
+              (append
+               mode-line-misc-info
+               package-menu-mode-line-format))
   (setq tabulated-list-format
         `[("Package" ,package-name-column-width package-menu--name-predicate)
           ("Version" ,package-version-column-width package-menu--version-predicate)
@@ -3642,6 +3646,24 @@ package-status-avail-obso
   "Face used on the status and version of avail-obso packages."
   :version "25.1")
 
+(defface package-mark-install-line
+  '((((class color) (background light))
+     :background "darkolivegreen1" :extend t)
+    (((class color) (background dark))
+     :background "seagreen" :extend t)
+    (t :inherit (highlight) :extend t))
+  "Face used for highlight the line where a package is marked to install."
+  :version "31.1")
+
+(defface package-mark-delete-line
+  '((((class color) (background light))
+     :background "rosybrown1" :extend t)
+    (((class color) (background dark))
+     :background "indianred4" :extend t)
+    (t :inherit (highlight) :extend t))
+  "Face used for highlight the line where a package is marked to delete."
+  :version "31.1")
+
 
 ;;; Package menu printing
 
@@ -3702,6 +3724,20 @@ package-menu--refresh-contents
   (package-refresh-contents package-menu-async))
 (define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1")
 
+(defun package-menu--overlay-line (face)
+  "Highlight whole line with face FACE."
+  (let ((ov (make-overlay (line-beginning-position)
+                          (1+ (line-end-position)))))
+    (overlay-put ov 'pkg-menu-ov t)
+    (overlay-put ov 'evaporate t)
+    (overlay-put ov 'face face)))
+
+(defun package-menu--remove-overlay ()
+  "Remove all overlays done by `package-menu--overlay-line' in current line."
+  (remove-overlays (line-beginning-position)
+                   (1+ (line-end-position))
+                   'pkg-menu-ov t))
+
 (defun package-menu-hide-package ()
   "Hide in Package Menu packages that match a regexp.
 Prompt for the regexp to match against package names.
@@ -3757,7 +3793,8 @@ package-menu-mark-delete
   (package--ensure-package-menu-mode)
   (if (member (package-menu-get-status)
               '("installed" "source" "dependency" "obsolete" "unsigned"))
-      (tabulated-list-put-tag "D" t)
+      (progn (package-menu--overlay-line 'package-mark-delete-line)
+             (tabulated-list-put-tag "D" t))
     (forward-line)))
 
 (defun package-menu-mark-install (&optional _num)
@@ -3766,7 +3803,8 @@ package-menu-mark-install
   (interactive "p" package-menu-mode)
   (package--ensure-package-menu-mode)
   (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
-      (tabulated-list-put-tag "I" t)
+      (progn (package-menu--overlay-line 'package-mark-install-line)
+             (tabulated-list-put-tag "I" t))
     (forward-line)))
 
 (defun package-menu-mark-unmark (&optional _num)
@@ -3774,6 +3812,7 @@ package-menu-mark-unmark
 The current package is the package at point."
   (interactive "p" package-menu-mode)
   (package--ensure-package-menu-mode)
+  (package-menu--remove-overlay)
   (tabulated-list-put-tag " " t))
 
 (defun package-menu-backup-unmark ()
@@ -3781,6 +3820,7 @@ package-menu-backup-unmark
   (interactive nil package-menu-mode)
   (package--ensure-package-menu-mode)
   (forward-line -1)
+  (package-menu--remove-overlay)
   (tabulated-list-put-tag " "))
 
 (defun package-menu-mark-obsolete-for-deletion ()
@@ -3791,7 +3831,8 @@ package-menu-mark-obsolete-for-deletion
     (goto-char (point-min))
     (while (not (eobp))
       (if (equal (package-menu-get-status) "obsolete")
-          (tabulated-list-put-tag "D" t)
+          (progn (package-menu--overlay-line 'package-mark-delete-line)
+                 (tabulated-list-put-tag "D" t))
         (forward-line 1)))))
 
 (defvar package--quick-help-keys
@@ -4207,6 +4248,69 @@ package-menu--mark-or-notify-upgrades
             (package-menu--mark-upgrades-1)
           (package-menu--find-and-notify-upgrades))))))
 
+;; Mode-line
+(defconst package-menu-mode-line-format
+  '((package-menu-mode-line-info
+     (:eval (symbol-value 'package-menu-mode-line-info)))))
+
+(defvar-local package-menu-mode-line-info nil
+  "Variable which stores package-menu mode-line format.")
+
+(defun package-menu--set-mode-line-format ()
+  "Display package-menu mode-line."
+  (when-let* ((buf (get-buffer "*Packages*"))
+              ((buffer-live-p buf)))
+    (with-current-buffer buf
+      (setq package-menu-mode-line-info
+            (let ((installed 0)
+                  (new 0)
+                  (total (length package-archive-contents))
+                  (to-upgrade (length (package-menu--find-upgrades)))
+                  (total-help "Total number of packages of all package archives")
+                  (installed-help "Total number of packages installed")
+                  (upgrade-help "Total number of packages to upgrade")
+                  (new-help "Total number of new packages available"))
+
+              (save-excursion
+                (goto-char (point-min))
+                (while (not (eobp))
+                  (let ((status (package-menu-get-status)))
+                    (cond
+                     ((member status
+                              '("installed" "dependency" "unsigned"))
+                      (setq installed (1+ installed)))
+                     ((equal status "new")
+                      (setq new (1+ new)))))
+                  (forward-line)))
+
+              (setq installed (number-to-string installed))
+              (setq total (number-to-string total))
+              (setq to-upgrade (number-to-string to-upgrade))
+              (setq new (number-to-string new))
+
+              (list
+               "["
+               (propertize "Total: " 'help-echo total-help)
+               (propertize total
+                           'help-echo total-help
+                           'face 'font-lock-keyword-face)
+               " / "
+               (propertize "Installed: " 'help-echo installed-help)
+               (propertize installed
+                           'help-echo installed-help
+                           'face 'package-status-installed)
+               " / "
+               (propertize "To Upgrade: " 'help-echo upgrade-help)
+               (propertize to-upgrade
+                           'help-echo upgrade-help
+                           'face 'font-lock-keyword-face)
+               " / "
+               (propertize "New: " 'help-echo new-help)
+               (propertize new
+                           'help-echo new-help
+                           'face 'package-status-new)
+               "] "))))))
+
 ;;;###autoload
 (defun list-packages (&optional no-fetch)
   "Display a list of packages.
@@ -4225,6 +4329,8 @@ list-packages
             #'package-menu--post-refresh)
   (add-hook 'package--post-download-archives-hook
             #'package-menu--mark-or-notify-upgrades 'append)
+  (add-hook 'package--post-download-archives-hook
+            #'package-menu--set-mode-line-format 'append)
 
   ;; Generate the Package Menu.
   (let ((buf (get-buffer-create "*Packages*")))
-- 
2.49.0

-- 
                                          - E.G via GNU Emacs and Org.