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

[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 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   |   24 +++++++++++++++++++++---
 emacs/notmuch-tagger.el |   35 +++++++++++++++++++++++++++++++++++
 3 files changed, 65 insertions(+), 5 deletions(-)
 create mode 100644 emacs/notmuch-tagger.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 3e8647d..6eac7ff 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -597,8 +597,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 4d6c014..ee94802 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)
@@ -1136,11 +1137,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))))
+    tags))
+
+(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.
 
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..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

[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   |    9 +++++----
 emacs/notmuch-tagger.el |   33 +++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index ee94802..5a465ff 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -441,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 0d4d471..243c636 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 |   62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)

diff --git a/test/emacs b/test/emacs
index 4e941bb..115f7d5 100755
--- a/test/emacs
+++ b/test/emacs
@@ -840,5 +840,67 @@ 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"'
+parent=${gen_msg_id}
+# Add tag "mytagfoo" to one of the emails
+notmuch tag +mytagfoo id:${parent}
+# 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 of notmuch-show emails are clickable"
+add_message \
+    '[subject]="foo bar"' \
+    '[body]="body 1"'
+parent=${gen_msg_id}
+# Add tag "mytagfoo" to one of the emails
+notmuch tag +mytagfoo id:${parent}
+# 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_done
-- 
1.7.10.4

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

[Mark Walters]

On Mon, 10 Dec 2012, Damien Cassou <damien.cassou@gmail.com> wrote:
> 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

Hi 

I like this series but there are two (related) problems that I missed on
earlier review. 

The first is that the headerline tags are not updated when the user tags
a message, and the second is that the tags for the message itself (ie in
the emacs buffer not the headerline) are updated but cease to be
buttons.

I think the function notmuch-show-update-tags is the one that does the
updating of the display. (Incidentally that seems to break if the user
likes tags containing brackets).

This is probably the place to link to as there are lots of ways messages
get tagged.

Best wishes (and sorry for not catching this before)

Mark




>
> 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
> _______________________________________________
> 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 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   |   27 +++++++++++++++++++++++----
 emacs/notmuch-tagger.el |   35 +++++++++++++++++++++++++++++++++++
 3 files changed, 67 insertions(+), 6 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..a71497a 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)
@@ -364,7 +365,8 @@ operation on the contents of the current buffer."
 	  (replace-match (concat "("
 				 (propertize (mapconcat 'identity tags " ")
 					     'face 'notmuch-tag-face)
-				 ")"))))))
+				 ")")))))
+  (notmuch-show-update-header-line))
 
 (defun notmuch-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return a cons
@@ -1136,11 +1138,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))))
+    tags))
+
+(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.
 
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 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