[PATCH] Add command rmail-summary-by-thread (was: Summary by thread in rmail)

[Andrea Monaco]

This patch adds a new command rmail-summary-by-thread.  It shows a
summary of all messages that are in the same thread as a given message,
defaulting to current message.

Admittedly it's a bit complex but it works like a charm (in my tests).

First it fills rmail-summary-message-ids-hash-table, that is a hash
table linking Message-Ids with rmail message indices.

Then it fills rmail-summary-subjects-hash-table, that links simplified
Subject fields with the index of the first message having that subject.
(Yeah, I'm totally in love with hash tables!)

Then it uses those to fill rmail-summary-message-parents-vector, a
vector holding the "parents" of each message, that is the messages
referenced in the References and In-reply-to fields of that message,
plus the first message with the same subject.

With all this information, building the thread is just a matter of
walking the graph recursively, traversing parents and descendants of
each message and ticking their index in a local vector.


Andrea Monaco



diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 0144a34e5e..3e3207e974 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -67,6 +67,18 @@ rmail-summary-currently-displayed-msgs
 by `rmail-summary-fill-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 the 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.
@@ -297,6 +309,47 @@ rmail-summary-fill-displayed-messages
              ?y)
        (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-negate ()
   "Toggle display of messages that match the summary and those which do not."
   (interactive)
@@ -318,6 +371,57 @@ rmail-summary
   (interactive)
   (rmail-new-summary "All" '(rmail-summary) nil))
 
+(defun rmail-summary-direct-descendants (msgnum encountered-msgs)
+  "Find all direct descendants of MSGNUM.
+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)
+  "Walk message MSGNUM by ticking parents and descendants in 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 thread as MSGNUM, or current 
message.
+Threads are based on the Subject, References and In-reply-to
+fields."
+  (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.