Make Rmail summary address display customizable

* lisp/mail/rmailsum.el (rmail-summary-sender-function)
(rmail-summary-recipient-function, rmail-summary-address-width):
New user options.
(rmail-summary--address-display, rmail-summary-name-or-address)
(rmail-summary-recipient-strip-quoted-names)
(rmail-summary-recipient-names): New functions.
(rmail-header-summary): Use them when formatting sender and
recipient fields (bug#80406).

* doc/emacs/rmail.texi (Rmail Make Summary): Document them.

* test/lisp/mail/rmailsum-tests.el: New file.
(rmailsum-tests-name-or-address-prefers-name)
(rmailsum-tests-name-or-address-fallback-to-address)
(rmailsum-tests-recipient-strip-quoted-names-first-line)
(rmailsum-tests-recipient-names-folded)
(rmailsum-tests-recipient-names-fallback-to-address): New tests.

4 files changed, 206 insertions, 39 deletions

diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 987fe3a55d4..d82cd177fa6 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1001,6 +1001,22 @@ use for the summary window.  The variable
 for a message should include the line count of the message.  Setting
 this option to @code{nil} might speed up the generation of summaries.
 
+@vindex rmail-summary-sender-function
+@vindex rmail-summary-recipient-function
+  Rmail formats the sender and recipient fields in summary lines using
+the options @code{rmail-summary-sender-function} and
+@code{rmail-summary-recipient-function}.  For senders, the possible
+values include showing the address (the default), or showing the sender
+name with fallback to the address.  For recipients, the possible values
+include showing addresses from the first line of the @samp{To:} field
+(the default), showing the first recipient name with fallback to
+address, or showing all recipient names with fallback to addresses.
+Both options can also be set to a custom function.
+
+@vindex rmail-summary-address-width
+  The option @code{rmail-summary-address-width} controls the width of
+those fields.
+
 @node Rmail Summary Edit
 @subsection Editing in Summaries
 
diff --git a/etc/NEWS b/etc/NEWS
index 6ea88aca195..d05fed3f8d8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2008,6 +2008,12 @@ to 'imap-open' for 'imap-authenticate' to use, or remove 'plain' from
 already set.
 
 +++
+*** New user options for formatting Rmail summary lines.
+'rmail-summary-sender-function' and 'rmail-summary-recipient-function'
+control how the sender/recipient fields are displayed in the summary.
+'rmail-summary-address-width' controls the width of that field.
+
++++
 *** New user option 'rmail-mime-save-action'.
 This option specifies an action to take after saving a MIME attachment.
 Predefined values include visiting the file in Emacs, jumping to the
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 79c2d04ac4f..6af9bb4653a 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,6 +50,89 @@ Setting this option to nil might speed up the generation of summaries."
   :type 'boolean
   :group 'rmail-summary)
 
+(defcustom rmail-summary-address-width 25
+  "Width of the sender/recipient field in Rmail summary lines."
+  :type 'natnum
+  :version "31.1"
+  :group 'rmail-summary)
+
+(defun rmail-summary--address-display (part)
+  "Return display text for parsed address PART, or nil.
+Prefer a non-empty real name, falling back to a non-empty email address."
+  (let ((name (and (consp part) (cdr part)))
+        (addr (cond ((consp part) (car part))
+                    ((stringp part) part))))
+    (setq name (and (stringp name) (string-trim name)))
+    (setq addr (and (stringp addr) (string-trim addr)))
+    (cond ((and name (> (length name) 0)) name)
+          ((and addr (> (length addr) 0)) addr))))
+
+(defun rmail-summary-name-or-address (address)
+  "Return the first parsed address in ADDRESS as a display string.
+Return the first address's real name when it is non-empty; otherwise
+return its email address when that is non-empty.  If no address yields
+either, return unfolded ADDRESS trimmed of surrounding whitespace."
+  (require 'mail-parse)
+  (let* ((unfolded (replace-regexp-in-string "[\r\n]+[ \t]*" " " address))
+         (first (car (mail-header-parse-addresses unfolded))))
+    (or (rmail-summary--address-display first)
+        (string-trim unfolded))))
+
+(defun rmail-summary-recipient-strip-quoted-names (recipient)
+  "Strip quoted names from the first line of RECIPIENT field.
+Applies `mail-strip-quoted-names' to the first physical line of the
+header field value."
+  (when (string-match "\n" recipient)
+    (setq recipient (substring recipient 0 (match-beginning 0))))
+  (setq recipient (string-trim-right recipient "[ \t]+"))
+  (mail-strip-quoted-names recipient))
+
+(defun rmail-summary-recipient-names (recipient)
+  "Return all parsed addresses in RECIPIENT as display strings.
+For each parsed address, use its non-empty real name, falling back to
+its non-empty email address.  Skip parsed items with neither, and
+return the selected values joined by \", \"."
+  (if (and (stringp recipient) (> (length recipient) 0))
+      (progn
+        (require 'mail-parse)
+        (let* ((unfolded (replace-regexp-in-string "[\r\n]+[ \t]*" " "
+                                                   recipient))
+               (parts (mail-header-parse-addresses unfolded))
+               (results nil))
+          (dolist (part parts)
+            (let ((display (rmail-summary--address-display part)))
+              (when display
+                (push display results))))
+          (mapconcat #'identity (nreverse results) ", ")))
+    ""))
+
+(defcustom rmail-summary-sender-function #'mail-strip-quoted-names
+  "Function used to format the sender field in Rmail summary lines.
+The function is called with the raw contents of the From: field as a
+string, and should return a string."
+  :type '(choice (function-item :tag "Address"
+                                mail-strip-quoted-names)
+                 (function-item :tag "Name (fallback to address)"
+                                rmail-summary-name-or-address)
+                 function)
+  :version "31.1"
+  :group 'rmail-summary)
+
+(defcustom rmail-summary-recipient-function #'rmail-summary-recipient-strip-quoted-names
+  "Function used to format the recipient field in Rmail summary lines.
+The function is called with the raw contents of the To: field as a
+string, and should return a string.  When extracting names, fall back to
+email addresses if no name can be extracted."
+  :type '(choice (function-item :tag "Addresses (first line)"
+                                rmail-summary-recipient-strip-quoted-names)
+                 (function-item :tag "First recipient name (fallback to address)"
+                                rmail-summary-name-or-address)
+                 (function-item :tag "All recipient names (fallback to addresses)"
+                                rmail-summary-recipient-names)
+                 function)
+  :version "31.1"
+  :group 'rmail-summary)
+
 (defcustom rmail-summary-progressively-narrow nil
   "Non-nil means progressively narrow the set of messages produced by summary.
 This enables you to apply the summary criteria on top one another,
@@ -970,26 +1053,39 @@ the message being processed."
                      (t "??????"))))
            "  "
            (save-excursion
-             (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
-                               (mail-strip-quoted-names
-                                (buffer-substring
-                                 (1- (point))
-                                 ;; Get all the lines of the From field
-                                 ;; so that we get a whole comment if there is one,
-                                 ;; so that mail-strip-quoted-names can discard it.
-                                 (progn
-                                   (while (progn (forward-line 1)
-                                                 (looking-at "[ \t]")))
-                                   ;; Back up over newline, then trailing spaces or tabs
-                                   (forward-char -1)
-                                   (skip-chars-backward " \t")
-                                   (point))))))
+             (let* ((from-raw (and (re-search-forward "^From:[ \t]*" nil t)
+                                   (buffer-substring
+                                    (1- (point))
+                                    ;; Get all the lines of the From field
+                                    ;; so that we get a whole comment if there is one,
+                                    ;; so that mail-strip-quoted-names can discard it.
+                                    (progn
+                                      (while (progn (forward-line 1)
+                                                    (looking-at "[ \t]")))
+                                      ;; Back up over newline, then trailing spaces or tabs
+                                      (forward-char -1)
+                                      (skip-chars-backward " \t")
+                                      (point)))))
+                    ;; FROM is used for self-detection and should be
+                    ;; independent of display customization via
+                    ;; `rmail-summary-sender-function'.
+                    (from (and from-raw
+                               (mail-strip-quoted-names from-raw)))
+                    (from-display (and from-raw
+                                       (funcall rmail-summary-sender-function
+                                                from-raw)))
+                    (width rmail-summary-address-width)
+                    (after (min 11 width))
+                    (before (- width after))
                     len mch lo newline)
-               ;; If there are multiple lines in FROM,
-               ;; discard up to the last newline in it.
+               ;; If there are multiple lines in FROM or FROM-DISPLAY,
+               ;; discard up to the last newline in them.
                (while (and (stringp from)
                            (setq newline (string-search "\n" from)))
                  (setq from (substring from (1+ newline))))
+               (while (and (stringp from-display)
+                           (setq newline (string-search "\n" from-display)))
+                 (setq from-display (substring from-display (1+ newline))))
                (if (or (null from)
                        (string-match
                         (or rmail-user-mail-address-regexp
@@ -1004,38 +1100,34 @@ the message being processed."
                      (goto-char (point-min))
                      (if (not (re-search-forward "^To:[ \t]*" nil t))
                          nil
-                       (setq from
+                       (setq from-display
                              (concat "to: "
-                                     (mail-strip-quoted-names
-                                      (buffer-substring
-                                       (point)
-                                       (progn (end-of-line)
-                                              (skip-chars-backward " \t")
-                                              (point)))))))))
-               (if (null from)
-                   "                         "
-                 ;; We are going to return only 25 characters of the
+                                     (funcall rmail-summary-recipient-function
+                                              (mail-fetch-field "To")))))))
+               (if (null from-display)
+                   (make-string width ?\s)
+                 ;; We are going to return only `rmail-summary-address-width' characters of the
                  ;; address, so make sure it is RFC2047 decoded before
                  ;; taking its substring.  This is important when the address is not on the same line as the name, e.g.:
                  ;; To: =?UTF-8?Q?=C5=A0t=C4=9Bp=C3=A1n_?= =?UTF-8?Q?N=C4=9Bmec?=
                  ;; <stepnem@gmail.com>
-                 (setq from (rfc2047-decode-string from))
+                 (setq from-display (rfc2047-decode-string from-display))
                  ;; We cannot tolerate any leftover newlines in From,
                  ;; as that disrupts the rmail-summary display.
                  ;; Newlines can be left in From if it was malformed,
                  ;; e.g. had unbalanced quotes.
-                 (setq from (replace-regexp-in-string "\n+" " " from))
-                 (setq len (length from))
-                 (setq mch (string-match "[@%]" from))
-                 (format "%25s"
-                         (if (or (not mch) (<= len 25))
-                             (substring from (max 0 (- len 25)))
-                           (substring from
-                                      (setq lo (cond ((< (- mch 14) 0) 0)
-                                                     ((< len (+ mch 11))
-                                                      (- len 25))
-                                                     (t (- mch 14))))
-                                      (min len (+ lo 25)))))))))
+                 (setq from-display (replace-regexp-in-string "\n+" " " from-display))
+                 (setq len (length from-display))
+                 (setq mch (string-match "[@%]" from-display))
+                 (format (format "%%%ds" width)
+                         (if (or (not mch) (<= len width))
+                             (substring from-display (max 0 (- len width)))
+                           (substring from-display
+                                      (setq lo (cond ((< (- mch before) 0) 0)
+                                                     ((< len (+ mch after))
+                                                      (- len width))
+                                                     (t (- mch before))))
+                                      (min len (+ lo width)))))))))
    (concat (if (re-search-forward "^Subject:" nil t)
                (let (pos str)
                  (skip-chars-forward " \t")
diff --git a/test/lisp/mail/rmailsum-tests.el b/test/lisp/mail/rmailsum-tests.el
new file mode 100644
index 00000000000..fe9d672ba66
--- /dev/null
+++ b/test/lisp/mail/rmailsum-tests.el
@@ -0,0 +1,53 @@
+;;; rmailsum-tests.el --- tests for rmailsum.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2026 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'rmailsum)
+
+(ert-deftest rmailsum-tests-name-or-address-prefers-name ()
+  (let ((from "Foo Bar <foo@example.test>"))
+    (should (equal (rmail-summary-name-or-address from)
+                   "Foo Bar"))))
+
+(ert-deftest rmailsum-tests-name-or-address-fallback-to-address ()
+  (let ((from "<foo@example.test>"))
+    (should (equal (rmail-summary-name-or-address from)
+                   "foo@example.test"))))
+
+(ert-deftest rmailsum-tests-recipient-strip-quoted-names-first-line ()
+  (let ((to "Foo Bar <foo@example.test>,\n Baz Quux <baz@example.test>"))
+    (should (equal (rmail-summary-recipient-strip-quoted-names to)
+                   "foo@example.test,"))))
+
+(ert-deftest rmailsum-tests-recipient-names-folded ()
+  (let ((to "Foo Bar <foo@example.test>,\n Baz Quux <baz@example.test>"))
+    (should (equal (rmail-summary-recipient-names to)
+                   "Foo Bar, Baz Quux"))))
+
+(ert-deftest rmailsum-tests-recipient-names-fallback-to-address ()
+  (let ((to "Foo Bar <foo@example.test>,\n <baz@example.test>"))
+    (should (equal (rmail-summary-recipient-names to)
+                   "Foo Bar, baz@example.test"))))
+
+(provide 'rmailsum-tests)
+;;; rmailsum-tests.el ends here