From: Mark Walters Date: Sat, 14 Dec 2013 23:53:15 +0000 (+0000) Subject: [PATCH v2 3/5] emacs: show: mark tags changed since buffer loaded X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=9b314eb6fbb27d08fa26c730abff26d498dc3f7f;p=notmuch-archives.git [PATCH v2 3/5] emacs: show: mark tags changed since buffer loaded --- diff --git a/60/2e2f4a55d8a209757d95eaeb1a03505ebffbd5 b/60/2e2f4a55d8a209757d95eaeb1a03505ebffbd5 new file mode 100644 index 000000000..7516f347b --- /dev/null +++ b/60/2e2f4a55d8a209757d95eaeb1a03505ebffbd5 @@ -0,0 +1,285 @@ +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 AF4F5431FD6 + for ; Sat, 14 Dec 2013 15:53:40 -0800 (PST) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: 0.201 +X-Spam-Level: +X-Spam-Status: No, score=0.201 tagged_above=-999 required=5 + tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001, + RCVD_IN_DNSWL_LOW=-0.7] autolearn=unavailable +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 hYcG+esHyUMZ for ; + Sat, 14 Dec 2013 15:53:40 -0800 (PST) +Received: from mail-wi0-f172.google.com (mail-wi0-f172.google.com + [209.85.212.172]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) + (No client certificate requested) + by olra.theworths.org (Postfix) with ESMTPS id 1BFFF431FDD + for ; Sat, 14 Dec 2013 15:53:38 -0800 (PST) +Received: by mail-wi0-f172.google.com with SMTP id en1so736010wid.5 + for ; Sat, 14 Dec 2013 15:53:38 -0800 (PST) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; + h=from:to:cc:subject:date:message-id:in-reply-to:references; + bh=6RRraT+Vza5sw07yf6mzcXfq7FHpVVmI06BVv/F6dG8=; + b=GOLUjzkpk8CfrSm5sczDvQ5dyDP42dRhEOwzhz2xYkoSlZ+45rwfUdK6W4i9l7hzv/ + 2vl5xpsaHlXj1iB6QNzyVV9/cruHP+rBLykU2+NbRICGB/WtkqnSmsj3zqBPlTHquoRq + bb8NG8+UpPpYmOHRczPtLWTgPwouqGhZqrbQbEIoEXAnikUaUjb26XV0QQxRF1WRotqb + xDtx6YJqBiDSoIkOS1ANuto9AxTQ7fvPq3jmub7W8S+vMqbznEfhloUGEDlCXCrh2uem + yA1uxokTkDw+jIZiK7JiCMLQhxLtahO867mj6x8fgKpfJj8MCJLrv7wc+sWBX8/Y68cW + l9aA== +X-Received: by 10.180.206.11 with SMTP id lk11mr5505535wic.16.1387065217994; + Sat, 14 Dec 2013 15:53:37 -0800 (PST) +Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31]) + by mx.google.com with ESMTPSA id xm7sm11198835wib.0.2013.12.14.15.53.36 + for + (version=TLSv1.2 cipher=RC4-SHA bits=128/128); + Sat, 14 Dec 2013 15:53:37 -0800 (PST) +From: Mark Walters +To: notmuch@notmuchmail.org +Subject: [PATCH v2 3/5] emacs: show: mark tags changed since buffer loaded +Date: Sat, 14 Dec 2013 23:53:15 +0000 +Message-Id: <1387065197-15776-4-git-send-email-markwalters1009@gmail.com> +X-Mailer: git-send-email 1.7.9.1 +In-Reply-To: <1387065197-15776-1-git-send-email-markwalters1009@gmail.com> +References: <1387065197-15776-1-git-send-email-markwalters1009@gmail.com> +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, 14 Dec 2013 23:53:41 -0000 + +This shows any tags changed in the show buffer since it was loaded or +refreshed. 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. + +One nice feature is that this makes it clear when a message was unread +when you first loaded the 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. For convenience an entry for the entry string in the +notmuch-tag-formats (and the corresponding notmuch-tag-deleted-formats +notmuch-tag-added-formats) is applied to all tags which do not have an +explicit match. + +This means that a user can tell notmuch not to show deleted tags at +all by setting notmuch-tag-deleted-formats to +'(("" nil)) +or not to show any deleted tags except "unread" by setting it to +'(("" nil) + ("unread" (propertize tag 'face '(strike-through "red")))) + +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 | 22 ++++++++-- + emacs/notmuch-tag.el | 105 +++++++++++++++++++++++++++++++++++-------------- + test/test-lib.el | 4 ++ + 3 files changed, 96 insertions(+), 35 deletions(-) + +diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el +index 1ac80ca..30e84b1 100644 +--- a/emacs/notmuch-show.el ++++ b/emacs/notmuch-show.el +@@ -341,11 +341,21 @@ operation on the contents of the current buffer." + "Update the displayed tags of the current message." + (save-excursion + (goto-char (notmuch-show-message-top)) +- (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) +- (let ((inhibit-read-only t)) +- (replace-match (concat "(" +- (notmuch-tag-format-tags tags) +- ")")))))) ++ (let* ((orig-tags (notmuch-show-get-prop :orig-tags)) ++ (all-tags (sort (delete-dups (append tags orig-tags)) #'string<)) ++ (display-tags (mapcar (lambda (tag) (cond ((and (member tag tags) (member tag orig-tags)) ++ tag) ++ ((not (member tag tags)) ++ (cons tag 'deleted)) ++ ((not (member tag orig-tags)) ++ (cons tag 'added)))) ++ all-tags))) ++ ++ (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) ++ (let ((inhibit-read-only t)) ++ (replace-match (concat "(" ++ (notmuch-tag-format-tags display-tags) ++ ")"))))))) + + (defun notmuch-clean-address (address) + "Try to clean a single email ADDRESS for display. Return a cons +@@ -1167,6 +1177,8 @@ function is used." + + (jit-lock-register #'notmuch-show-buttonise-links) + ++ (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags)))) ++ + ;; Set the header line to the subject of the first message. + (setq header-line-format (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject)))) + +diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el +index b60f46c..81ce287 100644 +--- a/emacs/notmuch-tag.el ++++ b/emacs/notmuch-tag.el +@@ -28,34 +28,8 @@ + (require 'crm) + (require 'notmuch-lib) + +-(defcustom notmuch-tag-formats +- '(("unread" (propertize tag 'face '(:foreground "red"))) +- ("flagged" (propertize tag 'face '(:foreground "blue")) +- (notmuch-tag-format-image-data tag (notmuch-tag-star-icon)))) +- "Custom formats for individual tags. +- +-This gives a list that maps from tag names to lists of formatting +-expressions. The car of each element gives a tag name and the +-cdr gives a list of Elisp expressions that modify the tag. If +-the list is empty, the tag will simply be hidden. Otherwise, +-each expression will be evaluated in order: for the first +-expression, the variable `tag' will be bound to the tag name; for +-each later expression, the variable `tag' will be bound to the +-result of the previous expression. In this way, each expression +-can build on the formatting performed by the previous expression. +-The result of the last expression will displayed in place of the +-tag. +- +-For example, to replace a tag with another string, simply use +-that string as a formatting expression. To change the foreground +-of a tag to red, use the expression +- (propertize tag 'face '(:foreground \"red\")) +- +-See also `notmuch-tag-format-image', which can help replace tags +-with images." +- +- :group 'notmuch-search +- :group 'notmuch-show ++(define-widget 'notmuch-tag-format-type 'lazy ++ "Customize widget for notmuch-tag-format and friends" + :type '(alist :key-type (string :tag "Tag") + :extra-offset -3 + :value-type +@@ -82,6 +56,61 @@ with images." + (string :tag "Custom"))) + (sexp :tag "Custom"))))) + ++(defcustom notmuch-tag-formats ++ '(("unread" (propertize tag 'face '(:foreground "red"))) ++ ("flagged" (propertize tag 'face '(:foreground "blue")) ++ (notmuch-tag-format-image-data tag (notmuch-tag-star-icon)))) ++ "Custom formats for individual tags. ++ ++This gives a list that maps from tag names to lists of formatting ++expressions. The car of each element gives a tag name and the ++cdr gives a list of Elisp expressions that modify the tag. If the ++car is an empty string it matches all tags that do not have an ++explicit match. If the list is empty, the tag will simply be ++hidden. Otherwise, each expression will be evaluated in order: ++for the first expression, the variable `tag' will be bound to the ++tag name; for each later expression, the variable `tag' will be ++bound to the result of the previous expression. In this way, ++each expression can build on the formatting performed by the ++previous expression. The result of the last expression will ++displayed in place of the tag. ++ ++For example, to replace a tag with another string, simply use ++that string as a formatting expression. To change the foreground ++of a tag to red, use the expression ++ (propertize tag 'face '(:foreground \"red\")) ++ ++See also `notmuch-tag-format-image', which can help replace tags ++with images." ++ :group 'notmuch-search ++ :group 'notmuch-show ++ :type 'notmuch-tag-format-type) ++ ++(defcustom notmuch-tag-deleted-formats ++ '(("" (propertize tag 'face ++ (if (display-supports-face-attributes-p '(:strike-through "red")) ++ '(:strike-through "red") ++ '(:inverse-video t))))) ++ "Custom formats for tags when deleted. ++ ++By default this shows deleted tags with strike-through in red, ++unless strike-through is not available (e.g., emacs is running in ++a terminal) in which case it uses inverse video. To hide deleted ++tags completely set this to ++ '((\"\" nil)) ++ ++See `notmuch-tag-formats' for full documentation." ++ :group 'notmuch-show ++ :type 'notmuch-tag-format-type) ++ ++(defcustom notmuch-tag-added-formats ++ '(("" (propertize tag 'face '(:underline "green")))) ++ "Custom formats for tags when added. ++ ++See `notmuch-tag-formats' for full documentation." ++ :group 'notmuch-show ++ :type 'notmuch-tag-format-type) ++ + (defun notmuch-tag-format-image-data (tag data) + "Replace TAG with image DATA, if available. + +@@ -136,8 +165,24 @@ This can be used with `notmuch-tag-format-image-data'." + ") + + (defun notmuch-tag-format-tag (tag) +- "Format TAG by looking into `notmuch-tag-formats'." +- (let ((formats (assoc tag notmuch-tag-formats))) ++ "Format TAG by looking into `notmuch-tag-formats'. ++ ++TAG can either be a string for a tag or a cons cell. In the ++latter case the car of the cons cell is the tag string, the cdr ++should be 'deleted or 'added to indicate whether the tag has been ++deleted or added. The format for tag is looked up in ++`notmuch-tag-formats' or `notmuch-tag-deleted-formats' or ++`notmuch-tag-added-formats' as appropriate." ++ (let* ((status (if (consp tag) (cdr tag))) ++ (tag (if (consp tag) (car tag) tag)) ++ (status-formats (cond ++ ((eq status 'deleted) ++ notmuch-tag-deleted-formats) ++ ((eq status 'added) ++ notmuch-tag-added-formats) ++ (t notmuch-tag-formats))) ++ (formats (or (append (assoc tag status-formats)) ++ (append (assoc "" status-formats))))) + (cond + ((null formats) ;; - Tag not in `notmuch-tag-formats', + tag) ;; the format is the tag itself. +diff --git a/test/test-lib.el b/test/test-lib.el +index 1c9e224..a1b40b7 100644 +--- a/test/test-lib.el ++++ b/test/test-lib.el +@@ -174,3 +174,7 @@ nothing." + (dolist (form body ret) + (setq ret (eval form)) + (notmuch-post-command)))) ++ ++;; hide deleted tags ++(setq notmuch-tag-deleted-formats ++ '(("" nil))) +-- +1.7.9.1 +