[PATCH 0/2] Add some thread based actions to pick

[PATCH 0/2] Add some thread based actions to pick

[Mark Walters]

This addes the a macro to notmuch pick to apply a command to all
messages in the current thread. In the second patch we add the ability
to tag/archive whole threads.

This is independent of
id:1354970494-18050-1-git-send-email-markwalters1009@gmail.com and
id:1354970674-18136-1-git-send-email-markwalters1009@gmail.com but may
have overlapping context (in the keybindings) so they should be applied first.

I can easily supply a version applying straight to master if preferred.

Best wishes

Mark



Mark Walters (2):
  contrib: pick: add thread based utility functions
  contrib: pick: thread tagging (including archiving) implemented

 contrib/notmuch-pick/notmuch-pick.el |   58 ++++++++++++++++++++++++++++++++++
 1 files changed, 58 insertions(+), 0 deletions(-)

-- 
1.7.9.1

[PATCH 1/2] contrib: pick: add thread based utility functions

[Mark Walters]

Previously notmuch-pick had no thread based functionality. This adds a
macro to iterate through all messages in a thread. To simplify this it
adds a text-property marker to the first message of each thread.
---
 contrib/notmuch-pick/notmuch-pick.el |   28 ++++++++++++++++++++++++++++
 1 files changed, 28 insertions(+), 0 deletions(-)

diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el
index b474231..77e15bb 100644
--- a/contrib/notmuch-pick/notmuch-pick.el
+++ b/contrib/notmuch-pick/notmuch-pick.el
@@ -552,6 +552,33 @@ than only the current message."
 	  (message (format "Command '%s' exited abnormally with code %d"
 			   shell-command exit-code)))))))
 
+(defun notmuch-pick-thread-top ()
+  (interactive)
+  (while (not (notmuch-pick-get-prop :first))
+    (forward-line -1)))
+
+(defmacro notmuch-pick-thread-mapc (function)
+  "Iterate through all messages in the current thread
+ and call FUNCTION for side effects."
+  (save-excursion
+    (notmuch-pick-thread-top)
+    (loop do (progn
+	       (funcall function)
+	       (forward-line))
+	  while (and (notmuch-pick-get-message-properties)
+		     (not (notmuch-pick-get-prop :first))))))
+
+(defun notmuch-pick-get-messages-ids-thread ()
+  "Return all id: queries of messages in the current thread."
+  (let ((message-ids))
+    (notmuch-pick-thread-mapc
+     (lambda () (push (notmuch-pick-get-message-id) message-ids)))
+    message-ids))
+
+(defun notmuch-pick-get-messages-ids-thread-search ()
+  "Return a search string for all message ids of messages in the
+current thread."
+  (mapconcat 'identity (notmuch-pick-get-messages-ids-thread) " or "))
 (defun notmuch-pick-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return
 AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
@@ -638,6 +665,7 @@ unchanged ADDRESS if parsing fails."
 	(push "├" tree-status)))
 
       (push (concat (if replies "┬" "─") "►") tree-status)
+      (plist-put msg :first (and first (eq 0 depth)))
       (notmuch-pick-insert-msg (plist-put msg :tree-status tree-status))
       (pop tree-status)
       (pop tree-status)
-- 
1.7.9.1

[PATCH 2/2] contrib: pick: thread tagging (including archiving) implemented

[Mark Walters]

Previously pick had no actions based on the entire thread: this adds
some. Note in this version '*' is bound to `tag thread' which is not
consistent with search or show. However it still might be the most
natural thing (as it is similar to running * in the show pane).
---
 contrib/notmuch-pick/notmuch-pick.el |   30 ++++++++++++++++++++++++++++++
 1 files changed, 30 insertions(+), 0 deletions(-)

diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el
index 77e15bb..23442b9 100644
--- a/contrib/notmuch-pick/notmuch-pick.el
+++ b/contrib/notmuch-pick/notmuch-pick.el
@@ -173,6 +173,7 @@
     (define-key map "q" 'notmuch-pick-quit)
     (define-key map "x" 'notmuch-pick-quit)
     (define-key map "?" 'notmuch-help)
+    (define-key map "A" 'notmuch-pick-archive-thread)
     (define-key map "a" 'notmuch-pick-archive-message-then-next)
     (define-key map "=" 'notmuch-pick-refresh-view)
     (define-key map "s" 'notmuch-pick-to-search)
@@ -188,6 +189,7 @@
     (define-key map "|" 'notmuch-pick-pipe-message)
     (define-key map "-" 'notmuch-pick-remove-tag)
     (define-key map "+" 'notmuch-pick-add-tag)
+    (define-key map "*" 'notmuch-pick-tag-thread)
     (define-key map " " 'notmuch-pick-scroll-or-next)
     (define-key map "b" 'notmuch-pick-scroll-message-window-back)
     map))
@@ -579,6 +581,34 @@ than only the current message."
   "Return a search string for all message ids of messages in the
 current thread."
   (mapconcat 'identity (notmuch-pick-get-messages-ids-thread) " or "))
+
+(defun notmuch-pick-tag-thread (&optional tag-changes)
+  "Tag all messages in the current thread"
+  (interactive)
+  (setq tag-changes (funcall 'notmuch-tag (notmuch-pick-get-messages-ids-thread-search) tag-changes))
+  (notmuch-pick-thread-mapc
+   (lambda () (notmuch-pick-tag-update-display tag-changes))))
+
+(defun notmuch-pick-archive-thread (&optional unarchive)
+  "Archive each message in thread.
+
+Archive each message currently shown by applying the tag changes
+in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
+default). If a prefix argument is given, the messages will be
+\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
+will be reversed.
+
+Note: This command is safe from any race condition of new messages
+being delivered to the same thread. It does not archive the
+entire thread, but only the messages shown in the current
+buffer."
+  (interactive "P")
+  (when notmuch-archive-tags
+    (notmuch-pick-tag-thread
+     (notmuch-tag-change-list notmuch-archive-tags unarchive))))
+
+;; Functions below here display the pick buffer itself.
+
 (defun notmuch-pick-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return
 AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
-- 
1.7.9.1

Re: [PATCH 1/2] contrib: pick: add thread based utility functions

[David Bremner]

Mark Walters <markwalters1009@gmail.com> writes:

> Previously notmuch-pick had no thread based functionality. This adds a
> macro to iterate through all messages in a thread. To simplify this it
> adds a text-property marker to the first message of each thread.


> +(defun notmuch-pick-get-messages-ids-thread ()
> +  "Return all id: queries of messages in the current thread."
> +  (let ((message-ids))
> +    (notmuch-pick-thread-mapc
> +     (lambda () (push (notmuch-pick-get-message-id) message-ids)))
> +    message-ids))

As a style thing, it seems more idiomatic to me to have a map macro
which returns a sequence, rather than faking it with mapc and push. But
maybe that's a typical common lisp style, I don't know.

More importantly, in emacs 24.3 I get an infinite loop when trying to
evaluate the update notmuch-pick.el. 

The backtrace is below. I'm not a macro expert, but seems like too much
is happening at compile/eval time.

----------------------------------------------------------------------

Debugger entered--Lisp error: (quit)
  (save-excursion (beginning-of-line) (get-text-property (point) :notmuch-message-properties))
  notmuch-pick-get-message-properties()
  (or props (notmuch-pick-get-message-properties))
  (let ((props (or props (notmuch-pick-get-message-properties)))) (plist-get props prop))
  notmuch-pick-get-prop(:first)
  (not (notmuch-pick-get-prop :first))
  (while (not (notmuch-pick-get-prop :first)) (forward-line -1))
  notmuch-pick-thread-top()
  (save-excursion (notmuch-pick-thread-top) (progn (while (progn (progn (funcall function) (forward-line)) (and (notmuch-pick-get-message-properties) (not (notmuch-pick-get-prop :first))))) nil))
  (lambda (function) "Iterate through all messages in the current thread\n and call FUNCTION for side effects." (save-excursion (notmuch-pick-thread-top) (progn (while (progn (progn (funcall function) (forward-line)) (and (notmuch-pick-get-message-properties) (not (notmuch-pick-get-prop :first))))) nil)))((lambda nil (push (notmuch-pick-get-message-id) message-ids)))
  macroexpand((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) nil)
  macroexp--expand-all((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))))
  macroexp--all-forms(((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))
  #[1028 "\300.\300\301.\302\"\303.\a!.\b@A#.\x06@#\207" [macroexp--cons macroexp--all-clauses 1 macroexp--all-forms] 10 "\n\n(fn FORM BODY BINDINGS FUN)"](((let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) ((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids) ((message-ids)) let)
  macroexp--expand-all((let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))
  macroexp--all-forms((lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) 2)
  macroexp--expand-all((function (lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))))
  macroexp--all-forms((defalias (quote notmuch-pick-get-messages-ids-thread) (function (lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))) 1)
  #[514 "\300.\301\"\211\204.
  macroexp--expand-all((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
  macroexpand-all((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
  #[0 "	\nB.\303\300!)\207" [(defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) load-file-name macroexp--pending-eager-loads macroexpand-all] 2 "\n\n(fn)"]()
  funcall(#[0 "	\nB.\303\300!)\207" [(defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) load-file-name macroexp--pending-eager-loads macroexpand-all] 2 "\n\n(fn)"])
  internal-macroexpand-for-load((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
  eval-current-buffer()
  call-interactively(eval-current-buffer record nil)
  command-execute(eval-current-buffer record)
  execute-extended-command(nil "eval-current-buffer")
  call-interactively(execute-extended-command nil nil)

Re: [PATCH 1/2] contrib: pick: add thread based utility functions

[Mark Walters]

Hi

David Bremner <david@tethera.net> writes:

> Mark Walters <markwalters1009@gmail.com> writes:
>
>> Previously notmuch-pick had no thread based functionality. This adds a
>> macro to iterate through all messages in a thread. To simplify this it
>> adds a text-property marker to the first message of each thread.
>
>
>> +(defun notmuch-pick-get-messages-ids-thread ()
>> +  "Return all id: queries of messages in the current thread."
>> +  (let ((message-ids))
>> +    (notmuch-pick-thread-mapc
>> +     (lambda () (push (notmuch-pick-get-message-id) message-ids)))
>> +    message-ids))
>
> As a style thing, it seems more idiomatic to me to have a map macro
> which returns a sequence, rather than faking it with mapc and push. But
> maybe that's a typical common lisp style, I don't know.

I think I agree: this is very closely copied from notmuch-show
(notmuch-show-mapc and notmuch-show-get-messages-id) so it is probably
worth staying the same.

> More importantly, in emacs 24.3 I get an infinite loop when trying to
> evaluate the update notmuch-pick.el. 

I think this is just stupidity on my part: it should be a defun rather
than a defmacro. Would you be able to test that (or I can send a new
version if you prefer)?

Also, how are you loading notmuch-pick? In my set up the macro and
function work interchangeably.

Best wishes

Mark

>
> The backtrace is below. I'm not a macro expert, but seems like too much
> is happening at compile/eval time.
>
> ----------------------------------------------------------------------
>
> Debugger entered--Lisp error: (quit)
>   (save-excursion (beginning-of-line) (get-text-property (point) :notmuch-message-properties))
>   notmuch-pick-get-message-properties()
>   (or props (notmuch-pick-get-message-properties))
>   (let ((props (or props (notmuch-pick-get-message-properties)))) (plist-get props prop))
>   notmuch-pick-get-prop(:first)
>   (not (notmuch-pick-get-prop :first))
>   (while (not (notmuch-pick-get-prop :first)) (forward-line -1))
>   notmuch-pick-thread-top()
>   (save-excursion (notmuch-pick-thread-top) (progn (while (progn (progn (funcall function) (forward-line)) (and (notmuch-pick-get-message-properties) (not (notmuch-pick-get-prop :first))))) nil))
>   (lambda (function) "Iterate through all messages in the current thread\n and call FUNCTION for side effects." (save-excursion (notmuch-pick-thread-top) (progn (while (progn (progn (funcall function) (forward-line)) (and (notmuch-pick-get-message-properties) (not (notmuch-pick-get-prop :first))))) nil)))((lambda nil (push (notmuch-pick-get-message-id) message-ids)))
>   macroexpand((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) nil)
>   macroexp--expand-all((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))))
>   macroexp--all-forms(((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))
>   #[1028 "\300.\300\301.\302\"\303.\a!.\b@A#..@#\207" [macroexp--cons macroexp--all-clauses 1 macroexp--all-forms] 10 "\n\n(fn FORM BODY BINDINGS FUN)"](((let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) ((notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids) ((message-ids)) let)
>   macroexp--expand-all((let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))
>   macroexp--all-forms((lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) 2)
>   macroexp--expand-all((function (lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids))))
>   macroexp--all-forms((defalias (quote notmuch-pick-get-messages-ids-thread) (function (lambda nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))) 1)
>   #[514 "\300.\301\"\211\204.
>   macroexp--expand-all((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
>   macroexpand-all((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
>   #[0 "	\nB.\303\300!)\207" [(defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) load-file-name macroexp--pending-eager-loads macroexpand-all] 2 "\n\n(fn)"]()
>   funcall(#[0 "	\nB.\303\300!)\207" [(defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)) load-file-name macroexp--pending-eager-loads macroexpand-all] 2 "\n\n(fn)"])
>   internal-macroexpand-for-load((defun notmuch-pick-get-messages-ids-thread nil "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-pick-thread-mapc (lambda nil (push (notmuch-pick-get-message-id) message-ids))) message-ids)))
>   eval-current-buffer()
>   call-interactively(eval-current-buffer record nil)
>   command-execute(eval-current-buffer record)
>   execute-extended-command(nil "eval-current-buffer")
>   call-interactively(execute-extended-command nil nil)

Re: [PATCH 1/2] contrib: pick: add thread based utility functions

[David Bremner]

Mark Walters <markwalters1009@gmail.com> writes:
>
> David Bremner <david@tethera.net> writes:
>
>
>> More importantly, in emacs 24.3 I get an infinite loop when trying to
>> evaluate the update notmuch-pick.el. 
>
> I think this is just stupidity on my part: it should be a defun rather
> than a defmacro. Would you be able to test that (or I can send a new
> version if you prefer)?
>

Yes, changing that defmacro to a defun fixes the loop.

I load pick as follows

    (add-to-list 'load-path
                 (expand-file-name "~/software/upstream/notmuch/contrib/notmuch-pick"))
    (require 'notmuch-pick nil t)


I'll need another version in any case, since it doesn't apply to master
anymore, but hold off for a review of 2/2.

d

Re: [PATCH 2/2] contrib: pick: thread tagging (including archiving) implemented

[David Bremner]

Mark Walters <markwalters1009@gmail.com> writes:

> Previously pick had no actions based on the entire thread: this adds
> some. Note in this version '*' is bound to `tag thread' which is not
> consistent with search or show. However it still might be the most
> natural thing (as it is similar to running * in the show pane).

Hmm. not sure about this. But since nobody complained in six months,
let's go with it unless they wake up.

> +  (setq tag-changes (funcall 'notmuch-tag
> (notmuch-pick-get-messages-ids-thread-search) tag-changes))

Why "(funcall 'notmuch-tag ...) instead of a "(notmuch-tag ...)" here?
Personally I'd use let instead of setq here, but ymmv.

> +Archive each message currently shown by applying the tag changes
> +in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
> +default). If a prefix argument is given, the messages will be
> +\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
> +will be reversed.

It seems to me the default value for notmuch-archive-tags should not be
hard-coded into this docstring, especially since notmuch-archive-tags
turns into a link in the help text.

d

Re: [PATCH 2/2] contrib: pick: thread tagging (including archiving) implemented

[Mark Walters]

Thanks for the review. A couple of comments below:

On Sat, 01 Jun 2013, David Bremner <david@tethera.net> wrote:
> Mark Walters <markwalters1009@gmail.com> writes:
>
>> Previously pick had no actions based on the entire thread: this adds
>> some. Note in this version '*' is bound to `tag thread' which is not
>> consistent with search or show. However it still might be the most
>> natural thing (as it is similar to running * in the show pane).
>
> Hmm. not sure about this. But since nobody complained in six months,
> let's go with it unless they wake up.

Ok

>> +  (setq tag-changes (funcall 'notmuch-tag
>> (notmuch-pick-get-messages-ids-thread-search) tag-changes))
>
> Why "(funcall 'notmuch-tag ...) instead of a "(notmuch-tag ...)" here?
> Personally I'd use let instead of setq here, but ymmv.

I agree with both of these but this is almost identical code to that in
notmuch-show-tag-all. 

>> +Archive each message currently shown by applying the tag changes
>> +in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
>> +default). If a prefix argument is given, the messages will be
>> +\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
>> +will be reversed.
>
> It seems to me the default value for notmuch-archive-tags should not be
> hard-coded into this docstring, especially since notmuch-archive-tags
> turns into a link in the help text.

I am happy either way on this one but again this is the same as
notmuch-show-archive-thread.

I think it's probably best to keep show and pick the same where they are
similar but I can change the above if you disagree.

Best wishes

Mark