From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Andrea Monaco Newsgroups: gmane.emacs.devel Subject: [PATCH] Add command rmail-summary-by-thread (was: Summary by thread in rmail) Date: Tue, 15 Nov 2022 20:07:18 +0100 Message-ID: <87cz9om3yx.fsf@autistici.org> References: <83bkqki1y8.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="38708"; mail-complaints-to="usenet@ciao.gmane.io" Cc: rms@gnu.org, emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Tue Nov 15 20:08:13 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ov1I5-0009rf-FI for ged-emacs-devel@m.gmane-mx.org; Tue, 15 Nov 2022 20:08:13 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ov1HX-0004zu-Q6; Tue, 15 Nov 2022 14:07:39 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ov1HW-0004yW-Du for emacs-devel@gnu.org; Tue, 15 Nov 2022 14:07:38 -0500 Original-Received: from confino.investici.org ([93.190.126.19]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ov1HQ-0003rb-B1; Tue, 15 Nov 2022 14:07:34 -0500 Original-Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4NBbK341jPz10xl; Tue, 15 Nov 2022 19:07:19 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1668539239; bh=K3xf9mHR5uESZnVYYCrT9tdjAq4R3Tm9ecp3IL+ODn8=; h=From:To:Cc:Subject:In-Reply-To:Date:From; b=NT+4q45+px/qgcXjiJAv6CuNUUVyw56t+UvmY3/w8EqWMkj5RaATJyFrIE3/LkOQT Qu+nicbo83FaWutLbl7lNuKCGFcTlasDs8dG2MecY6Q9exbMOyigr0FSyCNknt3FpG ZkUdony2xrLe+jgU7VtRNLSAGOXOn/IpL9C6ffLM= Original-Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: andrea.monaco@autistici.org) by localhost (Postfix) with ESMTPSA id 4NBbK32Wfqz10vJ; Tue, 15 Nov 2022 19:07:19 +0000 (UTC) In-Reply-To: <83bkqki1y8.fsf@gnu.org> (message from Eli Zaretskii on Mon, 10 Oct 2022 10:15:43 +0300) Received-SPF: pass client-ip=93.190.126.19; envelope-from=andrea.monaco@autistici.org; helo=confino.investici.org X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:299876 Archived-At: 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.