diff options
| -rw-r--r-- | Makefile | 6 | ||||
| -rw-r--r-- | piem-lei.el | 612 | ||||
| -rw-r--r-- | tests/piem-lei-tests.el | 120 | ||||
| -rw-r--r-- | tests/piem-tests.el | 1 |
4 files changed, 737 insertions, 2 deletions
@@ -5,8 +5,8 @@ EMACS = emacs BATCH = $(EMACS) --batch -Q -L . -L tests EL = piem.el piem-b4.el piem-elfeed.el piem-eww.el piem-gnus.el \ - piem-maildir.el piem-notmuch.el piem-rmail.el \ - tests/piem-rmail-tests.el tests/piem-tests.el + piem-lei.el piem-maildir.el piem-notmuch.el piem-rmail.el \ + tests/piem-lei-tests.el tests/piem-rmail-tests.el tests/piem-tests.el ELC = $(EL:.el=.elc) all: compile Documentation/piem.info piem-autoloads.el @@ -35,10 +35,12 @@ piem-b4.elc: piem-b4.el piem.elc piem-elfeed.elc: piem-elfeed.el piem.elc piem-eww.elc: piem-eww.el piem.elc piem-gnus.elc: piem-gnus.el piem.elc +piem-lei.elc: piem-lei.el piem.elc piem-maildir.elc: piem-maildir.el piem-notmuch.elc: piem-notmuch.el piem.elc piem-rmail.elc: piem-rmail.el piem.elc piem.elc: piem.el piem-maildir.elc +tests/piem-lei-tests.elc: tests/piem-lei-tests.el piem-lei.elc tests/piem-rmail-tests.elc: tests/piem-rmail-tests.el piem-rmail.elc tests/piem-tests.elc: tests/piem-tests.el piem.elc diff --git a/piem-lei.el b/piem-lei.el new file mode 100644 index 0000000..5795087 --- /dev/null +++ b/piem-lei.el @@ -0,0 +1,612 @@ +;;; piem-lei.el --- lei integration for piem -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Kyle Meyer <kyle@kyleam.com> + +;; Author: Kyle Meyer <kyle@kyleam.com> +;; Keywords: vc, tools +;; Package-Requires: ((emacs "26.3")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'cl-lib) +(require 'iso8601) +(require 'json) +(require 'message) +(require 'piem) +(require 'seq) +(require 'subr-x) + +(defgroup piem-lei nil + "lei integration for piem." + :group 'piem) + + +;;;; Message display + +(defface piem-lei-show-header-name + '((t :inherit message-header-name)) + "Face for header names in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-header-from + ;; Given it's focused on sending, message.el unsurprisingly doesn't + ;; define a -from. + '((t :inherit message-header-to)) + "Face for From headers in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-header-to + '((t :inherit message-header-to)) + "Face for To headers in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-header-cc + '((t :inherit message-header-cc)) + "Face for Cc headers in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-header-other + '((t :inherit message-header-other)) + "Face for all other headers in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-header-subject + '((t :inherit message-header-subject)) + "Face for Subject headers in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-cited-text-1 + '((t :inherit message-cited-text-1)) + "Face for 1st-level cited text in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-cited-text-2 + '((t :inherit message-cited-text-2)) + "Face for 2nd-level cited text in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-cited-text-3 + '((t :inherit message-cited-text-3)) + "Face for 3rd-level cited text in `piem-lei-show-mode' buffers.") + +(defface piem-lei-show-cited-text-4 + '((t :inherit message-cited-text-4)) + "Face for 4th-level cited text in `piem-lei-show-mode' buffers.") + +(defvar-local piem-lei-show-mid nil + "Message ID shown in current buffer.") + +(defun piem-lei-show--fontify-headers () + (save-excursion + (let (last-value-face) + (while (looking-at + (rx line-start + (group (one-or-more (not (or ":" "\n"))) ":") + (group (one-or-more not-newline)))) + (put-text-property + (match-beginning 1) (match-end 1) + 'font-lock-face 'piem-lei-show-header-name) + (put-text-property + (match-beginning 2) (match-end 2) + 'font-lock-face + (setq last-value-face + (pcase (downcase (match-string 1)) + ("cc:" 'piem-lei-show-header-cc) + ("from:" 'piem-lei-show-header-from) + ("subject:" 'piem-lei-show-header-subject) + ("to:" 'piem-lei-show-header-to) + (_ 'piem-lei-show-header-other)))) + (forward-line) + ;; Handle values that continue onto next line. + (while (eq (char-after) ?\t) + (save-excursion + (skip-chars-forward "\t") + (put-text-property (point) (line-end-position) + 'font-lock-face last-value-face)) + (forward-line)))))) + +(defun piem-lei-show (mid &optional display) + "Show message for MID. +When called non-interactively, return the buffer but do not display it +unless DISPLAY is non-nil." + (interactive + (list (read-string "Message ID: " nil nil (piem-mid)) + 'display)) + (with-current-buffer (get-buffer-create "*lei-show*") + (let ((inhibit-read-only t)) + (erase-buffer) + (call-process "lei" nil '(t nil) nil + "q" "--format=text" (concat "m:" mid)) + (goto-char (point-min)) + (when (looking-at-p "# blob:") + (delete-region (line-beginning-position) + (1+ (line-end-position)))) + (piem-lei-show-mode) + (setq piem-lei-show-mid mid) + (piem-lei-show--fontify-headers)) + (if display + (pop-to-buffer (current-buffer)) + (current-buffer)))) + +(defvar piem-lei-show-mode-font-lock-keywords + '(("^> \\(.*\\)" 0 'piem-lei-show-cited-text-1) + ("^>> \\(.*\\)" 0 'piem-lei-show-cited-text-2) + ("^>>> \\(.*\\)" 0 'piem-lei-show-cited-text-3) + ("^>>>> \\(.*\\)" 0 'piem-lei-show-cited-text-4)) + "Font lock keywords for `piem-lei-show-mode'.") + +(defvar piem-lei-show-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "s" #'piem-lei-query) + (define-key map "t" #'piem-lei-query-thread) + map) + "Keymap for `piem-lei-show-mode'.") + +(define-derived-mode piem-lei-show-mode special-mode "lei-show" + "Major mode for displaying message via lei." + :group 'piem-lei + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq font-lock-defaults (list piem-lei-show-mode-font-lock-keywords t)) + (setq-local line-move-visual t)) + + +;;;; Searching + +(defface piem-lei-query-date + '((t :inherit font-lock-variable-name-face)) + "Face for date in `piem-lei-query-mode' buffers.") + +(defface piem-lei-query-pct + '((t :inherit shadow)) + "Face for \"search relevance\" in `piem-lei-query-mode' buffers.") + +(defface piem-lei-query-from + '((t :inherit font-lock-doc-face)) + "Face for sender name in `piem-lei-query-mode' buffers.") + +(defface piem-lei-query-subject + '((t :inherit default)) + "Face for subject in `piem-lei-query-mode' buffers.") + +(defun piem-lei-query--read-json-item () + (let ((json-object-type 'alist) + (json-array-type 'list) + ;; Using symbols for lei-q's output should be fine, though + ;; it's a little odd for the "t:" field. + (json-key-type 'symbol) + (json-false nil) + (json-null nil)) + (json-read))) + +(defvar piem-lei-query--date-re + (rx string-start + (group (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)) + "T" (group (= 2 digit) ":" (= 2 digit)) ":" (= 2 digit) "Z" + string-end)) + +(defun piem-lei-query--format-date (data) + (let ((date (cdr (assq 'dt data)))) + (propertize + (if (string-match piem-lei-query--date-re date) + (concat (match-string 1 date) " " + (match-string 2 date)) + (error "Date did not match expected format: %S" date)) + 'font-lock-face 'piem-lei-query-date))) + +;;;###autoload +(defun piem-lei-query (query) + "Call `lei q' with QUERY. +QUERY is split according to `split-string-and-unquote'." + (interactive + (list (split-string-and-unquote + (read-string "Query: " "d:20.days.ago.. " 'piem-lei-query-history)))) + (with-current-buffer (get-buffer-create "*lei-query*") + (let ((inhibit-read-only t)) + (erase-buffer) + (apply #'call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" query) + (goto-char (point-min)) + (while (not (eobp)) + (let ((data (piem-lei-query--read-json-item))) + (delete-region (line-beginning-position) (point)) + (insert + (format "%s %3s %-20.20s %s" + (piem-lei-query--format-date data) + (if-let ((pct (cdr (assq 'pct data)))) + (propertize + (concat (number-to-string (cdr (assq 'pct data))) + "%") + 'font-lock-face 'piem-lei-query-pct) + "") + (propertize (let ((from (car (cdr (assq 'f data))))) + (or (car from) (cadr from))) + 'font-lock-face 'piem-lei-query-from) + (propertize (cdr (assq 's data)) + 'font-lock-face 'piem-lei-query-subject))) + (add-text-properties (line-beginning-position) (line-end-position) + (list 'piem-lei-query-result data))) + (forward-line)) + (insert "End of lei-q results")) + (goto-char (point-min)) + (piem-lei-query-mode) + (pop-to-buffer-same-window (current-buffer)))) + +(defun piem-lei-query-get-mid (&optional pos) + "Return message ID for position POS in a `piem-lei-query-mode' buffer. +When POS is nil, use the position at the start of the current +line." + (cdr (assq 'm (get-text-property (or pos (line-beginning-position)) + 'piem-lei-query-result)))) + +(defun piem-lei-query-show () + "Display message for current `piem-lei-query-mode' line." + (interactive) + (display-buffer + (piem-lei-show + (or (piem-lei-query-get-mid) + (user-error "No Message ID associated with current line"))) + '(display-buffer-below-selected + (inhibit-same-window . t) + (window-height . 0.8)))) + +(defun piem-lei-query--get-visible-message-window () + (seq-some + (lambda (w) + (with-current-buffer (window-buffer w) + (and (derived-mode-p 'piem-lei-show-mode) + w))) + (window-list (selected-frame)))) + +(defun piem-lei-query-next-line (n) + "Move to the Nth next query result. +If a `piem-lei-show-mode' buffer is visible in the frame, update +it to display the message." + (interactive "p") + (unless (= n 0) + (pcase-let ((ntimes (abs n)) + (`(,move-fn ,pos-fn) + (if (> n 0) + (list #'next-single-property-change + #'line-end-position) + (list #'previous-single-property-change + #'line-beginning-position))) + (target nil)) + (while (and (> ntimes 0) + (setq target (funcall move-fn + (funcall pos-fn) + 'piem-lei-query-result))) + (cl-decf ntimes)) + (if (not target) + (ding) + (goto-char target) + (goto-char (line-beginning-position)) + (when (piem-lei-query--get-visible-message-window) + (piem-lei-query-show)))))) + +(defun piem-lei-query-previous-line (n) + "Move to the Nth previous query result. +If a `piem-lei-show-mode' buffer is visible in the frame, update +it to display the message." + (interactive "p") + (piem-lei-query-next-line (- n))) + +(defun piem-lei-query-show-or-scroll-up (arg) + "Show or scroll up message for current query line. +If there is a visible `piem-lei-show-mode' buffer for the current +line's message, scroll its text upward, passing ARG to +`scroll-up-command'. Otherwise show the message with +`piem-lei-query-show'." + (interactive "^P") + (if-let ((mid (piem-lei-query-get-mid))) + (let ((w (piem-lei-query--get-visible-message-window))) + (if (and w + (equal (with-current-buffer (window-buffer w) + piem-lei-show-mid) + mid)) + (with-selected-window w + (scroll-up-command arg)) + (piem-lei-query-show))) + (ding))) + +(defun piem-lei-query-show-or-scroll-down (arg) + "Show or scroll down message for current query line. +If there is a visible `piem-lei-show-mode' buffer for the current +line's message, scroll its text downward, passing ARG to +`scroll-down-command'. Otherwise show the message with +`piem-lei-query-show'." + (interactive "^P") + (piem-lei-query-show-or-scroll-up + (cond ((eq arg '-) nil) + (arg (- arg)) + (t '-)))) + +(defvar piem-lei-query-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'piem-lei-query-show) + (define-key map (kbd "DEL") #'piem-lei-query-show-or-scroll-down) + (define-key map (kbd "SPC") #'piem-lei-query-show-or-scroll-up) + (define-key map "n" #'piem-lei-query-next-line) + (define-key map "p" #'piem-lei-query-previous-line) + (define-key map "s" #'piem-lei-query) + (define-key map "t" #'piem-lei-query-thread) + map) + "Keymap for `piem-lei-query-mode'.") + +(define-derived-mode piem-lei-query-mode special-mode "lei-query" + "Major mode for displaying overview of `lei q' results." + :group 'piem-lei + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq-local line-move-visual t)) + + +;;;;; Threading + +(defface piem-lei-query-thread-marker + '((t :inherit default)) + "Face for thread marker in `piem-lei-query-mode' buffers.") + +(defface piem-lei-query-thread-ghost + '((t :inherit font-lock-comment-face)) + "Face for ghost message IDs in `piem-lei-query-mode' buffers.") + +;; The approach here tries to loosely follow what is in public-inbox's +;; SearchThread.pm, which in turn is a modified version of the +;; algorithm described at <https://www.jwz.org/doc/threading.html>. + +(cl-defstruct piem-lei-msg mid parent children time ghost) + +(defun piem-lei-query--add-child (parent child) + (let ((mid-parent (piem-lei-msg-mid parent)) + (mid-child (piem-lei-msg-mid child))) + (when (equal mid-parent mid-child) + (error "Parent and child have same message ID: %s" + mid-parent)) + (when-let ((parent-old (piem-lei-msg-parent child))) + (setf (piem-lei-msg-children parent-old) + (delq child (piem-lei-msg-children parent-old)))) + (push child (piem-lei-msg-children parent)) + (setf (piem-lei-msg-parent child) parent))) + +(defun piem-lei-query--has-descendant (msg1 msg2) + "Is MSG2 a descendant of MSG1?" + (let ((msg1-mid (piem-lei-msg-mid msg1)) + seen) + (catch 'stop + (while msg2 + (let ((msg2-mid (piem-lei-msg-mid msg2))) + (when (or (equal msg1-mid msg2-mid) + (member msg2 seen)) + (throw 'stop t)) + (push msg2-mid seen)) + (setq msg2 (piem-lei-msg-parent msg2))) + nil))) + +(defun piem-lei-query--thread (records) + "Thread messages in RECORDS. + +RECORDS is a list of alists with information from `lei q'. This +information is used to construct, link, and order `piem-lei-msg' +objects. + +Return a list with a `piem-lei-msg' object for each root." + (let ((thread (make-hash-table :test #'equal))) + (dolist (record records) + (let ((mid (cdr (assq 'm record)))) + (puthash mid + (make-piem-lei-msg + :mid mid :time (cdr (assq 'time record))) + thread))) + (dolist (record (sort (copy-sequence records) + (lambda (a b) + (time-less-p (cdr (assq 'time a)) + (cdr (assq 'time b)))))) + (let ((msg-prev nil) + (msg-cur (gethash (cdr (assq 'm record)) thread))) + (dolist (ref (cdr (assq 'refs record))) + (let ((msg (or (gethash ref thread) + (puthash ref + (make-piem-lei-msg :mid ref :ghost t) + thread)))) + (when (and msg-prev + (not (piem-lei-msg-parent msg)) + (not (piem-lei-query--has-descendant msg msg-prev))) + (piem-lei-query--add-child msg-prev msg)) + (setq msg-prev msg))) + (when (and msg-prev + (not (piem-lei-query--has-descendant msg-cur msg-prev))) + (piem-lei-query--add-child msg-prev msg-cur)))) + (let (roots) + (maphash + (lambda (_ v) + (setf (piem-lei-msg-children v) + (sort (piem-lei-msg-children v) + (lambda (a b) + (time-less-p (piem-lei-msg-time a) + (piem-lei-msg-time b))))) + (unless (piem-lei-msg-parent v) + (push v roots))) + thread) + (nreverse roots)))) + +(defvar piem-lei-query--subject-split-re + (rx string-start + ;; Prefix. + (group (zero-or-more space) + (or (and (one-or-more (and "bug#" (one-or-more digit) ":")) + (one-or-more space) + (zero-or-more + ;; This pattern... + "[" (one-or-more (not (any "]" "\n"))) "]" + (one-or-more space))) + (one-or-more + ;; ... is repeated here. Extract it to an rx-let + ;; binding once minimum Emacs version is at least + ;; 27. + "[" (one-or-more (not (any "]" "\n"))) "]" + (one-or-more space)))) + ;; Main subject. A match consists of at least two islands of + ;; non-space characters because there's not much point in + ;; eliding one word. + (group (one-or-more (not space)) + (one-or-more space) + (not space) + (one-or-more anychar)))) + +(defun piem-lei-query--split-subject (s) + (if (string-match piem-lei-query--subject-split-re s) + (cons (match-string 1 s) (match-string 2 s)) + (cons nil s))) + +(defun piem-lei-query--elide-subject (s1 s2) + (pcase-let ((`(,head2 . ,tail2) (piem-lei-query--split-subject s2))) + (if (and s1 head2 + (let ((tail1 (cdr (piem-lei-query--split-subject s1)))) + (equal tail1 tail2))) + (concat head2 (if (char-displayable-p ?…) "…" "...")) + s2))) + +(defun piem-lei-query--format-thread-marker (level) + (if (= level 0) + "" + (concat (make-string (* 2 (1- level)) ?\s) + (propertize "` " 'font-lock-face 'piem-lei-query-thread-marker)))) + +(defun piem-lei-query--slurp (args) + (with-temp-buffer + (apply #'call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" args) + (goto-char (point-min)) + (let (items) + (while (not (eobp)) + (let ((item (piem-lei-query--read-json-item))) + (push (cons 'time (encode-time + (iso8601-parse (cdr (assq 'dt item))))) + item) + (push (cons (cdr (assq 'm item)) item) items)) + (forward-line)) + (nreverse items)))) + +(defun piem-lei-query-thread (mid) + "Show thread containing message MID." + (interactive + (list (or (piem-lei-get-mid) + (read-string "Message ID: " nil nil (piem-mid))))) + (let* ((records (piem-lei-query--slurp + (list "--threads" (concat "m:" mid)))) + (msgs (piem-lei-query--thread records)) + depths pt-final subject-prev) + (with-current-buffer (get-buffer-create "*lei-thread*") + (let ((inhibit-read-only t)) + (erase-buffer) + (while msgs + (let* ((msg (pop msgs)) + (mid-msg (piem-lei-msg-mid msg)) + (children (piem-lei-msg-children msg)) + (depth (1+ (or (cdr (assoc (piem-lei-msg-parent msg) depths)) + -1)))) + (when children + (setq msgs (append children msgs))) + (push (cons msg depth) depths) + (if (not (piem-lei-msg-ghost msg)) + (let* ((data (cdr (assoc mid-msg records))) + (subject (let ((case-fold-search t)) + (replace-regexp-in-string + (rx string-start + (one-or-more "re:" (one-or-more space))) + "" + (string-trim (cdr (assq 's data))))))) + (insert + (piem-lei-query--format-date data) " " + (piem-lei-query--format-thread-marker depth) + (let ((from (car (cdr (assq 'f data))))) + (propertize (or (car from) (cadr from)) + 'font-lock-face 'piem-lei-query-from)) + (if (equal subject subject-prev) + "" + (concat " " + (propertize (piem-lei-query--elide-subject + subject-prev subject) + 'font-lock-face + 'piem-lei-query-subject)))) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'piem-lei-query-result data)) + (setq subject-prev subject)) + (insert (make-string 17 ?\s) ; Date alignment. + (piem-lei-query--format-thread-marker depth) + (propertize (concat " <" mid-msg ">") + 'font-lock-face + 'piem-lei-query-thread-ghost)) + (setq subject-prev nil)) + (when (equal mid-msg mid) + (setq pt-final (line-beginning-position))) + (insert ?\n))) + (insert "End of lei-q results")) + (goto-char (or pt-final (point-min))) + (piem-lei-query-mode) + (pop-to-buffer-same-window (current-buffer))))) + + +;;;; piem integration + +(defun piem-lei-get-mid () + "Return the message ID of a lei buffer." + (cond ((derived-mode-p 'piem-lei-show-mode) + piem-lei-show-mid) + ((derived-mode-p 'piem-lei-query-mode) + (piem-lei-query-get-mid)))) + +(defun piem-lei-get-inbox () + "Return inbox name from a lei buffer." + (when-let ((mid (piem-lei-get-mid))) + (with-temp-buffer + (call-process "lei" nil '(t nil) nil + "q" "--format=mboxrd" (concat "m:" mid)) + (goto-char (point-min)) + (piem-inbox-by-header-match)))) + +(defun piem-lei-known-mid-p (mid) + "Return non-nil if MID is known to lei. +The message ID should not include have surrounding brackets." + (not (string-empty-p + (with-temp-buffer + (call-process "lei" nil '(t nil) nil + "q" "--format=ldjson" (concat "m:" mid)) + (buffer-string))))) + +(defun piem-lei-mid-to-thread (mid) + "Return a function that inserts an mbox for MID's thread." + (when (piem-lei-known-mid-p mid) + (lambda () + (call-process "lei" nil '(t nil) nil + "q" "--format=mboxrd" "--threads" + (concat "m:" mid))))) + +;;;###autoload +(define-minor-mode piem-lei-mode + "Toggle lei support for piem. +With a prefix argument ARG, enable piem-lei mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil." + :global t + :init-value nil + (if piem-lei-mode + (progn + (add-hook 'piem-get-inbox-functions #'piem-lei-get-inbox) + (add-hook 'piem-get-mid-functions #'piem-lei-get-mid) + (add-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread)) + (remove-hook 'piem-get-inbox-functions #'piem-lei-get-inbox) + (remove-hook 'piem-get-mid-functions #'piem-lei-get-mid) + (remove-hook 'piem-mid-to-thread-functions #'piem-lei-mid-to-thread))) + +;;; piem-lei.el ends here +(provide 'piem-lei) diff --git a/tests/piem-lei-tests.el b/tests/piem-lei-tests.el new file mode 100644 index 0000000..dd58360 --- /dev/null +++ b/tests/piem-lei-tests.el @@ -0,0 +1,120 @@ +;;; piem-lei-tests.el --- tests for piem-lei -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 all contributors <piem@inbox.kyleam.com> + +;; Author: Kyle Meyer <kyle@kyleam.com> + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'piem-lei) + +(ert-deftest piem-lei-query--add-child () + (should-error + (piem-lei-query--add-child + (make-piem-lei-msg :mid "m1") + (make-piem-lei-msg :mid "m1"))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (equal (piem-lei-msg-parent m2) m1)) + (should (equal (piem-lei-msg-children m1) (list m2)))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3")) + (m4 (make-piem-lei-msg :mid "m4"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m1 m4) + (piem-lei-query--add-child m3 m2) + (should (equal (piem-lei-msg-parent m2) m3)) + (should (equal (piem-lei-msg-children m1) (list m4))) + (should (equal (piem-lei-msg-children m3) (list m2))))) + +(ert-deftest piem-lei-query--has-descendant () + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (should-not + (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1"))) + (should (piem-lei-query--has-descendant m1 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2"))) + (piem-lei-query--add-child m1 m2) + (should (piem-lei-query--has-descendant m1 m2)) + (should-not + (piem-lei-query--has-descendant m2 m1))) + (let ((m1 (make-piem-lei-msg :mid "m1")) + (m2 (make-piem-lei-msg :mid "m2")) + (m3 (make-piem-lei-msg :mid "m3"))) + (piem-lei-query--add-child m1 m2) + (piem-lei-query--add-child m2 m3) + (should (piem-lei-query--has-descendant m1 m2)) + (should (piem-lei-query--has-descendant m1 m3)) + (should (piem-lei-query--has-descendant m2 m3)) + (should-not (piem-lei-query--has-descendant m2 m1)) + (should-not (piem-lei-query--has-descendant m3 m2)) + (should-not (piem-lei-query--has-descendant m3 m1)))) + +(ert-deftest piem-lei-query--elide-subject:keep-original () + (should (equal "ghi jlk" + (piem-lei-query--elide-subject + nil + "ghi jlk"))) + (should (equal "ghi jlk" + (piem-lei-query--elide-subject + "abc def" + "ghi jlk"))) + (should (equal "abc def" + (piem-lei-query--elide-subject + "[PATCH] abc def" + "abc def"))) + (should (equal "abc def" + (piem-lei-query--elide-subject + "[bug#00000] [PATCH] abc def" + "abc def"))) + (should (equal "abc def" + (piem-lei-query--elide-subject + "[PATCH] abc def" + "abc def"))) + (should (equal "[bug#00000] [PATCH v2] abc" + (piem-lei-query--elide-subject + "[bug#00000] [PATCH] abc" + "[bug#00000] [PATCH v2] abc"))) + (should (equal "[bug#00000] [PATCH v2] ghi jlk mno" + (piem-lei-query--elide-subject + "[bug#00000] [PATCH] abc def" + "[bug#00000] [PATCH v2] ghi jlk mno")))) + +(defvar piem-lei-tests-elide-string (if (char-displayable-p ?…) "…" "...")) + +(ert-deftest piem-lei-query--elide-subject:elide () + (should (equal (concat "[PATCH v2] " piem-lei-tests-elide-string) + (piem-lei-query--elide-subject + "[PATCH] abc def" + "[PATCH v2] abc def"))) + (should (equal (concat "[bug#00000] [PATCH v2] " piem-lei-tests-elide-string) + (piem-lei-query--elide-subject + "[bug#00000] [PATCH] abc def" + "[bug#00000] [PATCH v2] abc def"))) + (should (equal (concat "bug#00000: [PATCH v2] " piem-lei-tests-elide-string) + (piem-lei-query--elide-subject + "[bug#00000] [PATCH] abc def" + "bug#00000: [PATCH v2] abc def")))) + +(provide 'piem-lei-tests) +;;; piem-lei-tests.el ends here diff --git a/tests/piem-tests.el b/tests/piem-tests.el index 5f01a5e..91beb9a 100644 --- a/tests/piem-tests.el +++ b/tests/piem-tests.el @@ -21,6 +21,7 @@ (require 'ert) (require 'piem) +(require 'piem-lei-tests) (require 'piem-rmail-tests) (ert-deftest piem-message-link-re () |