--- /dev/null
+Return-Path: <m.walters@qmul.ac.uk>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 24C39431FC0\r
+ for <notmuch@notmuchmail.org>; Sat, 22 Mar 2014 01:35:59 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.098\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.098 tagged_above=-999 required=5\r
+ tests=[DKIM_ADSP_CUSTOM_MED=0.001, FREEMAIL_FROM=0.001,\r
+ NML_ADSP_CUSTOM_MED=1.2, RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id 9Pj2Yt2gIhh7 for <notmuch@notmuchmail.org>;\r
+ Sat, 22 Mar 2014 01:35:52 -0700 (PDT)\r
+Received: from mail2.qmul.ac.uk (mail2.qmul.ac.uk [138.37.6.6])\r
+ (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits))\r
+ (No client certificate requested)\r
+ by olra.theworths.org (Postfix) with ESMTPS id A0906431FBC\r
+ for <notmuch@notmuchmail.org>; Sat, 22 Mar 2014 01:35:51 -0700 (PDT)\r
+Received: from smtp.qmul.ac.uk ([138.37.6.40])\r
+ by mail2.qmul.ac.uk with esmtp (Exim 4.71)\r
+ (envelope-from <m.walters@qmul.ac.uk>)\r
+ id 1WRHPB-0006K0-4w; Sat, 22 Mar 2014 08:35:49 +0000\r
+Received: from 93-97-24-31.zone5.bethere.co.uk ([93.97.24.31] helo=localhost)\r
+ by smtp.qmul.ac.uk with esmtpsa (TLSv1:AES128-SHA:128) (Exim 4.71)\r
+ (envelope-from <m.walters@qmul.ac.uk>)\r
+ id 1WRHPA-0004sL-DJ; Sat, 22 Mar 2014 08:35:49 +0000\r
+From: Mark Walters <markwalters1009@gmail.com>\r
+To: Austin Clements <amdragon@MIT.EDU>\r
+Subject: Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded\r
+In-Reply-To: <20140322033933.GC31187@mit.edu>\r
+References: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
+ <1394597397-8486-6-git-send-email-markwalters1009@gmail.com>\r
+ <20140322033933.GC31187@mit.edu>\r
+User-Agent: Notmuch/0.15.2+615~g78e3a93 (http://notmuchmail.org) Emacs/23.4.1\r
+ (x86_64-pc-linux-gnu)\r
+Date: Sat, 22 Mar 2014 08:35:47 +0000\r
+Message-ID: <87pplek4v0.fsf@qmul.ac.uk>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=us-ascii\r
+X-Sender-Host-Address: 93.97.24.31\r
+X-QM-Geographic: According to ripencc,\r
+ this message was delivered by a machine in Britain (UK) (GB).\r
+X-QM-SPAM-Info: Sender has good ham record. :)\r
+X-QM-Body-MD5: f404520bc2784f490db12d6f20b6231b (of first 20000 bytes)\r
+X-SpamAssassin-Score: 0.0\r
+X-SpamAssassin-SpamBar: /\r
+X-SpamAssassin-Report: The QM spam filters have analysed this message to\r
+ determine if it is\r
+ spam. We require at least 5.0 points to mark a message as spam.\r
+ This message scored 0.0 points. Summary of the scoring: \r
+ * 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail\r
+ provider * (markwalters1009[at]gmail.com)\r
+ * -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay\r
+ * domain\r
+ * 0.0 AWL AWL: From: address is in the auto white-list\r
+X-QM-Scan-Virus: ClamAV says the message is clean\r
+Cc: notmuch@notmuchmail.org\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Sat, 22 Mar 2014 08:35:59 -0000\r
+\r
+\r
+Hi\r
+\r
+Ok I have something working based on your version below. I will post\r
+once I have tested a little more. Since the diff with my version will be\r
+quite big I will just comment on the differences from your version.\r
+\r
+On Sat, 22 Mar 2014, Austin Clements <amdragon@MIT.EDU> wrote:\r
+> Quoth Mark Walters on Mar 12 at 4:09 am:\r
+>> This allows (and requires) the original-tags to be passed along with\r
+>> the current-tags to be passed to notmuch-tag-format-tags. This allows\r
+>> the tag formatting to show added and deleted tags.By default a removed\r
+>> tag is displayed with strike-through in red (if strike-through is not\r
+>> available, eg on a terminal, inverse video is used instead) and an\r
+>> added tag is displayed underlined in green.\r
+>> \r
+>> If the caller does not wish to use the new feature it can pass\r
+>> current-tags for both arguments and, at this point, we do exactly that\r
+>> in the three callers of this function.\r
+>> \r
+>> Note, we cannot tidily allow original-tags to be optional because we would\r
+>> need to distinguish nil meaning "we are not specifying original-tags"\r
+>> from nil meaning there were no original-tags (an empty list).\r
+>> \r
+>> We use this in subsequent patches to make it clear when a message was\r
+>> unread when you first loaded a show buffer (previously the unread tag\r
+>> could be removed before a user realised that it had been unread).\r
+>> \r
+>> The code adds into the existing tag formatting code. The user can\r
+>> specify exactly how a tag should be displayed normally, when deleted,\r
+>> or when added.\r
+>> \r
+>> Since the formatting code matches regexps a user can match all deleted\r
+>> tags with a ".*" in notmuch-tag-deleted-formats. For example setting\r
+>> notmuch-tag-deleted-formats to '((".*" nil)) tells notmuch not to show\r
+>> deleted tags at all.\r
+>> \r
+>> All the variables are customizable; however, more complicated cases\r
+>> like changing the face depending on the type of display will require\r
+>> custom lisp.\r
+>> \r
+>> Currently this overrides notmuch-tag-deleted-formats for the tests\r
+>> setting it to '((".*" nil)) so that they get removed from the display\r
+>> and, thus, all tests still pass.\r
+>> ---\r
+>> emacs/notmuch-show.el | 4 +-\r
+>> emacs/notmuch-tag.el | 72 +++++++++++++++++++++++++++++++++++-------------\r
+>> emacs/notmuch-tree.el | 2 +-\r
+>> emacs/notmuch.el | 2 +-\r
+>> test/test-lib.el | 5 +++\r
+>> 5 files changed, 61 insertions(+), 24 deletions(-)\r
+>> \r
+>> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+>> index 019f51d..5492be4 100644\r
+>> --- a/emacs/notmuch-show.el\r
+>> +++ b/emacs/notmuch-show.el\r
+>> @@ -344,7 +344,7 @@ (defun notmuch-show-update-tags (tags)\r
+>> (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)\r
+>> (let ((inhibit-read-only t))\r
+>> (replace-match (concat "("\r
+>> - (notmuch-tag-format-tags tags)\r
+>> + (notmuch-tag-format-tags tags tags)\r
+>> ")"))))))\r
+>> \r
+>> (defun notmuch-clean-address (address)\r
+>> @@ -423,7 +423,7 @@ (defun notmuch-show-insert-headerline (headers date tags depth)\r
+>> " ("\r
+>> date\r
+>> ") ("\r
+>> - (notmuch-tag-format-tags tags)\r
+>> + (notmuch-tag-format-tags tags tags)\r
+>> ")\n")\r
+>> (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
+>> \r
+>> diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
+>> index 4698856..cfccb8e 100644\r
+>> --- a/emacs/notmuch-tag.el\r
+>> +++ b/emacs/notmuch-tag.el\r
+>> @@ -184,45 +184,77 @@ (defun notmuch-tag-clear-cache ()\r
+>> "Clear the internal cache of tag formats."\r
+>> (clrhash notmuch-tag--format-cache))\r
+>> \r
+>> -(defun notmuch-tag-format-tag (tag)\r
+>> - "Format TAG by according to `notmuch-tag-formats'.\r
+>> -\r
+>> -Callers must ensure that the tag format cache has been recently cleared\r
+>> -via `notmuch-tag-clear-cache' before using this function. For example,\r
+>> -it would be appropriate to clear the cache just prior to filling a\r
+>> -buffer that uses formatted tags."\r
+>> -\r
+>> - (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
+>> +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)\r
+>> + "Format TAG according to the appropriate `notmuch-tag-formats`.\r
+>> +\r
+>> +Applies formats for TAG from the appropriate one of\r
+>> +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and\r
+>> +`notmuch-tag-added-formats` based on TAG-STATE to the partially\r
+>\r
+> The second ` should be a ' on all four of the above references.\r
+>\r
+>> +formatted tag FORMATTED-TAG."\r
+>> + (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))\r
+>\r
+> Something's strange here. If this hits in the cache, it will ignore\r
+> formatted-tag. I can't actually construct a situation where this does\r
+> the wrong thing, but it always seems to do the right thing for the\r
+> wrong reasons.\r
+>\r
+> This code would make a lot more sense to me if it were turned\r
+> inside-out with `notmuch-tag-format-tag':\r
+>\r
+> (defun notmuch-tag-format-tag (tags orig-tags tag)\r
+> "Format TAG according to `notmuch-tag-formats'.\r
+>\r
+> TAGS and ORIG-TAGS are lists of the current tags and the original\r
+> tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
+> are not in TAGS) are shown using formats from\r
+> `notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
+> are in TAGS but are not in ORIG-TAGS) are shown using formats\r
+> from `notmuch-tag-added-formats' and tags which have not been\r
+> changed (the normal case) are shown using formats from\r
+> `notmuch-tag-formats'"\r
+> (let* ((tag-state (cond ((not (member tag tags)) 'deleted)\r
+> ((not (member tag orig-tags)) 'added)))\r
+> (formatted (gethash (cons tag tag-state) notmuch-tag--format-cache\r
+> 'missing)))\r
+> (when (eq formatted 'missing)\r
+\r
+I changed formatted to formatted-tag.\r
+\r
+> (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))\r
+> (over (case tag-state\r
+> ((nil) nil)\r
+> (deleted (notmuch-tag--get-formats \r
+> tag notmuch-tag-deleted-formats))\r
+> (added (notmuch-tag--get-formats \r
+> tag notmuch-tag-deleted-formats)))))\r
+\r
+I moved the nil case to an otherwise case (and corrected the typo of\r
+deleted-formats to added-formats in the second clause).\r
+\r
+> (setq formatted (notmuch-tag--do-format\r
+> (notmuch-tag--do-format tag) base over))\r
+\r
+I split this into two steps. I also slightly changed\r
+notmuch-tag--do-format so it gets passed tag and formatted-tag\r
+\r
+> (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
+> formatted))\r
+>\r
+> (defun notmuch-tag--get-formats (tag format-alist)\r
+> "Find the first item whose car regexp-matches TAG."\r
+> (save-match-data\r
+> ;; Don't use assoc-default since there's no way to distinguish a\r
+> ;; missing key from a present key with a null cdr.\r
+> (assoc* tag format-alist\r
+> :test (lambda (tag key)\r
+> (and (eq (string-match key tag) 0)\r
+> (= (match-end 0) (length tag)))))))\r
+\r
+I have not changed this.\r
+\r
+> (defun notmuch-tag--do-format (tag formats)\r
+> "Apply a tag-formats entry to TAG."\r
+\r
+We need to pass formatted-tag as well as the original unformatted tag\r
+because we want to do the look up to decide what to do based on the\r
+original tag not whatever it has become.\r
+\r
+> (cond ((null formats) ;; - Tag not in `formats',\r
+> tag) ;; the format is the tag itself.\r
+> ((null (cdr formats)) ;; - Tag was deliberately hidden,\r
+> nil) ;; no format must be returned\r
+> (t\r
+> ;; Tag was found and has formats, we must apply all the\r
+> ;; formats. TAG may be null so treat that as a special case.\r
+> (let ((old-tag tag) (tag (or tag "")))\r
+> (dolist (format (cdr formats))\r
+> (setq tag (eval format)))\r
+> (if (and (null old-tag) (equal tag ""))\r
+> nil\r
+> tag)))))\r
+\r
+This got slightly tweaked because of the formatted/original split above.\r
+\r
+\r
+> (Completely untested and all indented with spaces and probably\r
+> incorrectly because I wrote it all in my email buffer, but you get the\r
+> idea.)\r
+\r
+And I think I fixed all the whitespace\r
+\r
+This looks much nicer than my version. Thanks!\r
+\r
+Best wishes\r
+\r
+Mark\r
+\r
+\r
+\r
+>\r
+>> (when (eq formatted 'missing)\r
+>> - (let* ((formats\r
+>> + (let* ((tag-formats (case tag-state\r
+>> + ((list nil) notmuch-tag-formats)\r
+>\r
+> While this isn't *technically* wrong, I don't think you meant to\r
+> accept a tag-state of 'list. Should be\r
+>\r
+> (case tag-state\r
+> ((nil) notmuch-tag-formats)\r
+> (deleted ...\r
+>\r
+>> + (deleted notmuch-tag-deleted-formats)\r
+>> + (added notmuch-tag-added-formats)))\r
+>> + (formats\r
+>> (save-match-data\r
+>> ;; Don't use assoc-default since there's no way to\r
+>> ;; distinguish a missing key from a present key with a\r
+>> ;; null cdr:.\r
+>> - (assoc* tag notmuch-tag-formats\r
+>> + (assoc* tag tag-formats\r
+>> :test (lambda (tag key)\r
+>> (and (eq (string-match key tag) 0)\r
+>> (= (match-end 0) (length tag))))))))\r
+>> (setq formatted\r
+>> (cond\r
+>> - ((null formats) ;; - Tag not in `notmuch-tag-formats',\r
+>> - tag) ;; the format is the tag itself.\r
+>> + ((null formats) ;; - Tag not in `tag-formats',\r
+>> + formatted-tag) ;; the format is the tag itself.\r
+>> ((null (cdr formats)) ;; - Tag was deliberately hidden,\r
+>> nil) ;; no format must be returned\r
+>> - (t ;; - Tag was found and has formats,\r
+>> - (let ((tag tag)) ;; we must apply all the formats.\r
+>> + (t\r
+>> + ;; Tag was found and has formats, we must apply all\r
+>> + ;; the formats. FORMATTED-TAG may be null so treat\r
+>> + ;; that as a special case.\r
+>> + (let ((tag (or formatted-tag "")))\r
+>> (dolist (format (cdr formats) tag)\r
+>> - (setq tag (eval format)))))))\r
+>> - (puthash tag formatted notmuch-tag--format-cache)))\r
+>> + (setq tag (eval format)))\r
+>> + (if (and (null formatted-tag)\r
+>> + (equal tag ""))\r
+>> + nil\r
+>> + tag)))))\r
+>> + (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))\r
+>> formatted))\r
+>> \r
+>> -(defun notmuch-tag-format-tags (tags &optional face)\r
+>> +(defun notmuch-tag-format-tag (tags orig-tags tag)\r
+>> + "Format TAG according to `notmuch-tag-formats'.\r
+>> +\r
+>> +TAGS and ORIG-TAGS are lists of the current tags and the original\r
+>> +tags; tags which have been deleted (i.e., are in ORIG-TAGS but\r
+>> +are not in TAGS) are shown using formats from\r
+>> +`notmuch-tag-deleted-formats'; tags which have been added (i.e.,\r
+>> +are in TAGS but are not in ORIG-TAGS) are shown using formats\r
+>> +from `notmuch-tag-added-formats' and tags which have not been\r
+>> +changed (the normal case) are shown using formats from\r
+>> +`notmuch-tag-formats'"\r
+>> + (let* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))\r
+>> + (cond ((not (member tag tags))\r
+>> + (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))\r
+>> + ((not (member tag orig-tags))\r
+>> + (notmuch-tag-format-tag-by-state tag formatted-tag 'added))\r
+>> + (t\r
+>> + formatted-tag))))\r
+>> +\r
+>> +(defun notmuch-tag-format-tags (tags orig-tags &optional face)\r
+>> "Return a string representing formatted TAGS."\r
+>> - (let ((face (or face 'notmuch-tag-face)))\r
+>> + (let ((face (or face 'notmuch-tag-face))\r
+>> + (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))\r
+>> (notmuch-apply-face\r
+>> (mapconcat #'identity\r
+>> ;; nil indicated that the tag was deliberately hidden\r
+>> - (delq nil (mapcar #'notmuch-tag-format-tag tags))\r
+>> + (delq nil (mapcar\r
+>> + (apply-partially #'notmuch-tag-format-tag tags orig-tags)\r
+>> + all-tags))\r
+>> " ")\r
+>> face\r
+>> t)))\r
+>> diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
+>> index c78d9de..8bf2fbc 100644\r
+>> --- a/emacs/notmuch-tree.el\r
+>> +++ b/emacs/notmuch-tree.el\r
+>> @@ -704,7 +704,7 @@ (defun notmuch-tree-format-field (field format-string msg)\r
+>> (face (if match\r
+>> 'notmuch-tree-match-tag-face\r
+>> 'notmuch-tree-no-match-tag-face)))\r
+>> - (format format-string (notmuch-tag-format-tags tags face)))))))\r
+>> + (format format-string (notmuch-tag-format-tags tags tags face)))))))\r
+>> \r
+>> (defun notmuch-tree-format-field-list (field-list msg)\r
+>> "Format fields of MSG according to FIELD-LIST and return string"\r
+>> diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
+>> index 93a6d8b..609f408 100644\r
+>> --- a/emacs/notmuch.el\r
+>> +++ b/emacs/notmuch.el\r
+>> @@ -754,7 +754,7 @@ (defun notmuch-search-insert-field (field format-string result)\r
+>> \r
+>> ((string-equal field "tags")\r
+>> (let ((tags (plist-get result :tags)))\r
+>> - (insert (format format-string (notmuch-tag-format-tags tags)))))))\r
+>> + (insert (format format-string (notmuch-tag-format-tags tags tags)))))))\r
+>> \r
+>> (defun notmuch-search-show-result (result &optional pos)\r
+>> "Insert RESULT at POS or the end of the buffer if POS is null."\r
+>> diff --git a/test/test-lib.el b/test/test-lib.el\r
+>> index 37fcb3d..437f83f 100644\r
+>> --- a/test/test-lib.el\r
+>> +++ b/test/test-lib.el\r
+>> @@ -165,3 +165,8 @@ (defun notmuch-test-expect-equal (output expected)\r
+>> \r
+>> (t\r
+>> (notmuch-test-report-unexpected output expected)))))\r
+>> +\r
+>> +;; For historical reasons, we hide deleted tags by default in the test\r
+>> +;; suite\r
+>> +(setq notmuch-tag-deleted-formats\r
+>> + '((".*" nil)))\r
projects / notmuch-archives.git / commitdiff