[PATCH v2 3/5] emacs: show: mark tags changed since buffer loaded
authorMark Walters <markwalters1009@gmail.com>
Sat, 14 Dec 2013 23:53:15 +0000 (23:53 +0000)
committerW. Trevor King <wking@tremily.us>
Fri, 7 Nov 2014 17:58:45 +0000 (09:58 -0800)
60/2e2f4a55d8a209757d95eaeb1a03505ebffbd5 [new file with mode: 0644]

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