unofficial mirror of notmuch@notmuchmail.org
 help / color / mirror / code / Atom feed
* [PATCH v3] emacs: display tags in notmuch-show with links
@ 2012-12-10 14:32 Damien Cassou
  2012-12-10 14:32 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou
                   ` (4 more replies)
  0 siblings, 5 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-10 14:32 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply	[flat|nested] 8+ messages in thread

* [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
  2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
@ 2012-12-10 14:32 ` Damien Cassou
  2012-12-10 14:32 ` [PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable Damien Cassou
                   ` (3 subsequent siblings)
  4 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-10 14:32 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable
  2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
  2012-12-10 14:32 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou
@ 2012-12-10 14:32 ` Damien Cassou
  2012-12-10 14:32 ` [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable Damien Cassou
                   ` (2 subsequent siblings)
  4 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-10 14:32 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable
  2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
  2012-12-10 14:32 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou
  2012-12-10 14:32 ` [PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable Damien Cassou
@ 2012-12-10 14:32 ` Damien Cassou
  2012-12-10 14:32 ` [PATCH 4/4] emacs: Add unit-tests for clickable tags Damien Cassou
  2012-12-10 16:05 ` [PATCH v3] emacs: display tags in notmuch-show with links Mark Walters
  4 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-10 14:32 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH 4/4] emacs: Add unit-tests for clickable tags
  2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
                   ` (2 preceding siblings ...)
  2012-12-10 14:32 ` [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable Damien Cassou
@ 2012-12-10 14:32 ` Damien Cassou
  2012-12-10 16:05 ` [PATCH v3] emacs: display tags in notmuch-show with links Mark Walters
  4 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-10 14:32 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: [PATCH v3] emacs: display tags in notmuch-show with links
  2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
                   ` (3 preceding siblings ...)
  2012-12-10 14:32 ` [PATCH 4/4] emacs: Add unit-tests for clickable tags Damien Cassou
@ 2012-12-10 16:05 ` Mark Walters
  4 siblings, 0 replies; 8+ messages in thread
From: Mark Walters @ 2012-12-10 16:05 UTC (permalink / raw)
  To: Damien Cassou, notmuch


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

^ permalink raw reply	[flat|nested] 8+ messages in thread

* [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
  2012-12-11  9:00 Damien Cassou
@ 2012-12-11  9:00 ` Damien Cassou
  0 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-11  9:00 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

* [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
  2012-12-13 13:09 [PATCH v5] emacs: display tags in notmuch-show with links Damien Cassou
@ 2012-12-13 13:09 ` Damien Cassou
  0 siblings, 0 replies; 8+ messages in thread
From: Damien Cassou @ 2012-12-13 13:09 UTC (permalink / raw)
  To: notmuch

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

^ permalink raw reply related	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2012-12-13 13:09 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-12-10 14:32 [PATCH v3] emacs: display tags in notmuch-show with links Damien Cassou
2012-12-10 14:32 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou
2012-12-10 14:32 ` [PATCH 2/4] emacs: Make tags in notmuch-show header-line clickable Damien Cassou
2012-12-10 14:32 ` [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable Damien Cassou
2012-12-10 14:32 ` [PATCH 4/4] emacs: Add unit-tests for clickable tags Damien Cassou
2012-12-10 16:05 ` [PATCH v3] emacs: display tags in notmuch-show with links Mark Walters
  -- strict thread matches above, loose matches on Subject: below --
2012-12-11  9:00 Damien Cassou
2012-12-11  9:00 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou
2012-12-13 13:09 [PATCH v5] emacs: display tags in notmuch-show with links Damien Cassou
2012-12-13 13:09 ` [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line Damien Cassou

Code repositories for project(s) associated with this public inbox

	https://yhetil.org/notmuch.git/

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).