Subject: [PATCH] Pretiffy package-menu

From: Elijah Gabe Pérez <[email-masked]>
Date: Sat, 14 Jun 2025 20:12:34 -0600

>From a3be7ce9837f6dcc41c07fc4ee8731584a82041a 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 packages installed, Total packages from all the packages
archive, Total packages to upgrade and Total new packages
available.

Highlight packages marked for installation or deletion

* 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-install, package-menu-delete): Tweak for add
overlays.
(package-menu--overlay-line): New function.
(package-menu-mode-line): New user option.
(package-menu-mode-line-format, package-menu-mode-line-info):
New buffer-local variables.
(list-packages): Add 'package-menu-mode-line-format' to
'package--post-download-archives-hook'.
* etc/NEWS: Announce changes.
---
 etc/NEWS                   |   9 +++
 lisp/emacs-lisp/package.el | 161 ++++++++++++++++++++++++++++++++++++-
 2 files changed, 167 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index edfd7f20f18..1534f61691e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1837,6 +1837,15 @@ the command will only copy those files.
 +++
 *** package-x.el is now obsolete.
 
+---
+*** New user option 'package-menu-mode-line'.
+If non-nil, package-menu will display additional information about Total
+packages installed, Total packages from all the package archives, Total
+packages to upgrade and Total new packages available.
+
+---
+*** Package-menu now highlights packages marked for installation or deletion.
+
 ** Xref
 
 ---
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 82fcf439a11..45dafabaeb8 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,28 @@ 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) (min-colors 88) (background light))
+     :background "darkolivegreen1" :extend t)
+    (((class color) (min-colors 88) (background dark))
+     :background "seagreen" :extend t)
+    (((class color) (min-colors 8))
+     :background "green" :foreground "white" :extend t)
+    (t :inverse-video t :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) (min-colors 88) (background light))
+     :background "rosybrown1" :extend t)
+    (((class color) (min-colors 88) (background dark))
+     :background "indianred4" :extend t)
+    (((class color) (min-colors 8))
+     :background "red" :foreground "white" :extend t)
+    (t :inverse-video t :extend t))
+  "Face used for highlight the line where a package is marked to delete."
+  :version "31.1")
+
 
 ;;; Package menu printing
 
@@ -3702,6 +3728,50 @@ package-menu--refresh-contents
   (package-refresh-contents package-menu-async))
 (define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1")
 
+(define-fringe-bitmap
+  'package-menu-install
+  (vector
+   #b000000
+   #b001100
+   #b001100
+   #b111111
+   #b111111
+   #b001100
+   #b001100
+   #b000000)
+  nil nil 'center)
+
+(define-fringe-bitmap
+  'package-menu-delete
+  (vector
+   #b000000
+   #b000000
+   #b000000
+   #b111111
+   #b111111
+   #b000000
+   #b000000
+   #b000000)
+  nil nil 'center)
+
+(defun package-menu--overlay-line (face fringe fringe-face)
+  "Highlight whole line with face FACE and display FRINGE on current line."
+  (let ((ov (make-overlay (line-beginning-position)
+                          (1+ (line-end-position)))))
+    (overlay-put ov 'pkg-menu-ov t)
+    (overlay-put ov 'evaporate t)
+    (when (display-graphic-p)
+      (overlay-put ov 'before-string
+                   (propertize "x" 'display
+                               `(left-fringe ,fringe ,fringe-face))))
+    (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 +3827,10 @@ 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
+                                         'package-menu-delete
+                                         'error)
+             (tabulated-list-put-tag "D" t))
     (forward-line)))
 
 (defun package-menu-mark-install (&optional _num)
@@ -3766,7 +3839,10 @@ 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
+                                         'package-menu-install
+                                         'success)
+             (tabulated-list-put-tag "I" t))
     (forward-line)))
 
 (defun package-menu-mark-unmark (&optional _num)
@@ -3774,6 +3850,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 +3858,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 +3869,10 @@ 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
+                                             'package-menu-delete
+                                             'error)
+                 (tabulated-list-put-tag "D" t))
         (forward-line 1)))))
 
 (defvar package--quick-help-keys
@@ -4207,6 +4288,78 @@ package-menu--mark-or-notify-upgrades
             (package-menu--mark-upgrades-1)
           (package-menu--find-and-notify-upgrades))))))
 
+;; Mode-line
+(defcustom package-menu-mode-line t
+  "If non-nil, package-menu will display additional information in mode-line.
+package-menu mode-line information includes: Total packages installed,
+Total packages from all the packages archive, Total packages to upgrade
+and Total new packages available."
+  :type 'boolean
+  :version "31.1")
+
+(defconst package-menu-mode-line-format
+  '((package-menu-mode-line
+     (:eval (when package-menu-mode-line-info
+              (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-mode-line-format ()
+  "Display package-menu mode-line."
+  (when-let* (package-menu-mode-line
+              (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 packages of all package archives")
+                  (installed-help "Total packages installed")
+                  (upgrade-help "Total packages to upgrade")
+                  (new-help "Total new packages available"))
+              (save-excursion
+                (goto-char (point-min))
+                (while (not (eobp))
+                  (cond
+                   ((member (package-menu-get-status)
+                            '("installed" "dependency" "unsigned"))
+                    (setq installed (1+ installed)))
+                   ((equal (package-menu-get-status) "new")
+                    (setq new (1+ new))))
+                  (forward-line)))
+
+              ;; XXX: Add a efficient way for set these variables (?)
+              (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 +4378,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-mode-line-format 'append)
 
   ;; Generate the Package Menu.
   (let ((buf (get-buffer-create "*Packages*")))
-- 
2.49.0

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