[PATCH 2/2] emacs: Allow tagging regions in notmuch-tree

[Pierre Neidhardt]

---
 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