--- /dev/null
+Return-Path: <m.walters@qmul.ac.uk>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id DD861431FB6\r
+ for <notmuch@notmuchmail.org>; Tue, 6 Nov 2012 15:14:51 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.098\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.098 tagged_above=-999 required=5\r
+ tests=[DKIM_ADSP_CUSTOM_MED=0.001, FREEMAIL_FROM=0.001,\r
+ NML_ADSP_CUSTOM_MED=1.2, RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id SVr2ndUEQRMK for <notmuch@notmuchmail.org>;\r
+ Tue, 6 Nov 2012 15:14:50 -0800 (PST)\r
+Received: from mail2.qmul.ac.uk (mail2.qmul.ac.uk [138.37.6.6])\r
+ (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits))\r
+ (No client certificate requested)\r
+ by olra.theworths.org (Postfix) with ESMTPS id C86C1431FAE\r
+ for <notmuch@notmuchmail.org>; Tue, 6 Nov 2012 15:14:49 -0800 (PST)\r
+Received: from smtp.qmul.ac.uk ([138.37.6.40])\r
+ by mail2.qmul.ac.uk with esmtp (Exim 4.71)\r
+ (envelope-from <m.walters@qmul.ac.uk>)\r
+ id 1TVsLy-0005yQ-29; Tue, 06 Nov 2012 23:14:44 +0000\r
+Received: from 93-97-24-31.zone5.bethere.co.uk ([93.97.24.31] helo=localhost)\r
+ by smtp.qmul.ac.uk with esmtpsa (TLSv1:AES128-SHA:128) (Exim 4.69)\r
+ (envelope-from <m.walters@qmul.ac.uk>)\r
+ id 1TVsLw-0005gV-W0; Tue, 06 Nov 2012 23:14:41 +0000\r
+From: Mark Walters <markwalters1009@gmail.com>\r
+To: Damien Cassou <damien.cassou@gmail.com>,\r
+ notmuch mailing list <notmuch@notmuchmail.org>\r
+Subject: Re: [PATCH] emacs: display tags in notmuch-show's header-line with\r
+ links to search\r
+In-Reply-To: <1352234344-28119-1-git-send-email-damien.cassou@gmail.com>\r
+References: <1352234344-28119-1-git-send-email-damien.cassou@gmail.com>\r
+User-Agent: Notmuch/0.14+94~gd1761fe (http://notmuchmail.org) Emacs/23.4.1\r
+ (x86_64-pc-linux-gnu)\r
+Date: Tue, 06 Nov 2012 23:14:41 +0000\r
+Message-ID: <87txt2z5lq.fsf@qmul.ac.uk>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=utf-8\r
+Content-Transfer-Encoding: quoted-printable\r
+X-Sender-Host-Address: 93.97.24.31\r
+X-QM-SPAM-Info: Sender has good ham record. :)\r
+X-QM-Body-MD5: 406d0455b9234758e2b1b4e1bad0115d (of first 20000 bytes)\r
+X-SpamAssassin-Score: -1.8\r
+X-SpamAssassin-SpamBar: -\r
+X-SpamAssassin-Report: The QM spam filters have analysed this message to\r
+ determine if it is\r
+ spam. We require at least 5.0 points to mark a message as spam.\r
+ This message scored -1.8 points.\r
+ Summary of the scoring: \r
+ * -2.3 RCVD_IN_DNSWL_MED RBL: Sender listed at http://www.dnswl.org/,\r
+ * medium trust\r
+ * [138.37.6.40 listed in list.dnswl.org]\r
+ * 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail\r
+ provider * (markwalters1009[at]gmail.com)\r
+ * 0.5 AWL AWL: From: address is in the auto white-list\r
+X-QM-Scan-Virus: ClamAV says the message is clean\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Tue, 06 Nov 2012 23:14:52 -0000\r
+\r
+\r
+Hi=20\r
+\r
+This is not a full review: just a couple of thoughts. It basically seems\r
+to work as expected. I am not quite sure what behaviour you would expect\r
+in a couple of corner cases:\r
+\r
+1) what it the user toggles the display of matching messages (elide\r
+mode)? Do you still want all tags from all messages including those not\r
+visible?\r
+\r
+2) What about any tags from excluded messages? Should they show up? What\r
+if they would be excluded but aren't because of the particular search?\r
+\r
+\r
+On Tue, 06 Nov 2012, Damien Cassou <damien.cassou@gmail.com> wrote:\r
+> In notmuch-show, the header-line was previously only showing the\r
+> subject of the current thread. With this commit, the header-line now\r
+> additionally shows all the tags associated to the thread. Each tag is\r
+> a link to open a new notmuch-search buffer for this tag.\r
+>\r
+> This patch is the first one of an upcoming series whose goal is to\r
+> integrate notmuch-labeler into notmuch. See the following for more\r
+> details:\r
+> https://github.com/DamienCassou/notmuch-labeler\r
+>\r
+> This patch includes header-button.el, a package contributed by Jonas\r
+> Bernoulli that fixes a limitation of the button.el Emacs library.\r
+>\r
+> ATTENTION: Because I didn't get the permission of Jonas Bernoulli yet,\r
+> I recommend *not* to integrate this patch into notmuch right now.\r
+> Please see this email as a call for review.\r
+>\r
+> Note: This code breaks the two unit-tests "Do not call notmuch for\r
+> non-inlinable..." that are in test/emacs. This is because these tests\r
+> expect that notmuch would be called only once, but my patch forces an\r
+> additional call to notmuch to get the list of tags for the current\r
+> thread.\r
+>\r
+> ---\r
+> emacs/header-button.el | 133 ++++++++++++++++++++++++++++++++++++++++++=\r
+++++++\r
+> emacs/notmuch-query.el | 16 ++++++\r
+> emacs/notmuch-show.el | 20 ++++++--\r
+> emacs/notmuch-tager.el | 76 +++++++++++++++++++++++++++\r
+\r
+I would go for tagger rather than tager (but others can disagree).\r
+\r
+> test/emacs | 37 ++++++++++++++\r
+> 5 files changed, 279 insertions(+), 3 deletions(-)\r
+> create mode 100644 emacs/header-button.el\r
+> create mode 100644 emacs/notmuch-tager.el\r
+>\r
+> diff --git a/emacs/notmuch-query.el b/emacs/notmuch-query.el\r
+> index d66baea..c1d2ec9 100644\r
+> --- a/emacs/notmuch-query.el\r
+> +++ b/emacs/notmuch-query.el\r
+> @@ -81,4 +81,20 @@ See the function notmuch-query-get-threads for more in=\r
+formation."\r
+> (lambda (msg) (plist-get msg :id))\r
+> (notmuch-query-get-threads search-terms)))\r
+>=20=20\r
+> +(defun notmuch-query-thread-tags-from-id (thread-id)\r
+> + "Return the tags of thread whose id is THREAD-ID.\r
+> +The thread tags are the union of the tags of emails in the\r
+> +thread."\r
+> + (let ((tag-lists\r
+> + (notmuch-query-map-forest\r
+> + (lambda (msg) (plist-get msg :tags))\r
+> + (car (notmuch-query-get-threads\r
+> + (list (concat "thread:" thread-id)))))))\r
+> + (case (length tag-lists)\r
+> + (0 nil)\r
+> + (1 (car tag-lists))\r
+> + (otherwise (reduce (lambda (l1 l2)\r
+> + (union l1 l2 :test 'string=3D))\r
+> + tag-lists)))))\r
+\r
+Couldn't you do this with notmuch-show-mapc and avoid the extra call to\r
+notmuch? It also probably helps some cases of excluded tags and elide\r
+mode.\r
+\r
+\r
+If for some reason the query is better than I think you work\r
+to remove the thread: from the thread-id below and then add it back in\r
+here?\r
+\r
+\r
+> +\r
+> (provide 'notmuch-query)\r
+> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+> index f273eb4..3a09998 100644\r
+> --- a/emacs/notmuch-show.el\r
+> +++ b/emacs/notmuch-show.el\r
+> @@ -36,6 +36,7 @@\r
+> (require 'notmuch-mua)\r
+> (require 'notmuch-crypto)\r
+> (require 'notmuch-print)\r
+> +(require 'notmuch-tager)\r
+>=20=20\r
+> (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
+> (declare-function notmuch-fontify-headers "notmuch" nil)\r
+> @@ -1048,6 +1049,12 @@ function is used."\r
+> (notmuch-show-goto-first-wanted-message)\r
+> (current-buffer)))\r
+>=20=20\r
+> +(defun notmuch-show-thread-id ()\r
+> + "Return the raw thread id of the currently visited thread."\r
+> + ;; `notmuch-show-thread-id' is of the form "thread:00001212" so we\r
+> + ;; have to extract the second part.\r
+> + (second (split-string notmuch-show-thread-id ":")))\r
+> +\r
+\r
+Here is where the thread: is removed.\r
+\r
+Anyway just some thoughts!\r
+\r
+Best wishes\r
+\r
+Mark\r
+\r
+\r
+> (defun notmuch-show-build-buffer ()\r
+> (let ((inhibit-read-only t))\r
+>=20=20\r
+> @@ -1077,11 +1084,18 @@ function is used."\r
+>=20=20\r
+> (jit-lock-register #'notmuch-show-buttonise-links)\r
+>=20=20\r
+> - ;; Set the header line to the subject of the first message.\r
+> - (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-=\r
+subject)))\r
+> -\r
+> + (notmuch-show-update-header-line)\r
+> (run-hooks 'notmuch-show-hook))))\r
+>=20=20\r
+> +(defun notmuch-show-update-header-line ()\r
+> + "Make the header-line show the thread's subject and tags."\r
+> + (let ((thread-subject (notmuch-show-strip-re (notmuch-show-get-subject=\r
+))))\r
+> + (setq header-line-format\r
+> + (cons\r
+> + thread-subject\r
+> + (notmuch-tager-present-tags\r
+> + (notmuch-query-thread-tags-from-id (notmuch-show-thread-id)))))))\r
+> +\r
+> (defun notmuch-show-capture-state ()\r
+> "Capture the state of the current buffer.\r
+>=20=20\r
+> diff --git a/emacs/notmuch-tager.el b/emacs/notmuch-tager.el\r
+> new file mode 100644\r
+> index 0000000..1f83e29\r
+> --- /dev/null\r
+> +++ b/emacs/notmuch-tager.el\r
+> @@ -0,0 +1,76 @@\r
+> +;; notmuch-tager.el --- Library to show labels as links\r
+> +;;\r
+> +;; Copyright =C2=A9 Damien Cassou\r
+> +;;\r
+> +;; This file is part of Notmuch.\r
+> +;;\r
+> +;; Notmuch is free software: you can redistribute it and/or modify it\r
+> +;; under the terms of the GNU General Public License as published by\r
+> +;; the Free Software Foundation, either version 3 of the License, or\r
+> +;; (at your option) any later version.\r
+> +;;\r
+> +;; Notmuch is distributed in the hope that it will be useful, but\r
+> +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
+> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
+> +;; General Public License for more details.\r
+> +;;\r
+> +;; You should have received a copy of the GNU General Public License\r
+> +;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.\r
+> +;;\r
+> +;; Authors: Damien Cassou <damien.cassou@gmail.com>\r
+> +;;; Commentary:\r
+> +;;\r
+> +;;; Code:\r
+> +;;\r
+> +\r
+> +(require 'button)\r
+> +(require 'header-button)\r
+> +\r
+> +(defun notmuch-tager-separate-elems (list sep)\r
+> + "Return a list with all elements of LIST separated by SEP."\r
+> + (let ((first t)\r
+> + (res nil))\r
+> + (dolist (elt (reverse list) res)\r
+> + (unless first\r
+> + (push sep res))\r
+> + (setq first nil)\r
+> + (push elt res))))\r
+> +\r
+> +(defun notmuch-tager-goto-target (target)\r
+> + "Show a `notmuch-search' buffer for the TARGET tag."\r
+> + (notmuch-search (concat "tag:" target)))\r
+> +\r
+> +(defun notmuch-tager-button-action (button)\r
+> + "Open `notmuch-search' for the tag referenced by BUTTON."\r
+> + (let ((tag (header-button-get button :notmuch-tager-tag)))\r
+> + (notmuch-tager-goto-target tag)))\r
+> +\r
+> +(define-button-type 'notmuch-tager-button-type\r
+> + :supertype 'header\r
+> + :action 'notmuch-tager-button-action\r
+> + :follow-link t)\r
+> +\r
+> +(defun notmuch-tager-make-link (target)\r
+> + "Return a property list that presents a link to TARGET.\r
+> +\r
+> +TARGET is a notmuch tag."\r
+> + (header-button-format\r
+> + target\r
+> + :type 'notmuch-tager-button-type\r
+> + :notmuch-tager-tag target\r
+> + :help-echo (format "%s: Search other messages like this" target)))\r
+> +\r
+> +(defun notmuch-tager-format-tags (tags)\r
+> + "Return a format list for TAGS suitable for use in header line.\r
+> +See Info node `(elisp)Mode Line Format' for more information."\r
+> + (mapcar 'notmuch-tager-make-link tags))\r
+> +\r
+> +(defun notmuch-tager-present-tags (tags)\r
+> + "Return a property list which nicely presents all TAGS."\r
+> + (list\r
+> + " ("\r
+> + (notmuch-tager-separate-elems (notmuch-tager-format-tags tags) ", ")\r
+> + ")"))\r
+> +\r
+> +(provide 'notmuch-tager)\r
+> +;;; notmuch-tager.el ends here\r
+> diff --git a/test/emacs b/test/emacs\r
+> index 44f641e..c062e4d 100755\r
+> --- a/test/emacs\r
+> +++ b/test/emacs\r
+> @@ -820,5 +820,42 @@ Date: Fri, 05 Jan 2001 15:43:57 +0000\r
+> EOF\r
+> test_expect_equal_file OUTPUT EXPECTED\r
+>=20=20\r
+> +test_begin_subtest "Extracting all tags from a thread"\r
+> +add_message \\r
+> + '[subject]=3D"Extracting all tags from a thread"' \\r
+> + '[body]=3D"body 1"'\r
+> +parent=3D${gen_msg_id}\r
+> +add_message \\r
+> + '[subject]=3D"Extracting all tags from a thread"' \\r
+> + '[body]=3D"body 2"' \\r
+> + "[in-reply-to]=3D\<$parent\>"\r
+> +add_message \\r
+> + '[subject]=3D"Extracting all tags from a thread"' \\r
+> + '[body]=3D"body 3"' \\r
+> + "[in-reply-to]=3D\<$parent\>"\r
+> +latest=3D${gen_msg_id}\r
+> +# Extract the thread-id from one of the emails\r
+> +thread_id=3D$(notmuch search id:${latest} | sed -e "s/thread:\([a-f0-9]*=\r
+\).*/\1/")\r
+> +# Add tag "mytagfoo" to one of the emails\r
+> +notmuch tag +mytagfoo id:${latest}\r
+> +test_emacs_expect_t \\r
+> + "(let ((output (notmuch-query-thread-tags-from-id \"${thread_id}\"))\r
+> + (expected '(\"inbox\" \"mytagfoo\" \"unread\")))\r
+> + (notmuch-test-expect-equal output expected))"\r
+> +\r
+> +test_begin_subtest "The tags appear in the header-line of notmuch-show"\r
+> +add_message \\r
+> + '[subject]=3D"foo bar"' \\r
+> + '[body]=3D"body 1"'\r
+> +parent=3D${gen_msg_id}\r
+> +# Add tag "mytagfoo" to one of the emails\r
+> +notmuch tag +mytagfoo id:${parent}\r
+> +# Extract the thread-id from one of the emails\r
+> +thread_id=3D$(notmuch search id:${latest} | sed -e "s/thread:\([a-f0-9]*=\r
+\).*/\1/")\r
+> +test_emacs_expect_t \\r
+> + "(notmuch-show \"thread:${thread_id}\")\r
+> + (if (string-match-p \"mytagfoo\" (format-mode-line header-line-form=\r
+at))\r
+> + t\r
+> + \"The tag mytagfoo was not in the header-line-format\")"\r
+>=20=20\r
+> test_done\r
+>\r
+> diff --git a/emacs/header-button.el b/emacs/header-button.el\r
+> new file mode 100644\r
+> index 0000000..9b0cbcf\r
+> --- /dev/null\r
+> +++ b/emacs/header-button.el\r
+> @@ -0,0 +1,133 @@\r
+> +;;; header-button.el --- clickable buttons in header lines\r
+> +\r
+> +;; Copyright (C) 2010-2012 Jonas Bernoulli\r
+> +\r
+> +;; Author: Jonas Bernoulli <jonas@bernoul.li>\r
+> +;; Created: 20100604\r
+> +;; Version: 0.2.2\r
+> +;; Homepage: https://github.com/tarsius/header-button\r
+> +;; Keywords: extensions\r
+> +\r
+> +;; This file is not part of GNU Emacs.\r
+> +\r
+> +;; This file is free software; you can redistribute it and/or modify\r
+> +;; it under the terms of the GNU General Public License as published by\r
+> +;; the Free Software Foundation; either version 3, or (at your option)\r
+> +;; any later version.\r
+> +\r
+> +;; This file is distributed in the hope that it will be useful,\r
+> +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
+> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
+> +;; GNU General Public License for more details.\r
+> +\r
+> +;; You should have received a copy of the GNU General Public License\r
+> +;; along with this program. If not, see <http://www.gnu.org/licenses/>.\r
+> +\r
+> +;;; Commentary:\r
+> +\r
+> +;; This package extends `button' by adding support for adding buttons to\r
+> +;; the header line. Since the header line is very limited compared to a\r
+> +;; buffer most of the functionality provided by `button' is not available\r
+> +;; for buttons in the header line.\r
+> +\r
+> +;; While `button' provides the function `insert-button' (as well as\r
+> +;; others) to insert a button into a buffer at point, something similar\r
+> +;; can't be done here, due to the lack of point in header lines.\r
+> +\r
+> +;; Instead us `header-button-format' like this:\r
+> +;;\r
+> +;; (setq header-line-format\r
+> +;; (concat "Here's a button: "\r
+> +;; (header-button-format "Click me!" :action 'my-action)))\r
+> +\r
+> +;; Like with `button' you can create your own derived button types:\r
+> +;;\r
+> +;; (define-button-type 'my-header\r
+> +;; :supertype 'header\r
+> +;; :action 'my-action)\r
+> +;;\r
+> +;; (setq header-line-format\r
+> +;; (concat (header-button-format "Click me!" :action 'my-action) "=\r
+ "\r
+> +;; (header-button-format "No me!" :type 'my-header)))\r
+> +\r
+> +;; The function associated with `:action' is called with the button plist\r
+> +;; as only argument. Do no use `plist-get' to extract a value from it.\r
+> +;; Instead use `header-button-get' which will also extract values stored\r
+> +;; in it's type.\r
+> +;;\r
+> +;; (defun my-action (button)\r
+> +;; (message "This button labeled `%s' belongs to category `%s'"\r
+> +;; (header-button-label button)\r
+> +;; (header-button-get button 'category)))\r
+> +\r
+> +;;; Code:\r
+> +\r
+> +(require 'button)\r
+> +\r
+> +(defvar header-button-map\r
+> + (let ((map (make-sparse-keymap)))\r
+> + ;; $$$ follow-link does not work here\r
+> + (define-key map [header-line mouse-1] 'header-button-push)\r
+> + (define-key map [header-line mouse-2] 'header-button-push)\r
+> + map)\r
+> + "Keymap used by buttons in header lines.")\r
+> +\r
+> +(define-button-type 'header\r
+> + 'keymap header-button-map\r
+> + 'help-echo (purecopy "mouse-1: Push this button"))\r
+> +\r
+> +(defun header-button-get (button prop)\r
+> + "Get the property of header button BUTTON named PROP."\r
+> + (let ((entry (plist-member button prop)))\r
+> + (if entry\r
+> + (cadr entry)\r
+> + (get (plist-get button 'category) prop))))\r
+> +\r
+> +(defun header-button-label (button)\r
+> + "Return header button BUTTON's text label."\r
+> + (plist-get button 'label))\r
+> +\r
+> +(defun header-button-format (label &rest properties)\r
+> + "Format a header button string with the label LABEL.\r
+> +The remaining arguments form a sequence of PROPERTY VALUE pairs,\r
+> +specifying properties to add to the button.\r
+> +In addition, the keyword argument :type may be used to specify a\r
+> +button-type from which to inherit other properties; see\r
+> +`define-button-type'.\r
+> +\r
+> +To actually create the header button set the value of variable\r
+> +`header-line-format' to the string returned by this function\r
+> +\(or a string created by concatenating that string with others."\r
+> + (let ((type-entry (or (plist-member properties 'type)\r
+> + (plist-member properties :type))))\r
+> + (when (plist-get properties 'category)\r
+> + (error "Button `category' property may not be set directly"))\r
+> + (if (null type-entry)\r
+> + (setq properties\r
+> + (cons 'category\r
+> + (cons (button-category-symbol 'header) properties)))\r
+> + (setcar type-entry 'category)\r
+> + (setcar (cdr type-entry)\r
+> + (button-category-symbol (car (cdr type-entry)))))\r
+> + (apply #'propertize label\r
+> + (nconc (list 'button (list t) 'label label) properties))))\r
+> +\r
+> +(defun header-button-activate (button)\r
+> + "Call header button BUTTON's `:action' property."\r
+> + (funcall (header-button-get button :action) button))\r
+> +\r
+> +(defun header-button-push ()\r
+> + "Perform the action specified by the pressed header button."\r
+> + (interactive)\r
+> + (let* ((posn (event-start last-command-event))\r
+> + (object (posn-object posn))\r
+> + (buffer (window-buffer (posn-window posn)))\r
+> + (button (text-properties-at (cdr object) (car object))))\r
+> + (with-current-buffer buffer\r
+> + (header-button-activate button))))\r
+> +\r
+> +(provide 'header-button)\r
+> +;; Local Variables:\r
+> +;; indent-tabs-mode: nil\r
+> +;; End:\r
+> +;;; header-button.el ends here\r
+> --=20\r
+> 1.7.10.4\r
+>\r
+> _______________________________________________\r
+> notmuch mailing list\r
+> notmuch@notmuchmail.org\r
+> http://notmuchmail.org/mailman/listinfo/notmuch\r
projects / notmuch-archives.git / commitdiff