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 B18EB431FC4 for ; Tue, 10 Dec 2013 00:57:42 -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=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 7ZLJaPDOnq7T for ; Tue, 10 Dec 2013 00:57:36 -0800 (PST) Received: from mail-wg0-f52.google.com (mail-wg0-f52.google.com [74.125.82.52]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id AD208431FBC for ; Tue, 10 Dec 2013 00:57:35 -0800 (PST) Received: by mail-wg0-f52.google.com with SMTP id x13so4617143wgg.19 for ; Tue, 10 Dec 2013 00:57:33 -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=Yq3g95MdqLBnfwuFclNeg5qDzuO6vzcQkLx6reuah2g=; b=r04bDIOLXtNeE7r5jrXTcfus/1i3p3xa2823AD2XOXwlGkve6SDP02Zoi6e3k7V8jS TT4lNp/PPqpbJx4zn4q19l91luDDislbkbZGLg0II2iQ48ihNpyWUvsPnRStSDalcTvl EeD7x63/YgPlViYpEpV12UgjP5prZBrFqd6ZsKCabehxIy0nvHAPiSkA1yI2UKDIhgIT Gqxj9tvEOF9+ZLJBp4VHd0cAABEEQGOFDYEEI+5SqoF3uAnk05geYBFLglH+pNPgE5KM vdC0JzdGFS44RSqZtnnje2oNtGSK0gEa8RTtTB4kp9WSIAQwsWREjBP+4enSNu71pIbk k5MA== X-Received: by 10.180.183.72 with SMTP id ek8mr18156775wic.49.1386665853158; Tue, 10 Dec 2013 00:57:33 -0800 (PST) Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31]) by mx.google.com with ESMTPSA id w20sm3180192wia.5.2013.12.10.00.57.31 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Tue, 10 Dec 2013 00:57:32 -0800 (PST) From: Mark Walters To: notmuch@notmuchmail.org Subject: [PATCH WIP v4 1/3] emacs: show: mark tags changed since buffer loaded Date: Tue, 10 Dec 2013 08:57:25 +0000 Message-Id: <1386665847-6439-2-git-send-email-markwalters1009@gmail.com> X-Mailer: git-send-email 1.7.9.1 In-Reply-To: <1386665847-6439-1-git-send-email-markwalters1009@gmail.com> References: <1386665847-6439-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: Tue, 10 Dec 2013 08:57:43 -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. --- emacs/notmuch-show.el | 22 ++++++++-- emacs/notmuch-tag.el | 105 +++++++++++++++++++++++++++++++++++-------------- 2 files changed, 92 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. -- 1.7.9.1