[PATCH] Summary by thread in rmail

[Andrea Monaco]

I had some code ready.  This only looks at the Subject field.  You can
invoke it with rmail-thread-summary and it creates a buffer called
e.g. RMAIL-thread-summary that is independent of RMAIL-summary.  There's
still no code to update the summary after getting new mail.  It's basic,
but it works.


Let me know,

Andrea Monaco



diff --git a/lisp/mail/rmailthread.el b/lisp/mail/rmailthread.el
new file mode 100644
index 0000000000..a06d0ab144
--- /dev/null
+++ b/lisp/mail/rmailthread.el
@@ -0,0 +1,147 @@
+
+(defvar rmail-thread-summary-buffer nil)
+(put 'rmail-thread-summary-buffer 'permanent-local t)
+
+
+
+
+(defun rmail-get-create-thread-summary-buffer ()
+  "Return the Rmail thread summary buffer.
+If necessary, it is created and undo is disabled."
+  (if (and rmail-thread-summary-buffer (buffer-name 
rmail-thread-summary-buffer))
+      rmail-thread-summary-buffer
+    (let ((buff (generate-new-buffer (concat (buffer-name) 
"-thread-summary"))))
+      (with-current-buffer buff
+       (setq buffer-undo-list t))
+      buff)))
+
+
+
+(defun rmail-new-thread-summary (desc redo function &rest args)
+  "Create a summary of selected messages by thread."
+  (message "Computing thread summary lines...")
+  (unless rmail-buffer
+    (error "No RMAIL buffer found"))
+  (let (mesg was-in-summary sumbuf)
+    (if (derived-mode-p 'rmail-summary-mode)
+       (setq was-in-summary t))
+    (with-current-buffer rmail-buffer
+      (setq rmail-thread-summary-buffer (rmail-new-thread-summary-1 desc redo 
function args)
+           ;; r-s-b is buffer-local.
+           sumbuf rmail-thread-summary-buffer
+           mesg rmail-current-message))
+    ;; Now display the summary buffer and go to the right place in it.
+    (unless was-in-summary
+      (if (and (one-window-p)
+              pop-up-windows
+              (not pop-up-frames))
+         ;; If there is just one window, put the summary on the top.
+         (progn
+           (split-window (selected-window) rmail-summary-window-size)
+           (select-window (next-window (frame-first-window)))
+           (rmail-pop-to-buffer sumbuf)
+           ;; If pop-to-buffer did not use that window, delete that
+           ;; window.  (This can happen if it uses another frame.)
+           (if (not (eq sumbuf (window-buffer (frame-first-window))))
+               (delete-other-windows)))
+       (rmail-pop-to-buffer sumbuf))
+      (set-buffer rmail-buffer))
+      ;; This is how rmail makes the summary buffer reappear.
+      ;; We do this here to make the window the proper size.
+      ;(rmail-select-summary nil)
+                                       ;(set-buffer sumbuf))
+    (switch-to-buffer sumbuf)
+    ;(rmail-summary-goto-msg mesg t t)
+    ;(rmail-summary-construct-io-menu)
+    (message "Computing thread summary lines... done")))
+
+
+
+(defun rmail-new-thread-summary-1 (description redo function args)
+  (let ((summary-msgs ())
+       (rmail-new-thread-summary-line-count 0)
+       ordered-threads
+       (threadbuf (rmail-get-create-thread-summary-buffer)))
+    ;; Scan the messages, getting their summary strings
+    ;; and putting the list of them in SUMMARY-MSGS.
+    (let* ((msgnum 1)
+          (main-buffer (current-buffer))
+          (total rmail-total-messages)
+          (rmail-thread-hash-table (make-hash-table :test 'equal :size 1024))
+          (inhibit-read-only t))
+      (save-excursion
+       ;; Go where the mbox text is.
+       (if (rmail-buffers-swapped-p)
+           (set-buffer rmail-view-buffer))
+       (let ((old-min (point-min-marker))
+             (old-max (point-max-marker)))
+         (unwind-protect
+             ;; Can't use save-restriction here; that doesn't work if we
+             ;; plan to modify text outside the original restriction.
+             (save-excursion
+               (widen)
+               (goto-char (point-min))
+               (while (>= total msgnum)
+                 (with-current-buffer main-buffer
+                   ;; First test whether to include this message.
+                   (if (or (null function)
+                           (apply function msgnum args))
+                       (let* ((subject (rmail-simplified-subject msgnum))
+                              (cell (gethash subject rmail-thread-hash-table))
+                              (th cell)
+                              thread)
+                         (while (and (not thread) th)
+                           (if (equal (caar th) subject)
+                               (setq thread (car th)))
+                           (setq th (cdr th)))
+                         (if thread
+                             (setcdr thread
+                                     (cons (cons msgnum (rmail-get-summary 
msgnum)) (cdr thread)))
+                           (progn
+                             (let* ((newthread (list subject (cons msgnum 
(rmail-get-summary msgnum))))
+                                    (newcell (cons newthread cell)))
+                               (setq cell newcell)
+                               (puthash subject newcell 
rmail-thread-hash-table)
+                               (setq ordered-threads (cons newthread 
ordered-threads)))))
+                         (setq msgnum (1+ msgnum))
+                         (if (and (not (zerop msgnum))
+                                  (zerop (% msgnum 10)))
+                             (message "Computing thread summary lines... %d"
+                                      msgnum))))))
+               (setq ordered-threads (nreverse ordered-threads))))
+         (narrow-to-region old-min old-max))))
+    (setq rmail-thread-summary-buffer nil)
+    (save-excursion
+      (let ((rbuf (current-buffer))
+           (total rmail-total-messages))
+       (set-buffer threadbuf)
+       ;; Set up the summary buffer's contents.
+       (let ((buffer-read-only nil))
+         (erase-buffer)
+         (while ordered-threads
+           (let ((thread-message (cdar ordered-threads)))
+             (setq thread-message (nreverse thread-message))
+             (princ (cdar thread-message) threadbuf)
+             (setq thread-message (cdr thread-message))
+             (while thread-message
+               (let* ((suml (cdar thread-message))
+                      (newsuml (concat (substring suml 0 42) "  " (substring 
suml 42))))
+                 (princ newsuml threadbuf))
+               (setq thread-message (cdr thread-message))))
+           (setq ordered-threads (cdr ordered-threads)))
+         (goto-char (point-min)))
+       ;; Set up the rest of its state and local variables.
+       (setq buffer-read-only t)
+       (rmail-summary-mode)
+       (setq-local minor-mode-alist (list (list t (concat ": " description))))
+       (setq rmail-buffer rbuf
+             rmail-summary-redo redo
+             rmail-total-messages total)))
+    threadbuf))
+
+
+
+(defun rmail-thread-summary ()
+  "Display a summary of all messages by thread, one line per message."
+  (interactive)
+  (rmail-new-thread-summary "All" '(rmail-thread-summary) nil))