f1/bdc3a570df58f24f09c45b0cfe5508d4043c0e

   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 237FD431FD5\r
   6         for <notmuch@notmuchmail.org>; Fri, 14 Feb 2014 01:15:47 -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.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 9XifGe3FhPLb for <notmuch@notmuchmail.org>;\r
  18         Fri, 14 Feb 2014 01:15:39 -0800 (PST)\r
  19 Received: from mail-we0-f171.google.com (mail-we0-f171.google.com\r
  20         [74.125.82.171]) (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 E1D51431FC0\r
  23         for <notmuch@notmuchmail.org>; Fri, 14 Feb 2014 01:15:33 -0800 (PST)\r
  24 Received: by mail-we0-f171.google.com with SMTP id u56so8609814wes.16\r
  25         for <notmuch@notmuchmail.org>; Fri, 14 Feb 2014 01:15: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:in-reply-to:references;\r
  28         bh=ZiUTQHXlTIz68ac3ytpCHHMj12hwMZv0MixshL9ukpo=;\r
  29         b=lCYHcTv1fCIoQGtZsWPmn7kSy/Qhc/EQdIPuRLG8b7j250qZVCJU74Nd/VcNRwvW9F\r
  30         lXB8QVX2HpxHhayO28/vgzd/aI4kW6C96ACuBoo+BcupG3IkKTjOXmXE3Bt4b27/kNvK\r
  31         vTGKjUkKy5Wi6ek9k1LFJsjln3DEU1VJNwwFtTHiQ9mspNcll/QdPpUWw4df0YOnPz31\r
  32         86XqWAjReUD3UmEkoCp30kwEhJ035nCAU9mW5v8s8a4WqeZbZs29hBePjEozIuSJrAD8\r
  33         yq/K3/E9jFbZGoQLrOBvxLsO6ujfU7zG+LKBujFxgGGvVu56NTwDPlQkHS5FYzXIyc3L\r
  34         ibXQ==\r
  35 X-Received: by 10.180.38.41 with SMTP id d9mr1246381wik.9.1392369332739;\r
  36         Fri, 14 Feb 2014 01:15:32 -0800 (PST)\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 dd3sm11127826wjb.9.2014.02.14.01.15.31\r
  39         for <multiple recipients>\r
  40         (version=TLSv1.2 cipher=RC4-SHA bits=128/128);\r
  41         Fri, 14 Feb 2014 01:15:32 -0800 (PST)\r
  42 From: Mark Walters <markwalters1009@gmail.com>\r
  43 To: notmuch@notmuchmail.org,\r
  44         Austin Clements <amdragon@MIT.EDU>\r
  45 Subject: [WIP Patch 4/7] emacs: show: mark tags changed since buffer loaded\r
  46 Date: Fri, 14 Feb 2014 09:15:16 +0000\r
  47 Message-Id: <1392369319-24508-5-git-send-email-markwalters1009@gmail.com>\r
  48 X-Mailer: git-send-email 1.7.9.1\r
  49 In-Reply-To: <1392369319-24508-1-git-send-email-markwalters1009@gmail.com>\r
  50 References: <1392369319-24508-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: Fri, 14 Feb 2014 09:15:47 -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. For convenience an entry for the empty string in the\r
  87 notmuch-tag-formats (and the corresponding notmuch-tag-deleted-formats\r
  88 notmuch-tag-added-formats) is applied to all tags which do not have an\r
  89 explicit match.\r
  90 \r
  91 This means that a user can tell notmuch not to show deleted tags at\r
  92 all by setting notmuch-tag-deleted-formats to\r
  93 '(("" nil))\r
  94 or not to show any deleted tags except "unread" by setting it to\r
  95 '(("" nil)\r
  96   ("unread" (propertize tag 'face '(strike-through "red"))))\r
  97 \r
  98 All the variables are customizable; however, more complicated cases\r
  99 like changing the face depending on the type of display will require\r
 100 custom lisp.\r
 101 \r
 102 Currently this overrides notmuch-tag-deleted-formats for the tests\r
 103 setting it to '(("" nil)) so that they get removed from the display\r
 104 and, thus, all tests still pass.\r
 105 ---\r
 106  emacs/notmuch-show.el |    4 +-\r
 107  emacs/notmuch-tag.el  |   65 ++++++++++++++++++++++++++++++++++++++----------\r
 108  emacs/notmuch-tree.el |    2 +-\r
 109  emacs/notmuch.el      |    2 +-\r
 110  test/test-lib.el      |    5 ++++\r
 111  5 files changed, 60 insertions(+), 18 deletions(-)\r
 112 \r
 113 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 114 index 1ac80ca..1ce56f9 100644\r
 115 --- a/emacs/notmuch-show.el\r
 116 +++ b/emacs/notmuch-show.el\r
 117 @@ -344,7 +344,7 @@ operation on the contents of the current buffer."\r
 118      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
 119         (let ((inhibit-read-only t))\r
 120           (replace-match (concat "("\r
 121 -                                (notmuch-tag-format-tags tags)\r
 122 +                                (notmuch-tag-format-tags tags tags)\r
 123                                  ")"))))))\r
 124  \r
 125  (defun notmuch-clean-address (address)\r
 126 @@ -423,7 +423,7 @@ message at DEPTH in the current thread."\r
 127             " ("\r
 128             date\r
 129             ") ("\r
 130 -           (notmuch-tag-format-tags tags)\r
 131 +           (notmuch-tag-format-tags tags tags)\r
 132             ")\n")\r
 133      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 134  \r
 135 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 136 index add60a3..812a0f4 100644\r
 137 --- a/emacs/notmuch-tag.el\r
 138 +++ b/emacs/notmuch-tag.el\r
 139 @@ -192,36 +192,73 @@ This can be used with `notmuch-tag-format-image-data'."\r
 140    </g>\r
 141  </svg>")\r
 142  \r
 143 -(defun notmuch-tag-format-tag (tag)\r
 144 -  "Format TAG by looking into `notmuch-tag-formats'."\r
 145 -  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
 146 +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)\r
 147 +  "Format TAG by looking into the appropriate `notmuch-tag-formats`.\r
 148 +\r
 149 +Applies formats for TAG from the appropriate one of\r
 150 +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and\r
 151 +`notmuch-tag-added-formats` based on TAG-STATE to the partially\r
 152 +formatted tag FORMATTED-TAG."\r
 153 +  (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))\r
 154      (when (eq formatted 'missing)\r
 155 -      (let* ((formats\r
 156 +      (let* ((tag-formats (cond ((null tag-state) notmuch-tag-formats)\r
 157 +                               ((eq 'deleted tag-state) notmuch-tag-deleted-formats)\r
 158 +                               ((eq 'added tag-state) notmuch-tag-added-formats)))\r
 159 +            (formats\r
 160               (save-match-data\r
 161 -               (assoc* tag notmuch-tag-formats\r
 162 +               (assoc* tag tag-formats\r
 163                         :test (lambda (tag key)\r
 164                                 (and (eq (string-match key tag) 0)\r
 165                                      (= (match-end 0) (length tag))))))))\r
 166         (setq formatted\r
 167               (cond\r
 168 -              ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
 169 -               tag)                    ;;   the format is the tag itself.\r
 170 +              ((null formats)          ;; - Tag not in `tag-formats',\r
 171 +               formatted-tag)          ;;   the format is the tag itself.\r
 172                ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
 173                 nil)                    ;;   no format must be returned\r
 174 -              (t                       ;; - Tag was found and has formats,\r
 175 -               (let ((tag tag))        ;;   we must apply all the formats.\r
 176 +              (t\r
 177 +               ;; Tag was found and has formats, we must apply all\r
 178 +               ;; the formats.  FORMATTED-TAG may be null so treat\r
 179 +               ;; that as a special case.\r
 180 +               (let ((tag (or formatted-tag "")))\r
 181                   (dolist (format (cdr formats) tag)\r
 182 -                   (setq tag (eval format)))))))\r
 183 -       (puthash tag formatted notmuch-tag--format-cache)))\r
 184 +                   (setq tag (eval format)))\r
 185 +                 (if (and (null formatted-tag)\r
 186 +                          (equal tag ""))\r
 187 +                     nil\r
 188 +                   tag)))))\r
 189 +       (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
 190      formatted))\r
 191  \r
 192 -(defun notmuch-tag-format-tags (tags &optional face)\r
 193 +(defun notmuch-tag-format-tag (tags orig-tags tag)\r
 194 +  "Format TAG by looking into `notmuch-tag-formats'.\r
 195 +\r
 196 +TAGS and ORIG-TAGS are lists of the current tags and the original\r
 197 +tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
 198 +are not in TAGS) are shown using formats from\r
 199 +`notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
 200 +are in TAGS but are not in ORIG-TAGS) are shown using formats\r
 201 +from `notmuch-tag-added-formats' and tags which have not been\r
 202 +changed (the normal case) are shown using formats from\r
 203 +`notmuch-tag-formats'"\r
 204 +  (let* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))\r
 205 +    (cond ((not (member tag tags))\r
 206 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))\r
 207 +         ((not (member tag orig-tags))\r
 208 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'added))\r
 209 +         (t\r
 210 +           formatted-tag))))\r
 211 +\r
 212 +(defun notmuch-tag-format-tags (tags orig-tags &optional face)\r
 213    "Return a string representing formatted TAGS."\r
 214 -  (let ((face (or face 'notmuch-tag-face)))\r
 215 +  (let ((face (or face 'notmuch-tag-face))\r
 216 +       (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))\r
 217      (notmuch-combine-face-text-property-string\r
 218       (mapconcat #'identity\r
 219                 ;; nil indicated that the tag was deliberately hidden\r
 220 -               (delq nil (mapcar #'notmuch-tag-format-tag tags))\r
 221 +               (delq nil (mapcar\r
 222 +                          (apply-partially #'notmuch-tag-format-tag tags orig-tags)\r
 223 +                          all-tags))\r
 224                 " ")\r
 225       face\r
 226       t)))\r
 227 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
 228 index 4f2ac02..b37e2cd 100644\r
 229 --- a/emacs/notmuch-tree.el\r
 230 +++ b/emacs/notmuch-tree.el\r
 231 @@ -704,7 +704,7 @@ unchanged ADDRESS if parsing fails."\r
 232             (face (if match\r
 233                       'notmuch-tree-match-tag-face\r
 234                     'notmuch-tree-no-match-tag-face)))\r
 235 -       (format format-string (notmuch-tag-format-tags tags face)))))))\r
 236 +       (format format-string (notmuch-tag-format-tags tags tags face)))))))\r
 237  \r
 238  (defun notmuch-tree-format-field-list (field-list msg)\r
 239    "Format fields of MSG according to FIELD-LIST and return string"\r
 240 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 241 index 0471750..1436e5a 100644\r
 242 --- a/emacs/notmuch.el\r
 243 +++ b/emacs/notmuch.el\r
 244 @@ -754,7 +754,7 @@ non-authors is found, assume that all of the authors match."\r
 245  \r
 246     ((string-equal field "tags")\r
 247      (let ((tags (plist-get result :tags)))\r
 248 -      (insert (format format-string (notmuch-tag-format-tags tags)))))))\r
 249 +      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))\r
 250  \r
 251  (defun notmuch-search-show-result (result &optional pos)\r
 252    "Insert RESULT at POS or the end of the buffer if POS is null."\r
 253 diff --git a/test/test-lib.el b/test/test-lib.el\r
 254 index 37fcb3d..437f83f 100644\r
 255 --- a/test/test-lib.el\r
 256 +++ b/test/test-lib.el\r
 257 @@ -165,3 +165,8 @@ nothing."\r
 258  \r
 259       (t\r
 260        (notmuch-test-report-unexpected output expected)))))\r
 261 +\r
 262 +;; For historical reasons, we hide deleted tags by default in the test\r
 263 +;; suite\r
 264 +(setq notmuch-tag-deleted-formats\r
 265 +      '((".*" nil)))\r
 266 -- \r
 267 1.7.9.1\r
 268 \r