fc/ddcc671b99b4265d9064361a1709876574f48c

   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 EA7A3431FB6\r
   6         for <notmuch@notmuchmail.org>; Sat, 10 Nov 2012 08:42:35 -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: 1.7\r
  10 X-Spam-Level: *\r
  11 X-Spam-Status: No, score=1.7 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, FREEMAIL_REPLY=2.499, RCVD_IN_DNSWL_LOW=-0.7]\r
  14         autolearn=disabled\r
  15 Received: from olra.theworths.org ([127.0.0.1])\r
  16         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  17         with ESMTP id 0sUuV0LU3a+5 for <notmuch@notmuchmail.org>;\r
  18         Sat, 10 Nov 2012 08:42:34 -0800 (PST)\r
  19 Received: from mail-wi0-f179.google.com (mail-wi0-f179.google.com\r
  20         [209.85.212.179]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
  21         (No client certificate requested)\r
  22         by olra.theworths.org (Postfix) with ESMTPS id C4770431FAF\r
  23         for <notmuch@notmuchmail.org>; Sat, 10 Nov 2012 08:42:33 -0800 (PST)\r
  24 Received: by mail-wi0-f179.google.com with SMTP id hm6so1027954wib.2\r
  25         for <notmuch@notmuchmail.org>; Sat, 10 Nov 2012 08:42:32 -0800 (PST)\r
  26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\r
  27         h=from:to:cc:subject:date:message-id:x-mailer:mime-version\r
  28         :content-type:content-transfer-encoding;\r
  29         bh=SokKGH5nL2A7mAwfJwWFkf3dGi1c6ohOxYnwTr9Cr/w=;\r
  30         b=TK6sze1FbLOckGUlw+NMdx2Kytmz0sBCuYCrluwNfVBZtIjRLC10MvmbT37OLUYfHH\r
  31         5oX7RoMPbJBP1sD3KuYedWkRdMb+dmtwiyRjw1Bpxatqvg3CGOofB0LlXP1FwWTqI29Y\r
  32         2P4gbvN9XezWDiAbyWMlhIRJGPuWAo8x9cXwu/OFQgmwvO0lRf//N49n3BWwwv643krb\r
  33         j9PssL9rGAtaaGu5LK9Ha80zfoTbxZ799/bfCMT9n9WrGqBTd9NyBY7n2cem1gFxCTvX\r
  34         hGb43DiHsjvaFfr13x2hhBjSFc2wMw0dQ1uWvvjXqJ9vPzg/VqbhNh5m45o+yGUcHScV\r
  35         KBWA==\r
  36 Received: by 10.180.97.35 with SMTP id dx3mr7785198wib.14.1352565752453;\r
  37         Sat, 10 Nov 2012 08:42:32 -0800 (PST)\r
  38 Received: from localhost.localdomain (ble59-4-82-228-190-150.fbx.proxad.net.\r
  39         [82.228.190.150])\r
  40         by mx.google.com with ESMTPS id i6sm6952373wix.5.2012.11.10.08.42.31\r
  41         (version=TLSv1/SSLv3 cipher=OTHER);\r
  42         Sat, 10 Nov 2012 08:42:31 -0800 (PST)\r
  43 From: Damien Cassou <damien.cassou@gmail.com>\r
  44 To: notmuch mailing list <notmuch@notmuchmail.org>\r
  45 Subject: [PATCH v2] emacs: display tags in notmuch-show with links\r
  46 Date: Sat, 10 Nov 2012 17:41:59 +0100\r
  47 Message-Id: <1352565719-12397-1-git-send-email-damien.cassou@gmail.com>\r
  48 X-Mailer: git-send-email 1.7.10.4\r
  49 MIME-Version: 1.0\r
  50 Content-Type: text/plain; charset=UTF-8\r
  51 Content-Transfer-Encoding: 8bit\r
  52 X-BeenThere: notmuch@notmuchmail.org\r
  53 X-Mailman-Version: 2.1.13\r
  54 Precedence: list\r
  55 List-Id: "Use and development of the notmuch mail system."\r
  56         <notmuch.notmuchmail.org>\r
  57 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  58         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  59 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  60 List-Post: <mailto:notmuch@notmuchmail.org>\r
  61 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  62 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  63         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  64 X-List-Received-Date: Sat, 10 Nov 2012 16:42:36 -0000\r
  65 \r
  66 This patch obsoletes\r
  67 id:1352234344-28119-1-git-send-email-damien.cassou@gmail.com\r
  68 \r
  69 This patch makes clickable all tags that appear in notmuch-show\r
  70 buffers. Each tag is a link to open a new notmuch-search buffer for\r
  71 this tag. Additionally, the buffer's header-line now shows the\r
  72 thread's tags (also clickable).\r
  73 \r
  74 This patch is the first one of an upcoming series whose goal is to\r
  75 integrate notmuch-labeler into notmuch. See the following for more\r
  76 details:\r
  77 https://github.com/DamienCassou/notmuch-labeler\r
  78 \r
  79 This patch includes header-button.el, a package contributed by Jonas\r
  80 Bernoulli that fixes a limitation of the button.el Emacs library.\r
  81 Jonas gave me the authorization to include the package in notmuch, but\r
  82 only if the package is first searched in the existing `load-path'. See\r
  83 this thread:\r
  84 id:CA+y5ggiGrAcicQLeskaXFoxYyJQVVXZ1VRX=XS8zPFR9_mBFxA@mail.gmail.com\r
  85 \r
  86 With respect to v1, I took care of the comments you made:\r
  87 - Renamed tager to tagger;\r
  88 - Avoided an additional call to notmuch by reading existing data in\r
  89   the buffer with `notmuch-show-mapc';\r
  90 - As a result of previous point, a thread's tags now equals the union\r
  91   of the emails' tags that are visible;\r
  92 - Stopped stripping "thread:" from the thread-id to add it back\r
  93   later.\r
  94 \r
  95 With respect to v1, I added the following:\r
  96 - Each label on each message is now clickable;\r
  97 - Moved header-button.el to fallback-libs/ and only load this one when\r
  98   it is not already in the `load-path'.\r
  99 \r
 100 You can follow this patch series on\r
 101 https://github.com/DamienCassou/notmuch/tree/labeler-integration\r
 102 \r
 103 Signed-off-by: Damien Cassou <damien.cassou@gmail.com>\r
 104 ---\r
 105  emacs/fallback-libs/.nosearch        |    1 +\r
 106  emacs/fallback-libs/header-button.el |  138 ++++++++++++++++++++++++++++++++++\r
 107  emacs/notmuch-show.el                |   33 ++++++--\r
 108  emacs/notmuch-tagger.el              |  129 +++++++++++++++++++++++++++++++\r
 109  test/emacs                           |   61 +++++++++++++++\r
 110  5 files changed, 355 insertions(+), 7 deletions(-)\r
 111  create mode 100644 emacs/fallback-libs/.nosearch\r
 112  create mode 100644 emacs/fallback-libs/header-button.el\r
 113  create mode 100644 emacs/notmuch-tagger.el\r
 114 \r
 115 diff --git a/emacs/fallback-libs/.nosearch b/emacs/fallback-libs/.nosearch\r
 116 new file mode 100644\r
 117 index 0000000..0a01dc9\r
 118 --- /dev/null\r
 119 +++ b/emacs/fallback-libs/.nosearch\r
 120 @@ -0,0 +1 @@\r
 121 +This file prevents Emacs from adding the directory to the `load-path'.\r
 122 diff --git a/emacs/fallback-libs/header-button.el b/emacs/fallback-libs/header-button.el\r
 123 new file mode 100644\r
 124 index 0000000..05f6f32\r
 125 --- /dev/null\r
 126 +++ b/emacs/fallback-libs/header-button.el\r
 127 @@ -0,0 +1,138 @@\r
 128 +;;; header-button.el --- clickable buttons in header lines\r
 129 +\r
 130 +;; Copyright (C) 2010-2012  Jonas Bernoulli\r
 131 +\r
 132 +;; Author: Jonas Bernoulli <jonas@bernoul.li>\r
 133 +;; Created: 20100604\r
 134 +;; Version: 0.2.2\r
 135 +;; Homepage: https://github.com/tarsius/header-button\r
 136 +;; Keywords: extensions\r
 137 +\r
 138 +;; This file is not part of GNU Emacs.\r
 139 +\r
 140 +;; This file is free software; you can redistribute it and/or modify\r
 141 +;; it under the terms of the GNU General Public License as published by\r
 142 +;; the Free Software Foundation; either version 3, or (at your option)\r
 143 +;; any later version.\r
 144 +\r
 145 +;; This file is distributed in the hope that it will be useful,\r
 146 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 147 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 148 +;; GNU General Public License for more details.\r
 149 +\r
 150 +;; You should have received a copy of the GNU General Public License\r
 151 +;; along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
 152 +\r
 153 +;;; Commentary:\r
 154 +\r
 155 +;; This package extends `button' by adding support for adding buttons to\r
 156 +;; the header line.  Since the header line is very limited compared to a\r
 157 +;; buffer most of the functionality provided by `button' is not available\r
 158 +;; for buttons in the header line.\r
 159 +\r
 160 +;; While `button' provides the function `insert-button' (as well as\r
 161 +;; others) to insert a button into a buffer at point, something similar\r
 162 +;; can't be done here, due to the lack of point in header lines.\r
 163 +\r
 164 +;; Instead use `header-button-format' like this:\r
 165 +;;\r
 166 +;; (setq header-line-format\r
 167 +;;       (concat "Here's a button: "\r
 168 +;;               (header-button-format "Click me!" :action 'my-action)))\r
 169 +\r
 170 +;; Like with `button' you can create your own derived button types:\r
 171 +;;\r
 172 +;; (define-button-type 'my-header\r
 173 +;;   :supertype 'header\r
 174 +;;   :action 'my-action)\r
 175 +;;\r
 176 +;; (setq header-line-format\r
 177 +;;       (concat (header-button-format "Click me!" :action 'my-action) " "\r
 178 +;;               (header-button-format "No me!" :type 'my-header)))\r
 179 +\r
 180 +;; The function associated with `:action' is called with the button plist\r
 181 +;; as only argument.  Do no use `plist-get' to extract a value from it.\r
 182 +;; Instead use `header-button-get' which will also extract values stored\r
 183 +;; in it's type.\r
 184 +;;\r
 185 +;; (defun my-action (button)\r
 186 +;;   (message "This button labeled `%s' belongs to category `%s'"\r
 187 +;;            (header-button-label button)\r
 188 +;;            (header-button-get button 'category)))\r
 189 +\r
 190 +;;; Code:\r
 191 +\r
 192 +(require 'button)\r
 193 +\r
 194 +(defvar header-button-map\r
 195 +  (let ((map (make-sparse-keymap)))\r
 196 +    ;; $$$ follow-link does not work here\r
 197 +    (define-key map [header-line mouse-1] 'header-button-push)\r
 198 +    (define-key map [header-line mouse-2] 'header-button-push)\r
 199 +    map)\r
 200 +  "Keymap used by buttons in header lines.")\r
 201 +\r
 202 +(define-button-type 'header\r
 203 +  'keymap header-button-map\r
 204 +  'help-echo (purecopy "mouse-1: Push this button"))\r
 205 +\r
 206 +(defun header-button-get (button prop)\r
 207 +  "Get the property of header button BUTTON named PROP."\r
 208 +  (let ((entry (plist-member button prop)))\r
 209 +    (if entry\r
 210 +        (cadr entry)\r
 211 +      (get (plist-get button 'category) prop))))\r
 212 +\r
 213 +(defun header-button-label (button)\r
 214 +  "Return header button BUTTON's text label."\r
 215 +  (plist-get button 'label))\r
 216 +\r
 217 +(defun header-button-format (label &rest properties)\r
 218 +  "Format a header button string with the label LABEL.\r
 219 +The remaining arguments form a sequence of PROPERTY VALUE pairs,\r
 220 +specifying properties to add to the button.\r
 221 +In addition, the keyword argument :type may be used to specify a\r
 222 +button-type from which to inherit other properties; see\r
 223 +`define-button-type'.\r
 224 +\r
 225 +To actually create the header button set the value of variable\r
 226 +`header-line-format' to the string returned by this function\r
 227 +\(or a string created by concatenating that string with others."\r
 228 +  (let ((type-entry (or (plist-member properties 'type)\r
 229 +                        (plist-member properties :type))))\r
 230 +    (when (plist-get properties 'category)\r
 231 +      (error "Button `category' property may not be set directly"))\r
 232 +    (if (null type-entry)\r
 233 +        (setq properties\r
 234 +              (cons 'category\r
 235 +                    (cons (button-category-symbol 'header) properties)))\r
 236 +      (setcar type-entry 'category)\r
 237 +      (setcar (cdr type-entry)\r
 238 +              (button-category-symbol (car (cdr type-entry)))))\r
 239 +    (apply #'propertize label\r
 240 +           (nconc (list 'button (list t) 'label label) properties))))\r
 241 +\r
 242 +(defun header-button-activate (button)\r
 243 +  "Call header button BUTTON's `:action' property."\r
 244 +  ;; Older versions only supported `:action' but button.el uses\r
 245 +  ;; `action' instead.  Now we support both and query `:action'\r
 246 +  ;; first because `action' defaults to function `ignore'.\r
 247 +  (funcall (or (header-button-get button :action)\r
 248 +               (header-button-get button 'action))\r
 249 +           button))\r
 250 +\r
 251 +(defun header-button-push ()\r
 252 +  "Perform the action specified by the pressed header button."\r
 253 +  (interactive)\r
 254 +  (let* ((posn (event-start last-command-event))\r
 255 +         (object (posn-object posn))\r
 256 +         (buffer (window-buffer (posn-window posn)))\r
 257 +         (button (text-properties-at (cdr object) (car object))))\r
 258 +    (with-current-buffer buffer\r
 259 +      (header-button-activate button))))\r
 260 +\r
 261 +(provide 'header-button)\r
 262 +;; Local Variables:\r
 263 +;; indent-tabs-mode: nil\r
 264 +;; End:\r
 265 +;;; header-button.el ends here\r
 266 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 267 index d061367..6f38381 100644\r
 268 --- a/emacs/notmuch-show.el\r
 269 +++ b/emacs/notmuch-show.el\r
 270 @@ -36,6 +36,7 @@\r
 271  (require 'notmuch-mua)\r
 272  (require 'notmuch-crypto)\r
 273  (require 'notmuch-print)\r
 274 +(require 'notmuch-tagger)\r
 275  \r
 276  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
 277  (declare-function notmuch-fontify-headers "notmuch" nil)\r
 278 @@ -430,10 +431,11 @@ message at DEPTH in the current thread."\r
 279             (notmuch-show-clean-address (plist-get headers :From))\r
 280             " ("\r
 281             date\r
 282 -           ") ("\r
 283 -           (propertize (mapconcat 'identity tags " ")\r
 284 -                       'face 'notmuch-tag-face)\r
 285 -           ")\n")\r
 286 +           ") "\r
 287 +           (propertize\r
 288 +            (format-mode-line (notmuch-tagger-present-tags tags))\r
 289 +            'face 'notmuch-tag-face)\r
 290 +           "\n")\r
 291      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 292  \r
 293  (defun notmuch-show-insert-header (header header-value)\r
 294 @@ -1082,11 +1084,28 @@ function is used."\r
 295  \r
 296        (jit-lock-register #'notmuch-show-buttonise-links)\r
 297  \r
 298 -      ;; Set the header line to the subject of the first message.\r
 299 -      (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))\r
 300 -\r
 301 +      (notmuch-show-update-header-line)\r
 302        (run-hooks 'notmuch-show-hook))))\r
 303  \r
 304 +(defun notmuch-show-thread-tags ()\r
 305 +  "Return the list of tags for the current thread."\r
 306 +  (let ((tags (list)))\r
 307 +    (notmuch-show-mapc (lambda ()\r
 308 +                        (mapcar (lambda (elt)\r
 309 +                                  ;; Avoid adding duplicate tags\r
 310 +                                  (add-to-list 'tags elt))\r
 311 +                                (notmuch-show-get-tags))))\r
 312 +    tags))\r
 313 +\r
 314 +(defun notmuch-show-update-header-line ()\r
 315 +  "Make the header-line show the thread's subject and tags."\r
 316 +  (let ((thread-subject (notmuch-show-strip-re (notmuch-show-get-subject))))\r
 317 +    (setq header-line-format\r
 318 +         (list\r
 319 +          thread-subject\r
 320 +          " "\r
 321 +          (notmuch-tagger-present-tags (notmuch-show-thread-tags) t)))))\r
 322 +\r
 323  (defun notmuch-show-capture-state ()\r
 324    "Capture the state of the current buffer.\r
 325  \r
 326 diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el\r
 327 new file mode 100644\r
 328 index 0000000..e825df5\r
 329 --- /dev/null\r
 330 +++ b/emacs/notmuch-tagger.el\r
 331 @@ -0,0 +1,129 @@\r
 332 +;; notmuch-tagger.el --- Library to show labels as links\r
 333 +;;\r
 334 +;; Copyright © Damien Cassou\r
 335 +;;\r
 336 +;; This file is part of Notmuch.\r
 337 +;;\r
 338 +;; Notmuch is free software: you can redistribute it and/or modify it\r
 339 +;; under the terms of the GNU General Public License as published by\r
 340 +;; the Free Software Foundation, either version 3 of the License, or\r
 341 +;; (at your option) any later version.\r
 342 +;;\r
 343 +;; Notmuch is distributed in the hope that it will be useful, but\r
 344 +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
 345 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\r
 346 +;; General Public License for more details.\r
 347 +;;\r
 348 +;; You should have received a copy of the GNU General Public License\r
 349 +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
 350 +;;\r
 351 +;; Authors: Damien Cassou <damien.cassou@gmail.com>\r
 352 +;;; Commentary:\r
 353 +;;\r
 354 +;;; Code:\r
 355 +;;\r
 356 +\r
 357 +(require 'button)\r
 358 +\r
 359 +(or (require 'header-button nil t)\r
 360 +    (let ((load-path\r
 361 +           (cons (expand-file-name\r
 362 +                  "fallback-libs"\r
 363 +                  (file-name-directory (or load-file-name buffer-file-name)))\r
 364 +                 load-path)))\r
 365 +      (require 'header-button)))\r
 366 +\r
 367 +(defun notmuch-tagger-separate-elems (list sep)\r
 368 +  "Return a list with all elements of LIST separated by SEP."\r
 369 +  (let ((first t)\r
 370 +        (res nil))\r
 371 +    (dolist (elt (reverse list) res)\r
 372 +      (unless first\r
 373 +        (push sep res))\r
 374 +      (setq first nil)\r
 375 +      (push elt res))))\r
 376 +\r
 377 +(defun notmuch-tagger-goto-target (target)\r
 378 +  "Show a `notmuch-search' buffer for the TARGET tag."\r
 379 +  (notmuch-search (concat "tag:" target)))\r
 380 +\r
 381 +(defun notmuch-tagger-headerline-button-action (button)\r
 382 +  "Open `notmuch-search' for the tag referenced by BUTTON."\r
 383 +  (let ((tag (header-button-get button 'notmuch-tagger-tag)))\r
 384 +    (notmuch-tagger-goto-target tag)))\r
 385 +\r
 386 +(defun notmuch-tagger-body-button-action (button)\r
 387 +  "Open `notmuch-search' for the tag referenced by BUTTON."\r
 388 +  (let ((tag (button-get button 'notmuch-tagger-tag)))\r
 389 +    (notmuch-tagger-goto-target tag)))\r
 390 +\r
 391 +(define-button-type 'notmuch-tagger-headerline-button-type\r
 392 +  'supertype 'header\r
 393 +  'action    #'notmuch-tagger-headerline-button-action\r
 394 +  'follow-link t)\r
 395 +\r
 396 +(define-button-type 'notmuch-tagger-body-button-type\r
 397 +  'action    #'notmuch-tagger-body-button-action\r
 398 +  'follow-link t)\r
 399 +\r
 400 +(defun notmuch-tagger-make-headerline-link (target)\r
 401 +  "Return a property list that presents a link to TARGET.\r
 402 +\r
 403 +TARGET is a notmuch tag.\r
 404 +The returned property list will only work in the header-line."\r
 405 +  (header-button-format\r
 406 +   target\r
 407 +   :type 'notmuch-tagger-headerline-button-type\r
 408 +   'notmuch-tagger-tag target\r
 409 +   'help-echo (format "%s: Search other messages like this" target)))\r
 410 +\r
 411 +(defun notmuch-tagger-make-body-link (target)\r
 412 +  "Return a property list that presents a link to TARGET.\r
 413 +\r
 414 +TARGET is a notmuch tag.\r
 415 +The returned property list will work everywhere except in the\r
 416 +header-line."\r
 417 +  (let ((button (copy-sequence target)))\r
 418 +    (make-text-button\r
 419 +     button nil\r
 420 +     'type 'notmuch-tagger-body-button-type\r
 421 +     'notmuch-tagger-tag target\r
 422 +     'help-echo (format "%s: Search other messages like this" target))\r
 423 +    button))\r
 424 +\r
 425 +(defun notmuch-tagger-make-link (target headerline)\r
 426 +"Return a property list that presents a link to TARGET.\r
 427 +\r
 428 +TARGET is a notmuch tag.\r
 429 +\r
 430 +If HEADERLINE is non-nil the returned list will be ready for\r
 431 +inclusion in the buffer's header-line. HEADERLINE must be nil in\r
 432 +all other cases."\r
 433 +  (if headerline\r
 434 +      (notmuch-tagger-make-headerline-link target)\r
 435 +    (notmuch-tagger-make-body-link target)))\r
 436 +\r
 437 +(defun notmuch-tagger-format-tags (tags &optional headerline)\r
 438 +  "Return a format list for TAGS suitable for use in header line.\r
 439 +See Info node `(elisp)Mode Line Format' for more information.\r
 440 +\r
 441 +If HEADERLINE is non-nil the returned list will be ready for\r
 442 +inclusion in the buffer's header-line. HEADERLINE must be nil in\r
 443 +all other cases."\r
 444 +  (mapcar\r
 445 +   (lambda (tag) (notmuch-tagger-make-link tag headerline))\r
 446 +   tags))\r
 447 +\r
 448 +(defun notmuch-tagger-present-tags (tags &optional headerline)\r
 449 +  "Return a property list which nicely presents all TAGS.\r
 450 +\r
 451 +If HEADERLINE is non-nil the returned list will be ready for\r
 452 +inclusion in the buffer's header-line. HEADERLINE must be nil in\r
 453 +all other cases."\r
 454 +  (list\r
 455 +   "("\r
 456 +   (notmuch-tagger-separate-elems (notmuch-tagger-format-tags tags headerline) " ")\r
 457 +   ")"))\r
 458 +\r
 459 +(provide 'notmuch-tagger)\r
 460 +;;; notmuch-tagger.el ends here\r
 461 diff --git a/test/emacs b/test/emacs\r
 462 index 44f641e..ecdc841 100755\r
 463 --- a/test/emacs\r
 464 +++ b/test/emacs\r
 465 @@ -820,5 +820,66 @@ Date: Fri, 05 Jan 2001 15:43:57 +0000\r
 466  EOF\r
 467  test_expect_equal_file OUTPUT EXPECTED\r
 468  \r
 469 +test_begin_subtest "Extracting all tags from a thread"\r
 470 +add_message \\r
 471 +    '[subject]="Extracting all tags from a thread"' \\r
 472 +    '[body]="body 1"'\r
 473 +parent=${gen_msg_id}\r
 474 +add_message \\r
 475 +    '[subject]="Extracting all tags from a thread"' \\r
 476 +    '[body]="body 2"' \\r
 477 +    "[in-reply-to]=\<$parent\>"\r
 478 +add_message \\r
 479 +    '[subject]="Extracting all tags from a thread"' \\r
 480 +    '[body]="body 3"' \\r
 481 +    "[in-reply-to]=\<$parent\>"\r
 482 +latest=${gen_msg_id}\r
 483 +# Extract the thread-id from one of the emails\r
 484 +thread_id=$(notmuch search id:${latest} | sed -e "s/thread:\([a-f0-9]*\).*/\1/")\r
 485 +# Add tag "mytagfoo" to one of the emails\r
 486 +notmuch tag +mytagfoo id:${latest}\r
 487 +test_emacs_expect_t \\r
 488 +    "(notmuch-show \"thread:${thread_id}\")\r
 489 +     (let ((output (notmuch-show-thread-tags))\r
 490 +           (expected '(\"inbox\" \"mytagfoo\" \"unread\")))\r
 491 +      (notmuch-test-expect-equal\r
 492 +         (sort output #'string<)\r
 493 +         (sort expected #'string<)))"\r
 494 +\r
 495 +test_begin_subtest "The tags appear in the header-line of notmuch-show"\r
 496 +add_message \\r
 497 +    '[subject]="foo bar"' \\r
 498 +    '[body]="body 1"'\r
 499 +parent=${gen_msg_id}\r
 500 +# Add tag "mytagfoo" to one of the emails\r
 501 +notmuch tag +mytagfoo id:${parent}\r
 502 +# Extract the thread-id from one of the emails\r
 503 +thread_id=$(notmuch search id:${latest} | sed -e "s/thread:\([a-f0-9]*\).*/\1/")\r
 504 +test_emacs_expect_t \\r
 505 +    "(notmuch-show \"thread:${thread_id}\")\r
 506 +     (if (string-match-p \"mytagfoo\" (format-mode-line header-line-format))\r
 507 +         t\r
 508 +       \"The tag mytagfoo was not in the header-line-format\")"\r
 509 +\r
 510 +test_begin_subtest "The tags of notmuch-show emails are clickable"\r
 511 +add_message \\r
 512 +    '[subject]="foo bar"' \\r
 513 +    '[body]="body 1"'\r
 514 +parent=${gen_msg_id}\r
 515 +# Add tag "mytagfoo" to one of the emails\r
 516 +notmuch tag +mytagfoo id:${parent}\r
 517 +# Extract the thread-id from one of the emails\r
 518 +thread_id=$(notmuch search id:${latest} | sed -e "s/thread:\([a-f0-9]*\).*/\1/")\r
 519 +test_emacs_expect_t \\r
 520 +    "(notmuch-show \"thread:${thread_id}\")\r
 521 +    (goto-char (point-min))\r
 522 +    (re-search-forward \"mytagfoo\")\r
 523 +    (backward-char) ;; to be 'in' the tag\r
 524 +    (unless (eq major-mode 'notmuch-show-mode)\r
 525 +       (error \"We must be in notmch-show at this point but we are in %s.\" major-mode))\r
 526 +    (push-button) ;; simulate a press on the RET key\r
 527 +    (if (eq major-mode 'notmuch-search-mode)\r
 528 +        t\r
 529 +       (format \"We must be in notmch-search at this point but we are in %s.\" major-mode))"\r
 530  \r
 531  test_done\r
 532 -- \r
 533 1.7.10.4\r
 534 \r