[PATCH] Make rmail-summary-by-thread faster

[Andrea Monaco]

I found the first implementation of rmail-summary-by-thread a bit slow.
There's an optimization that escaped me at first: generate another
vector called rmail-summary-message-descendants-vector that holds the
direct descendants of each message, that is the symmetric relation to
rmail-summary-message-parents-vector.  Now it is much faster.


Andrea Monaco



diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b30c32aaffd..9d9c6d16988 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -84,6 +84,11 @@ rmail-summary-message-parents-vector
 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-message-descendants-vector nil
+  "Vector that holds the direct descendants of each message.
+This is the symmetric relation to `rmail-summary-message-parents-vector'.
+  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.
@@ -331,14 +336,16 @@ rmail-summary--split-header-field
     (if header
        (split-string header "[ \f\t\n\r\v,;]+"))))
 
-(defun rmail-summary-fill-message-parents-vector ()
-  "Fill `rmail-summary-message-parents-vector'."
+(defun rmail-summary-fill-message-parents-and-descs-vectors ()
+  "Fill `rmail-summary-message-parents-vector' and 
`rmail-summary-message-descendants-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))
+    (setq rmail-summary-message-descendants-vector
+          (make-vector (1+ rmail-total-messages) nil))
     (let ((msgnum 1))
       (while (<= msgnum rmail-total-messages)
        (let* ((parents nil)
@@ -346,18 +353,23 @@ rmail-summary-fill-message-parents-vector
               (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"
+              (reply-tos (rmail-summary--split-header-field "In-reply-to"
                                                             msgnum)))
          (if subj-par
-             (setq parents (cons (cdr subj-par) parents))
+             (progn
+               (setq parents (cons (cdr subj-par) nil))
+               (aset rmail-summary-message-descendants-vector (cdr subj-par)
+                     (cons msgnum (aref 
rmail-summary-message-descendants-vector (cdr subj-par)))))
            (puthash subject (cons (cons subject msgnum) subj-cell)
                     rmail-summary-subjects-hash-table))
-         (dolist (id (append refs reply-to))
+         (dolist (id (append refs reply-tos))
            (let ((ent
                    (assoc id
                           (gethash id rmail-summary-message-ids-hash-table))))
-             (if ent
-                 (setq parents (cons (cdr ent) parents)))))
+             (when ent
+               (setq parents (cons (cdr ent) parents))
+               (aset rmail-summary-message-descendants-vector (cdr ent)
+                     (cons msgnum (aref 
rmail-summary-message-descendants-vector (cdr ent)))))))
          (aset rmail-summary-message-parents-vector msgnum parents)
          (setq msgnum (1+ msgnum)))))))
 
@@ -387,20 +399,6 @@ rmail-summary
   (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
-            (not (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 (aref encountered-msgs msgnum)
@@ -412,7 +410,7 @@ rmail-summary--walk-thread-message-recursively
       (mapc walk-thread-msg
             (aref rmail-summary-message-parents-vector msgnum))
       (mapc walk-thread-msg
-            (rmail-summary-direct-descendants msgnum encountered-msgs)))))
+            (aref rmail-summary-message-descendants-vector msgnum)))))
 
 ;;;###autoload
 (defun rmail-summary-by-thread (&optional msgnum)
@@ -430,7 +428,7 @@ rmail-summary-by-thread
     (unless (and rmail-summary-message-parents-vector
                 (= (length rmail-summary-message-parents-vector)
                    (1+ rmail-total-messages)))
-      (rmail-summary-fill-message-parents-vector))
+      (rmail-summary-fill-message-parents-and-descs-vectors))
     (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)