--- /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 21BA8431FC0\r
+ for <notmuch@notmuchmail.org>; Sat, 22 Mar 2014 04:44:35 -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 MV3vWZ7vlNgX for <notmuch@notmuchmail.org>;\r
+ Sat, 22 Mar 2014 04:44:27 -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 09C36431FBC\r
+ for <notmuch@notmuchmail.org>; Sat, 22 Mar 2014 04:44:27 -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 1WRKLc-00060L-Kt; Sat, 22 Mar 2014 11:44:21 +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 1WRKLb-00046f-T7; Sat, 22 Mar 2014 11:44:20 +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: <87pplek4v0.fsf@qmul.ac.uk>\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> <87pplek4v0.fsf@qmul.ac.uk>\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 11:44:18 +0000\r
+Message-ID: <87mwgih2zx.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: fea0858007c2b9064a64c69cb1ffd51b (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 11:44:35 -0000\r
+\r
+\r
+On Sat, 22 Mar 2014, Mark Walters <markwalters1009@gmail.com> wrote:\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
+Ok I have realised I was wrong and your version was fine (as the choice\r
+of formats was already made). However, I do still pass the unformatted\r
+tag so that the formatter can access that as `bare-tag'.\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
+More importantly I was getting (erratic) weird effects because some of\r
+these changes changed tag (and even the copy of tag outside this\r
+function). I fixed this by using copy-sequence for the second let\r
+clause.\r
+\r
+Best wishes \r
+\r
+Mark\r
+\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