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