4e/6b4adde65f59fe708ffd9a058730e05e16eb3e

   1 Return-Path: <markwalters1009@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 1C205431FC3\r
   6         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:25 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: 0.201\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=0.201 tagged_above=-999 required=5\r
  12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
  13         FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,\r
  14         RCVD_IN_DNSWL_LOW=-0.7] 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 VWkr3qvP5T4x for <notmuch@notmuchmail.org>;\r
  18         Tue, 11 Mar 2014 21:10:17 -0700 (PDT)\r
  19 Received: from mail-wi0-f177.google.com (mail-wi0-f177.google.com\r
  20         [209.85.212.177]) (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 2CED5431FC7\r
  23         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:11 -0700 (PDT)\r
  24 Received: by mail-wi0-f177.google.com with SMTP id cc10so1797530wib.16\r
  25         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:09 -0700 (PDT)\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:in-reply-to:references;\r
  28         bh=1yB+/VbdMVtGTGpjjaxPfwGGbn1ezSBwdv+ZLS+lSzI=;\r
  29         b=dQHwrVre6JnxsUiIrQhIfB6ctW10PBLMtpTZYhgcnro4QywkDRQdA9ibwWV/qSUksm\r
  30         kiLspGaXLhcpuZpADVsNlfiwX8u3MYxAttUbFpgX5RmAGXLbWxW/zvMl7ErP1N/H4GUZ\r
  31         Jn8m5h6zmHOY6SVBT7G2uhUnA7xhct8AOt08thH1qsCGTY5l+Hy3xQVSYzQOGj3DFy0W\r
  32         fUxYoiUaxqNBf81MZmayGfygPBvZTdwnYMtt1+7SXOzDcvxrB0Xi88qnl7G6VHWMGwbz\r
  33         4UJVw6EpLVNkT1SejNBO1S62SRfo3ilNIMYSV7Eo+nELn002MiJCmeX5DvLVFLk15Nt5\r
  34         1isg==\r
  35 X-Received: by 10.195.13.17 with SMTP id eu17mr39966064wjd.24.1394597409868;\r
  36         Tue, 11 Mar 2014 21:10:09 -0700 (PDT)\r
  37 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])\r
  38         by mx.google.com with ESMTPSA id hy8sm66427140wjb.2.2014.03.11.21.10.08\r
  39         for <multiple recipients>\r
  40         (version=TLSv1.2 cipher=RC4-SHA bits=128/128);\r
  41         Tue, 11 Mar 2014 21:10:09 -0700 (PDT)\r
  42 From: Mark Walters <markwalters1009@gmail.com>\r
  43 To: notmuch@notmuchmail.org,\r
  44         amdragon@mit.edu\r
  45 Subject: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded\r
  46 Date: Wed, 12 Mar 2014 04:09:54 +0000\r
  47 Message-Id: <1394597397-8486-6-git-send-email-markwalters1009@gmail.com>\r
  48 X-Mailer: git-send-email 1.7.9.1\r
  49 In-Reply-To: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
  50 References: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
  51 X-BeenThere: notmuch@notmuchmail.org\r
  52 X-Mailman-Version: 2.1.13\r
  53 Precedence: list\r
  54 List-Id: "Use and development of the notmuch mail system."\r
  55         <notmuch.notmuchmail.org>\r
  56 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  57         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  58 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  59 List-Post: <mailto:notmuch@notmuchmail.org>\r
  60 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  61 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  62         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  63 X-List-Received-Date: Wed, 12 Mar 2014 04:10:25 -0000\r
  64 \r
  65 This allows (and requires) the original-tags to be passed along with\r
  66 the current-tags to be passed to notmuch-tag-format-tags. This allows\r
  67 the tag formatting to show added and deleted tags.By default a removed\r
  68 tag is displayed with strike-through in red (if strike-through is not\r
  69 available, eg on a terminal, inverse video is used instead) and an\r
  70 added tag is displayed underlined in green.\r
  71 \r
  72 If the caller does not wish to use the new feature it can pass\r
  73 current-tags for both arguments and, at this point, we do exactly that\r
  74 in the three callers of this function.\r
  75 \r
  76 Note, we cannot tidily allow original-tags to be optional because we would\r
  77 need to distinguish nil meaning "we are not specifying original-tags"\r
  78 from nil meaning there were no original-tags (an empty list).\r
  79 \r
  80 We use this in subsequent patches to make it clear when a message was\r
  81 unread when you first loaded a show buffer (previously the unread tag\r
  82 could be removed before a user realised that it had been unread).\r
  83 \r
  84 The code adds into the existing tag formatting code. The user can\r
  85 specify exactly how a tag should be displayed normally, when deleted,\r
  86 or when added.\r
  87 \r
  88 Since the formatting code matches regexps a user can match all deleted\r
  89 tags with a ".*" in notmuch-tag-deleted-formats.  For example setting\r
  90 notmuch-tag-deleted-formats to '((".*" nil)) tells notmuch not to show\r
  91 deleted tags at all.\r
  92 \r
  93 All the variables are customizable; however, more complicated cases\r
  94 like changing the face depending on the type of display will require\r
  95 custom lisp.\r
  96 \r
  97 Currently this overrides notmuch-tag-deleted-formats for the tests\r
  98 setting it to '((".*" nil)) so that they get removed from the display\r
  99 and, thus, all tests still pass.\r
 100 ---\r
 101  emacs/notmuch-show.el |    4 +-\r
 102  emacs/notmuch-tag.el  |   72 +++++++++++++++++++++++++++++++++++-------------\r
 103  emacs/notmuch-tree.el |    2 +-\r
 104  emacs/notmuch.el      |    2 +-\r
 105  test/test-lib.el      |    5 +++\r
 106  5 files changed, 61 insertions(+), 24 deletions(-)\r
 107 \r
 108 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 109 index 019f51d..5492be4 100644\r
 110 --- a/emacs/notmuch-show.el\r
 111 +++ b/emacs/notmuch-show.el\r
 112 @@ -344,7 +344,7 @@ (defun notmuch-show-update-tags (tags)\r
 113      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
 114         (let ((inhibit-read-only t))\r
 115           (replace-match (concat "("\r
 116 -                                (notmuch-tag-format-tags tags)\r
 117 +                                (notmuch-tag-format-tags tags tags)\r
 118                                  ")"))))))\r
 119  \r
 120  (defun notmuch-clean-address (address)\r
 121 @@ -423,7 +423,7 @@ (defun notmuch-show-insert-headerline (headers date tags depth)\r
 122             " ("\r
 123             date\r
 124             ") ("\r
 125 -           (notmuch-tag-format-tags tags)\r
 126 +           (notmuch-tag-format-tags tags tags)\r
 127             ")\n")\r
 128      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 129  \r
 130 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 131 index 4698856..cfccb8e 100644\r
 132 --- a/emacs/notmuch-tag.el\r
 133 +++ b/emacs/notmuch-tag.el\r
 134 @@ -184,45 +184,77 @@ (defun notmuch-tag-clear-cache ()\r
 135    "Clear the internal cache of tag formats."\r
 136    (clrhash notmuch-tag--format-cache))\r
 137  \r
 138 -(defun notmuch-tag-format-tag (tag)\r
 139 -  "Format TAG by according to `notmuch-tag-formats'.\r
 140 -\r
 141 -Callers must ensure that the tag format cache has been recently cleared\r
 142 -via `notmuch-tag-clear-cache' before using this function.  For example,\r
 143 -it would be appropriate to clear the cache just prior to filling a\r
 144 -buffer that uses formatted tags."\r
 145 -\r
 146 -  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
 147 +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)\r
 148 +  "Format TAG according to the appropriate `notmuch-tag-formats`.\r
 149 +\r
 150 +Applies formats for TAG from the appropriate one of\r
 151 +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and\r
 152 +`notmuch-tag-added-formats` based on TAG-STATE to the partially\r
 153 +formatted tag FORMATTED-TAG."\r
 154 +  (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))\r
 155      (when (eq formatted 'missing)\r
 156 -      (let* ((formats\r
 157 +      (let* ((tag-formats (case tag-state\r
 158 +                               ((list nil) notmuch-tag-formats)\r
 159 +                               (deleted notmuch-tag-deleted-formats)\r
 160 +                               (added notmuch-tag-added-formats)))\r
 161 +            (formats\r
 162               (save-match-data\r
 163                 ;; Don't use assoc-default since there's no way to\r
 164                 ;; distinguish a missing key from a present key with a\r
 165                 ;; null cdr:.\r
 166 -               (assoc* tag notmuch-tag-formats\r
 167 +               (assoc* tag tag-formats\r
 168                         :test (lambda (tag key)\r
 169                                 (and (eq (string-match key tag) 0)\r
 170                                      (= (match-end 0) (length tag))))))))\r
 171         (setq formatted\r
 172               (cond\r
 173 -              ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
 174 -               tag)                    ;;   the format is the tag itself.\r
 175 +              ((null formats)          ;; - Tag not in `tag-formats',\r
 176 +               formatted-tag)          ;;   the format is the tag itself.\r
 177                ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
 178                 nil)                    ;;   no format must be returned\r
 179 -              (t                       ;; - Tag was found and has formats,\r
 180 -               (let ((tag tag))        ;;   we must apply all the formats.\r
 181 +              (t\r
 182 +               ;; Tag was found and has formats, we must apply all\r
 183 +               ;; the formats.  FORMATTED-TAG may be null so treat\r
 184 +               ;; that as a special case.\r
 185 +               (let ((tag (or formatted-tag "")))\r
 186                   (dolist (format (cdr formats) tag)\r
 187 -                   (setq tag (eval format)))))))\r
 188 -       (puthash tag formatted notmuch-tag--format-cache)))\r
 189 +                   (setq tag (eval format)))\r
 190 +                 (if (and (null formatted-tag)\r
 191 +                          (equal tag ""))\r
 192 +                     nil\r
 193 +                   tag)))))\r
 194 +       (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
 195      formatted))\r
 196  \r
 197 -(defun notmuch-tag-format-tags (tags &optional face)\r
 198 +(defun notmuch-tag-format-tag (tags orig-tags tag)\r
 199 +  "Format TAG according to `notmuch-tag-formats'.\r
 200 +\r
 201 +TAGS and ORIG-TAGS are lists of the current tags and the original\r
 202 +tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
 203 +are not in TAGS) are shown using formats from\r
 204 +`notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
 205 +are in TAGS but are not in ORIG-TAGS) are shown using formats\r
 206 +from `notmuch-tag-added-formats' and tags which have not been\r
 207 +changed (the normal case) are shown using formats from\r
 208 +`notmuch-tag-formats'"\r
 209 +  (let* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))\r
 210 +    (cond ((not (member tag tags))\r
 211 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))\r
 212 +         ((not (member tag orig-tags))\r
 213 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'added))\r
 214 +         (t\r
 215 +           formatted-tag))))\r
 216 +\r
 217 +(defun notmuch-tag-format-tags (tags orig-tags &optional face)\r
 218    "Return a string representing formatted TAGS."\r
 219 -  (let ((face (or face 'notmuch-tag-face)))\r
 220 +  (let ((face (or face 'notmuch-tag-face))\r
 221 +       (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))\r
 222      (notmuch-apply-face\r
 223       (mapconcat #'identity\r
 224                 ;; nil indicated that the tag was deliberately hidden\r
 225 -               (delq nil (mapcar #'notmuch-tag-format-tag tags))\r
 226 +               (delq nil (mapcar\r
 227 +                          (apply-partially #'notmuch-tag-format-tag tags orig-tags)\r
 228 +                          all-tags))\r
 229                 " ")\r
 230       face\r
 231       t)))\r
 232 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
 233 index c78d9de..8bf2fbc 100644\r
 234 --- a/emacs/notmuch-tree.el\r
 235 +++ b/emacs/notmuch-tree.el\r
 236 @@ -704,7 +704,7 @@ (defun notmuch-tree-format-field (field format-string msg)\r
 237             (face (if match\r
 238                       'notmuch-tree-match-tag-face\r
 239                     'notmuch-tree-no-match-tag-face)))\r
 240 -       (format format-string (notmuch-tag-format-tags tags face)))))))\r
 241 +       (format format-string (notmuch-tag-format-tags tags tags face)))))))\r
 242  \r
 243  (defun notmuch-tree-format-field-list (field-list msg)\r
 244    "Format fields of MSG according to FIELD-LIST and return string"\r
 245 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 246 index 93a6d8b..609f408 100644\r
 247 --- a/emacs/notmuch.el\r
 248 +++ b/emacs/notmuch.el\r
 249 @@ -754,7 +754,7 @@ (defun notmuch-search-insert-field (field format-string result)\r
 250  \r
 251     ((string-equal field "tags")\r
 252      (let ((tags (plist-get result :tags)))\r
 253 -      (insert (format format-string (notmuch-tag-format-tags tags)))))))\r
 254 +      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))\r
 255  \r
 256  (defun notmuch-search-show-result (result &optional pos)\r
 257    "Insert RESULT at POS or the end of the buffer if POS is null."\r
 258 diff --git a/test/test-lib.el b/test/test-lib.el\r
 259 index 37fcb3d..437f83f 100644\r
 260 --- a/test/test-lib.el\r
 261 +++ b/test/test-lib.el\r
 262 @@ -165,3 +165,8 @@ (defun notmuch-test-expect-equal (output expected)\r
 263  \r
 264       (t\r
 265        (notmuch-test-report-unexpected output expected)))))\r
 266 +\r
 267 +;; For historical reasons, we hide deleted tags by default in the test\r
 268 +;; suite\r
 269 +(setq notmuch-tag-deleted-formats\r
 270 +      '((".*" nil)))\r
 271 -- \r
 272 1.7.9.1\r
 273 \r