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

[Pierre Neidhardt <mail@ambrevar.xyz>]

[-- Attachment #1.1: Type: text/plain, Size: 2793 bytes --]

Hi!

Thanks for your review.  I've submitted and updated patch.

> Thanks for contributing to Notmuch. Some generic comments:
>
> 1) Please consider a more comprehensive commit message [1].  The "why"
>    here is maybe obvious, but consider pointing out whether this makes
>    it more consistent with other parts of the UI (or not). Also, a (bit
>    more extended) of the changes is always helpful, both to help read
>    the diff and to warn of any potential breaking changes.

Done.

> 2) Please update doc/notmuch-emacs.rst.  You can re-use docstrings; let
>    me know if you need help doing that. We haven't been strict about
>    this is in the past, but the emacs docs are really lagging.

I've documented +/-.

> 3) We generally want at least one test for a new
>    feature. test/T460-emacs-tree.sh has the existing tree related
>    tests. Again, if you need help with the test suite, let us know.

I've added a test, but I wasn't able to run it on Guix
(https://guix.info).  It fails like this:

--8<---------------cut here---------------start------------->8---
> guix environment notmuch -- /home/ambrevar/.local/share/emacs/site-lisp/notmuch/test/T460-emacs-tree.sh
guix environment: error: execlp: No such file or directory: "/home/ambrevar/.local/share/emacs/site-lisp/notmuch/test/T460-emacs-tree.sh"
--8<---------------cut here---------------end--------------->8---

> 4) Please use notmuch-tree-- as a prefix for new private symbols that
>    users should not rely on. I'm not sure about which symbols that applies
>    to here.

I've mirrored the implementation of search-mode.
There are indeed a few functions that are only used locally, but so are
they in notmuch.el, so I guess this should be part of another patch.

>> +(defun notmuch-tree-foreach-result (beg end fn)
>
>> +  (lexical-let ((pos (notmuch-tree-result-beginning beg))
>
> As an aside, I'm curious if we can profitably start to use
> file level lexical-binding for parts of notmuch-emacs.

Absolutely, lexical bindings are heavily recommended:

- It enforces better coding practice.
- It's more performent.
- It will spot bugs! :)

I believe this should be part of a different patch set though.

>> +  (notmuch-tree-foreach-result beg end
>> +    (lambda (pos)
>> +      (save-mark-and-excursion
>
> I did wonder if notmuch-tree-foreach-result should be a macro. I'm not
> sure if the small gain in code compactness from just passing a "body" in
> the style of notmuch-show--with-currently-shown-message is worth it.

A macro could work here, but this would only save typing "(lambda".
Functions are preferable to macros if they can fit the bill, and I think
it's the case here.

Cheers!

-- 
Pierre Neidhardt
https://ambrevar.xyz/

[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-emacs-Allow-tagging-regions-in-notmuch-tree.patch --]
[-- Type: text/x-patch, Size: 5920 bytes --]

From bb078dc42649a15c704185610ae15e566a161d7e Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0003-doc-emacs-document-tagging-bindings-for-notmuch-sear.patch --]
[-- Type: text/x-patch, Size: 975 bytes --]

From 55cb33079a49697d2713a27c4375a2e83ff1d184 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Tue, 14 May 2019 12:06:20 +0200
Subject: [PATCH 3/4] doc/emacs: document "+/-" tagging bindings for
 notmuch-search and notmuch-tree

---
 doc/notmuch-emacs.rst | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/doc/notmuch-emacs.rst b/doc/notmuch-emacs.rst
index 1655e2f0..a9357350 100644
--- a/doc/notmuch-emacs.rst
+++ b/doc/notmuch-emacs.rst
@@ -162,6 +162,10 @@ menu of results that the user can explore further by pressing
 ``g`` ``=``
     Refresh the buffer
 
+``+,-``
+    Add or remove arbitrary tags from the current thread or the
+		threads in the region.
+
 ``?``
     Display full set of key bindings
 
@@ -302,6 +306,10 @@ tags.
 ``g`` ``=``
     Refresh the buffer
 
+``+,-``
+    Add or remove arbitrary tags from the current message or the
+		messages in the region.
+
 ``?``
     Display full set of key bindings
 
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0004-T460-emacs-tree-test-tagging-on-region-in-tree-view.patch --]
[-- Type: text/x-patch, Size: 2310 bytes --]

From b4e594a6f5ed452d025641ee9e3f45ca8c48c229 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Tue, 14 May 2019 12:29:33 +0200
Subject: [PATCH 4/4] T460-emacs-tree: test tagging on region in tree view

---
 test/T460-emacs-tree.sh | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/test/T460-emacs-tree.sh b/test/T460-emacs-tree.sh
index cb2c90b8..b68b905e 100755
--- a/test/T460-emacs-tree.sh
+++ b/test/T460-emacs-tree.sh
@@ -88,6 +88,45 @@ test_begin_subtest "Untag message in notmuch tree view (database)"
 output=$(notmuch search --output=messages 'tag:test_thread_tag')
 test_expect_equal "$output" ""
 
+test_begin_subtest "Tag region in notmuch tree view"
+test_emacs '(notmuch-tree "tag:inbox")
+	    (notmuch-test-wait)
+	    ;; move to test thread above so that we can reuse the test output.
+	    (forward-line 23)
+	    (set-mark-command)
+	    (forward-line 7)
+	    (notmuch-tree-tag (list "+test_thread_tag"))
+	    (test-output)
+	    (delete-other-windows)'
+test_expect_equal_file $EXPECTED/notmuch-tree-tag-inbox-thread-tagged OUTPUT
+
+test_begin_subtest "Tag region in notmuch tree view (database)"
+output=$(notmuch search --output=messages 'tag:test_thread_tag')
+test_expect_equal "$output" \
+"id:87ocn0qh6d.fsf@yoom.home.cworth.org
+id:20091118005040.GA25380@dottiness.seas.harvard.edu
+id:yunaayketfm.fsf@aiko.keithp.com
+id:87fx8can9z.fsf@vertex.dottedmag
+id:20091117203301.GV3165@dottiness.seas.harvard.edu
+id:87iqd9rn3l.fsf@vertex.dottedmag
+id:20091117190054.GU3165@dottiness.seas.harvard.edu"
+
+test_begin_subtest "Untag region in notmuch tree view"
+test_emacs '(notmuch-tree "tag:inbox")
+	    (notmuch-test-wait)
+	    ;; mark the same region as above
+	    (forward-line 23)
+	    (set-mark-command)
+	    (forward-line 7)
+	    (notmuch-tree-tag-thread (list "-test_thread_tag"))
+	    (test-output)
+	    (delete-other-windows)'
+test_expect_equal_file $EXPECTED/notmuch-tree-tag-inbox OUTPUT
+
+test_begin_subtest "Untag region in notmuch tree view (database)"
+output=$(notmuch search --output=messages 'tag:test_thread_tag')
+test_expect_equal "$output" ""
+
 test_begin_subtest "Navigation of notmuch-hello to search results"
 test_emacs '(notmuch-hello)
 	    (goto-char (point-min))
-- 
2.21.0