From 51589f81323aa5010573ecfa5c3be95416a57df3 Mon Sep 17 00:00:00 2001 From: Andrea Monaco Date: Tue, 15 Nov 2022 20:07:18 +0100 Subject: [PATCH] New Rmail summary "by thread" * lisp/mail/rmailsum.el (rmail-summary-subjects-hash-table) (rmail-summary-message-parents-vector) (rmail-summary-message-ids-hash-table): New variables. (rmail-summary-fill-message-ids-hash-table) (rmail-summary--split-header-field) (rmail-summary-fill-message-parents-vector) (rmail-summary-direct-descendants) (rmail-summary--walk-thread-message-recursively) (rmail-summary-by-thread): New functions. * etc/NEWS: Announce the new Rmail features. --- etc/NEWS | 21 +++++--- lisp/mail/rmailsum.el | 115 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 47fc9f1e8e3..4c7af3c2769 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2156,13 +2156,20 @@ The older form still works but is undocumented. --- *** Rmail partial summaries can now be applied one on top of the other. -You can now narrow the filtering of messages by the summary's criteria -(recipients, topic, senders, etc.) by making a summary of the already -summarized messages. For example, invoking 'rmail-summary-by-senders', -followed by 'rmail-summary-by-topic' will produce a summary where both -the senders and the topic are according to your selection. The new -user option 'rmail-summary-apply-filters-consecutively' controls -whether the stacking of the filters is in effect. +You can now narrow the set of messages selected by Rmail summary's +criteria (recipients, topic, senders, etc.) by making a summary of the +already summarized messages. For example, invoking +'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will +produce a summary where both the senders and the topic are according +to your selection. The new user option +'rmail-summary-progressively-narrow' controls whether the stacking of +the filters is in effect; customize it to a non-nil value to enable +this feature. + +--- +*** New Rmail summary: by thread. +The new command 'rmail-summary-by-thread' produces a summary of +messages that belong to a single thread of discussion. ** EIEIO diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index d72464cb81a..93fc0f5d2bd 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -72,6 +72,18 @@ commands consecutively. Filled by `rmail-summary-populate-displayed-messages'.") (put 'rmail-summary-currently-displayed-msgs 'permanent-local t) +(defvar rmail-summary-message-ids-hash-table nil + "Hash table linking Message IDs of messages with their indices.") + +(defvar rmail-summary-subjects-hash-table nil + "Hash table linking subjects with index of the first message with that subject.") + +(defvar rmail-summary-message-parents-vector nil + "Vector that holds a list of indices of parents for each message. +Message A is parent to message B if the id of A appear in the +References or In-reply-to fields of B, or if A is the first +message with the same subject as B. First element is ignored.") + (defvar rmail-summary-font-lock-keywords '(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted. ("^ *[0-9]+-.*" . font-lock-type-face) ; Unread. @@ -303,6 +315,52 @@ commands consecutively. Filled by t) (forward-line 1)))))) +(defun rmail-summary-fill-message-ids-hash-table () + "Fill `rmail-summary-message-ids-hash-table'." + (with-current-buffer rmail-buffer + (setq rmail-summary-message-ids-hash-table (make-hash-table :test 'equal :size 1024)) + (let ((msgnum 1)) + (while (<= msgnum rmail-total-messages) + (let ((id (rmail-get-header "Message-ID" msgnum))) + (puthash id (cons (cons id msgnum) (gethash id rmail-summary-message-ids-hash-table)) + rmail-summary-message-ids-hash-table)) + (setq msgnum (1+ msgnum)))))) + +(defun rmail-summary--split-header-field (name &optional msgnum) + (let ((header (rmail-get-header name msgnum))) + (if header + (split-string header "[ \f\t\n\r\v,;]+")))) + +(defun rmail-summary-fill-message-parents-vector () + "Fill `rmail-summary-message-parents-vector'." + (with-current-buffer rmail-buffer + (rmail-summary-fill-message-ids-hash-table) + (setq rmail-summary-subjects-hash-table + (make-hash-table :test 'equal :size 1024)) + (setq rmail-summary-message-parents-vector + (make-vector (1+ rmail-total-messages) nil)) + (let ((msgnum 1)) + (while (<= msgnum rmail-total-messages) + (let* ((parents nil) + (subject (rmail-simplified-subject msgnum)) + (subj-cell (gethash subject rmail-summary-subjects-hash-table)) + (subj-par (assoc subject subj-cell)) + (refs (rmail-summary--split-header-field "References" msgnum)) + (reply-to (rmail-summary--split-header-field "In-reply-to" + msgnum))) + (if subj-par + (setq parents (cons (cdr subj-par) parents)) + (puthash subject (cons (cons subject msgnum) subj-cell) + rmail-summary-subjects-hash-table)) + (dolist (id (append refs reply-to)) + (let ((ent + (assoc id + (gethash id rmail-summary-message-ids-hash-table)))) + (if ent + (setq parents (cons (cdr ent) parents))))) + (aset rmail-summary-message-parents-vector msgnum parents) + (setq msgnum (1+ msgnum))))))) + (defun rmail-summary-invert () "Invert the criteria of the current summary. That is, show the messages that are not displayed, and hide @@ -330,6 +388,63 @@ the messages that are displayed." (interactive) (rmail-new-summary "All" '(rmail-summary) nil)) +(defun rmail-summary-direct-descendants (msgnum encountered-msgs) + "Find all direct descendants of MSGNUM, ignoring ENCOUNTERED-MSGS. +Assumes `rmail-summary-message-parents-vector' is filled. Ignores messages +already ticked in ENCOUNTERED-MSGS." + (let (desc + (msg 1)) + (while (<= msg rmail-total-messages) + (when (and + (eq nil (aref encountered-msgs msg)) + (memq msgnum (aref rmail-summary-message-parents-vector msg))) + (setq desc (cons msg desc))) + (setq msg (1+ msg))) + desc)) + +(defun rmail-summary--walk-thread-message-recursively (msgnum encountered-msgs) + "Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS, recursively." + (unless (eq (aref encountered-msgs msgnum) t) + (aset encountered-msgs msgnum t) + (let ((walk-thread-msg + (lambda (msg) + (rmail-summary--walk-thread-message-recursively + msg encountered-msgs)))) + (mapcar walk-thread-msg + (aref rmail-summary-message-parents-vector msgnum)) + (mapcar walk-thread-msg + (rmail-summary-direct-descendants msgnum encountered-msgs))))) + +;;;###autoload +(defun rmail-summary-by-thread (&optional msgnum) + "Display a summary of messages in the same discussion thread as MSGNUM. +Interactively, prompt for MSGNUM, defaulting to the current message. +Threads are based on the \"Subject\", \"References\" and \"In-reply-to\" +headers of the messages." + (interactive + (let* ((msg rmail-current-message) + (prompt (concat "Show thread containing message number"))) + (list (read-number prompt msg)))) + (with-current-buffer rmail-buffer + (unless msgnum + (setq msgnum rmail-current-message)) + (unless (and rmail-summary-message-parents-vector + (= (length rmail-summary-message-parents-vector) + (1+ rmail-total-messages))) + (rmail-summary-fill-message-parents-vector)) + (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) + (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) + (rmail-new-summary (format "thread containing message %d" msgnum) + (list 'rmail-summary-by-thread msgnum) + (if (and rmail-summary-intersect-consecutive-filters + (rmail-summary--exists-1)) + (lambda (msg msgnum) + (and (eq (aref rmail-summary-currently-displayed-msgs msg) + t) + (eq (aref enc-msgs msg) t))) + (lambda (msg msgnum) (eq (aref enc-msgs msg) t))) + msgnum)))) + ;;;###autoload (defun rmail-summary-by-labels (labels) "Display a summary of all messages with one or more LABELS. -- 2.39.2