aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile6
-rw-r--r--piem-lei.el612
-rw-r--r--tests/piem-lei-tests.el120
-rw-r--r--tests/piem-tests.el1
4 files changed, 737 insertions, 2 deletions
diff --git a/Makefile b/Makefile
index 4d88b34..b8d9fe6 100644
--- a/Makefile
+++ b/Makefile
@@ -5,8 +5,8 @@ EMACS = emacs
BATCH = $(EMACS) --batch -Q -L . -L tests
EL = piem.el piem-b4.el piem-elfeed.el piem-eww.el piem-gnus.el \
- piem-maildir.el piem-notmuch.el piem-rmail.el \
- tests/piem-rmail-tests.el tests/piem-tests.el
+ piem-lei.el piem-maildir.el piem-notmuch.el piem-rmail.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
@@ -35,10 +35,12 @@ piem-b4.elc: piem-b4.el piem.elc
piem-elfeed.elc: piem-elfeed.el piem.elc
piem-eww.elc: piem-eww.el piem.elc
piem-gnus.elc: piem-gnus.el piem.elc
+piem-lei.elc: piem-lei.el piem.elc
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
new file mode 100644
index 0000000..5795087
--- /dev/null
+++ b/piem-lei.el
@@ -0,0 +1,612 @@
+;;; piem-lei.el --- lei integration for piem -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Kyle Meyer <kyle@kyleam.com>
+
+;; Author: Kyle Meyer <kyle@kyleam.com>
+;; Keywords: vc, tools
+;; Package-Requires: ((emacs "26.3"))
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'iso8601)
+(require 'json)
+(require 'message)
+(require 'piem)
+(require 'seq)
+(require 'subr-x)
+
+(defgroup piem-lei nil
+ "lei integration for piem."
+ :group 'piem)
+
+
+;;;; Message display
+
+(defface piem-lei-show-header-name
+ '((t :inherit message-header-name))
+ "Face for header names in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-header-from
+ ;; Given it's focused on sending, message.el unsurprisingly doesn't
+ ;; define a -from.
+ '((t :inherit message-header-to))
+ "Face for From headers in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-header-to
+ '((t :inherit message-header-to))
+ "Face for To headers in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-header-cc
+ '((t :inherit message-header-cc))
+ "Face for Cc headers in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-header-other
+ '((t :inherit message-header-other))
+ "Face for all other headers in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-header-subject
+ '((t :inherit message-header-subject))
+ "Face for Subject headers in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-cited-text-1
+ '((t :inherit message-cited-text-1))
+ "Face for 1st-level cited text in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-cited-text-2
+ '((t :inherit message-cited-text-2))
+ "Face for 2nd-level cited text in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-cited-text-3
+ '((t :inherit message-cited-text-3))
+ "Face for 3rd-level cited text in `piem-lei-show-mode' buffers.")
+
+(defface piem-lei-show-cited-text-4
+ '((t :inherit message-cited-text-4))
+ "Face for 4th-level cited text in `piem-lei-show-mode' buffers.")
+
+(defvar-local piem-lei-show-mid nil
+ "Message ID shown in current buffer.")
+
+(defun piem-lei-show--fontify-headers ()
+ (save-excursion
+ (let (last-value-face)
+ (while (looking-at
+ (rx line-start
+ (group (one-or-more (not (or ":" "\n"))) ":")
+ (group (one-or-more not-newline))))
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'font-lock-face 'piem-lei-show-header-name)
+ (put-text-property
+ (match-beginning 2) (match-end 2)
+ 'font-lock-face
+ (setq last-value-face
+ (pcase (downcase (match-string 1))
+ ("cc:" 'piem-lei-show-header-cc)
+ ("from:" 'piem-lei-show-header-from)
+ ("subject:" 'piem-lei-show-header-subject)
+ ("to:" 'piem-lei-show-header-to)
+ (_ 'piem-lei-show-header-other))))
+ (forward-line)
+ ;; Handle values that continue onto next line.
+ (while (eq (char-after) ?\t)
+ (save-excursion
+ (skip-chars-forward "\t")
+ (put-text-property (point) (line-end-position)
+ 'font-lock-face last-value-face))
+ (forward-line))))))
+
+(defun piem-lei-show (mid &optional display)
+ "Show message for MID.
+When called non-interactively, return the buffer but do not display it
+unless DISPLAY is non-nil."
+ (interactive
+ (list (read-string "Message ID: " nil nil (piem-mid))
+ 'display))
+ (with-current-buffer (get-buffer-create "*lei-show*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (call-process "lei" nil '(t nil) nil
+ "q" "--format=text" (concat "m:" mid))
+ (goto-char (point-min))
+ (when (looking-at-p "# blob:")
+ (delete-region (line-beginning-position)
+ (1+ (line-end-position))))
+ (piem-lei-show-mode)
+ (setq piem-lei-show-mid mid)
+ (piem-lei-show--fontify-headers))
+ (if display
+ (pop-to-buffer (current-buffer))
+ (current-buffer))))
+
+(defvar piem-lei-show-mode-font-lock-keywords
+ '(("^> \\(.*\\)" 0 'piem-lei-show-cited-text-1)
+ ("^>> \\(.*\\)" 0 'piem-lei-show-cited-text-2)
+ ("^>>> \\(.*\\)" 0 'piem-lei-show-cited-text-3)
+ ("^>>>> \\(.*\\)" 0 'piem-lei-show-cited-text-4))
+ "Font lock keywords for `piem-lei-show-mode'.")
+
+(defvar piem-lei-show-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "s" #'piem-lei-query)
+ (define-key map "t" #'piem-lei-query-thread)
+ map)
+ "Keymap for `piem-lei-show-mode'.")
+
+(define-derived-mode piem-lei-show-mode special-mode "lei-show"
+ "Major mode for displaying message via lei."
+ :group 'piem-lei
+ (buffer-disable-undo)
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (setq font-lock-defaults (list piem-lei-show-mode-font-lock-keywords t))
+ (setq-local line-move-visual t))
+
+
+;;;; Searching
+
+(defface piem-lei-query-date
+ '((t :inherit font-lock-variable-name-face))
+ "Face for date in `piem-lei-query-mode' buffers.")
+
+(defface piem-lei-query-pct
+ '((t :inherit shadow))
+ "Face for \"search relevance\" in `piem-lei-query-mode' buffers.")
+
+(defface piem-lei-query-from
+ '((t :inherit font-lock-doc-face))
+ "Face for sender name in `piem-lei-query-mode' buffers.")
+
+(defface piem-lei-query-subject
+ '((t :inherit default))
+ "Face for subject in `piem-lei-query-mode' buffers.")
+
+(defun piem-lei-query--read-json-item ()
+ (let ((json-object-type 'alist)
+ (json-array-type 'list)
+ ;; Using symbols for lei-q's output should be fine, though
+ ;; it's a little odd for the "t:" field.
+ (json-key-type 'symbol)
+ (json-false nil)
+ (json-null nil))
+ (json-read)))
+
+(defvar piem-lei-query--date-re
+ (rx string-start
+ (group (= 4 digit) "-" (= 2 digit) "-" (= 2 digit))
+ "T" (group (= 2 digit) ":" (= 2 digit)) ":" (= 2 digit) "Z"
+ string-end))
+
+(defun piem-lei-query--format-date (data)
+ (let ((date (cdr (assq 'dt data))))
+ (propertize
+ (if (string-match piem-lei-query--date-re date)
+ (concat (match-string 1 date) " "
+ (match-string 2 date))
+ (error "Date did not match expected format: %S" date))
+ 'font-lock-face 'piem-lei-query-date)))
+
+;;;###autoload
+(defun piem-lei-query (query)
+ "Call `lei q' with QUERY.
+QUERY is split according to `split-string-and-unquote'."
+ (interactive
+ (list (split-string-and-unquote
+ (read-string "Query: " "d:20.days.ago.. " 'piem-lei-query-history))))
+ (with-current-buffer (get-buffer-create "*lei-query*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (apply #'call-process "lei" nil '(t nil) nil
+ "q" "--format=ldjson" query)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((data (piem-lei-query--read-json-item)))
+ (delete-region (line-beginning-position) (point))
+ (insert
+ (format "%s %3s %-20.20s %s"
+ (piem-lei-query--format-date data)
+ (if-let ((pct (cdr (assq 'pct data))))
+ (propertize
+ (concat (number-to-string (cdr (assq 'pct data)))
+ "%")
+ 'font-lock-face 'piem-lei-query-pct)
+ "")
+ (propertize (let ((from (car (cdr (assq 'f data)))))
+ (or (car from) (cadr from)))
+ 'font-lock-face 'piem-lei-query-from)
+ (propertize (cdr (assq 's data))
+ 'font-lock-face 'piem-lei-query-subject)))
+ (add-text-properties (line-beginning-position) (line-end-position)
+ (list 'piem-lei-query-result data)))
+ (forward-line))
+ (insert "End of lei-q results"))
+ (goto-char (point-min))
+ (piem-lei-query-mode)
+ (pop-to-buffer-same-window (current-buffer))))
+
+(defun piem-lei-query-get-mid (&optional pos)
+ "Return message ID for position POS in a `piem-lei-query-mode' buffer.
+When POS is nil, use the position at the start of the current
+line."
+ (cdr (assq 'm (get-text-property (or pos (line-beginning-position))
+ 'piem-lei-query-result))))
+
+(defun piem-lei-query-show ()
+ "Display message for current `piem-lei-query-mode' line."
+ (interactive)
+ (display-buffer
+ (piem-lei-show
+ (or (piem-lei-query-get-mid)
+ (user-error "No Message ID associated with current line")))
+ '(display-buffer-below-selected
+ (inhibit-same-window . t)
+ (window-height . 0.8))))
+
+(defun piem-lei-query--get-visible-message-window ()
+ (seq-some
+ (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (and (derived-mode-p 'piem-lei-show-mode)
+ w)))
+ (window-list (selected-frame))))
+
+(defun piem-lei-query-next-line (n)
+ "Move to the Nth next query result.
+If a `piem-lei-show-mode' buffer is visible in the frame, update
+it to display the message."
+ (interactive "p")
+ (unless (= n 0)
+ (pcase-let ((ntimes (abs n))
+ (`(,move-fn ,pos-fn)
+ (if (> n 0)
+ (list #'next-single-property-change
+ #'line-end-position)
+ (list #'previous-single-property-change
+ #'line-beginning-position)))
+ (target nil))
+ (while (and (> ntimes 0)
+ (setq target (funcall move-fn
+ (funcall pos-fn)
+ 'piem-lei-query-result)))
+ (cl-decf ntimes))
+ (if (not target)
+ (ding)
+ (goto-char target)
+ (goto-char (line-beginning-position))
+ (when (piem-lei-query--get-visible-message-window)
+ (piem-lei-query-show))))))
+
+(defun piem-lei-query-previous-line (n)
+ "Move to the Nth previous query result.
+If a `piem-lei-show-mode' buffer is visible in the frame, update
+it to display the message."
+ (interactive "p")
+ (piem-lei-query-next-line (- n)))
+
+(defun piem-lei-query-show-or-scroll-up (arg)
+ "Show or scroll up message for current query line.
+If there is a visible `piem-lei-show-mode' buffer for the current
+line's message, scroll its text upward, passing ARG to
+`scroll-up-command'. Otherwise show the message with
+`piem-lei-query-show'."
+ (interactive "^P")
+ (if-let ((mid (piem-lei-query-get-mid)))
+ (let ((w (piem-lei-query--get-visible-message-window)))
+ (if (and w
+ (equal (with-current-buffer (window-buffer w)
+ piem-lei-show-mid)
+ mid))
+ (with-selected-window w
+ (scroll-up-command arg))
+ (piem-lei-query-show)))
+ (ding)))
+
+(defun piem-lei-query-show-or-scroll-down (arg)
+ "Show or scroll down message for current query line.
+If there is a visible `piem-lei-show-mode' buffer for the current
+line's message, scroll its text downward, passing ARG to
+`scroll-down-command'. Otherwise show the message with
+`piem-lei-query-show'."
+ (interactive "^P")
+ (piem-lei-query-show-or-scroll-up
+ (cond ((eq arg '-) nil)
+ (arg (- arg))
+ (t '-))))
+
+(defvar piem-lei-query-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") #'piem-lei-query-show)
+ (define-key map (kbd "DEL") #'piem-lei-query-show-or-scroll-down)
+ (define-key map (kbd "SPC") #'piem-lei-query-show-or-scroll-up)
+ (define-key map "n" #'piem-lei-query-next-line)
+ (define-key map "p" #'piem-lei-query-previous-line)
+ (define-key map "s" #'piem-lei-query)
+ (define-key map "t" #'piem-lei-query-thread)
+ map)
+ "Keymap for `piem-lei-query-mode'.")
+
+(define-derived-mode piem-lei-query-mode special-mode "lei-query"
+ "Major mode for displaying overview of `lei q' results."
+ :group 'piem-lei
+ (buffer-disable-undo)
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (setq-local line-move-visual t))
+
+
+;;;;; Threading
+
+(defface piem-lei-query-thread-marker
+ '((t :inherit default))
+ "Face for thread marker in `piem-lei-query-mode' buffers.")
+
+(defface piem-lei-query-thread-ghost
+ '((t :inherit font-lock-comment-face))
+ "Face for ghost message IDs in `piem-lei-query-mode' buffers.")
+
+;; 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 <https://www.jwz.org/doc/threading.html>.
+
+(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))))
+
+(defvar piem-lei-query--subject-split-re
+ (rx string-start
+ ;; Prefix.
+ (group (zero-or-more space)
+ (or (and (one-or-more (and "bug#" (one-or-more digit) ":"))
+ (one-or-more space)
+ (zero-or-more
+ ;; This pattern...
+ "[" (one-or-more (not (any "]" "\n"))) "]"
+ (one-or-more space)))
+ (one-or-more
+ ;; ... is repeated here. Extract it to an rx-let
+ ;; binding once minimum Emacs version is at least
+ ;; 27.
+ "[" (one-or-more (not (any "]" "\n"))) "]"
+ (one-or-more space))))
+ ;; Main subject. A match consists of at least two islands of
+ ;; non-space characters because there's not much point in
+ ;; eliding one word.
+ (group (one-or-more (not space))
+ (one-or-more space)
+ (not space)
+ (one-or-more anychar))))
+
+(defun piem-lei-query--split-subject (s)
+ (if (string-match piem-lei-query--subject-split-re s)
+ (cons (match-string 1 s) (match-string 2 s))
+ (cons nil s)))
+
+(defun piem-lei-query--elide-subject (s1 s2)
+ (pcase-let ((`(,head2 . ,tail2) (piem-lei-query--split-subject s2)))
+ (if (and s1 head2
+ (let ((tail1 (cdr (piem-lei-query--split-subject s1))))
+ (equal tail1 tail2)))
+ (concat head2 (if (char-displayable-p ?…) "…" "..."))
+ s2)))
+
+(defun piem-lei-query--format-thread-marker (level)
+ (if (= level 0)
+ ""
+ (concat (make-string (* 2 (1- level)) ?\s)
+ (propertize "` " 'font-lock-face 'piem-lei-query-thread-marker))))
+
+(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-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 pt-final subject-prev)
+ (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)))
+ (subject (let ((case-fold-search t))
+ (replace-regexp-in-string
+ (rx string-start
+ (one-or-more "re:" (one-or-more space)))
+ ""
+ (string-trim (cdr (assq 's data)))))))
+ (insert
+ (piem-lei-query--format-date data) " "
+ (piem-lei-query--format-thread-marker depth)
+ (let ((from (car (cdr (assq 'f data)))))
+ (propertize (or (car from) (cadr from))
+ 'font-lock-face 'piem-lei-query-from))
+ (if (equal subject subject-prev)
+ ""
+ (concat " "
+ (propertize (piem-lei-query--elide-subject
+ subject-prev subject)
+ 'font-lock-face
+ 'piem-lei-query-subject))))
+ (add-text-properties (line-beginning-position)
+ (line-end-position)
+ (list 'piem-lei-query-result data))
+ (setq subject-prev subject))
+ (insert (make-string 17 ?\s) ; Date alignment.
+ (piem-lei-query--format-thread-marker depth)
+ (propertize (concat " <" mid-msg ">")
+ 'font-lock-face
+ 'piem-lei-query-thread-ghost))
+ (setq subject-prev nil))
+ (when (equal mid-msg mid)
+ (setq pt-final (line-beginning-position)))
+ (insert ?\n)))
+ (insert "End of lei-q results"))
+ (goto-char (or pt-final (point-min)))
+ (piem-lei-query-mode)
+ (pop-to-buffer-same-window (current-buffer)))))
+
+
+;;;; piem integration
+
+(defun piem-lei-get-mid ()
+ "Return the message ID of a lei buffer."
+ (cond ((derived-mode-p 'piem-lei-show-mode)
+ piem-lei-show-mid)
+ ((derived-mode-p 'piem-lei-query-mode)
+ (piem-lei-query-get-mid))))
+
+(defun piem-lei-get-inbox ()
+ "Return inbox name from a lei buffer."
+ (when-let ((mid (piem-lei-get-mid)))
+ (with-temp-buffer
+ (call-process "lei" nil '(t nil) nil
+ "q" "--format=mboxrd" (concat "m:" mid))
+ (goto-char (point-min))
+ (piem-inbox-by-header-match))))
+
+(defun piem-lei-known-mid-p (mid)
+ "Return non-nil if MID is known to lei.
+The message ID should not include have surrounding brackets."
+ (not (string-empty-p
+ (with-temp-buffer
+ (call-process "lei" nil '(t nil) nil
+ "q" "--format=ldjson" (concat "m:" mid))
+ (buffer-string)))))
+
+(defun piem-lei-mid-to-thread (mid)
+ "Return a function that inserts an mbox for MID's thread."
+ (when (piem-lei-known-mid-p mid)
+ (lambda ()
+ (call-process "lei" nil '(t nil) nil
+ "q" "--format=mboxrd" "--threads"
+ (concat "m:" mid)))))
+
+;;;###autoload
+(define-minor-mode piem-lei-mode
+ "Toggle lei support for piem.
+With a prefix argument ARG, enable piem-lei mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
+ :global t
+ :init-value nil
+ (if piem-lei-mode
+ (progn
+ (add-hook 'piem-get-inbox-functions #'piem-lei-get-inbox)
+ (add-hook 'piem-get-mid-functions #'piem-lei-get-mid)
+ (add-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread))
+ (remove-hook 'piem-get-inbox-functions #'piem-lei-get-inbox)
+ (remove-hook 'piem-get-mid-functions #'piem-lei-get-mid)
+ (remove-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread)))
+
+;;; 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 0000000..dd58360
--- /dev/null
+++ b/tests/piem-lei-tests.el
@@ -0,0 +1,120 @@
+;;; piem-lei-tests.el --- tests for piem-lei -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 all contributors <piem@inbox.kyleam.com>
+
+;; Author: Kyle Meyer <kyle@kyleam.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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))))
+
+(ert-deftest piem-lei-query--elide-subject:keep-original ()
+ (should (equal "ghi jlk"
+ (piem-lei-query--elide-subject
+ nil
+ "ghi jlk")))
+ (should (equal "ghi jlk"
+ (piem-lei-query--elide-subject
+ "abc def"
+ "ghi jlk")))
+ (should (equal "abc def"
+ (piem-lei-query--elide-subject
+ "[PATCH] abc def"
+ "abc def")))
+ (should (equal "abc def"
+ (piem-lei-query--elide-subject
+ "[bug#00000] [PATCH] abc def"
+ "abc def")))
+ (should (equal "abc def"
+ (piem-lei-query--elide-subject
+ "[PATCH] abc def"
+ "abc def")))
+ (should (equal "[bug#00000] [PATCH v2] abc"
+ (piem-lei-query--elide-subject
+ "[bug#00000] [PATCH] abc"
+ "[bug#00000] [PATCH v2] abc")))
+ (should (equal "[bug#00000] [PATCH v2] ghi jlk mno"
+ (piem-lei-query--elide-subject
+ "[bug#00000] [PATCH] abc def"
+ "[bug#00000] [PATCH v2] ghi jlk mno"))))
+
+(defvar piem-lei-tests-elide-string (if (char-displayable-p ?…) "…" "..."))
+
+(ert-deftest piem-lei-query--elide-subject:elide ()
+ (should (equal (concat "[PATCH v2] " piem-lei-tests-elide-string)
+ (piem-lei-query--elide-subject
+ "[PATCH] abc def"
+ "[PATCH v2] abc def")))
+ (should (equal (concat "[bug#00000] [PATCH v2] " piem-lei-tests-elide-string)
+ (piem-lei-query--elide-subject
+ "[bug#00000] [PATCH] abc def"
+ "[bug#00000] [PATCH v2] abc def")))
+ (should (equal (concat "bug#00000: [PATCH v2] " piem-lei-tests-elide-string)
+ (piem-lei-query--elide-subject
+ "[bug#00000] [PATCH] abc def"
+ "bug#00000: [PATCH v2] abc def"))))
+
+(provide 'piem-lei-tests)
+;;; piem-lei-tests.el ends here
diff --git a/tests/piem-tests.el b/tests/piem-tests.el
index 5f01a5e..91beb9a 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 ()