* [PATCH 01/18] lei: Add command and mode for displaying a message
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 02/18] piem-lei-show: Let caller suppress displaying buffer Kyle Meyer
` (16 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 02/18] piem-lei-show: Let caller suppress displaying buffer
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
2021-06-05 21:13 ` [PATCH 01/18] lei: Add command and mode for displaying a message Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 03/18] piem-lei-show: Highlight headers and quoted text Kyle Meyer
` (15 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 03/18] piem-lei-show: Highlight headers and quoted text
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
2021-06-05 21:13 ` [PATCH 01/18] lei: Add command and mode for displaying a message Kyle Meyer
2021-06-05 21:13 ` [PATCH 02/18] piem-lei-show: Let caller suppress displaying buffer Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 04/18] lei: Add command and mode for displaying overview of search results Kyle Meyer
` (14 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 04/18] lei: Add command and mode for displaying overview of search results
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (2 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 03/18] piem-lei-show: Highlight headers and quoted text Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 05/18] lei query: Add piem-lei-show wrapper for displaying line's message Kyle Meyer
` (13 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 05/18] lei query: Add piem-lei-show wrapper for displaying line's message
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (3 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 04/18] lei: Add command and mode for displaying overview of search results Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 06/18] lei: Add command for viewing a thread Kyle Meyer
` (12 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
---
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 06/18] lei: Add command for viewing a thread
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (4 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 05/18] lei query: Add piem-lei-show wrapper for displaying line's message Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 07/18] lei query: Fontify results Kyle Meyer
` (11 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 07/18] lei query: Fontify results
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (5 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 06/18] lei: Add command for viewing a thread Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 08/18] piem-lei-query-thread: Position point on seed message Kyle Meyer
` (10 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
---
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 08/18] piem-lei-query-thread: Position point on seed message
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (6 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 07/18] lei query: Fontify results Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 09/18] piem-lei-query-thread: Drop repeated subjects Kyle Meyer
` (9 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 09/18] piem-lei-query-thread: Drop repeated subjects
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (7 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 08/18] piem-lei-query-thread: Position point on seed message Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 10/18] piem-lei-query-thread: Deal with multiple "re:"s Kyle Meyer
` (8 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 10/18] piem-lei-query-thread: Deal with multiple "re:"s
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (8 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 09/18] piem-lei-query-thread: Drop repeated subjects Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 11/18] piem-lei-query-thread: Omit main part of subject if shared Kyle Meyer
` (7 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 11/18] piem-lei-query-thread: Omit main part of subject if shared
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (9 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 10/18] piem-lei-query-thread: Deal with multiple "re:"s Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 12/18] piem-lei-query-thread: Add bug#NNN special case when eliding subject Kyle Meyer
` (6 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 12/18] piem-lei-query-thread: Add bug#NNN special case when eliding subject
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (10 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 11/18] piem-lei-query-thread: Omit main part of subject if shared Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 13/18] lei query: Add next/previous line variants that update message buffer Kyle Meyer
` (5 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 13/18] lei query: Add next/previous line variants that update message buffer
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (11 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 12/18] piem-lei-query-thread: Add bug#NNN special case when eliding subject Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 14/18] piem-lei-show: Record message ID Kyle Meyer
` (4 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 14/18] piem-lei-show: Record message ID
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (12 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 13/18] lei query: Add next/previous line variants that update message buffer Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:13 ` [PATCH 15/18] lei query: Add commands for showing or scrolling message buffer Kyle Meyer
` (3 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 15/18] lei query: Add commands for showing or scrolling message buffer
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (13 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 14/18] piem-lei-show: Record message ID Kyle Meyer
@ 2021-06-05 21:13 ` Kyle Meyer
2021-06-05 21:14 ` [PATCH 16/18] lei: Configure bindings for query and show modes Kyle Meyer
` (2 subsequent siblings)
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:13 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 16/18] lei: Configure bindings for query and show modes
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (14 preceding siblings ...)
2021-06-05 21:13 ` [PATCH 15/18] lei query: Add commands for showing or scrolling message buffer Kyle Meyer
@ 2021-06-05 21:14 ` Kyle Meyer
2021-06-05 21:14 ` [PATCH 17/18] lei: Wire up piem.el hooks Kyle Meyer
2021-06-05 21:14 ` [PATCH 18/18] piem-lei-query-thread: Use piem-lei-get-mid to get message ID Kyle Meyer
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:14 UTC (permalink / raw)
To: piem
---
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 17/18] lei: Wire up piem.el hooks
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (15 preceding siblings ...)
2021-06-05 21:14 ` [PATCH 16/18] lei: Configure bindings for query and show modes Kyle Meyer
@ 2021-06-05 21:14 ` Kyle Meyer
2021-06-05 21:14 ` [PATCH 18/18] piem-lei-query-thread: Use piem-lei-get-mid to get message ID Kyle Meyer
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:14 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* [PATCH 18/18] piem-lei-query-thread: Use piem-lei-get-mid to get message ID
2021-06-05 21:13 [PATCH 00/18] Initial lei support Kyle Meyer
` (16 preceding siblings ...)
2021-06-05 21:14 ` [PATCH 17/18] lei: Wire up piem.el hooks Kyle Meyer
@ 2021-06-05 21:14 ` Kyle Meyer
17 siblings, 0 replies; 19+ messages in thread
From: Kyle Meyer @ 2021-06-05 21:14 UTC (permalink / raw)
To: piem
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
^ permalink raw reply related [flat|nested] 19+ messages in thread