public-inbox's upcoming lei (local email interface) opens up a lot of possibilities for integration with Emacs. This series is focused on adding basic commands to browse search results. Here's an example sequence of commands: * `M-x piem-lei-query' <search terms> There's no keybinding in piem-dispatch yet because the plan is to add a transient with some lei-q arguments. * RET (piem-lei-query-show) or SPC (piem-lei-query-show-or-scroll-up) to see a result. * t (piem-lei-query-thread) to see an overview of the message's thread. lei supports both local and remote operations, but the changes here are assuming that the messages are available locally. Using remote externals should work (lightly tested), but it involves network activity that could be avoided if the commands were written with remote operations in mind. I'm still not sure how the interface will settle, so I'm using that as an excuse for holding off on starting the documentation. [ 1/18] lei: Add command and mode for displaying a message [ 2/18] piem-lei-show: Let caller suppress displaying buffer [ 3/18] piem-lei-show: Highlight headers and quoted text [ 4/18] lei: Add command and mode for displaying overview of search results [ 5/18] lei query: Add piem-lei-show wrapper for displaying line's message [ 6/18] lei: Add command for viewing a thread [ 7/18] lei query: Fontify results [ 8/18] piem-lei-query-thread: Position point on seed message [ 9/18] piem-lei-query-thread: Drop repeated subjects [10/18] piem-lei-query-thread: Deal with multiple "re:"s [11/18] piem-lei-query-thread: Omit main part of subject if shared [12/18] piem-lei-query-thread: Add bug#NNN special case when eliding subject [13/18] lei query: Add next/previous line variants that update message buffer [14/18] piem-lei-show: Record message ID [15/18] lei query: Add commands for showing or scrolling message buffer [16/18] lei: Configure bindings for query and show modes [17/18] lei: Wire up piem.el hooks [18/18] piem-lei-query-thread: Use piem-lei-get-mid to get message ID Makefile | 6 +- piem-lei.el | 612 ++++++++++++++++++++++++++++++++++++++++ tests/piem-lei-tests.el | 120 ++++++++ tests/piem-tests.el | 1 + 4 files changed, 737 insertions(+), 2 deletions(-) create mode 100644 piem-lei.el create mode 100644 tests/piem-lei-tests.el base-commit: 5bc055a18ee987cd950f948830e9eef8855fd41b -- 2.31.1
This command is a simple wrapper around `lei q --format=text m:MID', letting lei handle the details. Things will eventually need to get more complicated (e.g., attachment handling, signatures, replies), but this should do for now. --- Makefile | 3 ++- piem-lei.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 1 deletion(-) create mode 100644 piem-lei.el diff --git a/Makefile b/Makefile index 4d88b342..dac422b2 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ 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 \ + piem-lei.el piem-maildir.el piem-notmuch.el piem-rmail.el \ tests/piem-rmail-tests.el tests/piem-tests.el ELC = $(EL:.el=.elc) @@ -35,6 +35,7 @@ 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 diff --git a/piem-lei.el b/piem-lei.el new file mode 100644 index 00000000..5b986fc0 --- /dev/null +++ b/piem-lei.el @@ -0,0 +1,58 @@ +;;; 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 'piem) + +(defgroup piem-lei nil + "lei integration for piem." + :group 'piem) + +\f +;;;; Message display + +(defun piem-lei-show (mid) + "Show message for MID." + (interactive + (list (read-string "Message ID: " nil nil (piem-mid)))) + (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)) + (pop-to-buffer (current-buffer)))) + +(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-local line-move-visual t)) + +;;; piem-lei.el ends here +(provide 'piem-lei) -- 2.31.1
piem-lei-show switches to the message buffer with pop-to-buffer, but that behavior won't work well in the context of a mode that gives an overview of lei-q search results. In that case, a wrapper command will want to control the display of the buffer so that it can keep a split window layout and avoid switching to the piem-lei-show-mode buffer. And more generally, Lisp callers are likely to want to handle the display themselves. Add an optional 'display' parameter that defaults to nil for non-interactive calls. --- piem-lei.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 5b986fc0..fe6ab79a 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -30,10 +30,13 @@ (defgroup piem-lei nil \f ;;;; Message display -(defun piem-lei-show (mid) - "Show message for MID." +(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)))) + (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) @@ -44,7 +47,9 @@ (defun piem-lei-show (mid) (delete-region (line-beginning-position) (1+ (line-end-position)))) (piem-lei-show-mode)) - (pop-to-buffer (current-buffer)))) + (if display + (pop-to-buffer (current-buffer)) + (current-buffer)))) (define-derived-mode piem-lei-show-mode special-mode "lei-show" "Major mode for displaying message via lei." -- 2.31.1
Piggyback off of message-* faces to hopefully fit in nicely with themes and expectations. Leave other highlighting (e.g., of diffs), until later. --- piem-lei.el | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index fe6ab79a..291964fc 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'message) (require 'piem) (defgroup piem-lei nil @@ -30,6 +31,77 @@ (defgroup piem-lei nil \f ;;;; 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.") + +(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 @@ -46,17 +118,26 @@ (defun piem-lei-show (mid &optional display) (when (looking-at-p "# blob:") (delete-region (line-beginning-position) (1+ (line-end-position)))) - (piem-lei-show-mode)) + (piem-lei-show-mode) + (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'.") + (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)) ;;; piem-lei.el ends here -- 2.31.1
The output is intended to resemble search in public-inbox's web interface: an entry for each matching message. This is different from notmuch-search's output in that results are not grouped in their thread. I like notmuch's interface, although I'm not sure that trying to reshape lei-q's JSON output into something like that is worth the code complication or computation cost. The plan is to eventually wire this up to a transient to allow the caller to specify arguments (e.g., --only to restrict the search results to a particular inbox). --- piem-lei.el | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 291964fc..ed153c26 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'json) (require 'message) (require 'piem) @@ -140,5 +141,72 @@ (define-derived-mode piem-lei-show-mode special-mode "lei-show" (setq font-lock-defaults (list piem-lei-show-mode-font-lock-keywords t)) (setq-local line-move-visual t)) +\f +;;;; Searching + +(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)))) + (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)))) + +;;;###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)))) + (concat (number-to-string (cdr (assq 'pct data))) + "%") + "") + (let ((from (car (cdr (assq 'f data))))) + (or (car from) (cadr from))) + (cdr (assq 's data)))) + (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)))) + +(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)) + ;;; piem-lei.el ends here (provide 'piem-lei) -- 2.31.1
--- piem-lei.el | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index ed153c26..12ccd870 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -200,6 +200,24 @@ (defun piem-lei-query (query) (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)))) + (define-derived-mode piem-lei-query-mode special-mode "lei-query" "Major mode for displaying overview of `lei q' results." :group 'piem-lei -- 2.31.1
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)) +\f +;;;;; 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 <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)))) + +(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 <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)))) + +(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
--- piem-lei.el | 60 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 12 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 1b744213..2bed43ef 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -146,6 +146,22 @@ (define-derived-mode piem-lei-show-mode special-mode "lei-show" \f ;;;; 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) @@ -164,9 +180,12 @@ (defvar piem-lei-query--date-re (defun piem-lei-query--format-date (data) (let ((date (cdr (assq 'dt data)))) - (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)))) + (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) @@ -188,12 +207,16 @@ (defun piem-lei-query (query) (format "%s %3s %-20.20s %s" (piem-lei-query--format-date data) (if-let ((pct (cdr (assq 'pct data)))) - (concat (number-to-string (cdr (assq 'pct data))) - "%") + (propertize + (concat (number-to-string (cdr (assq 'pct data))) + "%") + 'font-lock-face 'piem-lei-query-pct) "") - (let ((from (car (cdr (assq 'f data))))) - (or (car from) (cadr from))) - (cdr (assq 's data)))) + (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)) @@ -231,6 +254,14 @@ (define-derived-mode piem-lei-query-mode special-mode "lei-query" \f ;;;;; 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>. @@ -314,7 +345,7 @@ (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 @@ -358,15 +389,20 @@ (defun piem-lei-query-thread (mid) (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))) + (propertize (or (car from) (cadr from)) + 'font-lock-face 'piem-lei-query-from)) (concat " " - (cdr (assq 's data)))) + (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))) (insert (make-string 17 ?\s) ; Date alignment. (piem-lei-query--format-thread-marker depth) - (concat " <" mid-msg ">"))) + (propertize (concat " <" mid-msg ">") + 'font-lock-face + 'piem-lei-query-thread-ghost))) (insert ?\n))) (insert "End of lei-q results")) (goto-char (point-min)) -- 2.31.1
It seems likely that the caller wants to start digesting the thread in the context of the seed message, and that message may be part of a large thread. Move point to help orient the caller. Notmuch nicely distinguishes search hits from other messages when displaying a thread. Something along those lines is worth considering eventually. --- piem-lei.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 2bed43ef..74bf357e 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -370,7 +370,7 @@ (defun piem-lei-query-thread (mid) (let* ((records (piem-lei-query--slurp (list "--threads" (concat "m:" mid)))) (msgs (piem-lei-query--thread records)) - depths) + depths pt-final) (with-current-buffer (get-buffer-create "*lei-thread*") (let ((inhibit-read-only t)) (erase-buffer) @@ -403,9 +403,11 @@ (defun piem-lei-query-thread (mid) (propertize (concat " <" mid-msg ">") 'font-lock-face 'piem-lei-query-thread-ghost))) + (when (equal mid-msg mid) + (setq pt-final (line-beginning-position))) (insert ?\n))) (insert "End of lei-q results")) - (goto-char (point-min)) + (goto-char (or pt-final (point-min))) (piem-lei-query-mode) (pop-to-buffer-same-window (current-buffer))))) -- 2.31.1
public-inbox's web interface suppresses a message's subject when it matches the previous lines [*]. Teach piem-lei-query-thread to do the same to make it easier to spot subject shifts and identify subthreads. [*] notmuch-tree-mode does similar, displaying "..." instead. --- piem-lei.el | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 74bf357e..43ab01ee 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -370,7 +370,7 @@ (defun piem-lei-query-thread (mid) (let* ((records (piem-lei-query--slurp (list "--threads" (concat "m:" mid)))) (msgs (piem-lei-query--thread records)) - depths pt-final) + depths pt-final subject-prev) (with-current-buffer (get-buffer-create "*lei-thread*") (let ((inhibit-read-only t)) (erase-buffer) @@ -384,25 +384,34 @@ (defun piem-lei-query-thread (mid) (setq msgs (append children msgs))) (push (cons msg depth) depths) (if (not (piem-lei-msg-ghost msg)) - (let ((data (cdr (assoc mid-msg records)))) + (let* ((data (cdr (assoc mid-msg records))) + (subject (let ((case-fold-search t)) + (replace-regexp-in-string + (rx string-start "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)) - (concat " " - (propertize (cdr (assq 's data)) - 'font-lock-face - 'piem-lei-query-subject))) + (if (equal subject subject-prev) + "" + (concat " " + (propertize subject + 'font-lock-face + 'piem-lei-query-subject)))) (add-text-properties (line-beginning-position) (line-end-position) - (list 'piem-lei-query-result data))) + (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))) + 'piem-lei-query-thread-ghost)) + (setq subject-prev nil)) (when (equal mid-msg mid) (setq pt-final (line-beginning-position))) (insert ?\n))) -- 2.31.1
piem-lei-query-thread strips a message's subject of "re: " before checking matches the previous line's subject and should be dropped. "re: re: <subjects>" unfortunately don't seem uncommon, so strip multiple "re:"s. --- piem-lei.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index 43ab01ee..cf19195b 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -387,7 +387,8 @@ (defun piem-lei-query-thread (mid) (let* ((data (cdr (assoc mid-msg records))) (subject (let ((case-fold-search t)) (replace-regexp-in-string - (rx string-start "re:" (one-or-more space)) + (rx string-start + (one-or-more "re:" (one-or-more space))) "" (string-trim (cdr (assq 's data))))))) (insert -- 2.31.1
In addition to suppressing identical subjects (after stripping "re:"), public-inbox's web interface will compare the current line's subject with the previous line's, and cut off the shared tail: [PATCH] Add basic integration for Rmail ` <suppressed completely> ` [PATCH v2] " <-- here ` <suppressed completely> I think the above is helpful. However, in some cases, I find the presentation more confusing than helpful: [PATCH 0/3] notmuch: Improve handling of attached patches ` [PATCH 1/3] piem-notmuch--with-current-message: Declare debug and indent specs ` [PATCH 2/3] piem-notmuch-am-ready-mbox: Improve handling of attachments ` <suppressed completely> ` [PATCH v2 0/3] notmuch: Improve handling of attached patches ` [PATCH v2 1/3] piem-notmuch--with-current-message: Declare debug and indent specs ` [PATCH v2 2/3] piem-notmuch-am-ready-mbox: Improve handling of attachments ` [PATCH v2 3/3] gnus, notmuch: Absorb now-shared bits into patch attachment helper ` [PATCH " It takes me a second to figure out what the omitted bits in the last line's subject are. I'm not sure, but I think the subject truncation that I find clear is where the omitted text is the main subject after a bracketed tag (i.e. "[tag] main"), not more or less. Teach piem-lei-query-thread to split the subject into a "prefix" (some number of "[tag]" items) and a "main" part (everything else), and elide a line's main part if it matches the previous line's. In the above example, the last line would be ` [PATCH 3/3] … --- piem-lei.el | 30 ++++++++++++++++++++++++++++- tests/piem-lei-tests.el | 42 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index cf19195b..f7ccc6e4 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -341,6 +341,33 @@ (defun piem-lei-query--thread (records) thread) (nreverse roots)))) +(defvar piem-lei-query--subject-split-re + (rx string-start + ;; Prefix. + (group (zero-or-more space) + (one-or-more "[" (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) "" @@ -400,7 +427,8 @@ (defun piem-lei-query-thread (mid) (if (equal subject subject-prev) "" (concat " " - (propertize subject + (propertize (piem-lei-query--elide-subject + subject-prev subject) 'font-lock-face 'piem-lei-query-subject)))) (add-text-properties (line-beginning-position) diff --git a/tests/piem-lei-tests.el b/tests/piem-lei-tests.el index e20c62fa..71dc1099 100644 --- a/tests/piem-lei-tests.el +++ b/tests/piem-lei-tests.el @@ -70,5 +70,47 @@ (ert-deftest piem-lei-query--has-descendant () (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")))) + (provide 'piem-lei-tests) ;;; piem-lei-tests.el ends here -- 2.31.1
In debbugs threads, it's not uncommon for a leading "[bug#NNN]" in the subject to be converted to "bug#NNN:" [*]. I'm not sure what the source of this is, but it prevents the suppression of an otherwise identical subject. It's probably not worth normalizing before the comparison to get full suppression, but it'd be nice to at least elide the main part of the subject so it's more obvious that it didn't change. Add a special case so that "bug#NNN:" prefix is treated the same as a bracketed prefix. [*] example: https://yhetil.org/guix-patches/20201128051435.30580-1-kyle@kyleam.com --- My guess, which I haven't tried to confirm at all, is that the "[bug#NNN]" => "bug#NNN:" conversion is triggered via the debbugs.el interface. piem-lei.el | 14 ++++++++++++-- tests/piem-lei-tests.el | 6 +++++- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index f7ccc6e4..3760176c 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -345,8 +345,18 @@ (defvar piem-lei-query--subject-split-re (rx string-start ;; Prefix. (group (zero-or-more space) - (one-or-more "[" (one-or-more (not (any "]" "\n"))) "]" - (one-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. diff --git a/tests/piem-lei-tests.el b/tests/piem-lei-tests.el index 71dc1099..dd58360b 100644 --- a/tests/piem-lei-tests.el +++ b/tests/piem-lei-tests.el @@ -110,7 +110,11 @@ (ert-deftest piem-lei-query--elide-subject:elide () (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")))) + "[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 -- 2.31.1
Using next-line and previous-line directly is inconvenient for viewing results because the associated message buffer needs to be manually displayed even if a piem-lei-show-mode buffer is visible. Add commands that 1) automatically call piem-lei-query-show and 2) skip over ghost messages, because in that case there's nothing to display or otherwise act on. If the command is executed quickly, unconditionally showing the buffer is wasteful and won't perform well, so something like magit-update-other-window-delay should probably be added. --- piem-lei.el | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 3760176c..37502d07 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -26,6 +26,7 @@ (require 'iso8601) (require 'json) (require 'message) (require 'piem) +(require 'seq) (defgroup piem-lei nil "lei integration for piem." @@ -243,6 +244,47 @@ (defun piem-lei-query-show () (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))) + (define-derived-mode piem-lei-query-mode special-mode "lei-query" "Major mode for displaying overview of `lei q' results." :group 'piem-lei -- 2.31.1
This information will be needed for the "show or scroll" command, as well as for integration with piem.el hooks. --- piem-lei.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 37502d07..3cb61abc 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -77,6 +77,9 @@ (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) @@ -123,6 +126,7 @@ (defun piem-lei-show (mid &optional display) (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)) -- 2.31.1
Start with direct wrappers around scroll-{up,down}-command, but it might be worth making these circle around (like magit-diff-show-or-scroll-{up,down} do) rather than signaling an error at the beginning or end of the buffer. --- piem-lei.el | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 3cb61abc..8267da5b 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -289,6 +289,36 @@ (defun piem-lei-query-previous-line (n) (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 '-)))) + (define-derived-mode piem-lei-query-mode special-mode "lei-query" "Major mode for displaying overview of `lei q' results." :group 'piem-lei -- 2.31.1
--- piem-lei.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 8267da5b..71f548c9 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -139,6 +139,13 @@ (defvar piem-lei-show-mode-font-lock-keywords ("^>>>> \\(.*\\)" 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 @@ -319,6 +326,18 @@ (defun piem-lei-query-show-or-scroll-down (arg) (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 -- 2.31.1
piem-lei-show-mode and piem-lei-query-mode now have enough functionality to implement all piem.el hooks except for piem-am-ready-mbox-functions. --- piem-lei.el | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 71f548c9..bcc25896 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -27,6 +27,7 @@ (require 'json) (require 'message) (require 'piem) (require 'seq) +(require 'subr-x) (defgroup piem-lei nil "lei integration for piem." @@ -554,5 +555,58 @@ (defun piem-lei-query-thread (mid) (piem-lei-query-mode) (pop-to-buffer-same-window (current-buffer))))) +\f +;;;; 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) -- 2.31.1
piem-lei-query-thread uses piem-lei-query-get-mid to get the message ID for interactive calls. Switch to piem-lei-get-mid, which uses piem-lei-query-get-mid underneath, so that the message ID can also be extracted from piem-lei-show-mode buffers. --- piem-lei.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index bcc25896..5795087f 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -498,7 +498,7 @@ (defun piem-lei-query--slurp (args) (defun piem-lei-query-thread (mid) "Show thread containing message MID." (interactive - (list (or (piem-lei-query-get-mid) + (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)))) -- 2.31.1