3f/e4024a2de17396d437f528c816f02c4c804c72

   1 Return-Path: <amdragon@mit.edu>\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 18FF0431FB6\r
   6         for <notmuch@notmuchmail.org>; Fri, 21 Mar 2014 20:39:46 -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.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id n0eq2aqOPn8t for <notmuch@notmuchmail.org>;\r
  16         Fri, 21 Mar 2014 20:39:38 -0700 (PDT)\r
  17 Received: from dmz-mailsec-scanner-4.mit.edu (dmz-mailsec-scanner-4.mit.edu\r
  18         [18.9.25.15])\r
  19         (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits))\r
  20         (No client certificate requested)\r
  21         by olra.theworths.org (Postfix) with ESMTPS id F1AF0431FAE\r
  22         for <notmuch@notmuchmail.org>; Fri, 21 Mar 2014 20:39:37 -0700 (PDT)\r
  23 X-AuditID: 1209190f-f790b6d000000c3a-ad-532d05f9f9fc\r
  24 Received: from mailhub-auth-3.mit.edu ( [18.9.21.43])\r
  25         (using TLS with cipher AES256-SHA (256/256 bits))\r
  26         (Client did not present a certificate)\r
  27         by dmz-mailsec-scanner-4.mit.edu (Symantec Messaging Gateway) with SMTP\r
  28         id D8.65.03130.9F50D235; Fri, 21 Mar 2014 23:39:37 -0400 (EDT)\r
  29 Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11])\r
  30         by mailhub-auth-3.mit.edu (8.13.8/8.9.2) with ESMTP id s2M3dZoW015313; \r
  31         Fri, 21 Mar 2014 23:39:36 -0400\r
  32 Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91])\r
  33         (authenticated bits=0)\r
  34         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
  35         by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id s2M3dX5Q005936\r
  36         (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NOT);\r
  37         Fri, 21 Mar 2014 23:39:34 -0400\r
  38 Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.80)\r
  39         (envelope-from <amdragon@MIT.EDU>)\r
  40         id 1WRCmT-0004x6-60; Fri, 21 Mar 2014 23:39:33 -0400\r
  41 Date: Fri, 21 Mar 2014 23:39:33 -0400\r
  42 From: Austin Clements <amdragon@MIT.EDU>\r
  43 To: Mark Walters <markwalters1009@gmail.com>\r
  44 Subject: Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded\r
  45 Message-ID: <20140322033933.GC31187@mit.edu>\r
  46 References: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
  47         <1394597397-8486-6-git-send-email-markwalters1009@gmail.com>\r
  48 MIME-Version: 1.0\r
  49 Content-Type: text/plain; charset=us-ascii\r
  50 Content-Disposition: inline\r
  51 In-Reply-To: <1394597397-8486-6-git-send-email-markwalters1009@gmail.com>\r
  52 User-Agent: Mutt/1.5.21 (2010-09-15)\r
  53 X-Brightmail-Tracker:\r
  54  H4sIAAAAAAAAA+NgFmpmleLIzCtJLcpLzFFi42IR4hTV1v3JqhtscOQbu8XquTwW12/OZHZg\r
  55         8tg56y67x7NVt5gDmKK4bFJSczLLUov07RK4MlZvamAtWJJY8WbbZtYGxn1eXYycHBICJhJT\r
  56         J11nhbDFJC7cW8/WxcjFISQwm0li+bLJzBDORkaJ5Tv7GSGc00wSS8/uhypbwijx4thMRpB+\r
  57         FgFVid+X54HNYhPQkNi2fzlYXERAR+L2oQXsIDazgLTEt9/NTF2MHBzCAn4S204WgoR5gUoa\r
  58         P1+E2tbOKPFl+gd2iISgxMmZT1ggerUkbvx7CdYLMmf5Pw6QMKeAp8TCm4fASkQFVCSmnNzG\r
  59         NoFRaBaS7llIumchdC9gZF7FKJuSW6Wbm5iZU5yarFucnJiXl1qka6KXm1mil5pSuokRHNaS\r
  60         /DsYvx1UOsQowMGoxMNbwakdLMSaWFZcmXuIUZKDSUmU9wKjbrAQX1J+SmVGYnFGfFFpTmrx\r
  61         IUYJDmYlEV6mtzrBQrwpiZVVqUX5MClpDhYlcV55DqBJAumJJanZqakFqUUwWRkODiUJ3khg\r
  62         /AoJFqWmp1akZeaUIKSZODhBhvMADT/EAlTDW1yQmFucmQ6RP8WoKCXO6wiSEABJZJTmwfXC\r
  63         0s4rRnGgV4R5A0BW8ABTFlz3K6DBTECD+adqgQwuSURISTUwar/Y0P/w/9GNQQYZU31Wf8xY\r
  64         vsincF0eU+3FpYutEsM1tLIs5qydnnR9Rav4a+F9VgbdMXauEXeeMuqtlHnL96gkvW55mWPR\r
  65         iawJV1Yc0689ULj1otBs/zNnX9xIMZY4/7Ym/knpn7mrVs86v7mkZZX9WouKVcrisvmPDzye\r
  66         wdaxe8G0L5P6pZRYijMSDbWYi4oTAeAGlrMWAwAA\r
  67 Cc: notmuch@notmuchmail.org\r
  68 X-BeenThere: notmuch@notmuchmail.org\r
  69 X-Mailman-Version: 2.1.13\r
  70 Precedence: list\r
  71 List-Id: "Use and development of the notmuch mail system."\r
  72         <notmuch.notmuchmail.org>\r
  73 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  74         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  75 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  76 List-Post: <mailto:notmuch@notmuchmail.org>\r
  77 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  78 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  79         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  80 X-List-Received-Date: Sat, 22 Mar 2014 03:39:46 -0000\r
  81 \r
  82 Quoth Mark Walters on Mar 12 at  4:09 am:\r
  83 > This allows (and requires) the original-tags to be passed along with\r
  84 > the current-tags to be passed to notmuch-tag-format-tags. This allows\r
  85 > the tag formatting to show added and deleted tags.By default a removed\r
  86 > tag is displayed with strike-through in red (if strike-through is not\r
  87 > available, eg on a terminal, inverse video is used instead) and an\r
  88 > added tag is displayed underlined in green.\r
  89 > \r
  90 > If the caller does not wish to use the new feature it can pass\r
  91 > current-tags for both arguments and, at this point, we do exactly that\r
  92 > in the three callers of this function.\r
  93 > \r
  94 > Note, we cannot tidily allow original-tags to be optional because we would\r
  95 > need to distinguish nil meaning "we are not specifying original-tags"\r
  96 > from nil meaning there were no original-tags (an empty list).\r
  97 > \r
  98 > We use this in subsequent patches to make it clear when a message was\r
  99 > unread when you first loaded a show buffer (previously the unread tag\r
 100 > could be removed before a user realised that it had been unread).\r
 101 > \r
 102 > The code adds into the existing tag formatting code. The user can\r
 103 > specify exactly how a tag should be displayed normally, when deleted,\r
 104 > or when added.\r
 105 > \r
 106 > Since the formatting code matches regexps a user can match all deleted\r
 107 > tags with a ".*" in notmuch-tag-deleted-formats.  For example setting\r
 108 > notmuch-tag-deleted-formats to '((".*" nil)) tells notmuch not to show\r
 109 > deleted tags at all.\r
 110 > \r
 111 > All the variables are customizable; however, more complicated cases\r
 112 > like changing the face depending on the type of display will require\r
 113 > custom lisp.\r
 114 > \r
 115 > Currently this overrides notmuch-tag-deleted-formats for the tests\r
 116 > setting it to '((".*" nil)) so that they get removed from the display\r
 117 > and, thus, all tests still pass.\r
 118 > ---\r
 119 >  emacs/notmuch-show.el |    4 +-\r
 120 >  emacs/notmuch-tag.el  |   72 +++++++++++++++++++++++++++++++++++-------------\r
 121 >  emacs/notmuch-tree.el |    2 +-\r
 122 >  emacs/notmuch.el      |    2 +-\r
 123 >  test/test-lib.el      |    5 +++\r
 124 >  5 files changed, 61 insertions(+), 24 deletions(-)\r
 125 > \r
 126 > diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 127 > index 019f51d..5492be4 100644\r
 128 > --- a/emacs/notmuch-show.el\r
 129 > +++ b/emacs/notmuch-show.el\r
 130 > @@ -344,7 +344,7 @@ (defun notmuch-show-update-tags (tags)\r
 131 >      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
 132 >       (let ((inhibit-read-only t))\r
 133 >         (replace-match (concat "("\r
 134 > -                              (notmuch-tag-format-tags tags)\r
 135 > +                              (notmuch-tag-format-tags tags tags)\r
 136 >                                ")"))))))\r
 137 >  \r
 138 >  (defun notmuch-clean-address (address)\r
 139 > @@ -423,7 +423,7 @@ (defun notmuch-show-insert-headerline (headers date tags depth)\r
 140 >           " ("\r
 141 >           date\r
 142 >           ") ("\r
 143 > -         (notmuch-tag-format-tags tags)\r
 144 > +         (notmuch-tag-format-tags tags tags)\r
 145 >           ")\n")\r
 146 >      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 147 >  \r
 148 > diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 149 > index 4698856..cfccb8e 100644\r
 150 > --- a/emacs/notmuch-tag.el\r
 151 > +++ b/emacs/notmuch-tag.el\r
 152 > @@ -184,45 +184,77 @@ (defun notmuch-tag-clear-cache ()\r
 153 >    "Clear the internal cache of tag formats."\r
 154 >    (clrhash notmuch-tag--format-cache))\r
 155 >  \r
 156 > -(defun notmuch-tag-format-tag (tag)\r
 157 > -  "Format TAG by according to `notmuch-tag-formats'.\r
 158 > -\r
 159 > -Callers must ensure that the tag format cache has been recently cleared\r
 160 > -via `notmuch-tag-clear-cache' before using this function.  For example,\r
 161 > -it would be appropriate to clear the cache just prior to filling a\r
 162 > -buffer that uses formatted tags."\r
 163 > -\r
 164 > -  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
 165 > +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)\r
 166 > +  "Format TAG according to the appropriate `notmuch-tag-formats`.\r
 167 > +\r
 168 > +Applies formats for TAG from the appropriate one of\r
 169 > +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and\r
 170 > +`notmuch-tag-added-formats` based on TAG-STATE to the partially\r
 171 \r
 172 The second ` should be a ' on all four of the above references.\r
 173 \r
 174 > +formatted tag FORMATTED-TAG."\r
 175 > +  (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))\r
 176 \r
 177 Something's strange here.  If this hits in the cache, it will ignore\r
 178 formatted-tag.  I can't actually construct a situation where this does\r
 179 the wrong thing, but it always seems to do the right thing for the\r
 180 wrong reasons.\r
 181 \r
 182 This code would make a lot more sense to me if it were turned\r
 183 inside-out with `notmuch-tag-format-tag':\r
 184 \r
 185 (defun notmuch-tag-format-tag (tags orig-tags tag)\r
 186   "Format TAG according to `notmuch-tag-formats'.\r
 187 \r
 188 TAGS and ORIG-TAGS are lists of the current tags and the original\r
 189 tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
 190 are not in TAGS) are shown using formats from\r
 191 `notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
 192 are in TAGS but are not in ORIG-TAGS) are shown using formats\r
 193 from `notmuch-tag-added-formats' and tags which have not been\r
 194 changed (the normal case) are shown using formats from\r
 195 `notmuch-tag-formats'"\r
 196   (let* ((tag-state (cond ((not (member tag tags)) 'deleted)\r
 197                           ((not (member tag orig-tags)) 'added)))\r
 198          (formatted (gethash (cons tag tag-state) notmuch-tag--format-cache\r
 199                              'missing)))\r
 200     (when (eq formatted 'missing)\r
 201       (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))\r
 202             (over (case tag-state\r
 203                         ((nil) nil)\r
 204                         (deleted (notmuch-tag--get-formats \r
 205                                   tag notmuch-tag-deleted-formats))\r
 206                         (added (notmuch-tag--get-formats \r
 207                                 tag notmuch-tag-deleted-formats)))))\r
 208         (setq formatted (notmuch-tag--do-format\r
 209                          (notmuch-tag--do-format tag) base over))\r
 210         (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
 211     formatted))\r
 212 \r
 213 (defun notmuch-tag--get-formats (tag format-alist)\r
 214   "Find the first item whose car regexp-matches TAG."\r
 215   (save-match-data\r
 216     ;; Don't use assoc-default since there's no way to distinguish a\r
 217     ;; missing key from a present key with a null cdr.\r
 218     (assoc* tag format-alist\r
 219             :test (lambda (tag key)\r
 220                     (and (eq (string-match key tag) 0)\r
 221                           (= (match-end 0) (length tag)))))))\r
 222 \r
 223 (defun notmuch-tag--do-format (tag formats)\r
 224   "Apply a tag-formats entry to TAG."\r
 225   (cond ((null formats)         ;; - Tag not in `formats',\r
 226          tag)                   ;;   the format is the tag itself.\r
 227         ((null (cdr formats))   ;; - Tag was deliberately hidden,\r
 228          nil)                   ;;   no format must be returned\r
 229         (t\r
 230          ;; Tag was found and has formats, we must apply all the\r
 231          ;; formats.  TAG may be null so treat that as a special case.\r
 232          (let ((old-tag tag) (tag (or tag "")))\r
 233            (dolist (format (cdr formats))\r
 234              (setq tag (eval format)))\r
 235            (if (and (null old-tag) (equal tag ""))\r
 236                nil\r
 237              tag)))))\r
 238 \r
 239 (Completely untested and all indented with spaces and probably\r
 240 incorrectly because I wrote it all in my email buffer, but you get the\r
 241 idea.)\r
 242 \r
 243 >      (when (eq formatted 'missing)\r
 244 > -      (let* ((formats\r
 245 > +      (let* ((tag-formats (case tag-state\r
 246 > +                             ((list nil) notmuch-tag-formats)\r
 247 \r
 248 While this isn't *technically* wrong, I don't think you meant to\r
 249 accept a tag-state of 'list.  Should be\r
 250 \r
 251 (case tag-state\r
 252    ((nil) notmuch-tag-formats)\r
 253    (deleted ...\r
 254 \r
 255 > +                             (deleted notmuch-tag-deleted-formats)\r
 256 > +                             (added notmuch-tag-added-formats)))\r
 257 > +          (formats\r
 258 >             (save-match-data\r
 259 >               ;; Don't use assoc-default since there's no way to\r
 260 >               ;; distinguish a missing key from a present key with a\r
 261 >               ;; null cdr:.\r
 262 > -             (assoc* tag notmuch-tag-formats\r
 263 > +             (assoc* tag tag-formats\r
 264 >                       :test (lambda (tag key)\r
 265 >                               (and (eq (string-match key tag) 0)\r
 266 >                                    (= (match-end 0) (length tag))))))))\r
 267 >       (setq formatted\r
 268 >             (cond\r
 269 > -            ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
 270 > -             tag)                    ;;   the format is the tag itself.\r
 271 > +            ((null formats)          ;; - Tag not in `tag-formats',\r
 272 > +             formatted-tag)          ;;   the format is the tag itself.\r
 273 >              ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
 274 >               nil)                    ;;   no format must be returned\r
 275 > -            (t                       ;; - Tag was found and has formats,\r
 276 > -             (let ((tag tag))        ;;   we must apply all the formats.\r
 277 > +            (t\r
 278 > +             ;; Tag was found and has formats, we must apply all\r
 279 > +             ;; the formats.  FORMATTED-TAG may be null so treat\r
 280 > +             ;; that as a special case.\r
 281 > +             (let ((tag (or formatted-tag "")))\r
 282 >                 (dolist (format (cdr formats) tag)\r
 283 > -                 (setq tag (eval format)))))))\r
 284 > -     (puthash tag formatted notmuch-tag--format-cache)))\r
 285 > +                 (setq tag (eval format)))\r
 286 > +               (if (and (null formatted-tag)\r
 287 > +                        (equal tag ""))\r
 288 > +                   nil\r
 289 > +                 tag)))))\r
 290 > +     (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
 291 >      formatted))\r
 292 >  \r
 293 > -(defun notmuch-tag-format-tags (tags &optional face)\r
 294 > +(defun notmuch-tag-format-tag (tags orig-tags tag)\r
 295 > +  "Format TAG according to `notmuch-tag-formats'.\r
 296 > +\r
 297 > +TAGS and ORIG-TAGS are lists of the current tags and the original\r
 298 > +tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
 299 > +are not in TAGS) are shown using formats from\r
 300 > +`notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
 301 > +are in TAGS but are not in ORIG-TAGS) are shown using formats\r
 302 > +from `notmuch-tag-added-formats' and tags which have not been\r
 303 > +changed (the normal case) are shown using formats from\r
 304 > +`notmuch-tag-formats'"\r
 305 > +  (let* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))\r
 306 > +    (cond ((not (member tag tags))\r
 307 > +        (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))\r
 308 > +       ((not (member tag orig-tags))\r
 309 > +        (notmuch-tag-format-tag-by-state tag formatted-tag 'added))\r
 310 > +       (t\r
 311 > +         formatted-tag))))\r
 312 > +\r
 313 > +(defun notmuch-tag-format-tags (tags orig-tags &optional face)\r
 314 >    "Return a string representing formatted TAGS."\r
 315 > -  (let ((face (or face 'notmuch-tag-face)))\r
 316 > +  (let ((face (or face 'notmuch-tag-face))\r
 317 > +     (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))\r
 318 >      (notmuch-apply-face\r
 319 >       (mapconcat #'identity\r
 320 >               ;; nil indicated that the tag was deliberately hidden\r
 321 > -             (delq nil (mapcar #'notmuch-tag-format-tag tags))\r
 322 > +             (delq nil (mapcar\r
 323 > +                        (apply-partially #'notmuch-tag-format-tag tags orig-tags)\r
 324 > +                        all-tags))\r
 325 >               " ")\r
 326 >       face\r
 327 >       t)))\r
 328 > diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
 329 > index c78d9de..8bf2fbc 100644\r
 330 > --- a/emacs/notmuch-tree.el\r
 331 > +++ b/emacs/notmuch-tree.el\r
 332 > @@ -704,7 +704,7 @@ (defun notmuch-tree-format-field (field format-string msg)\r
 333 >           (face (if match\r
 334 >                     'notmuch-tree-match-tag-face\r
 335 >                   'notmuch-tree-no-match-tag-face)))\r
 336 > -     (format format-string (notmuch-tag-format-tags tags face)))))))\r
 337 > +     (format format-string (notmuch-tag-format-tags tags tags face)))))))\r
 338 >  \r
 339 >  (defun notmuch-tree-format-field-list (field-list msg)\r
 340 >    "Format fields of MSG according to FIELD-LIST and return string"\r
 341 > diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 342 > index 93a6d8b..609f408 100644\r
 343 > --- a/emacs/notmuch.el\r
 344 > +++ b/emacs/notmuch.el\r
 345 > @@ -754,7 +754,7 @@ (defun notmuch-search-insert-field (field format-string result)\r
 346 >  \r
 347 >     ((string-equal field "tags")\r
 348 >      (let ((tags (plist-get result :tags)))\r
 349 > -      (insert (format format-string (notmuch-tag-format-tags tags)))))))\r
 350 > +      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))\r
 351 >  \r
 352 >  (defun notmuch-search-show-result (result &optional pos)\r
 353 >    "Insert RESULT at POS or the end of the buffer if POS is null."\r
 354 > diff --git a/test/test-lib.el b/test/test-lib.el\r
 355 > index 37fcb3d..437f83f 100644\r
 356 > --- a/test/test-lib.el\r
 357 > +++ b/test/test-lib.el\r
 358 > @@ -165,3 +165,8 @@ (defun notmuch-test-expect-equal (output expected)\r
 359 >  \r
 360 >       (t\r
 361 >        (notmuch-test-report-unexpected output expected)))))\r
 362 > +\r
 363 > +;; For historical reasons, we hide deleted tags by default in the test\r
 364 > +;; suite\r
 365 > +(setq notmuch-tag-deleted-formats\r
 366 > +      '((".*" nil)))\r