46/33ab02e0fe805dd9aabb2b0f0d7c89aeef5f30

   1 Return-Path: <damien.cassou@gmail.com>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 20D5C431FD9\r
   6         for <notmuch@notmuchmail.org>; Tue, 11 Dec 2012 01:00:50 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.799\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.799 tagged_above=-999 required=5\r
  12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
  13         FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  14 Received: from olra.theworths.org ([127.0.0.1])\r
  15         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  16         with ESMTP id kf4WQ6wkqzUS for <notmuch@notmuchmail.org>;\r
  17         Tue, 11 Dec 2012 01:00:49 -0800 (PST)\r
  18 Received: from mail-wg0-f41.google.com (mail-wg0-f41.google.com\r
  19  [74.125.82.41])        (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
  20  certificate requested) by olra.theworths.org (Postfix) with ESMTPS id\r
  21  DEFBA431FAE    for <notmuch@notmuchmail.org>; Tue, 11 Dec 2012 01:00:48 -0800\r
  22  (PST)\r
  23 Received: by mail-wg0-f41.google.com with SMTP id ds1so1214872wgb.2\r
  24         for <notmuch@notmuchmail.org>; Tue, 11 Dec 2012 01:00:47 -0800 (PST)\r
  25 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\r
  26         h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references;\r
  27         bh=aW34qn1wrIONxWP6V0whAOqbeiiOjp9tmgLCntBpqBk=;\r
  28         b=TjOtZvlpAGU2ZEXoMjBJG3zzi0vIbqNTpgzTD0Riqshjg7xZgBMoUUd9FcDQ5ig9UU\r
  29         FQypbC5iVy/mH2tw6eAuzR0FO60c9dOcxVpvKuzQby+KA5jS0/q/XLnnLpBmR3ZXl3e8\r
  30         xMeSoICIBac4fPNHpktMTmpcuosEVyLlRUt+CtEumUCqVE4nQZ9Cy0SimAtNwCRDAycY\r
  31         de0DY8gA14zahhe8LbB0qVPp2PWOZW3FSqQKDvkA58v/GUXnOU9i/wAF0ZAEqyDNvFqc\r
  32         SjqFlIH/rvv5PB8A9qrMX/gTmxlxYbiRGzlImNVjz+GoBBE9f/zKgAIoduiqsSgpix3K\r
  33         JHGw==\r
  34 Received: by 10.216.72.12 with SMTP id s12mr371252wed.69.1355216447682;\r
  35         Tue, 11 Dec 2012 01:00:47 -0800 (PST)\r
  36 Received: from luz3.lille.inria.fr ([193.51.236.232])\r
  37         by mx.google.com with ESMTPS id b1sm15376748wix.11.2012.12.11.01.00.46\r
  38         (version=TLSv1/SSLv3 cipher=OTHER);\r
  39         Tue, 11 Dec 2012 01:00:47 -0800 (PST)\r
  40 From: Damien Cassou <damien.cassou@gmail.com>\r
  41 To: notmuch@notmuchmail.org\r
  42 Subject: [PATCH 3/4] emacs: Make all tags in `notmuch-show' clickable\r
  43 Date: Tue, 11 Dec 2012 10:00:36 +0100\r
  44 Message-Id: <1355216437-21109-4-git-send-email-damien.cassou@gmail.com>\r
  45 X-Mailer: git-send-email 1.7.10.4\r
  46 In-Reply-To: <1355216437-21109-1-git-send-email-damien.cassou@gmail.com>\r
  47 References: <1355216437-21109-1-git-send-email-damien.cassou@gmail.com>\r
  48 X-BeenThere: notmuch@notmuchmail.org\r
  49 X-Mailman-Version: 2.1.13\r
  50 Precedence: list\r
  51 List-Id: "Use and development of the notmuch mail system."\r
  52         <notmuch.notmuchmail.org>\r
  53 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  54         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  55 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  56 List-Post: <mailto:notmuch@notmuchmail.org>\r
  57 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  58 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  59         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  60 X-List-Received-Date: Tue, 11 Dec 2012 09:00:50 -0000\r
  61 \r
  62 Signed-off-by: Damien Cassou <damien.cassou@gmail.com>\r
  63 ---\r
  64  emacs/notmuch-show.el   |   15 +++++++--------\r
  65  emacs/notmuch-tagger.el |   33 +++++++++++++++++++++++++++++++++\r
  66  2 files changed, 40 insertions(+), 8 deletions(-)\r
  67 \r
  68 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
  69 index a71497a..93bce07 100644\r
  70 --- a/emacs/notmuch-show.el\r
  71 +++ b/emacs/notmuch-show.el\r
  72 @@ -362,10 +362,8 @@ operation on the contents of the current buffer."\r
  73      (goto-char (notmuch-show-message-top))\r
  74      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
  75         (let ((inhibit-read-only t))\r
  76 -         (replace-match (concat "("\r
  77 -                                (propertize (mapconcat 'identity tags " ")\r
  78 -                                            'face 'notmuch-tag-face)\r
  79 -                                ")")))))\r
  80 +         (replace-match (propertize (notmuch-tagger-format-tags tags)\r
  81 +                                    'face 'notmuch-tag-face)))))\r
  82    (notmuch-show-update-header-line))\r
  83  \r
  84  (defun notmuch-clean-address (address)\r
  85 @@ -442,10 +440,11 @@ message at DEPTH in the current thread."\r
  86             (notmuch-show-clean-address (plist-get headers :From))\r
  87             " ("\r
  88             date\r
  89 -           ") ("\r
  90 -           (propertize (mapconcat 'identity tags " ")\r
  91 -                       'face 'notmuch-tag-face)\r
  92 -           ")\n")\r
  93 +           ") "\r
  94 +           (propertize\r
  95 +            (notmuch-tagger-format-tags tags)\r
  96 +            'face 'notmuch-tag-face)\r
  97 +           "\n")\r
  98      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
  99  \r
 100  (defun notmuch-show-insert-header (header header-value)\r
 101 diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el\r
 102 index 38b858a..35b81ca 100644\r
 103 --- a/emacs/notmuch-tagger.el\r
 104 +++ b/emacs/notmuch-tagger.el\r
 105 @@ -44,12 +44,21 @@ test if the library is present before calling this function."\r
 106    (let ((tag (header-button-get button 'notmuch-tagger-tag)))\r
 107      (notmuch-tagger-goto-target tag)))\r
 108  \r
 109 +(defun notmuch-tagger-body-button-action (button)\r
 110 +  "Open `notmuch-search' for the tag referenced by BUTTON."\r
 111 +  (let ((tag (button-get button 'notmuch-tagger-tag)))\r
 112 +    (notmuch-tagger-goto-target tag)))\r
 113 +\r
 114  (eval-after-load "header-button"\r
 115    '(define-button-type 'notmuch-tagger-header-button-type\r
 116       'supertype 'header\r
 117       'action    #'notmuch-tagger-header-button-action\r
 118       'follow-link t))\r
 119  \r
 120 +(define-button-type 'notmuch-tagger-body-button-type\r
 121 +  'action    #'notmuch-tagger-body-button-action\r
 122 +  'follow-link t)\r
 123 +\r
 124  (defun notmuch-tagger-really-make-header-link (tag)\r
 125     "Return a property list that presents a link to TAG.\r
 126  \r
 127 @@ -73,6 +82,20 @@ if not."\r
 128        (notmuch-tagger-really-make-header-link tag)\r
 129      tag))\r
 130  \r
 131 +(defun notmuch-tagger-make-body-link (tag)\r
 132 +  "Return a property list that presents a link to TAG.\r
 133 +The returned property list will not work in the header-line. For\r
 134 +a link that works on the header-line, prefer\r
 135 +`notmuch-tagger-make-header-link'."\r
 136 +  (let ((button (copy-sequence tag)))\r
 137 +    (make-text-button\r
 138 +     button nil\r
 139 +     'type 'notmuch-tagger-body-button-type\r
 140 +     'notmuch-tagger-tag tag\r
 141 +     'skip t ;; don't stop when using TAB\r
 142 +     'help-echo (format "%s: Search other messages like this" tag))\r
 143 +    button))\r
 144 +\r
 145  (defun notmuch-tagger-format-tags-header-line (tags)\r
 146    "Format TAGS as a `mode-line-format' template.\r
 147  The result is suitable for inclusion in `header-line-format'."\r
 148 @@ -83,5 +106,15 @@ The result is suitable for inclusion in `header-line-format'."\r
 149      " ")\r
 150     ")"))\r
 151  \r
 152 +(defun notmuch-tagger-format-tags (tags)\r
 153 +  "Format TAGS as a string suitable for insertion in a buffer.\r
 154 +If the result of this function is to be used within the\r
 155 +header-line, prefer `notmuch-tagger-format-tags-header-line'\r
 156 +instead of this function."\r
 157 +  (concat\r
 158 +   "("\r
 159 +   (mapconcat #'notmuch-tagger-make-body-link tags " ")\r
 160 +   ")"))\r
 161 +\r
 162  (provide 'notmuch-tagger)\r
 163  ;;; notmuch-tagger.el ends here\r
 164 -- \r
 165 1.7.10.4\r
 166 \r