Make 'rmail-summary-by-thread' faster
* lisp/mail/rmailsum.el (rmail-summary-message-parents-vector) (rmail-summary-message-descendants-vector): Doc fixes. (rmail-summary-message-descendants-vector): New variable. (rmail-summary-fill-message-parents-and-descs-vectors): Renamed from 'rmail-summary-fill-message-parents-vector' and rewritten. (rmail-summary-direct-descendants): Function deleted.
This commit is contained in:
parent
88e59b16cb
commit
7cc2313eb0
1 changed files with 34 additions and 28 deletions
|
@ -80,9 +80,14 @@ commands consecutively. Filled by
|
||||||
|
|
||||||
(defvar rmail-summary-message-parents-vector nil
|
(defvar rmail-summary-message-parents-vector nil
|
||||||
"Vector that holds a list of indices of parents for each message.
|
"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
|
Message A is parent of message B if the id of A appears in the
|
||||||
References or In-reply-to fields of B, or if A is the first
|
\"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.")
|
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 antipode of `rmail-summary-message-parents-vector'.
|
||||||
|
First element is ignored.")
|
||||||
|
|
||||||
(defvar rmail-summary-font-lock-keywords
|
(defvar rmail-summary-font-lock-keywords
|
||||||
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
|
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
|
||||||
|
@ -318,11 +323,13 @@ message with the same subject as B. First element is ignored.")
|
||||||
(defun rmail-summary-fill-message-ids-hash-table ()
|
(defun rmail-summary-fill-message-ids-hash-table ()
|
||||||
"Fill `rmail-summary-message-ids-hash-table'."
|
"Fill `rmail-summary-message-ids-hash-table'."
|
||||||
(with-current-buffer rmail-buffer
|
(with-current-buffer rmail-buffer
|
||||||
(setq rmail-summary-message-ids-hash-table (make-hash-table :test 'equal :size 1024))
|
(setq rmail-summary-message-ids-hash-table
|
||||||
|
(make-hash-table :test 'equal :size 1024))
|
||||||
(let ((msgnum 1))
|
(let ((msgnum 1))
|
||||||
(while (<= msgnum rmail-total-messages)
|
(while (<= msgnum rmail-total-messages)
|
||||||
(let ((id (rmail-get-header "Message-ID" msgnum)))
|
(let ((id (rmail-get-header "Message-ID" msgnum)))
|
||||||
(puthash id (cons (cons id msgnum) (gethash id rmail-summary-message-ids-hash-table))
|
(puthash id (cons (cons id msgnum)
|
||||||
|
(gethash id rmail-summary-message-ids-hash-table))
|
||||||
rmail-summary-message-ids-hash-table))
|
rmail-summary-message-ids-hash-table))
|
||||||
(setq msgnum (1+ msgnum))))))
|
(setq msgnum (1+ msgnum))))))
|
||||||
|
|
||||||
|
@ -331,14 +338,18 @@ message with the same subject as B. First element is ignored.")
|
||||||
(if header
|
(if header
|
||||||
(split-string header "[ \f\t\n\r\v,;]+"))))
|
(split-string header "[ \f\t\n\r\v,;]+"))))
|
||||||
|
|
||||||
(defun rmail-summary-fill-message-parents-vector ()
|
(defun rmail-summary-fill-message-parents-and-descs-vectors ()
|
||||||
"Fill `rmail-summary-message-parents-vector'."
|
"Fill parents and descendats vectors for messages.
|
||||||
|
This populates `rmail-summary-message-parents-vector'
|
||||||
|
and `rmail-summary-message-descendants-vector'."
|
||||||
(with-current-buffer rmail-buffer
|
(with-current-buffer rmail-buffer
|
||||||
(rmail-summary-fill-message-ids-hash-table)
|
(rmail-summary-fill-message-ids-hash-table)
|
||||||
(setq rmail-summary-subjects-hash-table
|
(setq rmail-summary-subjects-hash-table
|
||||||
(make-hash-table :test 'equal :size 1024))
|
(make-hash-table :test 'equal :size 1024))
|
||||||
(setq rmail-summary-message-parents-vector
|
(setq rmail-summary-message-parents-vector
|
||||||
(make-vector (1+ rmail-total-messages) nil))
|
(make-vector (1+ rmail-total-messages) nil))
|
||||||
|
(setq rmail-summary-message-descendants-vector
|
||||||
|
(make-vector (1+ rmail-total-messages) nil))
|
||||||
(let ((msgnum 1))
|
(let ((msgnum 1))
|
||||||
(while (<= msgnum rmail-total-messages)
|
(while (<= msgnum rmail-total-messages)
|
||||||
(let* ((parents nil)
|
(let* ((parents nil)
|
||||||
|
@ -346,18 +357,27 @@ message with the same subject as B. First element is ignored.")
|
||||||
(subj-cell (gethash subject rmail-summary-subjects-hash-table))
|
(subj-cell (gethash subject rmail-summary-subjects-hash-table))
|
||||||
(subj-par (assoc subject subj-cell))
|
(subj-par (assoc subject subj-cell))
|
||||||
(refs (rmail-summary--split-header-field "References" msgnum))
|
(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)))
|
msgnum)))
|
||||||
(if subj-par
|
(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)
|
(puthash subject (cons (cons subject msgnum) subj-cell)
|
||||||
rmail-summary-subjects-hash-table))
|
rmail-summary-subjects-hash-table))
|
||||||
(dolist (id (append refs reply-to))
|
(dolist (id (append refs reply-tos))
|
||||||
(let ((ent
|
(let ((ent
|
||||||
(assoc id
|
(assoc id
|
||||||
(gethash id rmail-summary-message-ids-hash-table))))
|
(gethash id rmail-summary-message-ids-hash-table))))
|
||||||
(if ent
|
(when ent
|
||||||
(setq parents (cons (cdr ent) parents)))))
|
(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)
|
(aset rmail-summary-message-parents-vector msgnum parents)
|
||||||
(setq msgnum (1+ msgnum)))))))
|
(setq msgnum (1+ msgnum)))))))
|
||||||
|
|
||||||
|
@ -387,20 +407,6 @@ the messages that are displayed."
|
||||||
(interactive)
|
(interactive)
|
||||||
(rmail-new-summary "All" '(rmail-summary) nil))
|
(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)
|
(defun rmail-summary--walk-thread-message-recursively (msgnum encountered-msgs)
|
||||||
"Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS, recursively."
|
"Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS, recursively."
|
||||||
(unless (aref encountered-msgs msgnum)
|
(unless (aref encountered-msgs msgnum)
|
||||||
|
@ -412,7 +418,7 @@ already ticked in ENCOUNTERED-MSGS."
|
||||||
(mapc walk-thread-msg
|
(mapc walk-thread-msg
|
||||||
(aref rmail-summary-message-parents-vector msgnum))
|
(aref rmail-summary-message-parents-vector msgnum))
|
||||||
(mapc walk-thread-msg
|
(mapc walk-thread-msg
|
||||||
(rmail-summary-direct-descendants msgnum encountered-msgs)))))
|
(aref rmail-summary-message-descendants-vector msgnum)))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun rmail-summary-by-thread (&optional msgnum)
|
(defun rmail-summary-by-thread (&optional msgnum)
|
||||||
|
@ -430,7 +436,7 @@ headers of the messages."
|
||||||
(unless (and rmail-summary-message-parents-vector
|
(unless (and rmail-summary-message-parents-vector
|
||||||
(= (length rmail-summary-message-parents-vector)
|
(= (length rmail-summary-message-parents-vector)
|
||||||
(1+ rmail-total-messages)))
|
(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)))
|
(let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil)))
|
||||||
(rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
|
(rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
|
||||||
(rmail-new-summary (format "thread containing message %d" msgnum)
|
(rmail-new-summary (format "thread containing message %d" msgnum)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue