From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:aacc::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms12 with LMTPS id yfFBIjzpu2DVeAAAsNZ9tg (envelope-from ); Sat, 05 Jun 2021 21:14:36 +0000 Received: from out2.migadu.com ([2001:41d0:2:aacc::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id nrIcIjjpu2CoXwAAB5/wlQ (envelope-from ); Sat, 05 Jun 2021 21:14:32 +0000 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=kyleam.com; s=key1; t=1622927672; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=irf00Pi2jTTzIPJAzBj8C6ulZY/JZH2ltx1K+jt7oUo=; b=kxKh+Is6p4vipptU/3PooN8WUUQJ5BTLiLo72bTb0YQ8HWl756z/phjoVg/V7KdI+QkXFv Y3HKmgZ9jPH7/Y2VlnpofABm4t8eRl8dqBU1NllryT0Mp4Qx6y5xNPDGHGb6uT1Tnfj1fb TKMWt/5ep/altNU/kDopWHxa5awREyUvCxYpuPALG3HmmEhM3BOEFUJTtOqGregob0ArNV BCykcU+JBAHJ5e797Wh+LQtZF1o5QG6zgdFLToPlcLx8iBtgSfOZgidsXyhkVwFjI3/7CH gfHPbBvG2geGFQ6cKfsBzXR1o64IOQJ3+vZkINq6cr/wGp6ohcwMW5QcBS9o8A== From: Kyle Meyer To: piem@inbox.kyleam.com Subject: [PATCH 06/18] lei: Add command for viewing a thread Date: Sat, 5 Jun 2021 17:13:50 -0400 Message-Id: <20210605211402.20304-7-kyle@kyleam.com> In-Reply-To: <20210605211402.20304-1-kyle@kyleam.com> References: <20210605211402.20304-1-kyle@kyleam.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Migadu-Flow: FLOW_OUT X-Migadu-Auth-User: kyle@kyleam.com X-TUID: VUGsVbxZsyAh piem-lei-query presents a message-based overview. In many cases the caller will want to use that search result as a seed for finding the associated thread. Add a command that construct thread for a given message. The threading algorithm is based on public-inbox's. Some details may have been lost in translation, but I haven't spotted any differences yet when doing side-by-side comparisons of output from piem-lei-query-thread and public-inbox's web interface. And testing with a few ~100-message threads, the performance seems to be okay. The appearance also follows public-inbox's, which I like. --- Makefile | 3 +- piem-lei.el | 147 ++++++++++++++++++++++++++++++++++++++++ tests/piem-lei-tests.el | 74 ++++++++++++++++++++ tests/piem-tests.el | 1 + 4 files changed, 224 insertions(+), 1 deletion(-) create mode 100644 tests/piem-lei-tests.el diff --git a/Makefile b/Makefile index dac422b2..b8d9fe6f 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,7 @@ BATCH = $(EMACS) --batch -Q -L . -L tests EL = piem.el piem-b4.el piem-elfeed.el piem-eww.el piem-gnus.el \ piem-lei.el piem-maildir.el piem-notmuch.el piem-rmail.el \ - tests/piem-rmail-tests.el tests/piem-tests.el + tests/piem-lei-tests.el tests/piem-rmail-tests.el tests/piem-tests.el ELC = $(EL:.el=.elc) all: compile Documentation/piem.info piem-autoloads.el @@ -40,6 +40,7 @@ piem-maildir.elc: piem-maildir.el piem-notmuch.elc: piem-notmuch.el piem.elc piem-rmail.elc: piem-rmail.el piem.elc piem.elc: piem.el piem-maildir.elc +tests/piem-lei-tests.elc: tests/piem-lei-tests.el piem-lei.elc tests/piem-rmail-tests.elc: tests/piem-rmail-tests.el piem-rmail.elc tests/piem-tests.elc: tests/piem-tests.el piem.elc diff --git a/piem-lei.el b/piem-lei.el index 12ccd870..1b744213 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -21,6 +21,8 @@ ;;; Code: +(require 'cl-lib) +(require 'iso8601) (require 'json) (require 'message) (require 'piem) @@ -226,5 +228,150 @@ (define-derived-mode piem-lei-query-mode special-mode "lei-query" (setq buffer-read-only t) (setq-local line-move-visual t)) + +;;;;; Threading + +;; The approach here tries to loosely follow what is in public-inbox's +;; SearchThread.pm, which in turn is a modified version of the +;; algorithm described at . + +(cl-defstruct piem-lei-msg mid parent children time ghost) + +(defun piem-lei-query--add-child (parent child) + (let ((mid-parent (piem-lei-msg-mid parent)) + (mid-child (piem-lei-msg-mid child))) + (when (equal mid-parent mid-child) + (error "Parent and child have same message ID: %s" + mid-parent)) + (when-let ((parent-old (piem-lei-msg-parent child))) + (setf (piem-lei-msg-children parent-old) + (delq child (piem-lei-msg-children parent-old)))) + (push child (piem-lei-msg-children parent)) + (setf (piem-lei-msg-parent child) parent))) + +(defun piem-lei-query--has-descendant (msg1 msg2) + "Is MSG2 a descendant of MSG1?" + (let ((msg1-mid (piem-lei-msg-mid msg1)) + seen) + (catch 'stop + (while msg2 + (let ((msg2-mid (piem-lei-msg-mid msg2))) + (when (or (equal msg1-mid msg2-mid) + (member msg2 seen)) + (throw 'stop t)) + (push msg2-mid seen)) + (setq msg2 (piem-lei-msg-parent msg2))) + nil))) + +(defun piem-lei-query--thread (records) + "Thread messages in RECORDS. + +RECORDS is a list of alists with information from `lei q'. This +information is used to construct, link, and order `piem-lei-msg' +objects. + +Return a list with a `piem-lei-msg' object for each root." + (let ((thread (make-hash-table :test #'equal))) + (dolist (record records) + (let ((mid (cdr (assq 'm record)))) + (puthash mid + (make-piem-lei-msg + :mid mid :time (cdr (assq 'time record))) + thread))) + (dolist (record (sort (copy-sequence records) + (lambda (a b) + (time-less-p (cdr (assq 'time a)) + (cdr (assq 'time b)))))) + (let ((msg-prev nil) + (msg-cur (gethash (cdr (assq 'm record)) thread))) + (dolist (ref (cdr (assq 'refs record))) + (let ((msg (or (gethash ref thread) + (puthash ref + (make-piem-lei-msg :mid ref :ghost t) + thread)))) + (when (and msg-prev + (not (piem-lei-msg-parent msg)) + (not (piem-lei-query--has-descendant msg msg-prev))) + (piem-lei-query--add-child msg-prev msg)) + (setq msg-prev msg))) + (when (and msg-prev + (not (piem-lei-query--has-descendant msg-cur msg-prev))) + (piem-lei-query--add-child msg-prev msg-cur)))) + (let (roots) + (maphash + (lambda (_ v) + (setf (piem-lei-msg-children v) + (sort (piem-lei-msg-children v) + (lambda (a b) + (time-less-p (piem-lei-msg-time a) + (piem-lei-msg-time b))))) + (unless (piem-lei-msg-parent v) + (push v roots))) + thread) + (nreverse roots)))) + +(defun piem-lei-query--format-thread-marker (level) + (if (= level 0) + "" + (concat (make-string (* 2 (1- level)) ?\s) + "` "))) + +(defun piem-lei-query--slurp (args) + (with-temp-buffer + (apply #'call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" args) + (goto-char (point-min)) + (let (items) + (while (not (eobp)) + (let ((item (piem-lei-query--read-json-item))) + (push (cons 'time (encode-time + (iso8601-parse (cdr (assq 'dt item))))) + item) + (push (cons (cdr (assq 'm item)) item) items)) + (forward-line)) + (nreverse items)))) + +(defun piem-lei-query-thread (mid) + "Show thread containing message MID." + (interactive + (list (or (piem-lei-query-get-mid) + (read-string "Message ID: " nil nil (piem-mid))))) + (let* ((records (piem-lei-query--slurp + (list "--threads" (concat "m:" mid)))) + (msgs (piem-lei-query--thread records)) + depths) + (with-current-buffer (get-buffer-create "*lei-thread*") + (let ((inhibit-read-only t)) + (erase-buffer) + (while msgs + (let* ((msg (pop msgs)) + (mid-msg (piem-lei-msg-mid msg)) + (children (piem-lei-msg-children msg)) + (depth (1+ (or (cdr (assoc (piem-lei-msg-parent msg) depths)) + -1)))) + (when children + (setq msgs (append children msgs))) + (push (cons msg depth) depths) + (if (not (piem-lei-msg-ghost msg)) + (let ((data (cdr (assoc mid-msg records)))) + (insert + (piem-lei-query--format-date data) " " + (piem-lei-query--format-thread-marker depth) + (let ((from (car (cdr (assq 'f data))))) + (or (car from) (cadr from))) + (concat " " + (cdr (assq 's data)))) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'piem-lei-query-result data))) + (insert (make-string 17 ?\s) ; Date alignment. + (piem-lei-query--format-thread-marker depth) + (concat " <" mid-msg ">"))) + (insert ?\n))) + (insert "End of lei-q results")) + (goto-char (point-min)) + (piem-lei-query-mode) + (pop-to-buffer-same-window (current-buffer))))) + ;;; piem-lei.el ends here (provide 'piem-lei) diff --git a/tests/piem-lei-tests.el b/tests/piem-lei-tests.el new file mode 100644 index 00000000..e20c62fa --- /dev/null +++ b/tests/piem-lei-tests.el @@ -0,0 +1,74 @@ +;;; piem-lei-tests.el --- tests for piem-lei -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 all contributors + +;; Author: Kyle Meyer + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'ert) +(require 'piem-lei) + +(ert-deftest piem-lei-query--add-child () + (should-error + (piem-lei-query--add-child + (make-piem-lei-msg :mid "m1") + (make-piem-lei-msg :mid "m1"))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (equal (piem-lei-msg-parent m2) m1)) + (should (equal (piem-lei-msg-children m1) (list m2)))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3")) + (m4 (make-piem-lei-msg :mid "m4"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m1 m4) + (piem-lei-query--add-child m3 m2) + (should (equal (piem-lei-msg-parent m2) m3)) + (should (equal (piem-lei-msg-children m1) (list m4))) + (should (equal (piem-lei-msg-children m3) (list m2))))) + +(ert-deftest piem-lei-query--has-descendant () + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (should-not + (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1"))) + (should (piem-lei-query--has-descendant m1 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m2 m3) + (should (piem-lei-query--has-descendant m1 m2)) + (should (piem-lei-query--has-descendant m1 m3)) + (should (piem-lei-query--has-descendant m2 m3)) + (should-not (piem-lei-query--has-descendant m2 m1)) + (should-not (piem-lei-query--has-descendant m3 m2)) + (should-not (piem-lei-query--has-descendant m3 m1)))) + +(provide 'piem-lei-tests) +;;; piem-lei-tests.el ends here diff --git a/tests/piem-tests.el b/tests/piem-tests.el index 5f01a5e9..91beb9a5 100644 --- a/tests/piem-tests.el +++ b/tests/piem-tests.el @@ -21,6 +21,7 @@ (require 'ert) (require 'piem) +(require 'piem-lei-tests) (require 'piem-rmail-tests) (ert-deftest piem-message-link-re () -- 2.31.1