[PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line
authorDamien Cassou <damien.cassou@gmail.com>
Thu, 13 Dec 2012 13:09:24 +0000 (14:09 +0100)
committerW. Trevor King <wking@tremily.us>
Fri, 7 Nov 2014 17:52:06 +0000 (09:52 -0800)
af/bc19faea580ad61550cefd918475140b34d448 [new file with mode: 0644]

diff --git a/af/bc19faea580ad61550cefd918475140b34d448 b/af/bc19faea580ad61550cefd918475140b34d448
new file mode 100644 (file)
index 0000000..9878f29
--- /dev/null
@@ -0,0 +1,226 @@
+Return-Path: <damien.cassou@gmail.com>\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 BF20E431FBD\r
+       for <notmuch@notmuchmail.org>; Thu, 13 Dec 2012 05:09:40 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.799\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.799 tagged_above=-999 required=5\r
+       tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
+       FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7] 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 xyD+231TolUk for <notmuch@notmuchmail.org>;\r
+       Thu, 13 Dec 2012 05:09:39 -0800 (PST)\r
+Received: from mail-wg0-f47.google.com (mail-wg0-f47.google.com\r
+ [74.125.82.47])       (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
+ certificate requested)        by olra.theworths.org (Postfix) with ESMTPS id\r
+ ACEA5431FBC   for <notmuch@notmuchmail.org>; Thu, 13 Dec 2012 05:09:38 -0800\r
+ (PST)\r
+Received: by mail-wg0-f47.google.com with SMTP id dq11so771129wgb.2\r
+       for <notmuch@notmuchmail.org>; Thu, 13 Dec 2012 05:09:37 -0800 (PST)\r
+DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\r
+       h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references\r
+       :mime-version:content-type:content-transfer-encoding;\r
+       bh=qn4YEP6Hz7JoLlL2CrL0eJmvxXOsKEnld4YFdbhkm8E=;\r
+       b=ufHHkPi9mfMLB6QEnDYfqaS+T5dW1XJyZPc1ZtJzy/yduF1Wn7z9nxOuM0jhuZT5s1\r
+       oGNJaykTWRoxCaBdtEKhXw48qbUBvHDos/Uy0CTXCNJ7cxjKFZO65c6KO/yeFqbnoNP9\r
+       Bc6m+km1OoeSntwjsh5JL+8oVp/KB+7RjqdMEmEmHPPGHxW6/nf3BXbUABaiObaYG5M2\r
+       UPt24CqKdq2wYF/aZjS4zPWyqR2GHty/R7QkHKPjiUUU0jK0J1tmDbrC+MOth4/BpASQ\r
+       J1yvBPKvjiBj7C/XRwrtRz43Y7DC0ctF0JI2ROGYZnexNZfhCxHTyLMIcN1lxJ0cvQP1\r
+       Sc/A==\r
+Received: by 10.180.93.40 with SMTP id cr8mr28902880wib.15.1355404177458;\r
+       Thu, 13 Dec 2012 05:09:37 -0800 (PST)\r
+Received: from luz3.lille.inria.fr ([193.51.236.232])\r
+       by mx.google.com with ESMTPS id bz12sm2504214wib.5.2012.12.13.05.09.35\r
+       (version=TLSv1/SSLv3 cipher=OTHER);\r
+       Thu, 13 Dec 2012 05:09:36 -0800 (PST)\r
+From: Damien Cassou <damien.cassou@gmail.com>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH 1/4] emacs: Add a thread's tags to notmuch-show header-line\r
+Date: Thu, 13 Dec 2012 14:09:24 +0100\r
+Message-Id: <1355404167-31750-2-git-send-email-damien.cassou@gmail.com>\r
+X-Mailer: git-send-email 1.7.10.4\r
+In-Reply-To: <1355404167-31750-1-git-send-email-damien.cassou@gmail.com>\r
+References: <1355404167-31750-1-git-send-email-damien.cassou@gmail.com>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=UTF-8\r
+Content-Transfer-Encoding: 8bit\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: Thu, 13 Dec 2012 13:09:41 -0000\r
+\r
+Signed-off-by: Damien Cassou <damien.cassou@gmail.com>\r
+---\r
+ emacs/notmuch-lib.el    |   11 +++++++++--\r
+ emacs/notmuch-show.el   |   37 +++++++++++++++++++++++++++++--------\r
+ emacs/notmuch-tagger.el |   35 +++++++++++++++++++++++++++++++++++\r
+ 3 files changed, 73 insertions(+), 10 deletions(-)\r
+ create mode 100644 emacs/notmuch-tagger.el\r
+\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 9c4ee71..3541bb7 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -603,8 +603,15 @@ left it."\r
+     ;; Clear out what we've parsed\r
+     (delete-region (point-min) (point))))\r
\r
+-\r
+-\r
++(defun notmuch-intersperse (list sep)\r
++  "Return a list with all elements of LIST separated by SEP."\r
++  (let ((first t)\r
++        (res nil))\r
++    (dolist (elt list (nreverse res))\r
++      (unless first\r
++        (push sep res))\r
++      (setq first nil)\r
++      (push elt res))))\r
\r
+ (provide 'notmuch-lib)\r
\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index 7d9f8a9..9c5a85e 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-tagger)\r
\r
+ (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
+ (declare-function notmuch-fontify-headers "notmuch" nil)\r
+@@ -355,7 +356,7 @@ operation on the contents of the current buffer."\r
+   "Return a string comprised of `n' spaces."\r
+   (make-string n ? ))\r
\r
+-(defun notmuch-show-update-tags (tags)\r
++(defun notmuch-show-update-tags (tags &optional no-headerline-update)\r
+   "Update the displayed tags of the current message."\r
+   (save-excursion\r
+     (goto-char (notmuch-show-message-top))\r
+@@ -364,7 +365,9 @@ operation on the contents of the current buffer."\r
+         (replace-match (concat "("\r
+                                (propertize (mapconcat 'identity tags " ")\r
+                                            'face 'notmuch-tag-face)\r
+-                               ")"))))))\r
++                               ")")))))\r
++  (unless no-headerline-update\r
++    (notmuch-show-update-header-line)))\r
\r
+ (defun notmuch-clean-address (address)\r
+   "Try to clean a single email ADDRESS for display. Return a cons\r
+@@ -1136,11 +1139,28 @@ function is used."\r
\r
+       (jit-lock-register #'notmuch-show-buttonise-links)\r
\r
+-      ;; Set the header line to the subject of the first message.\r
+-      (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))\r
+-\r
++      (notmuch-show-update-header-line)\r
+       (run-hooks 'notmuch-show-hook))))\r
\r
++(defun notmuch-show-thread-tags ()\r
++  "Return the list of tags for the current thread."\r
++  (let ((tags (list)))\r
++    (notmuch-show-mapc (lambda ()\r
++                       (mapcar (lambda (elt)\r
++                                 ;; Avoid adding duplicate tags\r
++                                 (add-to-list 'tags elt))\r
++                               (notmuch-show-get-tags))))\r
++    (sort tags 'string<)))\r
++\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
++    (setq header-line-format\r
++        (list\r
++         thread-subject\r
++         " "\r
++         (notmuch-tagger-format-tags-header-line (notmuch-show-thread-tags))))))\r
++\r
+ (defun notmuch-show-capture-state ()\r
+   "Capture the state of the current buffer.\r
\r
+@@ -1443,10 +1463,10 @@ current thread."\r
+ (defun notmuch-show-get-depth ()\r
+   (notmuch-show-get-prop :depth))\r
\r
+-(defun notmuch-show-set-tags (tags)\r
++(defun notmuch-show-set-tags (tags &optional no-headerline-update)\r
+   "Set the tags of the current message."\r
+   (notmuch-show-set-prop :tags tags)\r
+-  (notmuch-show-update-tags tags))\r
++  (notmuch-show-update-tags tags no-headerline-update))\r
\r
+ (defun notmuch-show-get-tags ()\r
+   "Return the tags of the current message."\r
+@@ -1760,7 +1780,8 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."\r
+      (let* ((current-tags (notmuch-show-get-tags))\r
+           (new-tags (notmuch-update-tags current-tags tag-changes)))\r
+        (unless (equal current-tags new-tags)\r
+-       (notmuch-show-set-tags new-tags))))))\r
++       (notmuch-show-set-tags new-tags t)))))\r
++  (notmuch-show-update-header-line))\r
\r
+ (defun notmuch-show-add-tag ()\r
+   "Same as `notmuch-show-tag' but sets initial input to '+'."\r
+diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el\r
+new file mode 100644\r
+index 0000000..6fcebff\r
+--- /dev/null\r
++++ b/emacs/notmuch-tagger.el\r
+@@ -0,0 +1,35 @@\r
++;; notmuch-tagger.el --- Library to improve the way tags are displayed\r
++;;\r
++;; Copyright © 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
++(defun notmuch-tagger-format-tags-header-line (tags)\r
++  "Format TAGS as a `mode-line-format' template.\r
++The result is suitable for inclusion in `header-line-format'."\r
++  (list\r
++   "("\r
++   (notmuch-intersperse tags " ")\r
++   ")"))\r
++\r
++(provide 'notmuch-tagger)\r
++;;; notmuch-tagger.el ends here\r
+-- \r
+1.7.10.4\r
+\r