From: Mark Walters Date: Sat, 22 Mar 2014 08:35:47 +0000 (+0000) Subject: Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=093dd475785fd475fd938da04311fadecce652e7;p=notmuch-archives.git Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded --- diff --git a/d4/e2fc8337a931ee750b483e92c931b94b5955eb b/d4/e2fc8337a931ee750b483e92c931b94b5955eb new file mode 100644 index 000000000..14cbc4a89 --- /dev/null +++ b/d4/e2fc8337a931ee750b483e92c931b94b5955eb @@ -0,0 +1,400 @@ +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 24C39431FC0 + for ; Sat, 22 Mar 2014 01:35:59 -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 9Pj2Yt2gIhh7 for ; + Sat, 22 Mar 2014 01:35:52 -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 A0906431FBC + for ; Sat, 22 Mar 2014 01:35:51 -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 1WRHPB-0006K0-4w; Sat, 22 Mar 2014 08:35:49 +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 1WRHPA-0004sL-DJ; Sat, 22 Mar 2014 08:35:49 +0000 +From: Mark Walters +To: Austin Clements +Subject: Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded +In-Reply-To: <20140322033933.GC31187@mit.edu> +References: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com> + <1394597397-8486-6-git-send-email-markwalters1009@gmail.com> + <20140322033933.GC31187@mit.edu> +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 08:35:47 +0000 +Message-ID: <87pplek4v0.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: f404520bc2784f490db12d6f20b6231b (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 08:35:59 -0000 + + +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. + +> (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))))) + +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)))