From b13cd7660bb479a195ebcddab7d7de4db7f07568 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:45 -0400 Subject: lei: Add command and mode for displaying a message 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. Message-Id: <20210605211402.20304-2-kyle@kyleam.com> --- 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 4d88b34..dac422b 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 0000000..5b986fc --- /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 + +;; Author: Kyle Meyer +;; 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 . + +;;; Code: + +(require 'piem) + +(defgroup piem-lei nil + "lei integration for piem." + :group 'piem) + + +;;;; 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) -- cgit v1.2.3 From 2526059d47ca4645976ca2bc91900ebcf5bb2f48 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:46 -0400 Subject: piem-lei-show: Let caller suppress displaying buffer 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. Message-Id: <20210605211402.20304-3-kyle@kyleam.com> --- piem-lei.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 5b986fc..fe6ab79 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -30,10 +30,13 @@ ;;;; 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 @@ (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." -- cgit v1.2.3 From 7b51ed76fdbea12fe98b03e9ebaacf18fa16e8be Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:47 -0400 Subject: piem-lei-show: Highlight headers and quoted text Piggyback off of message-* faces to hopefully fit in nicely with themes and expectations. Leave other highlighting (e.g., of diffs), until later. Message-Id: <20210605211402.20304-4-kyle@kyleam.com> --- piem-lei.el | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index fe6ab79..291964f 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 @@ ;;;; 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 @@ unless DISPLAY is non-nil." (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 -- cgit v1.2.3 From 941e347c49caa46c71ba9d9842e4a47270cac452 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:48 -0400 Subject: lei: Add command and mode for displaying overview of search results 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). Message-Id: <20210605211402.20304-5-kyle@kyleam.com> --- piem-lei.el | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 291964f..ed153c2 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'json) (require 'message) (require 'piem) @@ -140,5 +141,72 @@ unless DISPLAY is non-nil." (setq font-lock-defaults (list piem-lei-show-mode-font-lock-keywords t)) (setq-local line-move-visual t)) + +;;;; 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) -- cgit v1.2.3 From 2a4f6fb5ac71e0805d145dec52a6e8e2ea6d9d76 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:49 -0400 Subject: lei query: Add piem-lei-show wrapper for displaying line's message Message-Id: <20210605211402.20304-6-kyle@kyleam.com> --- piem-lei.el | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index ed153c2..12ccd87 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -200,6 +200,24 @@ QUERY is split according to `split-string-and-unquote'." (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 -- cgit v1.2.3 From eb40c78da8217b22681f5c42d74d9bc64eff1e77 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:50 -0400 Subject: lei: Add command for viewing a thread 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. Message-Id: <20210605211402.20304-7-kyle@kyleam.com> --- 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 dac422b..b8d9fe6 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 12ccd87..1b74421 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 @@ line." (setq buffer-read-only t) (setq-local line-move-visual t)) + +;;;;; Threading + +;; The approach here tries to loosely follow what is in public-inbox's +;; SearchThread.pm, which in turn is a modified version of the +;; algorithm described at . + +(cl-defstruct piem-lei-msg mid parent children time ghost) + +(defun piem-lei-query--add-child (parent child) + (let ((mid-parent (piem-lei-msg-mid parent)) + (mid-child (piem-lei-msg-mid child))) + (when (equal mid-parent mid-child) + (error "Parent and child have same message ID: %s" + mid-parent)) + (when-let ((parent-old (piem-lei-msg-parent child))) + (setf (piem-lei-msg-children parent-old) + (delq child (piem-lei-msg-children parent-old)))) + (push child (piem-lei-msg-children parent)) + (setf (piem-lei-msg-parent child) parent))) + +(defun piem-lei-query--has-descendant (msg1 msg2) + "Is MSG2 a descendant of MSG1?" + (let ((msg1-mid (piem-lei-msg-mid msg1)) + seen) + (catch 'stop + (while msg2 + (let ((msg2-mid (piem-lei-msg-mid msg2))) + (when (or (equal msg1-mid msg2-mid) + (member msg2 seen)) + (throw 'stop t)) + (push msg2-mid seen)) + (setq msg2 (piem-lei-msg-parent msg2))) + nil))) + +(defun piem-lei-query--thread (records) + "Thread messages in RECORDS. + +RECORDS is a list of alists with information from `lei q'. This +information is used to construct, link, and order `piem-lei-msg' +objects. + +Return a list with a `piem-lei-msg' object for each root." + (let ((thread (make-hash-table :test #'equal))) + (dolist (record records) + (let ((mid (cdr (assq 'm record)))) + (puthash mid + (make-piem-lei-msg + :mid mid :time (cdr (assq 'time record))) + thread))) + (dolist (record (sort (copy-sequence records) + (lambda (a b) + (time-less-p (cdr (assq 'time a)) + (cdr (assq 'time b)))))) + (let ((msg-prev nil) + (msg-cur (gethash (cdr (assq 'm record)) thread))) + (dolist (ref (cdr (assq 'refs record))) + (let ((msg (or (gethash ref thread) + (puthash ref + (make-piem-lei-msg :mid ref :ghost t) + thread)))) + (when (and msg-prev + (not (piem-lei-msg-parent msg)) + (not (piem-lei-query--has-descendant msg msg-prev))) + (piem-lei-query--add-child msg-prev msg)) + (setq msg-prev msg))) + (when (and msg-prev + (not (piem-lei-query--has-descendant msg-cur msg-prev))) + (piem-lei-query--add-child msg-prev msg-cur)))) + (let (roots) + (maphash + (lambda (_ v) + (setf (piem-lei-msg-children v) + (sort (piem-lei-msg-children v) + (lambda (a b) + (time-less-p (piem-lei-msg-time a) + (piem-lei-msg-time b))))) + (unless (piem-lei-msg-parent v) + (push v roots))) + thread) + (nreverse roots)))) + +(defun piem-lei-query--format-thread-marker (level) + (if (= level 0) + "" + (concat (make-string (* 2 (1- level)) ?\s) + "` "))) + +(defun piem-lei-query--slurp (args) + (with-temp-buffer + (apply #'call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" args) + (goto-char (point-min)) + (let (items) + (while (not (eobp)) + (let ((item (piem-lei-query--read-json-item))) + (push (cons 'time (encode-time + (iso8601-parse (cdr (assq 'dt item))))) + item) + (push (cons (cdr (assq 'm item)) item) items)) + (forward-line)) + (nreverse items)))) + +(defun piem-lei-query-thread (mid) + "Show thread containing message MID." + (interactive + (list (or (piem-lei-query-get-mid) + (read-string "Message ID: " nil nil (piem-mid))))) + (let* ((records (piem-lei-query--slurp + (list "--threads" (concat "m:" mid)))) + (msgs (piem-lei-query--thread records)) + depths) + (with-current-buffer (get-buffer-create "*lei-thread*") + (let ((inhibit-read-only t)) + (erase-buffer) + (while msgs + (let* ((msg (pop msgs)) + (mid-msg (piem-lei-msg-mid msg)) + (children (piem-lei-msg-children msg)) + (depth (1+ (or (cdr (assoc (piem-lei-msg-parent msg) depths)) + -1)))) + (when children + (setq msgs (append children msgs))) + (push (cons msg depth) depths) + (if (not (piem-lei-msg-ghost msg)) + (let ((data (cdr (assoc mid-msg records)))) + (insert + (piem-lei-query--format-date data) " " + (piem-lei-query--format-thread-marker depth) + (let ((from (car (cdr (assq 'f data))))) + (or (car from) (cadr from))) + (concat " " + (cdr (assq 's data)))) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'piem-lei-query-result data))) + (insert (make-string 17 ?\s) ; Date alignment. + (piem-lei-query--format-thread-marker depth) + (concat " <" mid-msg ">"))) + (insert ?\n))) + (insert "End of lei-q results")) + (goto-char (point-min)) + (piem-lei-query-mode) + (pop-to-buffer-same-window (current-buffer))))) + ;;; piem-lei.el ends here (provide 'piem-lei) diff --git a/tests/piem-lei-tests.el b/tests/piem-lei-tests.el new file mode 100644 index 0000000..e20c62f --- /dev/null +++ b/tests/piem-lei-tests.el @@ -0,0 +1,74 @@ +;;; piem-lei-tests.el --- tests for piem-lei -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 all contributors + +;; Author: Kyle Meyer + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'ert) +(require 'piem-lei) + +(ert-deftest piem-lei-query--add-child () + (should-error + (piem-lei-query--add-child + (make-piem-lei-msg :mid "m1") + (make-piem-lei-msg :mid "m1"))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (equal (piem-lei-msg-parent m2) m1)) + (should (equal (piem-lei-msg-children m1) (list m2)))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3")) + (m4 (make-piem-lei-msg :mid "m4"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m1 m4) + (piem-lei-query--add-child m3 m2) + (should (equal (piem-lei-msg-parent m2) m3)) + (should (equal (piem-lei-msg-children m1) (list m4))) + (should (equal (piem-lei-msg-children m3) (list m2))))) + +(ert-deftest piem-lei-query--has-descendant () + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (should-not + (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1"))) + (should (piem-lei-query--has-descendant m1 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m2 m3) + (should (piem-lei-query--has-descendant m1 m2)) + (should (piem-lei-query--has-descendant m1 m3)) + (should (piem-lei-query--has-descendant m2 m3)) + (should-not (piem-lei-query--has-descendant m2 m1)) + (should-not (piem-lei-query--has-descendant m3 m2)) + (should-not (piem-lei-query--has-descendant m3 m1)))) + +(provide 'piem-lei-tests) +;;; piem-lei-tests.el ends here diff --git a/tests/piem-tests.el b/tests/piem-tests.el index 5f01a5e..91beb9a 100644 --- a/tests/piem-tests.el +++ b/tests/piem-tests.el @@ -21,6 +21,7 @@ (require 'ert) (require 'piem) +(require 'piem-lei-tests) (require 'piem-rmail-tests) (ert-deftest piem-message-link-re () -- cgit v1.2.3 From 17e1a088537e292ed7c55d44453e93b2fc07601c Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:51 -0400 Subject: lei query: Fontify results Message-Id: <20210605211402.20304-8-kyle@kyleam.com> --- piem-lei.el | 60 ++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 12 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 1b74421..2bed43e 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -146,6 +146,22 @@ unless DISPLAY is non-nil." ;;;; 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 @@ unless DISPLAY is non-nil." (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 @@ QUERY is split according to `split-string-and-unquote'." (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 @@ line." ;;;;; 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 . @@ -314,7 +345,7 @@ Return a list with a `piem-lei-msg' object for each root." (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 @@ Return a list with a `piem-lei-msg' object for each root." (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)) -- cgit v1.2.3 From 93000654bf06aac64330c285863d4c3db1b495db Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:52 -0400 Subject: piem-lei-query-thread: Position point on seed message 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. Message-Id: <20210605211402.20304-9-kyle@kyleam.com> --- piem-lei.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 2bed43e..74bf357 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -370,7 +370,7 @@ Return a list with a `piem-lei-msg' object for each root." (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 @@ Return a list with a `piem-lei-msg' object for each root." (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))))) -- cgit v1.2.3 From b28593830b8f99a24c562a4764e5a0d3bfb25831 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:53 -0400 Subject: piem-lei-query-thread: Drop repeated subjects 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. Message-Id: <20210605211402.20304-10-kyle@kyleam.com> --- piem-lei.el | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/piem-lei.el b/piem-lei.el index 74bf357..43ab01e 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -370,7 +370,7 @@ Return a list with a `piem-lei-msg' object for each root." (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 @@ Return a list with a `piem-lei-msg' object for each root." (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))) -- cgit v1.2.3 From f8fed3d666fb9b514a7d33bd869b64446cf2f1ed Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:54 -0400 Subject: piem-lei-query-thread: Deal with multiple "re:"s 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: " unfortunately don't seem uncommon, so strip multiple "re:"s. Message-Id: <20210605211402.20304-11-kyle@kyleam.com> --- piem-lei.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index 43ab01e..cf19195 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -387,7 +387,8 @@ Return a list with a `piem-lei-msg' object for each root." (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 -- cgit v1.2.3 From df741cd4254c274903dac9390d2b158558e6efa6 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:55 -0400 Subject: piem-lei-query-thread: Omit main part of subject if shared MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 ` ` [PATCH v2] " <-- here ` 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 ` ` [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] … Message-Id: <20210605211402.20304-12-kyle@kyleam.com> --- 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 cf19195..f7ccc6e 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -341,6 +341,33 @@ Return a list with a `piem-lei-msg' object for each root." 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 @@ Return a list with a `piem-lei-msg' object for each root." (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 e20c62f..71dc109 100644 --- a/tests/piem-lei-tests.el +++ b/tests/piem-lei-tests.el @@ -70,5 +70,47 @@ (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 -- cgit v1.2.3 From 653326e51503ba0bddcf9dc365003886527edbe2 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:56 -0400 Subject: piem-lei-query-thread: Add bug#NNN special case when eliding subject 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 Message-Id: <20210605211402.20304-13-kyle@kyleam.com> --- 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 f7ccc6e..3760176 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -345,8 +345,18 @@ Return a list with a `piem-lei-msg' object for each root." (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 71dc109..dd58360 100644 --- a/tests/piem-lei-tests.el +++ b/tests/piem-lei-tests.el @@ -110,7 +110,11 @@ (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 -- cgit v1.2.3 From 792195a2c6debbc3d7ad69d6bc11536a0f393b10 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:57 -0400 Subject: lei query: Add next/previous line variants that update message buffer 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. Message-Id: <20210605211402.20304-14-kyle@kyleam.com> --- piem-lei.el | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 3760176..37502d0 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -26,6 +26,7 @@ (require 'json) (require 'message) (require 'piem) +(require 'seq) (defgroup piem-lei nil "lei integration for piem." @@ -243,6 +244,47 @@ line." (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 -- cgit v1.2.3 From 546a351b0d0082a0710da2457f7ab78a9af6a1d0 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:58 -0400 Subject: piem-lei-show: Record message ID This information will be needed for the "show or scroll" command, as well as for integration with piem.el hooks. Message-Id: <20210605211402.20304-15-kyle@kyleam.com> --- piem-lei.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 37502d0..3cb61ab 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -77,6 +77,9 @@ '((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 @@ unless DISPLAY is non-nil." (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)) -- cgit v1.2.3 From 6738bf5704c7d7fdf12152980b43673a591182f0 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:13:59 -0400 Subject: lei query: Add commands for showing or scrolling message buffer 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. Message-Id: <20210605211402.20304-16-kyle@kyleam.com> --- piem-lei.el | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 3cb61ab..8267da5 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -289,6 +289,36 @@ it to display the message." (interactive "p") (piem-lei-query-next-line (- n))) +(defun piem-lei-query-show-or-scroll-up (arg) + "Show or scroll up message for current query line. +If there is a visible `piem-lei-show-mode' buffer for the current +line's message, scroll its text upward, passing ARG to +`scroll-up-command'. Otherwise show the message with +`piem-lei-query-show'." + (interactive "^P") + (if-let ((mid (piem-lei-query-get-mid))) + (let ((w (piem-lei-query--get-visible-message-window))) + (if (and w + (equal (with-current-buffer (window-buffer w) + piem-lei-show-mid) + mid)) + (with-selected-window w + (scroll-up-command arg)) + (piem-lei-query-show))) + (ding))) + +(defun piem-lei-query-show-or-scroll-down (arg) + "Show or scroll down message for current query line. +If there is a visible `piem-lei-show-mode' buffer for the current +line's message, scroll its text downward, passing ARG to +`scroll-down-command'. Otherwise show the message with +`piem-lei-query-show'." + (interactive "^P") + (piem-lei-query-show-or-scroll-up + (cond ((eq arg '-) nil) + (arg (- arg)) + (t '-)))) + (define-derived-mode piem-lei-query-mode special-mode "lei-query" "Major mode for displaying overview of `lei q' results." :group 'piem-lei -- cgit v1.2.3 From 5083f82952920cccede561c1e4d622611d20bcef Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:14:00 -0400 Subject: lei: Configure bindings for query and show modes Message-Id: <20210605211402.20304-17-kyle@kyleam.com> --- piem-lei.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 8267da5..71f548c 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -139,6 +139,13 @@ unless DISPLAY is non-nil." ("^>>>> \\(.*\\)" 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 @@ line's message, scroll its text downward, passing ARG to (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 -- cgit v1.2.3 From 52ece47dd7a490e9f30d9e4d85a0bddce44eb35e Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:14:01 -0400 Subject: lei: Wire up piem.el hooks 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. Message-Id: <20210605211402.20304-18-kyle@kyleam.com> --- piem-lei.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/piem-lei.el b/piem-lei.el index 71f548c..bcc2589 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -27,6 +27,7 @@ (require 'message) (require 'piem) (require 'seq) +(require 'subr-x) (defgroup piem-lei nil "lei integration for piem." @@ -554,5 +555,58 @@ Return a list with a `piem-lei-msg' object for each root." (piem-lei-query-mode) (pop-to-buffer-same-window (current-buffer))))) + +;;;; piem integration + +(defun piem-lei-get-mid () + "Return the message ID of a lei buffer." + (cond ((derived-mode-p 'piem-lei-show-mode) + piem-lei-show-mid) + ((derived-mode-p 'piem-lei-query-mode) + (piem-lei-query-get-mid)))) + +(defun piem-lei-get-inbox () + "Return inbox name from a lei buffer." + (when-let ((mid (piem-lei-get-mid))) + (with-temp-buffer + (call-process "lei" nil '(t nil) nil + "q" "--format=mboxrd" (concat "m:" mid)) + (goto-char (point-min)) + (piem-inbox-by-header-match)))) + +(defun piem-lei-known-mid-p (mid) + "Return non-nil if MID is known to lei. +The message ID should not include have surrounding brackets." + (not (string-empty-p + (with-temp-buffer + (call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" (concat "m:" mid)) + (buffer-string))))) + +(defun piem-lei-mid-to-thread (mid) + "Return a function that inserts an mbox for MID's thread." + (when (piem-lei-known-mid-p mid) + (lambda () + (call-process "lei" nil '(t nil) nil + "q" "--format=mboxrd" "--threads" + (concat "m:" mid))))) + +;;;###autoload +(define-minor-mode piem-lei-mode + "Toggle lei support for piem. +With a prefix argument ARG, enable piem-lei mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil." + :global t + :init-value nil + (if piem-lei-mode + (progn + (add-hook 'piem-get-inbox-functions #'piem-lei-get-inbox) + (add-hook 'piem-get-mid-functions #'piem-lei-get-mid) + (add-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread)) + (remove-hook 'piem-get-inbox-functions #'piem-lei-get-inbox) + (remove-hook 'piem-get-mid-functions #'piem-lei-get-mid) + (remove-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread))) + ;;; piem-lei.el ends here (provide 'piem-lei) -- cgit v1.2.3 From ba2089e26e4964361b258de66ad9198624ffbf1e Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 5 Jun 2021 17:14:02 -0400 Subject: piem-lei-query-thread: Use piem-lei-get-mid to get message ID 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. Message-Id: <20210605211402.20304-19-kyle@kyleam.com> --- piem-lei.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/piem-lei.el b/piem-lei.el index bcc2589..5795087 100644 --- a/piem-lei.el +++ b/piem-lei.el @@ -498,7 +498,7 @@ Return a list with a `piem-lei-msg' object for each root." (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)))) -- cgit v1.2.3