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

From: Elijah Gabe Pérez <[email-masked]>
Date: Mon, 16 Jun 2025 13:12:53 -0600

Eli Zaretskii <[email-masked]> writes:

>> This is enabled by default (I forgot to include it in the NEWS entry).
>> The reason why i decided make it an option is because some user
>> may find it annoying.
>
> In what ways could it be annoying?

Fine, I've removed the option.

>> These faces are not for the mode-line, are for the package-menu buffer,
>> specifically for highlight the line where a package was marked for
>> install/delete.
>
> Then I think inverse-video is too radical.  I'd suggest to use bold
> (if supported) or underline (if supported), with inverse-video being
> the last resort.

I've changed it to use `highlight` face instead, following Philip
suggestion.

>> +(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."
>
> This doc string has several grammatical issues, and also lacks some
> important information.  I suggest to rephrase as follows:
>
>    "Indicators for packages to be installed or deleted.
>  The value is an alist whose elements have the form (KIND . MARK),
>  where KIND is the operation to perform, either `install' or `delete',
>  and MARK is a string to indicate that the operation is pending for
>  the package.  The MARK string should satisfy the requirements of the
>  TAG argument of `tabulated-list-put-tag', which see.  It is displayed
>  in the padding area of the package's line.
>
>  Currently, only indicators for installing or deleting a package are
>  supported."

Thanks, it sounds better.

>> +(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)))
>
> Does package-menu use other faces in overlays, and if so, should we
> consider giving this overlay a non-default priority?

AFAIK, there are no other overlays in package-menu.

>From a4829091eec260e35c9a67cbe39fb78ea48bd89a 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.

And allow customize package-menu marks.

* 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-marks-indicators): New user options.
(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                   |   7 ++
 lisp/emacs-lisp/package.el | 132 ++++++++++++++++++++++++++++++++++++-
 2 files changed, 136 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 0c66ac38105..4b728075dbf 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1900,6 +1900,13 @@ the command will only copy those files.
 +++
 *** package-x.el is now obsolete.
 
+---
+*** New user option 'package-menu-marks-indicators'.
+This option controls the kind of mark string to use in package-menu-mark
+commands.
+
+---
+*** Package-menu now highlights packages marked for installation or deletion.
 
 ** RCIRC
 
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 82fcf439a11..5633ed1bdb5 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,37 @@ package-menu--refresh-contents
   (package-refresh-contents package-menu-async))
 (define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1")
 
+(defcustom package-menu-marks-indicators
+  '((install . "I")
+    (delete . "D"))
+  "Indicators for packages to be installed or deleted.
+The value is an alist whose elements have the form (KIND . MARK),
+where KIND is the operation to perform, either `install' or `delete',
+and MARK is a string to indicate that the operation is pending for
+the package.  The MARK string should satisfy the requirements of the
+TAG argument of `tabulated-list-put-tag', which see.  It is displayed
+in the padding area of the package's line.
+
+Currently, only indicators for installing or deleting a package are
+supported."
+  :type '(list (cons :tag "Install mark indicator" symbol string)
+               (cons :tag "Delete mark indicator" symbol string))
+  :version "31.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 +3810,9 @@ 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
+              (alist-get 'delete package-menu-marks-indicators) t))
     (forward-line)))
 
 (defun package-menu-mark-install (&optional _num)
@@ -3766,7 +3821,9 @@ 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
+              (alist-get 'install package-menu-marks-indicators) t))
     (forward-line)))
 
 (defun package-menu-mark-unmark (&optional _num)
@@ -3774,6 +3831,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 +3839,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 +3850,9 @@ 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
+                  (alist-get 'delete package-menu-marks-indicators) t))
         (forward-line 1)))))
 
 (defvar package--quick-help-keys
@@ -4207,6 +4268,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 +4349,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.