[PATCH v5] emacs: display tags in notmuch-show with links

[PATCH v5] emacs: display tags in notmuch-show with links

[Damien Cassou]

This patch obsoletes:
id:1355216437-21109-1-git-send-email-damien.cassou@gmail.com

[PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable
[PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable
[PATCH 4/4] emacs: Add unit-tests for clickable tags

These patches make clickable all tags that appear in notmuch-show
buffers. Each tag is a link to open a new notmuch-search buffer for
this tag. Additionally, the buffer's header-line now shows the
thread's tags (clickable only if the `header-button' library is loaded
or loadable).

These patches are the first of an upcoming series whose goal is to
integrate notmuch-labeler into notmuch. See the following for more
details: https://github.com/DamienCassou/notmuch-labeler

With respect to v4, I took care of the comments you made:

- integration of Mark Walters' patch to avoid duplicate update of the
  header-line tags
- implementation of Mark Walters' comment on sorting header-line tags

[PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 emacs/notmuch-lib.el    |   11 +++++++++--
 emacs/notmuch-show.el   |   37 +++++++++++++++++++++++++++++--------
 emacs/notmuch-tagger.el |   35 +++++++++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 10 deletions(-)
 create mode 100644 emacs/notmuch-tagger.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9c4ee71..3541bb7 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -603,8 +603,15 @@ left it."
     ;; Clear out what we've parsed
     (delete-region (point-min) (point))))
 
-
-
+(defun notmuch-intersperse (list sep)
+  "Return a list with all elements of LIST separated by SEP."
+  (let ((first t)
+        (res nil))
+    (dolist (elt list (nreverse res))
+      (unless first
+        (push sep res))
+      (setq first nil)
+      (push elt res))))
 
 (provide 'notmuch-lib)
 
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 7d9f8a9..9c5a85e 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -36,6 +36,7 @@
 (require 'notmuch-mua)
 (require 'notmuch-crypto)
 (require 'notmuch-print)
+(require 'notmuch-tagger)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
@@ -355,7 +356,7 @@ operation on the contents of the current buffer."
   "Return a string comprised of `n' spaces."
   (make-string n ? ))
 
-(defun notmuch-show-update-tags (tags)
+(defun notmuch-show-update-tags (tags &optional no-headerline-update)
   "Update the displayed tags of the current message."
   (save-excursion
     (goto-char (notmuch-show-message-top))
@@ -364,7 +365,9 @@ operation on the contents of the current buffer."
 	  (replace-match (concat "("
 				 (propertize (mapconcat 'identity tags " ")
 					     'face 'notmuch-tag-face)
-				 ")"))))))
+				 ")")))))
+  (unless no-headerline-update
+    (notmuch-show-update-header-line)))
 
 (defun notmuch-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return a cons
@@ -1136,11 +1139,28 @@ function is used."
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
-      ;; Set the header line to the subject of the first message.
-      (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
-
+      (notmuch-show-update-header-line)
       (run-hooks 'notmuch-show-hook))))
 
+(defun notmuch-show-thread-tags ()
+  "Return the list of tags for the current thread."
+  (let ((tags (list)))
+    (notmuch-show-mapc (lambda ()
+			 (mapcar (lambda (elt)
+				   ;; Avoid adding duplicate tags
+				   (add-to-list 'tags elt))
+				 (notmuch-show-get-tags))))
+    (sort tags 'string<)))
+
+(defun notmuch-show-update-header-line ()
+  "Make the header-line show the thread's subject and tags."
+  (let ((thread-subject (notmuch-show-strip-re (notmuch-show-get-subject))))
+    (setq header-line-format
+	  (list
+	   thread-subject
+	   " "
+	   (notmuch-tagger-format-tags-header-line (notmuch-show-thread-tags))))))
+
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
 
@@ -1443,10 +1463,10 @@ current thread."
 (defun notmuch-show-get-depth ()
   (notmuch-show-get-prop :depth))
 
-(defun notmuch-show-set-tags (tags)
+(defun notmuch-show-set-tags (tags &optional no-headerline-update)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)
-  (notmuch-show-update-tags tags))
+  (notmuch-show-update-tags tags no-headerline-update))
 
 (defun notmuch-show-get-tags ()
   "Return the tags of the current message."
@@ -1760,7 +1780,8 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
      (let* ((current-tags (notmuch-show-get-tags))
 	    (new-tags (notmuch-update-tags current-tags tag-changes)))
        (unless (equal current-tags new-tags)
-	 (notmuch-show-set-tags new-tags))))))
+	 (notmuch-show-set-tags new-tags t)))))
+  (notmuch-show-update-header-line))
 
 (defun notmuch-show-add-tag ()
   "Same as `notmuch-show-tag' but sets initial input to '+'."
diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
new file mode 100644
index 0000000..6fcebff
--- /dev/null
+++ b/emacs/notmuch-tagger.el
@@ -0,0 +1,35 @@
+;; notmuch-tagger.el --- Library to improve the way tags are displayed
+;;
+;; Copyright © Damien Cassou
+;;
+;; This file is part of Notmuch.
+;;
+;; Notmuch 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.
+;;
+;; Notmuch 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 Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: Damien Cassou <damien.cassou@gmail.com>
+;;; Commentary:
+;;
+;;; Code:
+;;
+
+(defun notmuch-tagger-format-tags-header-line (tags)
+  "Format TAGS as a `mode-line-format' template.
+The result is suitable for inclusion in `header-line-format'."
+  (list
+   "("
+   (notmuch-intersperse tags " ")
+   ")"))
+
+(provide 'notmuch-tagger)
+;;; notmuch-tagger.el ends here
-- 
1.7.10.4

[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 emacs/notmuch-tagger.el |   54 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 53 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
index 6fcebff..38b858a 100644
--- a/emacs/notmuch-tagger.el
+++ b/emacs/notmuch-tagger.el
@@ -23,12 +23,64 @@
 ;;; Code:
 ;;
 
+(defun notmuch-tagger-header-button-present-p ()
+  "Check if `header-button' can be loaded or is already loaded.
+
+`header-button' is a third-party library which facilitates the
+creation of links in emacs header-line. This function tries to
+`require' `header-button' and returns nil if and only if this
+fails."
+  (require 'header-button nil t))
+
+(defun notmuch-tagger-goto-target (tag)
+  "Show a `notmuch-search' buffer for the TAG."
+  (notmuch-search (concat "tag:\"" tag "\"")))
+
+(defun notmuch-tagger-header-button-action (button)
+  "Open `notmuch-search' for the tag referenced by BUTTON.
+This function depends on the presence of the `header-button'
+library. Please call `notmuch-tagger-header-button-present-p' to
+test if the library is present before calling this function."
+  (let ((tag (header-button-get button 'notmuch-tagger-tag)))
+    (notmuch-tagger-goto-target tag)))
+
+(eval-after-load "header-button"
+  '(define-button-type 'notmuch-tagger-header-button-type
+     'supertype 'header
+     'action    #'notmuch-tagger-header-button-action
+     'follow-link t))
+
+(defun notmuch-tagger-really-make-header-link (tag)
+   "Return a property list that presents a link to TAG.
+
+The returned property list will only work in the header-line.
+Additionally, this function depends on the presence of the
+`header-button' library. Please call
+`notmuch-tagger-header-button-present-p' to test if library is
+present before calling this function."
+   (header-button-format
+    tag
+    :type 'notmuch-tagger-header-button-type
+    'notmuch-tagger-tag tag
+    'help-echo (format "%s: Search other messages like this" tag)))
+
+(defun notmuch-tagger-make-header-link (tag)
+  "Return a property list to present TAG as a link to search.
+
+This only works if `header-button' is loaded. Simply returns tag
+if not."
+  (if (notmuch-tagger-header-button-present-p)
+      (notmuch-tagger-really-make-header-link tag)
+    tag))
+
 (defun notmuch-tagger-format-tags-header-line (tags)
   "Format TAGS as a `mode-line-format' template.
 The result is suitable for inclusion in `header-line-format'."
   (list
    "("
-   (notmuch-intersperse tags " ")
+   (notmuch-intersperse
+    (mapcar #'notmuch-tagger-make-header-link tags)
+    " ")
    ")"))
 
 (provide 'notmuch-tagger)
-- 
1.7.10.4

[PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 emacs/notmuch-show.el   |   15 +++++++--------
 emacs/notmuch-tagger.el |   33 +++++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 8 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 9c5a85e..8c07a00 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -362,10 +362,8 @@ operation on the contents of the current buffer."
     (goto-char (notmuch-show-message-top))
     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
 	(let ((inhibit-read-only t))
-	  (replace-match (concat "("
-				 (propertize (mapconcat 'identity tags " ")
-					     'face 'notmuch-tag-face)
-				 ")")))))
+	  (replace-match (propertize (notmuch-tagger-format-tags tags)
+				     'face 'notmuch-tag-face)))))
   (unless no-headerline-update
     (notmuch-show-update-header-line)))
 
@@ -443,10 +441,11 @@ message at DEPTH in the current thread."
 	    (notmuch-show-clean-address (plist-get headers :From))
 	    " ("
 	    date
-	    ") ("
-	    (propertize (mapconcat 'identity tags " ")
-			'face 'notmuch-tag-face)
-	    ")\n")
+	    ") "
+	    (propertize
+	     (notmuch-tagger-format-tags tags)
+	     'face 'notmuch-tag-face)
+	    "\n")
     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
 
 (defun notmuch-show-insert-header (header header-value)
diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
index 38b858a..35b81ca 100644
--- a/emacs/notmuch-tagger.el
+++ b/emacs/notmuch-tagger.el
@@ -44,12 +44,21 @@ test if the library is present before calling this function."
   (let ((tag (header-button-get button 'notmuch-tagger-tag)))
     (notmuch-tagger-goto-target tag)))
 
+(defun notmuch-tagger-body-button-action (button)
+  "Open `notmuch-search' for the tag referenced by BUTTON."
+  (let ((tag (button-get button 'notmuch-tagger-tag)))
+    (notmuch-tagger-goto-target tag)))
+
 (eval-after-load "header-button"
   '(define-button-type 'notmuch-tagger-header-button-type
      'supertype 'header
      'action    #'notmuch-tagger-header-button-action
      'follow-link t))
 
+(define-button-type 'notmuch-tagger-body-button-type
+  'action    #'notmuch-tagger-body-button-action
+  'follow-link t)
+
 (defun notmuch-tagger-really-make-header-link (tag)
    "Return a property list that presents a link to TAG.
 
@@ -73,6 +82,20 @@ if not."
       (notmuch-tagger-really-make-header-link tag)
     tag))
 
+(defun notmuch-tagger-make-body-link (tag)
+  "Return a property list that presents a link to TAG.
+The returned property list will not work in the header-line. For
+a link that works on the header-line, prefer
+`notmuch-tagger-make-header-link'."
+  (let ((button (copy-sequence tag)))
+    (make-text-button
+     button nil
+     'type 'notmuch-tagger-body-button-type
+     'notmuch-tagger-tag tag
+     'skip t ;; don't stop when using TAB
+     'help-echo (format "%s: Search other messages like this" tag))
+    button))
+
 (defun notmuch-tagger-format-tags-header-line (tags)
   "Format TAGS as a `mode-line-format' template.
 The result is suitable for inclusion in `header-line-format'."
@@ -83,5 +106,15 @@ The result is suitable for inclusion in `header-line-format'."
     " ")
    ")"))
 
+(defun notmuch-tagger-format-tags (tags)
+  "Format TAGS as a string suitable for insertion in a buffer.
+If the result of this function is to be used within the
+header-line, prefer `notmuch-tagger-format-tags-header-line'
+instead of this function."
+  (concat
+   "("
+   (mapconcat #'notmuch-tagger-make-body-link tags " ")
+   ")"))
+
 (provide 'notmuch-tagger)
 ;;; notmuch-tagger.el ends here
-- 
1.7.10.4

[PATCH 4/4] emacs: Add unit-tests for clickable tags

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 test/emacs |  103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)

diff --git a/test/emacs b/test/emacs
index 5403930..af9d37c 100755
--- a/test/emacs
+++ b/test/emacs
@@ -852,5 +852,108 @@ test_emacs "(let ((mm-text-html-renderer
 test_expect_success "Rendering HTML mail with images" \
     'cat OUTPUT && grep -q smiley OUTPUT'
 
+test_begin_subtest "Extracting all tags from a thread"
+add_message \
+    '[subject]="Extracting all tags from a thread"' \
+    '[body]="body 1"'
+parent=${gen_msg_id}
+add_message \
+    '[subject]="Extracting all tags from a thread"' \
+    '[body]="body 2"' \
+    "[in-reply-to]=\<$parent\>"
+add_message \
+    '[subject]="Extracting all tags from a thread"' \
+    '[body]="body 3"' \
+    "[in-reply-to]=\<$parent\>"
+latest=${gen_msg_id}
+# Extract the thread-id from one of the emails
+thread_id=$(notmuch search --output=threads id:${latest})
+echo THREAD ID: '"'$thread_id'"'
+# Add tag "mytagfoo" to one of the emails
+notmuch tag +mytagfoo id:${latest}
+test_emacs_expect_t \
+    "(notmuch-show \"${thread_id}\")
+     (let ((output (notmuch-show-thread-tags))
+           (expected '(\"inbox\" \"mytagfoo\" \"unread\")))
+      (notmuch-test-expect-equal
+         (sort output #'string<)
+         (sort expected #'string<)))"
+
+test_begin_subtest "The tags appear in the header-line of notmuch-show"
+add_message \
+    '[subject]="foo bar"' \
+    '[body]="body 1"'
+latest=${gen_msg_id}
+# Add tag "mytagfoo" to one of the emails
+notmuch tag +mytagfoo id:${latest}
+# Extract the thread-id from one of the emails
+thread_id=$(notmuch search --output=threads id:${latest})
+test_emacs_expect_t \
+    "(notmuch-show \"${thread_id}\")
+     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
+         t
+       \"The tag 'mytagfoo' was not in the header-line-format\")"
+
+test_begin_subtest "The tags appear in the header-line of notmuch-show even after update"
+add_message \
+    '[subject]="foo bar"' \
+    '[body]="body 1"'
+latest=${gen_msg_id}
+# Extract the thread-id from one of the emails
+thread_id=$(notmuch search --output=threads id:${latest})
+test_emacs_expect_t \
+    "(notmuch-show \"${thread_id}\")
+     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
+         (error \"There is no reason for 'mytagfoo' to be there.\"))
+     (notmuch-show-tag \"+mytagfoo\")
+     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
+         t
+       \"The tag 'mytagfoo' was not in the header-line-format\")"
+
+test_begin_subtest "The tags of notmuch-show emails are clickable"
+add_message \
+    '[subject]="foo bar"' \
+    '[body]="body 1"'
+latest=${gen_msg_id}
+# Add tag "mytagfoo" to one of the emails
+notmuch tag +mytagfoo id:${latest}
+# Extract the thread-id from one of the emails
+thread_id=$(notmuch search --output=threads id:${latest})
+test_emacs_expect_t \
+    "(notmuch-show \"${thread_id}\")
+    (goto-char (point-min))
+    (re-search-forward \"mytagfoo\")
+    (backward-char) ;; to be 'in' the tag
+    (unless (eq major-mode 'notmuch-show-mode)
+       (error \"We must be in notmuch-show at this point but we are in %s.\" major-mode))
+    (push-button) ;; simulate a press on the RET key
+    (if (eq major-mode 'notmuch-search-mode)
+        t
+       (format \"We must be in notmuch-search at this point but we are in %s.\" major-mode))"
+
+test_begin_subtest "The tags of notmuch-show emails are clickable even after update"
+add_message \
+    '[subject]="foo bar"' \
+    '[body]="body 1"'
+latest=${gen_msg_id}
+# Extract the thread-id from one of the emails
+thread_id=$(notmuch search --output=threads id:${latest})
+test_emacs_expect_t \
+    "(notmuch-show \"${thread_id}\")
+    (goto-char (point-min))
+    (if (re-search-forward \"mytagfoo\" nil t)
+         (error \"There is no reason for 'mytagfoo' to be there.\"))
+    (notmuch-show-tag \"+mytagfoo\")
+    (goto-char (point-min))
+    (unless (re-search-forward \"mytagfoo\" nil t)
+         (error \"The tag 'mytagfoo' must have been there.\"))
+    (backward-char) ;; to be 'in' the tag
+    (unless (eq major-mode 'notmuch-show-mode)
+       (error \"We must be in notmuch-show at this point but we are in %s.\" major-mode))
+    (push-button) ;; simulate a press on the RET key
+    (if (eq major-mode 'notmuch-search-mode)
+        t
+       (format \"We must be in notmuch-search at this point but we are in %s.\" major-mode))"
+
 
 test_done
-- 
1.7.10.4

Re: [PATCH 4/4] emacs: Add unit-tests for clickable tags

[Mark Walters]

Hi 

I thought I had checked the test output but I am getting a failure: the
last test in emacs-show is failing (test_begin_subtest "id
buttonization")

I think it is just saying your patch is working and making the tag inbox
in the message line a button.

Best wishes

Mark





 On Thu, 13 Dec 2012, Damien Cassou <damien.cassou@gmail.com> wrote:
> Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
> ---
>  test/emacs |  103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 103 insertions(+)
>
> diff --git a/test/emacs b/test/emacs
> index 5403930..af9d37c 100755
> --- a/test/emacs
> +++ b/test/emacs
> @@ -852,5 +852,108 @@ test_emacs "(let ((mm-text-html-renderer
>  test_expect_success "Rendering HTML mail with images" \
>      'cat OUTPUT && grep -q smiley OUTPUT'
>  
> +test_begin_subtest "Extracting all tags from a thread"
> +add_message \
> +    '[subject]="Extracting all tags from a thread"' \
> +    '[body]="body 1"'
> +parent=${gen_msg_id}
> +add_message \
> +    '[subject]="Extracting all tags from a thread"' \
> +    '[body]="body 2"' \
> +    "[in-reply-to]=\<$parent\>"
> +add_message \
> +    '[subject]="Extracting all tags from a thread"' \
> +    '[body]="body 3"' \
> +    "[in-reply-to]=\<$parent\>"
> +latest=${gen_msg_id}
> +# Extract the thread-id from one of the emails
> +thread_id=$(notmuch search --output=threads id:${latest})
> +echo THREAD ID: '"'$thread_id'"'
> +# Add tag "mytagfoo" to one of the emails
> +notmuch tag +mytagfoo id:${latest}
> +test_emacs_expect_t \
> +    "(notmuch-show \"${thread_id}\")
> +     (let ((output (notmuch-show-thread-tags))
> +           (expected '(\"inbox\" \"mytagfoo\" \"unread\")))
> +      (notmuch-test-expect-equal
> +         (sort output #'string<)
> +         (sort expected #'string<)))"
> +
> +test_begin_subtest "The tags appear in the header-line of notmuch-show"
> +add_message \
> +    '[subject]="foo bar"' \
> +    '[body]="body 1"'
> +latest=${gen_msg_id}
> +# Add tag "mytagfoo" to one of the emails
> +notmuch tag +mytagfoo id:${latest}
> +# Extract the thread-id from one of the emails
> +thread_id=$(notmuch search --output=threads id:${latest})
> +test_emacs_expect_t \
> +    "(notmuch-show \"${thread_id}\")
> +     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
> +         t
> +       \"The tag 'mytagfoo' was not in the header-line-format\")"
> +
> +test_begin_subtest "The tags appear in the header-line of notmuch-show even after update"
> +add_message \
> +    '[subject]="foo bar"' \
> +    '[body]="body 1"'
> +latest=${gen_msg_id}
> +# Extract the thread-id from one of the emails
> +thread_id=$(notmuch search --output=threads id:${latest})
> +test_emacs_expect_t \
> +    "(notmuch-show \"${thread_id}\")
> +     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
> +         (error \"There is no reason for 'mytagfoo' to be there.\"))
> +     (notmuch-show-tag \"+mytagfoo\")
> +     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))
> +         t
> +       \"The tag 'mytagfoo' was not in the header-line-format\")"
> +
> +test_begin_subtest "The tags of notmuch-show emails are clickable"
> +add_message \
> +    '[subject]="foo bar"' \
> +    '[body]="body 1"'
> +latest=${gen_msg_id}
> +# Add tag "mytagfoo" to one of the emails
> +notmuch tag +mytagfoo id:${latest}
> +# Extract the thread-id from one of the emails
> +thread_id=$(notmuch search --output=threads id:${latest})
> +test_emacs_expect_t \
> +    "(notmuch-show \"${thread_id}\")
> +    (goto-char (point-min))
> +    (re-search-forward \"mytagfoo\")
> +    (backward-char) ;; to be 'in' the tag
> +    (unless (eq major-mode 'notmuch-show-mode)
> +       (error \"We must be in notmuch-show at this point but we are in %s.\" major-mode))
> +    (push-button) ;; simulate a press on the RET key
> +    (if (eq major-mode 'notmuch-search-mode)
> +        t
> +       (format \"We must be in notmuch-search at this point but we are in %s.\" major-mode))"
> +
> +test_begin_subtest "The tags of notmuch-show emails are clickable even after update"
> +add_message \
> +    '[subject]="foo bar"' \
> +    '[body]="body 1"'
> +latest=${gen_msg_id}
> +# Extract the thread-id from one of the emails
> +thread_id=$(notmuch search --output=threads id:${latest})
> +test_emacs_expect_t \
> +    "(notmuch-show \"${thread_id}\")
> +    (goto-char (point-min))
> +    (if (re-search-forward \"mytagfoo\" nil t)
> +         (error \"There is no reason for 'mytagfoo' to be there.\"))
> +    (notmuch-show-tag \"+mytagfoo\")
> +    (goto-char (point-min))
> +    (unless (re-search-forward \"mytagfoo\" nil t)
> +         (error \"The tag 'mytagfoo' must have been there.\"))
> +    (backward-char) ;; to be 'in' the tag
> +    (unless (eq major-mode 'notmuch-show-mode)
> +       (error \"We must be in notmuch-show at this point but we are in %s.\" major-mode))
> +    (push-button) ;; simulate a press on the RET key
> +    (if (eq major-mode 'notmuch-search-mode)
> +        t
> +       (format \"We must be in notmuch-search at this point but we are in %s.\" major-mode))"
> +
>  
>  test_done
> -- 
> 1.7.10.4
>
> _______________________________________________
> notmuch mailing list
> notmuch@notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch

Re: [PATCH 4/4] emacs: Add unit-tests for clickable tags

[Damien Cassou]

[-- Attachment #1: Type: text/plain, Size: 424 bytes --]

On Thu, Dec 13, 2012 at 6:27 PM, Mark Walters <markwalters1009@gmail.com> wrote:
> I think it is just saying your patch is working and making the tag inbox
> in the message line a button.

I agree and attach a patch to this email that fixes this particular test.

--
Damien Cassou
http://damiencassou.seasidehosting.st

"Success is the ability to go from one failure to another without
losing enthusiasm."
Winston Churchill

[-- Attachment #2: 0001-test-fix-buttonization-test-as-labels-are-buttonized.patch --]
[-- Type: application/octet-stream, Size: 900 bytes --]

From b676145c23fe6ece9313824beee48b15e3f0bcb4 Mon Sep 17 00:00:00 2001
From: Damien Cassou <damien.cassou@gmail.com>
Date: Fri, 14 Dec 2012 13:01:45 +0100

Subject: [PATCH] test: fix buttonization test as labels are buttonized

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 test/emacs-show |    2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/emacs-show b/test/emacs-show
index b670abf..ad338b1 100755
--- a/test/emacs-show
+++ b/test/emacs-show
@@ -133,7 +133,7 @@ test_emacs '(notmuch-show "id:'$gen_msg_id'")
 	(notmuch-test-mark-links)
 	(test-visible-output)'
 cat <<EOF >EXPECTED
-Notmuch Test Suite <test_suite@notmuchmail.org> (2001-01-05) (inbox)
+Notmuch Test Suite <test_suite@notmuchmail.org> (2001-01-05) (<<inbox>>)
 Subject: id buttonization
 To: Notmuch Test Suite <test_suite@notmuchmail.org>
 Date: Fri, 05 Jan 2001 15:43:57 +0000
-- 
1.7.10.4

Re: [PATCH v5] emacs: display tags in notmuch-show with links

[Mark Walters]

This version looks good to me: +1

Best wishes

Mark

On Thu, 13 Dec 2012, Damien Cassou <damien.cassou@gmail.com> wrote:
> This patch obsoletes:
> id:1355216437-21109-1-git-send-email-damien.cassou@gmail.com
>
> [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
> [PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable
> [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable
> [PATCH 4/4] emacs: Add unit-tests for clickable tags
>
> These patches make clickable all tags that appear in notmuch-show
> buffers. Each tag is a link to open a new notmuch-search buffer for
> this tag. Additionally, the buffer's header-line now shows the
> thread's tags (clickable only if the `header-button' library is loaded
> or loadable).
>
> These patches are the first of an upcoming series whose goal is to
> integrate notmuch-labeler into notmuch. See the following for more
> details: https://github.com/DamienCassou/notmuch-labeler
>
> With respect to v4, I took care of the comments you made:
>
> - integration of Mark Walters' patch to avoid duplicate update of the
>   header-line tags
> - implementation of Mark Walters' comment on sorting header-line tags
> _______________________________________________
> notmuch mailing list
> notmuch@notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch

(no subject)

[Damien Cassou]

From: Damien Cassou <damien.cassou@gmail.com>
Subject: [PATCH v4] emacs: display tags in notmuch-show with links
In-Reply-To: 

This patch obsoletes:
id:1355149964-27905-1-git-send-email-damien.cassou@gmail.com

[PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable
[PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable
[PATCH 4/4] emacs: Add unit-tests for clickable tags

These patches make clickable all tags that appear in notmuch-show
buffers. Each tag is a link to open a new notmuch-search buffer for
this tag. Additionally, the buffer's header-line now shows the
thread's tags (clickable only if the `header-button' library is loaded
or loadable).

These patches are the first of an upcoming series whose goal is to
integrate notmuch-labeler into notmuch. See the following for more
details: https://github.com/DamienCassou/notmuch-labeler

With respect to v3, I took care of the comments you made:
- the header-line now updates when tags are changed
- the tags in the body stays clickable when tags are changed

Additionally, I added two unit tests to cover the above two comments
and fixed some others unit tests of mine.

[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 emacs/notmuch-tagger.el |   54 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 53 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
index 6fcebff..38b858a 100644
--- a/emacs/notmuch-tagger.el
+++ b/emacs/notmuch-tagger.el
@@ -23,12 +23,64 @@
 ;;; Code:
 ;;
 
+(defun notmuch-tagger-header-button-present-p ()
+  "Check if `header-button' can be loaded or is already loaded.
+
+`header-button' is a third-party library which facilitates the
+creation of links in emacs header-line. This function tries to
+`require' `header-button' and returns nil if and only if this
+fails."
+  (require 'header-button nil t))
+
+(defun notmuch-tagger-goto-target (tag)
+  "Show a `notmuch-search' buffer for the TAG."
+  (notmuch-search (concat "tag:\"" tag "\"")))
+
+(defun notmuch-tagger-header-button-action (button)
+  "Open `notmuch-search' for the tag referenced by BUTTON.
+This function depends on the presence of the `header-button'
+library. Please call `notmuch-tagger-header-button-present-p' to
+test if the library is present before calling this function."
+  (let ((tag (header-button-get button 'notmuch-tagger-tag)))
+    (notmuch-tagger-goto-target tag)))
+
+(eval-after-load "header-button"
+  '(define-button-type 'notmuch-tagger-header-button-type
+     'supertype 'header
+     'action    #'notmuch-tagger-header-button-action
+     'follow-link t))
+
+(defun notmuch-tagger-really-make-header-link (tag)
+   "Return a property list that presents a link to TAG.
+
+The returned property list will only work in the header-line.
+Additionally, this function depends on the presence of the
+`header-button' library. Please call
+`notmuch-tagger-header-button-present-p' to test if library is
+present before calling this function."
+   (header-button-format
+    tag
+    :type 'notmuch-tagger-header-button-type
+    'notmuch-tagger-tag tag
+    'help-echo (format "%s: Search other messages like this" tag)))
+
+(defun notmuch-tagger-make-header-link (tag)
+  "Return a property list to present TAG as a link to search.
+
+This only works if `header-button' is loaded. Simply returns tag
+if not."
+  (if (notmuch-tagger-header-button-present-p)
+      (notmuch-tagger-really-make-header-link tag)
+    tag))
+
 (defun notmuch-tagger-format-tags-header-line (tags)
   "Format TAGS as a `mode-line-format' template.
 The result is suitable for inclusion in `header-line-format'."
   (list
    "("
-   (notmuch-intersperse tags " ")
+   (notmuch-intersperse
+    (mapcar #'notmuch-tagger-make-header-link tags)
+    " ")
    ")"))
 
 (provide 'notmuch-tagger)
-- 
1.7.10.4

[PATCH v3] emacs: display tags in notmuch-show with links

[Damien Cassou]

This patch obsoletes:
id:1353266322-20318-1-git-send-email-damien.cassou@gmail.com

[PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable
[PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable
[PATCH 4/4] emacs: Add unit-tests for clickable tags

This patch makes clickable all tags that appear in notmuch-show
buffers. Each tag is a link to open a new notmuch-search buffer for
this tag. Additionally, the buffer's header-line now shows the
thread's tags (clickable only if the `header-button' library is loaded
or loadable).

This patch is the first one of an upcoming series whose goal is to
integrate notmuch-labeler into notmuch. See the following for more
details:
https://github.com/DamienCassou/notmuch-labeler

With respect to v2, I took care of the comments you made:
- moved notmuch-tagger-separate-elems to notmuch-lib
- renamed a few methods
- changed some comments to better reflect the method behavior
- changed links in the body so that TAB won't stop at them
- changed miscellaneous small things

[PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable

[Damien Cassou]

Signed-off-by: Damien Cassou <damien.cassou@gmail.com>
---
 emacs/notmuch-tagger.el |   54 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 53 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
index 6fcebff..0d4d471 100644
--- a/emacs/notmuch-tagger.el
+++ b/emacs/notmuch-tagger.el
@@ -23,12 +23,64 @@
 ;;; Code:
 ;;
 
+(defun notmuch-tagger-header-button-present-p ()
+  "Check if `header-button' can be loaded or is already loaded.
+
+`header-button' is a third-party library which facilitates the
+creation of links in emacs header-line. This function tries to
+`require' `header-button' and returns nil if and only if this
+fails."
+  (require 'header-button nil t))
+
+(defun notmuch-tagger-goto-target (tag)
+  "Show a `notmuch-search' buffer for the TAG."
+  (notmuch-search (concat "tag:" tag)))
+
+(defun notmuch-tagger-header-button-action (button)
+  "Open `notmuch-search' for the tag referenced by BUTTON.
+This function depends on the presence of the `header-button'
+library. Please call `notmuch-tagger-header-button-present-p' to
+test if the library is present before calling this function."
+  (let ((tag (header-button-get button 'notmuch-tagger-tag)))
+    (notmuch-tagger-goto-target tag)))
+
+(eval-after-load "header-button"
+  '(define-button-type 'notmuch-tagger-header-button-type
+     'supertype 'header
+     'action    #'notmuch-tagger-header-button-action
+     'follow-link t))
+
+(defun notmuch-tagger-really-make-header-link (tag)
+   "Return a property list that presents a link to TAG.
+
+The returned property list will only work in the header-line.
+Additionally, this function depends on the presence of the
+`header-button' library. Please call
+`notmuch-tagger-header-button-present-p' to test if library is
+present before calling this function."
+   (header-button-format
+    tag
+    :type 'notmuch-tagger-header-button-type
+    'notmuch-tagger-tag tag
+    'help-echo (format "%s: Search other messages like this" tag)))
+
+(defun notmuch-tagger-make-header-link (tag)
+  "Return a property list to present TAG as a link to search.
+
+This only works if `header-button' is loaded. Simply returns tag
+if not."
+  (if (notmuch-tagger-header-button-present-p)
+      (notmuch-tagger-really-make-header-link tag)
+    tag))
+
 (defun notmuch-tagger-format-tags-header-line (tags)
   "Format TAGS as a `mode-line-format' template.
 The result is suitable for inclusion in `header-line-format'."
   (list
    "("
-   (notmuch-intersperse tags " ")
+   (notmuch-intersperse
+    (mapcar #'notmuch-tagger-make-header-link tags)
+    " ")
    ")"))
 
 (provide 'notmuch-tagger)
-- 
1.7.10.4