From bb078dc42649a15c704185610ae15e566a161d7e Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Tue, 9 Apr 2019 18:37:48 +0200 Subject: [PATCH 2/4] emacs: Allow tagging regions in notmuch-tree Primarily this allows the user to tag multiple emails at once. This also enforces consistency with the search view. The implementation mostly adapts the search-mode code to the tree-mode. --- emacs/notmuch-tree.el | 101 +++++++++++++++++++++++++++++++++++------- 1 file changed, 86 insertions(+), 15 deletions(-) diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index c00315e8..ff471c19 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -297,13 +297,15 @@ FUNC." map)) (fset 'notmuch-tree-mode-map notmuch-tree-mode-map) -(defun notmuch-tree-get-message-properties () +(defun notmuch-tree-get-message-properties (&optional pos) "Return the properties of the current message as a plist. Some useful entries are: :headers - Property list containing the headers :Date, :Subject, :From, etc. :tags - Tags for this message" + (setq pos (or pos (point))) (save-excursion + (goto-char pos) (beginning-of-line) (get-text-property (point) :notmuch-message-properties))) @@ -332,6 +334,13 @@ Some useful entries are: "Return the tags of the current message." (notmuch-tree-get-prop :tags)) +(defun notmuch-tree-get-tags-region (beg end) + (let (output) + (notmuch-tree-foreach-result beg end + (lambda (pos) + (setq output (append output (notmuch-tree-get-tags))))) + output)) + (defun notmuch-tree-get-message-id (&optional bare) "Return the message id of the current message." (let ((id (notmuch-tree-get-prop :id))) @@ -387,24 +396,86 @@ NOT change the database." (when (string= tree-msg-id (notmuch-show-get-message-id)) (notmuch-show-update-tags new-tags))))))) -(defun notmuch-tree-tag (tag-changes) +(defun notmuch-tree-result-beginning (&optional pos) + "Return the point at the beginning of the message at POS (or point). + +If there is no thread at POS (or point), returns nil." + (when (notmuch-tree-get-message-properties pos) + ;; We pass 1+point because previous-single-property-change starts + ;; searching one before the position we give it. + (previous-single-property-change (1+ (or pos (point))) + :notmuch-message-properties nil (point-min)))) + +(defun notmuch-tree-result-end (&optional pos) + "Return the point at the end of the message at POS (or point). + +The returned point will be just after the newline character that +ends the result line. If there is no thread at POS (or point), +returns nil" + (when (notmuch-tree-get-message-properties pos) + (next-single-property-change (or pos (point)) :notmuch-message-properties + nil (point-max)))) + +(defun notmuch-tree-foreach-result (beg end fn) + "Invoke FN for each result between BEG and END. + +FN should take one argument. It will be applied to the +character position of the beginning of each result that overlaps +the region between points BEG and END. As a special case, if (= +BEG END), FN will be applied to the result containing point +BEG." + + (lexical-let ((pos (notmuch-tree-result-beginning beg)) + ;; End must be a marker in case fn changes the + ;; text. + (end (copy-marker end)) + ;; Make sure we examine at least one result, even if + ;; (= beg end). + (first t)) + ;; We have to be careful if the region extends beyond the results. + ;; In this case, pos could be null or there could be no result at + ;; pos. + (while (and pos (or (< pos end) first)) + (when (notmuch-tree-get-message-properties pos) + (funcall fn pos)) + (setq pos (notmuch-tree-result-end pos) + first nil)))) +(put 'notmuch-tree-foreach-result 'lisp-indent-function 2) + +(defun notmuch-tree-interactive-tag-changes (&optional initial-input) + "Prompt for tag changes for the current message or region. + +Returns (TAG-CHANGES REGION-BEGIN REGION-END)." + (let* ((region (notmuch-interactive-region)) + (beg (first region)) (end (second region)) + (prompt (if (= beg end) "Tag message" "Tag region"))) + (cons (notmuch-read-tag-changes + (notmuch-tree-get-tags-region beg end) prompt initial-input) + region))) + +(defun notmuch-tree-tag (tag-changes &optional beg end) "Change tags for the current message" - (interactive - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message"))) - (notmuch-tag (notmuch-tree-get-message-id) tag-changes) - (notmuch-tree-tag-update-display tag-changes)) - -(defun notmuch-tree-add-tag (tag-changes) + (interactive (notmuch-tree-interactive-tag-changes)) + (unless (and beg end) + (setq beg (car (notmuch-interactive-region)) + end (cadr (notmuch-interactive-region)))) + (notmuch-tree-foreach-result beg end + (lambda (pos) + (save-mark-and-excursion + (goto-char pos) + (notmuch-tag (notmuch-tree-get-message-id) + tag-changes) + (notmuch-tree-tag-update-display tag-changes))))) + +(defun notmuch-tree-add-tag (tag-changes &optional beg end) "Same as `notmuch-tree-tag' but sets initial input to '+'." - (interactive - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+"))) - (notmuch-tree-tag tag-changes)) + (interactive (notmuch-tree-interactive-tag-changes "+")) + (notmuch-tree-tag tag-changes beg end)) -(defun notmuch-tree-remove-tag (tag-changes) +(defun notmuch-tree-remove-tag (tag-changes &optional beg end) "Same as `notmuch-tree-tag' but sets initial input to '-'." - (interactive - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-"))) - (notmuch-tree-tag tag-changes)) + (interactive (notmuch-tree-interactive-tag-changes "-")) + (notmuch-tree-tag tag-changes beg end)) (defun notmuch-tree-resume-message () "Resume EDITING the current draft message." -- 2.21.0