90/5767014c4bda22e350d5cdb291ede66000d988

   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 1C655431FBD\r
   6         for <notmuch@notmuchmail.org>; Wed, 19 Feb 2014 12:20:54 -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 V2RPJ8cL68Av for <notmuch@notmuchmail.org>;\r
  18         Wed, 19 Feb 2014 12:20:46 -0800 (PST)\r
  19 Received: from mail-we0-f182.google.com (mail-we0-f182.google.com\r
  20         [74.125.82.182]) (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 5A141431FD4\r
  23         for <notmuch@notmuchmail.org>; Wed, 19 Feb 2014 12:20:39 -0800 (PST)\r
  24 Received: by mail-we0-f182.google.com with SMTP id u57so771031wes.27\r
  25         for <notmuch@notmuchmail.org>; Wed, 19 Feb 2014 12:20:38 -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=Vdm9E41asuK/JX07OyhLO/yljhes2PVpSgXCDdCfqsc=;\r
  29         b=QZfUkW2xSLxYE+cUOr0U/TnAVNF34Q/3bBCIL8yu60k9AC5izv8jg4cww5pvpz2Z49\r
  30         B8V4NSX7brL3jyNlK77pcbN5bbf49u+2s9bJHNcdgvvfhP4en1bS/U+Tqx4H0wyiz+W5\r
  31         RFplJLhP+y1yqZDdaZDrn+4WbOtuRJ65LtHG4QZo9xP8PL61lnpM7PrtCdLKW10yNRjP\r
  32         GhyD4VX8WZU0DnrLFAHkIiNrOKLQ1b2TnT7BcSBEfCbWAdScu6QMw22IPSAEabYP59cK\r
  33         7RoitQMw7wnAaewLIjxQM6VQcIbq5pR7x469ihPLKx2UetB4MrwFicXszfX9TZ569B2v\r
  34         ycJw==\r
  35 X-Received: by 10.180.96.102 with SMTP id dr6mr3401919wib.19.1392841238264;\r
  36         Wed, 19 Feb 2014 12:20:38 -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 bm8sm3129087wjc.12.2014.02.19.12.20.37\r
  39         for <multiple recipients>\r
  40         (version=TLSv1.2 cipher=RC4-SHA bits=128/128);\r
  41         Wed, 19 Feb 2014 12:20:37 -0800 (PST)\r
  42 From: Mark Walters <markwalters1009@gmail.com>\r
  43 To: notmuch@notmuchmail.org\r
  44 Subject: [PATCH v2 4/7] emacs: show: mark tags changed since buffer loaded\r
  45 Date: Wed, 19 Feb 2014 20:20:09 +0000\r
  46 Message-Id: <1392841212-8494-5-git-send-email-markwalters1009@gmail.com>\r
  47 X-Mailer: git-send-email 1.7.9.1\r
  48 In-Reply-To: <1392841212-8494-1-git-send-email-markwalters1009@gmail.com>\r
  49 References: <1392841212-8494-1-git-send-email-markwalters1009@gmail.com>\r
  50 X-BeenThere: notmuch@notmuchmail.org\r
  51 X-Mailman-Version: 2.1.13\r
  52 Precedence: list\r
  53 List-Id: "Use and development of the notmuch mail system."\r
  54         <notmuch.notmuchmail.org>\r
  55 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  56         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  57 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  58 List-Post: <mailto:notmuch@notmuchmail.org>\r
  59 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  60 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  61         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  62 X-List-Received-Date: Wed, 19 Feb 2014 20:20:54 -0000\r
  63 \r
  64 This allows (and requires) the original-tags to be passed along with\r
  65 the current-tags to be passed to notmuch-tag-format-tags. This allows\r
  66 the tag formatting to show added and deleted tags.By default a removed\r
  67 tag is displayed with strike-through in red (if strike-through is not\r
  68 available, eg on a terminal, inverse video is used instead) and an\r
  69 added tag is displayed underlined in green.\r
  70 \r
  71 If the caller does not wish to use the new feature it can pass\r
  72 current-tags for both arguments and, at this point, we do exactly that\r
  73 in the three callers of this function.\r
  74 \r
  75 Note, we cannot tidily allow original-tags to be optional because we would\r
  76 need to distinguish nil meaning "we are not specifying original-tags"\r
  77 from nil meaning there were no original-tags (an empty list).\r
  78 \r
  79 We use this in subsequent patches to make it clear when a message was\r
  80 unread when you first loaded a show buffer (previously the unread tag\r
  81 could be removed before a user realised that it had been unread).\r
  82 \r
  83 The code adds into the existing tag formatting code. The user can\r
  84 specify exactly how a tag should be displayed normally, when deleted,\r
  85 or when added. For convenience an entry for the empty string in the\r
  86 notmuch-tag-formats (and the corresponding notmuch-tag-deleted-formats\r
  87 notmuch-tag-added-formats) is applied to all tags which do not have an\r
  88 explicit match.\r
  89 \r
  90 This means that a user can tell notmuch not to show deleted tags at\r
  91 all by setting notmuch-tag-deleted-formats to\r
  92 '(("" nil))\r
  93 or not to show any deleted tags except "unread" by setting it to\r
  94 '(("" nil)\r
  95   ("unread" (propertize tag 'face '(strike-through "red"))))\r
  96 \r
  97 All the variables are customizable; however, more complicated cases\r
  98 like changing the face depending on the type of display will require\r
  99 custom lisp.\r
 100 \r
 101 Currently this overrides notmuch-tag-deleted-formats for the tests\r
 102 setting it to '(("" nil)) so that they get removed from the display\r
 103 and, thus, all tests still pass.\r
 104 ---\r
 105  emacs/notmuch-show.el |    4 +-\r
 106  emacs/notmuch-tag.el  |   65 ++++++++++++++++++++++++++++++++++++++----------\r
 107  emacs/notmuch-tree.el |    2 +-\r
 108  emacs/notmuch.el      |    2 +-\r
 109  test/test-lib.el      |    5 ++++\r
 110  5 files changed, 60 insertions(+), 18 deletions(-)\r
 111 \r
 112 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 113 index 4bddf6c..719e7d1 100644\r
 114 --- a/emacs/notmuch-show.el\r
 115 +++ b/emacs/notmuch-show.el\r
 116 @@ -344,7 +344,7 @@ operation on the contents of the current buffer."\r
 117      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
 118         (let ((inhibit-read-only t))\r
 119           (replace-match (concat "("\r
 120 -                                (notmuch-tag-format-tags tags)\r
 121 +                                (notmuch-tag-format-tags tags tags)\r
 122                                  ")"))))))\r
 123  \r
 124  (defun notmuch-clean-address (address)\r
 125 @@ -423,7 +423,7 @@ message at DEPTH in the current thread."\r
 126             " ("\r
 127             date\r
 128             ") ("\r
 129 -           (notmuch-tag-format-tags tags)\r
 130 +           (notmuch-tag-format-tags tags tags)\r
 131             ")\n")\r
 132      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 133  \r
 134 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 135 index 064fbdb..869b97d 100644\r
 136 --- a/emacs/notmuch-tag.el\r
 137 +++ b/emacs/notmuch-tag.el\r
 138 @@ -185,36 +185,73 @@ This can be used with `notmuch-tag-format-image-data'."\r
 139    </g>\r
 140  </svg>")\r
 141  \r
 142 -(defun notmuch-tag-format-tag (tag)\r
 143 -  "Format TAG by looking into `notmuch-tag-formats'."\r
 144 -  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
 145 +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)\r
 146 +  "Format TAG by looking into the appropriate `notmuch-tag-formats`.\r
 147 +\r
 148 +Applies formats for TAG from the appropriate one of\r
 149 +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and\r
 150 +`notmuch-tag-added-formats` based on TAG-STATE to the partially\r
 151 +formatted tag FORMATTED-TAG."\r
 152 +  (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))\r
 153      (when (eq formatted 'missing)\r
 154 -      (let* ((formats\r
 155 +      (let* ((tag-formats (cond ((null tag-state) notmuch-tag-formats)\r
 156 +                               ((eq 'deleted tag-state) notmuch-tag-deleted-formats)\r
 157 +                               ((eq 'added tag-state) notmuch-tag-added-formats)))\r
 158 +            (formats\r
 159               (save-match-data\r
 160 -               (assoc* tag notmuch-tag-formats\r
 161 +               (assoc* tag tag-formats\r
 162                         :test (lambda (tag key)\r
 163                                 (and (eq (string-match key tag) 0)\r
 164                                      (= (match-end 0) (length tag))))))))\r
 165         (setq formatted\r
 166               (cond\r
 167 -              ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
 168 -               tag)                    ;;   the format is the tag itself.\r
 169 +              ((null formats)          ;; - Tag not in `tag-formats',\r
 170 +               formatted-tag)          ;;   the format is the tag itself.\r
 171                ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
 172                 nil)                    ;;   no format must be returned\r
 173 -              (t                       ;; - Tag was found and has formats,\r
 174 -               (let ((tag tag))        ;;   we must apply all the formats.\r
 175 +              (t\r
 176 +               ;; Tag was found and has formats, we must apply all\r
 177 +               ;; the formats.  FORMATTED-TAG may be null so treat\r
 178 +               ;; that as a special case.\r
 179 +               (let ((tag (or formatted-tag "")))\r
 180                   (dolist (format (cdr formats) tag)\r
 181 -                   (setq tag (eval format)))))))\r
 182 -       (puthash tag formatted notmuch-tag--format-cache)))\r
 183 +                   (setq tag (eval format)))\r
 184 +                 (if (and (null formatted-tag)\r
 185 +                          (equal tag ""))\r
 186 +                     nil\r
 187 +                   tag)))))\r
 188 +       (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
 189      formatted))\r
 190  \r
 191 -(defun notmuch-tag-format-tags (tags &optional face)\r
 192 +(defun notmuch-tag-format-tag (tags orig-tags tag)\r
 193 +  "Format TAG by looking into `notmuch-tag-formats'.\r
 194 +\r
 195 +TAGS and ORIG-TAGS are lists of the current tags and the original\r
 196 +tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
 197 +are not in TAGS) are shown using formats from\r
 198 +`notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
 199 +are in TAGS but are not in ORIG-TAGS) are shown using formats\r
 200 +from `notmuch-tag-added-formats' and tags which have not been\r
 201 +changed (the normal case) are shown using formats from\r
 202 +`notmuch-tag-formats'"\r
 203 +  (let* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))\r
 204 +    (cond ((not (member tag tags))\r
 205 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))\r
 206 +         ((not (member tag orig-tags))\r
 207 +          (notmuch-tag-format-tag-by-state tag formatted-tag 'added))\r
 208 +         (t\r
 209 +           formatted-tag))))\r
 210 +\r
 211 +(defun notmuch-tag-format-tags (tags orig-tags &optional face)\r
 212    "Return a string representing formatted TAGS."\r
 213 -  (let ((face (or face 'notmuch-tag-face)))\r
 214 +  (let ((face (or face 'notmuch-tag-face))\r
 215 +       (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))\r
 216      (notmuch-combine-face-text-property-string\r
 217       (mapconcat #'identity\r
 218                 ;; nil indicated that the tag was deliberately hidden\r
 219 -               (delq nil (mapcar #'notmuch-tag-format-tag tags))\r
 220 +               (delq nil (mapcar\r
 221 +                          (apply-partially #'notmuch-tag-format-tag tags orig-tags)\r
 222 +                          all-tags))\r
 223                 " ")\r
 224       face\r
 225       t)))\r
 226 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
 227 index a106e09..7080e6f 100644\r
 228 --- a/emacs/notmuch-tree.el\r
 229 +++ b/emacs/notmuch-tree.el\r
 230 @@ -704,7 +704,7 @@ unchanged ADDRESS if parsing fails."\r
 231             (face (if match\r
 232                       'notmuch-tree-match-tag-face\r
 233                     'notmuch-tree-no-match-tag-face)))\r
 234 -       (format format-string (notmuch-tag-format-tags tags face)))))))\r
 235 +       (format format-string (notmuch-tag-format-tags tags tags face)))))))\r
 236  \r
 237  (defun notmuch-tree-format-field-list (field-list msg)\r
 238    "Format fields of MSG according to FIELD-LIST and return string"\r
 239 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 240 index 0c767f7..04587c0 100644\r
 241 --- a/emacs/notmuch.el\r
 242 +++ b/emacs/notmuch.el\r
 243 @@ -754,7 +754,7 @@ non-authors is found, assume that all of the authors match."\r
 244  \r
 245     ((string-equal field "tags")\r
 246      (let ((tags (plist-get result :tags)))\r
 247 -      (insert (format format-string (notmuch-tag-format-tags tags)))))))\r
 248 +      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))\r
 249  \r
 250  (defun notmuch-search-show-result (result &optional pos)\r
 251    "Insert RESULT at POS or the end of the buffer if POS is null."\r
 252 diff --git a/test/test-lib.el b/test/test-lib.el\r
 253 index 37fcb3d..437f83f 100644\r
 254 --- a/test/test-lib.el\r
 255 +++ b/test/test-lib.el\r
 256 @@ -165,3 +165,8 @@ nothing."\r
 257  \r
 258       (t\r
 259        (notmuch-test-report-unexpected output expected)))))\r
 260 +\r
 261 +;; For historical reasons, we hide deleted tags by default in the test\r
 262 +;; suite\r
 263 +(setq notmuch-tag-deleted-formats\r
 264 +      '((".*" nil)))\r
 265 -- \r
 266 1.7.9.1\r
 267 \r