* [Patch v3 0/8] emacs: show tag changes in buffer
@ 2014-03-12 4:09 Mark Walters
2014-03-12 4:09 ` [Patch v3 1/8] emacs: Combine notmuch-combine-face-text-property{, -string} Mark Walters
` (7 more replies)
0 siblings, 8 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
This is version 3 of this patch set. Version 2 is at
id:1392841212-8494-1-git-send-email-markwalters1009@gmail.com.
This includes a (very) slightly tweaked version of Austin's
notmuch-apply-face patch so that face properties for deleted/added
tags get applied on top of rather than instead of the default face for
that tag.
Otherwise I think this addesses all of Austin's review comments.
A diff from v2 is below: I have deleted the parts related to the
notmuch-apply-face addition.
Best wishes
Mark
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 869b97d..cfccb8e 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,18 +28,6 @@
(require 'crm)
(require 'notmuch-lib)
-;; (notmuch-tag-clear-cache will be called by the defcustom
-;; notmuch-tag-formats, so it has to be defined first.)
-
-(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
- "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.")
-
-(defun notmuch-tag-clear-cache ()
- "Clear the internal cache of tag formats.
-
-This must be called after changes to `notmuch-tag-formats'."
- (clrhash notmuch-tag--format-cache))
-
(define-widget 'notmuch-tag-format-type 'lazy
"Customize widget for notmuch-tag-format and friends"
:type '(alist :key-type (regexp :tag "Tag")
@@ -51,7 +39,7 @@ (define-widget 'notmuch-tag-format-type 'lazy
(string :tag "Display as")
(list :tag "Face" :extra-offset -4
(const :format "" :inline t
- (propertize tag 'face))
+ (notmuch-apply-face tag))
(list :format "%v"
(const :format "" quote)
custom-face-edit))
@@ -102,7 +90,11 @@ (defcustom notmuch-tag-formats
:type 'notmuch-tag-format-type)
(defcustom notmuch-tag-deleted-formats
- '((".*" (propertize tag 'face
+ '(("unread" (notmuch-apply-face "unread"
+ (if (display-supports-face-attributes-p '(:strike-through "red"))
+ '(:strike-through "red")
+ '(:inverse-video t))))
+ (".*" (notmuch-apply-face tag
(if (display-supports-face-attributes-p '(:strike-through "red"))
'(:strike-through "red")
'(:inverse-video t)))))
@@ -115,14 +107,14 @@ (defcustom notmuch-tag-deleted-formats
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))
+ '((\".*\" 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"))))
+ '((".*" (notmuch-apply-face tag '(:underline "green"))))
"Custom formats for tags when added.
For added tags the formats in `notmuch-tag-formats` are applied
@@ -185,8 +177,15 @@ (defun notmuch-tag-tag-icon ()
</g>
</svg>")
+(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
+ "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.")
+
+(defun notmuch-tag-clear-cache ()
+ "Clear the internal cache of tag formats."
+ (clrhash notmuch-tag--format-cache))
+
(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)
- "Format TAG by looking into the appropriate `notmuch-tag-formats`.
+ "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
@@ -194,11 +193,15 @@ (defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)
formatted tag FORMATTED-TAG."
(let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
(when (eq formatted 'missing)
- (let* ((tag-formats (cond ((null tag-state) notmuch-tag-formats)
- ((eq 'deleted tag-state) notmuch-tag-deleted-formats)
- ((eq 'added tag-state) notmuch-tag-added-formats)))
+ (let* ((tag-formats (case tag-state
+ ((list nil) notmuch-tag-formats)
+ (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 tag-formats
:test (lambda (tag key)
(and (eq (string-match key tag) 0)
@@ -224,7 +227,7 @@ (defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)
formatted))
(defun notmuch-tag-format-tag (tags orig-tags tag)
- "Format TAG by looking into `notmuch-tag-formats'.
+ "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
@@ -246,7 +249,7 @@ (defun notmuch-tag-format-tags (tags orig-tags &optional face)
"Return a string representing formatted TAGS."
(let ((face (or face 'notmuch-tag-face))
(all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))
- (notmuch-combine-face-text-property-string
+ (notmuch-apply-face
(mapconcat #'identity
;; nil indicated that the tag was deliberately hidden
(delq nil (mapcar
Austin Clements (2):
emacs: Combine notmuch-combine-face-text-property{,-string}
Make keys of notmuch-tag-formats regexps and use caching
Mark Walters (6):
emacs: tag split customise option for format-tags into a widget
emacs: tag: add customize for deleted/added tag formats
emacs: show: mark tags changed since buffer loaded
emacs: show: use orig-tags for tag display
emacs: search: use orig-tags in search
emacs: tree: use orig-tags in search
emacs/notmuch-lib.el | 35 +++++----
emacs/notmuch-show.el | 7 +-
emacs/notmuch-tag.el | 194 +++++++++++++++++++++++++++++++++++++------------
emacs/notmuch-tree.el | 12 ++-
emacs/notmuch.el | 44 +++++++----
test/test-lib.el | 5 +
6 files changed, 210 insertions(+), 87 deletions(-)
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 1/8] emacs: Combine notmuch-combine-face-text-property{, -string}
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 2/8] Make keys of notmuch-tag-formats regexps and use caching Mark Walters
` (6 subsequent siblings)
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
From: Austin Clements <amdragon@MIT.EDU>
This combines our two face combining functions into one, easy to use
function with a much shorter name: `notmuch-apply-face'. This
function takes the full set of arguments that
`notmuch-combine-face-text-property' took, but takes them in a more
convenient order and provides smarter defaults that make the function
easy to use on both strings and buffers.
---
emacs/notmuch-lib.el | 35 ++++++++++++++++++-----------------
emacs/notmuch-tag.el | 2 +-
emacs/notmuch-tree.el | 2 +-
emacs/notmuch.el | 2 +-
4 files changed, 21 insertions(+), 20 deletions(-)
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 2fefdad..fa7646f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -578,23 +578,32 @@ (defun notmuch-face-ensure-list-form (face)
face
(list face)))
-(defun notmuch-combine-face-text-property (start end face &optional below object)
- "Combine FACE into the 'face text property between START and END.
+(defun notmuch-apply-face (object face &optional below start end)
+ "Combine FACE into the 'face text property of OBJECT between START and END.
This function combines FACE with any existing faces between START
-and END in OBJECT (which defaults to the current buffer).
-Attributes specified by FACE take precedence over existing
-attributes unless BELOW is non-nil. FACE must be a face name (a
-symbol or string), a property list of face attributes, or a list
-of these. For convenience when applied to strings, this returns
-OBJECT."
+and END in OBJECT. Attributes specified by FACE take precedence
+over existing attributes unless BELOW is non-nil.
+
+OBJECT may be a string, a buffer, or nil (which means the current
+buffer). If object is a string, START and END are 0-based;
+otherwise they are buffer positions (integers or markers). FACE
+must be a face name (a symbol or string), a property list of face
+attributes, or a list of these. If START and/or END are omitted,
+they default to the beginning/end of OBJECT. For convenience
+when applied to strings, this returns OBJECT."
;; A face property can have three forms: a face name (a string or
;; symbol), a property list, or a list of these two forms. In the
;; list case, the faces will be combined, with the earlier faces
;; taking precedent. Here we canonicalize everything to list form
;; to make it easy to combine.
- (let ((pos start)
+ (let ((pos (cond (start start)
+ ((stringp object) 0)
+ (t 1)))
+ (end (cond (end end)
+ ((stringp object) (length object))
+ (t (1+ (buffer-size object)))))
(face-list (notmuch-face-ensure-list-form face)))
(while (< pos end)
(let* ((cur (get-text-property pos 'face object))
@@ -607,14 +616,6 @@ (defun notmuch-combine-face-text-property (start end face &optional below object
(setq pos next))))
object)
-(defun notmuch-combine-face-text-property-string (string face &optional below)
- (notmuch-combine-face-text-property
- 0
- (length string)
- face
- below
- string))
-
(defun notmuch-map-text-property (start end prop func &optional object)
"Transform text property PROP using FUNC.
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 908e7ad..41b1687 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -151,7 +151,7 @@ (defun notmuch-tag-format-tag (tag)
(defun notmuch-tag-format-tags (tags &optional face)
"Return a string representing formatted TAGS."
(let ((face (or face 'notmuch-tag-face)))
- (notmuch-combine-face-text-property-string
+ (notmuch-apply-face
(mapconcat #'identity
;; nil indicated that the tag was deliberately hidden
(delq nil (mapcar #'notmuch-tag-format-tag tags))
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 4f2ac02..e3aa2cd 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -715,7 +715,7 @@ (defun notmuch-tree-format-field-list (field-list msg)
(dolist (spec field-list result-string)
(let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
(setq result-string (concat result-string field-string))))
- (notmuch-combine-face-text-property-string result-string face t)))
+ (notmuch-apply-face result-string face t)))
(defun notmuch-tree-insert-msg (msg)
"Insert the message MSG according to notmuch-tree-result-format"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 0471750..5cddaac 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -649,7 +649,7 @@ (defun notmuch-search-color-line (start end line-tag-list)
(let ((tag (car elem))
(attributes (cdr elem)))
(when (member tag line-tag-list)
- (notmuch-combine-face-text-property start end attributes))))
+ (notmuch-apply-face nil attributes nil start end))))
;; Reverse the list so earlier entries take precedence
(reverse notmuch-search-line-faces)))
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 2/8] Make keys of notmuch-tag-formats regexps and use caching
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
2014-03-12 4:09 ` [Patch v3 1/8] emacs: Combine notmuch-combine-face-text-property{, -string} Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 3/8] emacs: tag split customise option for format-tags into a widget Mark Walters
` (5 subsequent siblings)
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
From: Austin Clements <amdragon@MIT.EDU>
This modifies `notmuch-tag-format-tag' to treat the keys of
`notmuch-tag-formats' as (anchored) regexps, rather than literal
strings. This is clearly more flexible, as it allows for prefix
matching, defining a fallback format, etc. This may cause compatibility
problems if people have customized `notmuch-tag-formats' to match tags
that contain regexp specials, but this seems unlikely.
Regular expression matching has quite a performance hit over string
lookup, so this also introduces a simple cache from exact tags to
formatted strings. The number of unique tags is likely to be quite
small, so this cache should have a high hit rate. In addition to
eliminating the regexp lookup in the common case, this cache stores
fully formatted tags, eliminating the repeated evaluation of potentially
expensive, user-specified formatting code. This makes regexp lookup at
least as fast as assoc for unformatted tags (e.g., inbox) and *faster*
than the current code for formatted tags (e.g., unread):
inbox (usec) unread (usec)
assoc: 0.4 2.8
regexp: 3.2 7.2
regexp+caching: 0.4 0.4
(Though even at 7.2 usec, tag formatting is not our top bottleneck.)
This cache must be explicitly cleared to keep it coherent, so this adds
the appropriate clearing calls.
---
emacs/notmuch-show.el | 1 +
emacs/notmuch-tag.el | 76 ++++++++++++++++++++++++++++++++++---------------
emacs/notmuch-tree.el | 1 +
emacs/notmuch.el | 1 +
4 files changed, 56 insertions(+), 23 deletions(-)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index b8782dd..019f51d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1145,6 +1145,7 @@ (defun notmuch-show-build-buffer ()
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
+ (notmuch-tag-clear-cache)
(erase-buffer)
(goto-char (point-min))
(save-excursion
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 41b1687..42c425e 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -34,17 +34,21 @@ (defcustom notmuch-tag-formats
(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.
+This is an association list that maps from tag name regexps to
+lists of formatting expressions. The first entry whose car
+regexp-matches a tag will be used to format that tag. The regexp
+is implicitly anchored, so to match a literal tag name, just use
+that tag name (if it contains special regexp characters like
+\".\" or \"*\", these have to be escaped). The cdr of the
+matching entry 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
@@ -56,7 +60,7 @@ (defcustom notmuch-tag-formats
:group 'notmuch-search
:group 'notmuch-show
- :type '(alist :key-type (string :tag "Tag")
+ :type '(alist :key-type (regexp :tag "Tag")
:extra-offset -3
:value-type
(radio :format "%v"
@@ -135,18 +139,44 @@ (defun notmuch-tag-tag-icon ()
</g>
</svg>")
+(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
+ "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.")
+
+(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 looking into `notmuch-tag-formats'."
- (let ((formats (assoc tag notmuch-tag-formats)))
- (cond
- ((null formats) ;; - Tag not in `notmuch-tag-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,
- (let ((tag tag)) ;; we must apply all the formats.
- (dolist (format (cdr formats) tag)
- (setq tag (eval format))))))))
+ "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)))
+ (when (eq formatted 'missing)
+ (let* ((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
+ :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 (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.
+ (dolist (format (cdr formats) tag)
+ (setq tag (eval format)))))))
+ (puthash tag formatted notmuch-tag--format-cache)))
+ formatted))
(defun notmuch-tag-format-tags (tags &optional face)
"Return a string representing formatted TAGS."
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index e3aa2cd..c78d9de 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -881,6 +881,7 @@ (defun notmuch-tree-worker (basic-query &optional query-context target open-targ
(message-arg "--entire-thread"))
(if (equal (car (process-lines notmuch-command "count" search-args)) "0")
(setq search-args basic-query))
+ (notmuch-tag-clear-cache)
(let ((proc (notmuch-start-notmuch
"notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
"show" "--body=false" "--format=sexp"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 5cddaac..93a6d8b 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -888,6 +888,7 @@ (defun notmuch-search (&optional query oldest-first target-thread target-line)
(set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line)
+ (notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 3/8] emacs: tag split customise option for format-tags into a widget
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
2014-03-12 4:09 ` [Patch v3 1/8] emacs: Combine notmuch-combine-face-text-property{, -string} Mark Walters
2014-03-12 4:09 ` [Patch v3 2/8] Make keys of notmuch-tag-formats regexps and use caching Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats Mark Walters
` (4 subsequent siblings)
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
We will re-use the customize option for format-tags for formattting
deleted tags to added tags in the next patch so split it into a
widget. There should be no functional change.
---
emacs/notmuch-tag.el | 55 ++++++++++++++++++++++++++-----------------------
1 files changed, 29 insertions(+), 26 deletions(-)
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 42c425e..a4dea39 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,6 +28,34 @@
(require 'crm)
(require 'notmuch-lib)
+(define-widget 'notmuch-tag-format-type 'lazy
+ "Customize widget for notmuch-tag-format and friends"
+ :type '(alist :key-type (regexp :tag "Tag")
+ :extra-offset -3
+ :value-type
+ (radio :format "%v"
+ (const :tag "Hidden" nil)
+ (set :tag "Modified"
+ (string :tag "Display as")
+ (list :tag "Face" :extra-offset -4
+ (const :format "" :inline t
+ (propertize tag 'face))
+ (list :format "%v"
+ (const :format "" quote)
+ custom-face-edit))
+ (list :format "%v" :extra-offset -4
+ (const :format "" :inline t
+ (notmuch-tag-format-image-data tag))
+ (choice :tag "Image"
+ (const :tag "Star"
+ (notmuch-tag-star-icon))
+ (const :tag "Empty star"
+ (notmuch-tag-star-empty-icon))
+ (const :tag "Tag"
+ (notmuch-tag-tag-icon))
+ (string :tag "Custom")))
+ (sexp :tag "Custom")))))
+
(defcustom notmuch-tag-formats
'(("unread" (propertize tag 'face '(:foreground "red")))
("flagged" (propertize tag 'face '(:foreground "blue"))
@@ -57,34 +85,9 @@ (defcustom notmuch-tag-formats
See also `notmuch-tag-format-image', which can help replace tags
with images."
-
:group 'notmuch-search
:group 'notmuch-show
- :type '(alist :key-type (regexp :tag "Tag")
- :extra-offset -3
- :value-type
- (radio :format "%v"
- (const :tag "Hidden" nil)
- (set :tag "Modified"
- (string :tag "Display as")
- (list :tag "Face" :extra-offset -4
- (const :format "" :inline t
- (propertize tag 'face))
- (list :format "%v"
- (const :format "" quote)
- custom-face-edit))
- (list :format "%v" :extra-offset -4
- (const :format "" :inline t
- (notmuch-tag-format-image-data tag))
- (choice :tag "Image"
- (const :tag "Star"
- (notmuch-tag-star-icon))
- (const :tag "Empty star"
- (notmuch-tag-star-empty-icon))
- (const :tag "Tag"
- (notmuch-tag-tag-icon))
- (string :tag "Custom")))
- (sexp :tag "Custom")))))
+ :type 'notmuch-tag-format-type)
(defun notmuch-tag-format-image-data (tag data)
"Replace TAG with image DATA, if available.
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
` (2 preceding siblings ...)
2014-03-12 4:09 ` [Patch v3 3/8] emacs: tag split customise option for format-tags into a widget Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-22 2:16 ` Austin Clements
2014-03-12 4:09 ` [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded Mark Walters
` (3 subsequent siblings)
7 siblings, 1 reply; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
Add customize options for deleted/added tag formats. These are not
used yet but will be later in the series.
We switch to using `notmuch-apply-face' rather than `propertize' in
the defcustom for faces so that the faces for deleted/added tags add
to the default face attributes for the tag.
We special case deleting the unread tag as that tag is a strong visual
cue and we don't need that cue when we are just saying it used to be
unread. Thus, we revert to the normal tag face with strikethough for
deleted unread tags.
---
emacs/notmuch-tag.el | 37 ++++++++++++++++++++++++++++++++++++-
1 files changed, 36 insertions(+), 1 deletions(-)
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index a4dea39..4698856 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -39,7 +39,7 @@ (define-widget 'notmuch-tag-format-type 'lazy
(string :tag "Display as")
(list :tag "Face" :extra-offset -4
(const :format "" :inline t
- (propertize tag 'face))
+ (notmuch-apply-face tag))
(list :format "%v"
(const :format "" quote)
custom-face-edit))
@@ -89,6 +89,41 @@ (defcustom notmuch-tag-formats
:group 'notmuch-show
:type 'notmuch-tag-format-type)
+(defcustom notmuch-tag-deleted-formats
+ '(("unread" (notmuch-apply-face "unread"
+ (if (display-supports-face-attributes-p '(:strike-through "red"))
+ '(:strike-through "red")
+ '(:inverse-video t))))
+ (".*" (notmuch-apply-face tag
+ (if (display-supports-face-attributes-p '(:strike-through "red"))
+ '(:strike-through "red")
+ '(:inverse-video t)))))
+ "Custom formats for tags when deleted.
+
+For deleted tags the formats in `notmuch-tag-formats` are applied
+first and then these formats are applied on top.
+
+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
+ '((".*" (notmuch-apply-face tag '(:underline "green"))))
+ "Custom formats for tags when added.
+
+For added tags the formats in `notmuch-tag-formats` are applied
+first and then these formats are applied on top.
+
+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.
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
` (3 preceding siblings ...)
2014-03-12 4:09 ` [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-22 3:39 ` Austin Clements
2014-03-12 4:09 ` [Patch v3 6/8] emacs: show: use orig-tags for tag display Mark Walters
` (2 subsequent siblings)
7 siblings, 1 reply; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
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
+formatted tag FORMATTED-TAG."
+ (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
(when (eq formatted 'missing)
- (let* ((formats
+ (let* ((tag-formats (case tag-state
+ ((list nil) notmuch-tag-formats)
+ (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)))
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 6/8] emacs: show: use orig-tags for tag display
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
` (4 preceding siblings ...)
2014-03-12 4:09 ` [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 7/8] emacs: search: use orig-tags in search Mark Walters
2014-03-12 4:09 ` [Patch v3 8/8] emacs: tree: " Mark Walters
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
This uses the previous patch to show the tag changes that have occured
in the show buffer since it was last loaded/refreshed.
---
emacs/notmuch-show.el | 4 +++-
1 files changed, 3 insertions(+), 1 deletions(-)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 5492be4..f6ca827 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 tags)
+ (notmuch-tag-format-tags tags (notmuch-show-get-prop :orig-tags))
")"))))))
(defun notmuch-clean-address (address)
@@ -1168,6 +1168,8 @@ (defun notmuch-show-build-buffer ()
(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))))
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 7/8] emacs: search: use orig-tags in search
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
` (5 preceding siblings ...)
2014-03-12 4:09 ` [Patch v3 6/8] emacs: show: use orig-tags for tag display Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 8/8] emacs: tree: " Mark Walters
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
This uses the recent functionality to show the tag changes in the
search buffer. Currently this is only used to show changes the search
buffer makes itself: i.e., it does not make display any changes
reflecting tagging done by other notmuch-buffers.
---
emacs/notmuch.el | 41 +++++++++++++++++++++++++----------------
1 files changed, 25 insertions(+), 16 deletions(-)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 609f408..cb71381 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -753,24 +753,33 @@ (defun notmuch-search-insert-field (field format-string result)
format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags")
- (let ((tags (plist-get result :tags)))
- (insert (format format-string (notmuch-tag-format-tags tags tags)))))))
+ (let ((tags (plist-get result :tags))
+ (orig-tags (plist-get result :orig-tags)))
+ (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
-(defun notmuch-search-show-result (result &optional pos)
- "Insert RESULT at POS or the end of the buffer if POS is null."
+(defun notmuch-search-show-result (result pos)
+ "Insert RESULT at POS."
;; Ignore excluded matches
(unless (= (plist-get result :matched) 0)
- (let ((beg (or pos (point-max))))
- (save-excursion
- (goto-char beg)
- (dolist (spec notmuch-search-result-format)
- (notmuch-search-insert-field (car spec) (cdr spec) result))
- (insert "\n")
- (notmuch-search-color-line beg (point) (plist-get result :tags))
- (put-text-property beg (point) 'notmuch-search-result result))
- (when (string= (plist-get result :thread) notmuch-search-target-thread)
- (setq notmuch-search-target-thread "found")
- (goto-char beg)))))
+ (save-excursion
+ (goto-char pos)
+ (dolist (spec notmuch-search-result-format)
+ (notmuch-search-insert-field (car spec) (cdr spec) result))
+ (insert "\n")
+ (notmuch-search-color-line pos (point) (plist-get result :tags))
+ (put-text-property pos (point) 'notmuch-search-result result))))
+
+(defun notmuch-search-append-result (result)
+ "Insert RESULT at the end of the buffer.
+
+This is only called when a result is first inserted so it also
+sets the :orig-tag property."
+ (let ((new-result (plist-put result :orig-tags (plist-get result :tags)))
+ (pos (point-max)))
+ (notmuch-search-show-result new-result pos)
+ (when (string= (plist-get result :thread) notmuch-search-target-thread)
+ (setq notmuch-search-target-thread "found")
+ (goto-char pos))))
(defun notmuch-search-process-filter (proc string)
"Process and filter the output of \"notmuch search\""
@@ -784,7 +793,7 @@ (defun notmuch-search-process-filter (proc string)
(save-excursion
(goto-char (point-max))
(insert string))
- (notmuch-sexp-parse-partial-list 'notmuch-search-show-result
+ (notmuch-sexp-parse-partial-list 'notmuch-search-append-result
results-buf)))))
(defun notmuch-search-tag-all (tag-changes)
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* [Patch v3 8/8] emacs: tree: use orig-tags in search
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
` (6 preceding siblings ...)
2014-03-12 4:09 ` [Patch v3 7/8] emacs: search: use orig-tags in search Mark Walters
@ 2014-03-12 4:09 ` Mark Walters
7 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-12 4:09 UTC (permalink / raw)
To: notmuch, amdragon
This uses the recent functionality to show the tag changes in the tree
buffer. Currently this is only used to show changes the tree buffer
makes itself: i.e., it does not make display any changes reflecting
tagging done by other notmuch-buffers.
---
emacs/notmuch-tree.el | 9 ++++++---
1 files changed, 6 insertions(+), 3 deletions(-)
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 8bf2fbc..7d5f475 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -701,10 +701,11 @@ (defun notmuch-tree-format-field (field format-string msg)
((string-equal field "tags")
(let ((tags (plist-get msg :tags))
+ (orig-tags (plist-get msg :orig-tags))
(face (if match
'notmuch-tree-match-tag-face
'notmuch-tree-no-match-tag-face)))
- (format format-string (notmuch-tag-format-tags tags tags face)))))))
+ (format format-string (notmuch-tag-format-tags tags orig-tags face)))))))
(defun notmuch-tree-format-field-list (field-list msg)
"Format fields of MSG according to FIELD-LIST and return string"
@@ -766,8 +767,10 @@ (defun notmuch-tree-insert-tree (tree depth tree-status first last)
(push "├" tree-status)))
(push (concat (if replies "┬" "─") "►") tree-status)
- (plist-put msg :first (and first (eq 0 depth)))
- (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
+ (setq msg (plist-put msg :first (and first (eq 0 depth))))
+ (setq msg (plist-put msg :tree-status tree-status))
+ (setq msg (plist-put msg :orig-tags (plist-get msg :tags)))
+ (notmuch-tree-goto-and-insert-msg msg)
(pop tree-status)
(pop tree-status)
--
1.7.9.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* Re: [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats
2014-03-12 4:09 ` [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats Mark Walters
@ 2014-03-22 2:16 ` Austin Clements
2014-03-22 7:47 ` Mark Walters
0 siblings, 1 reply; 15+ messages in thread
From: Austin Clements @ 2014-03-22 2:16 UTC (permalink / raw)
To: Mark Walters; +Cc: notmuch
Quoth Mark Walters on Mar 12 at 4:09 am:
> Add customize options for deleted/added tag formats. These are not
> used yet but will be later in the series.
>
> We switch to using `notmuch-apply-face' rather than `propertize' in
> the defcustom for faces so that the faces for deleted/added tags add
> to the default face attributes for the tag.
>
> We special case deleting the unread tag as that tag is a strong visual
> cue and we don't need that cue when we are just saying it used to be
> unread. Thus, we revert to the normal tag face with strikethough for
> deleted unread tags.
> ---
> emacs/notmuch-tag.el | 37 ++++++++++++++++++++++++++++++++++++-
> 1 files changed, 36 insertions(+), 1 deletions(-)
>
> diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
> index a4dea39..4698856 100644
> --- a/emacs/notmuch-tag.el
> +++ b/emacs/notmuch-tag.el
> @@ -39,7 +39,7 @@ (define-widget 'notmuch-tag-format-type 'lazy
> (string :tag "Display as")
> (list :tag "Face" :extra-offset -4
> (const :format "" :inline t
> - (propertize tag 'face))
> + (notmuch-apply-face tag))
> (list :format "%v"
> (const :format "" quote)
> custom-face-edit))
> @@ -89,6 +89,41 @@ (defcustom notmuch-tag-formats
> :group 'notmuch-show
> :type 'notmuch-tag-format-type)
>
> +(defcustom notmuch-tag-deleted-formats
> + '(("unread" (notmuch-apply-face "unread"
> + (if (display-supports-face-attributes-p '(:strike-through "red"))
> + '(:strike-through "red")
> + '(:inverse-video t))))
> + (".*" (notmuch-apply-face tag
> + (if (display-supports-face-attributes-p '(:strike-through "red"))
> + '(:strike-through "red")
> + '(:inverse-video t)))))
Aren't the two formatters above the same thing? Is this somehow
different from just having the .* formatter? The indentation also
seems a little odd, though that may just be the diff.
> + "Custom formats for tags when deleted.
> +
> +For deleted tags the formats in `notmuch-tag-formats` are applied
> +first and then these formats are applied on top.
> +
> +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
> + '((".*" (notmuch-apply-face tag '(:underline "green"))))
> + "Custom formats for tags when added.
> +
> +For added tags the formats in `notmuch-tag-formats` are applied
> +first and then these formats are applied on top.
Maybe add
To disable special formatting of added tags, set this to ().
to parallel notmuch-tag-deleted-formats?
> +
> +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.
>
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
2014-03-12 4:09 ` [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded Mark Walters
@ 2014-03-22 3:39 ` Austin Clements
2014-03-22 7:56 ` Mark Walters
2014-03-22 8:35 ` Mark Walters
0 siblings, 2 replies; 15+ messages in thread
From: Austin Clements @ 2014-03-22 3:39 UTC (permalink / raw)
To: Mark Walters; +Cc: notmuch
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)
(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)))))
(setq formatted (notmuch-tag--do-format
(notmuch-tag--do-format tag) base over))
(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)))))))
(defun notmuch-tag--do-format (tag formats)
"Apply a tag-formats entry to TAG."
(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)))))
(Completely untested and all indented with spaces and probably
incorrectly because I wrote it all in my email buffer, but you get the
idea.)
> (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)))
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats
2014-03-22 2:16 ` Austin Clements
@ 2014-03-22 7:47 ` Mark Walters
0 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-22 7:47 UTC (permalink / raw)
To: Austin Clements; +Cc: notmuch
Hi
Many thanks for the review.
On Sat, 22 Mar 2014, Austin Clements <amdragon@MIT.EDU> wrote:
> Quoth Mark Walters on Mar 12 at 4:09 am:
>> Add customize options for deleted/added tag formats. These are not
>> used yet but will be later in the series.
>>
>> We switch to using `notmuch-apply-face' rather than `propertize' in
>> the defcustom for faces so that the faces for deleted/added tags add
>> to the default face attributes for the tag.
>>
>> We special case deleting the unread tag as that tag is a strong visual
>> cue and we don't need that cue when we are just saying it used to be
>> unread. Thus, we revert to the normal tag face with strikethough for
>> deleted unread tags.
>> ---
>> emacs/notmuch-tag.el | 37 ++++++++++++++++++++++++++++++++++++-
>> 1 files changed, 36 insertions(+), 1 deletions(-)
>>
>> diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
>> index a4dea39..4698856 100644
>> --- a/emacs/notmuch-tag.el
>> +++ b/emacs/notmuch-tag.el
>> @@ -39,7 +39,7 @@ (define-widget 'notmuch-tag-format-type 'lazy
>> (string :tag "Display as")
>> (list :tag "Face" :extra-offset -4
>> (const :format "" :inline t
>> - (propertize tag 'face))
>> + (notmuch-apply-face tag))
>> (list :format "%v"
>> (const :format "" quote)
>> custom-face-edit))
>> @@ -89,6 +89,41 @@ (defcustom notmuch-tag-formats
>> :group 'notmuch-show
>> :type 'notmuch-tag-format-type)
>>
>> +(defcustom notmuch-tag-deleted-formats
>> + '(("unread" (notmuch-apply-face "unread"
>> + (if (display-supports-face-attributes-p '(:strike-through "red"))
>> + '(:strike-through "red")
>> + '(:inverse-video t))))
>> + (".*" (notmuch-apply-face tag
>> + (if (display-supports-face-attributes-p '(:strike-through "red"))
>> + '(:strike-through "red")
>> + '(:inverse-video t)))))
>
> Aren't the two formatters above the same thing? Is this somehow
> different from just having the .* formatter? The indentation also
> seems a little odd, though that may just be the diff.
These are not the same because these functions apply to tag which is the
partially formatted tag, not tag itself. Thus the latter applies the
above formatting to the string "unread" rather than `tag' which would be
the string unread with previous formatting applied.
It might be nice to change the name in the function so a formatter has
access to tag and formatted-tag but that would break people's existing
formats.
>
>> + "Custom formats for tags when deleted.
>> +
>> +For deleted tags the formats in `notmuch-tag-formats` are applied
>> +first and then these formats are applied on top.
>> +
>> +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
>> + '((".*" (notmuch-apply-face tag '(:underline "green"))))
>> + "Custom formats for tags when added.
>> +
>> +For added tags the formats in `notmuch-tag-formats` are applied
>> +first and then these formats are applied on top.
>
> Maybe add
>
> To disable special formatting of added tags, set this to ().
>
> to parallel notmuch-tag-deleted-formats?
Yes this is a good point as it is not obvious what the correct form is
as it is different from the deleted case (here we want to apply no
further formatting to the tag so it shows as normal, there we wanted to
hide the tag)
Best wishes
Mark
>
>> +
>> +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.
>>
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
2014-03-22 3:39 ` Austin Clements
@ 2014-03-22 7:56 ` Mark Walters
2014-03-22 8:35 ` Mark Walters
1 sibling, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-22 7:56 UTC (permalink / raw)
To: Austin Clements; +Cc: notmuch
On Sat, 22 Mar 2014, Austin Clements <amdragon@MIT.EDU> 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.
Fixed.
>
>> +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.
I think the code is OK: it only hits the cache if it has already got an
entry for the pair (tag tag-state) which means it worked it out before
and that used formatted-tag.
So my code looks in the cache twice for a deleted tag once to find the
partially formatted tag from default formatting which it then ignores
and looks up the fully formatted tag with deleted formatting applied
too. In the case that we have already seen the partially formatted tag
but not the fully formatted tag we look the partially formatted tag in
the cache and then work out and store the fully formatted tag.
In comparison your code looks up (tag tag-state) in the cache, if it's
there then it returns that and is done, if it is not then it calculates
it from scratch. In particular your code does not look to see if we
already have the partially formatted tag in the cache (nor, if we meet
the deleted case first, does it save the partially formatted tag in the
cache).
Of course, the efficiency differences are totally trivial: I only
mention them to try and show how the two versions differ.
I think your version is clearer so will try something along those lines.
>
> 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)
> (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)))))
> (setq formatted (notmuch-tag--do-format
> (notmuch-tag--do-format tag) base over))
> (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)))))))
>
> (defun notmuch-tag--do-format (tag formats)
> "Apply a tag-formats entry to TAG."
> (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)))))
>
> (Completely untested and all indented with spaces and probably
> incorrectly because I wrote it all in my email buffer, but you get the
> idea.)
>
>> (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 ...
I have gone with what you suggested on irc: making the nil case the
otherwise case.
Best wishes
Mark
>
>> + (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)))
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
2014-03-22 3:39 ` Austin Clements
2014-03-22 7:56 ` Mark Walters
@ 2014-03-22 8:35 ` Mark Walters
2014-03-22 11:44 ` Mark Walters
1 sibling, 1 reply; 15+ messages in thread
From: Mark Walters @ 2014-03-22 8:35 UTC (permalink / raw)
To: Austin Clements; +Cc: notmuch
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 <amdragon@MIT.EDU> 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)))
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
2014-03-22 8:35 ` Mark Walters
@ 2014-03-22 11:44 ` Mark Walters
0 siblings, 0 replies; 15+ messages in thread
From: Mark Walters @ 2014-03-22 11:44 UTC (permalink / raw)
To: Austin Clements; +Cc: notmuch
On Sat, 22 Mar 2014, Mark Walters <markwalters1009@gmail.com> wrote:
> 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 <amdragon@MIT.EDU> 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.
Ok I have realised I was wrong and your version was fine (as the choice
of formats was already made). However, I do still pass the unformatted
tag so that the formatter can access that as `bare-tag'.
>> (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)))))
More importantly I was getting (erratic) weird effects because some of
these changes changed tag (and even the copy of tag outside this
function). I fixed this by using copy-sequence for the second let
clause.
Best wishes
Mark
> 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)))
^ permalink raw reply [flat|nested] 15+ messages in thread
end of thread, other threads:[~2014-03-22 11:44 UTC | newest]
Thread overview: 15+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-03-12 4:09 [Patch v3 0/8] emacs: show tag changes in buffer Mark Walters
2014-03-12 4:09 ` [Patch v3 1/8] emacs: Combine notmuch-combine-face-text-property{, -string} Mark Walters
2014-03-12 4:09 ` [Patch v3 2/8] Make keys of notmuch-tag-formats regexps and use caching Mark Walters
2014-03-12 4:09 ` [Patch v3 3/8] emacs: tag split customise option for format-tags into a widget Mark Walters
2014-03-12 4:09 ` [Patch v3 4/8] emacs: tag: add customize for deleted/added tag formats Mark Walters
2014-03-22 2:16 ` Austin Clements
2014-03-22 7:47 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 5/8] emacs: show: mark tags changed since buffer loaded Mark Walters
2014-03-22 3:39 ` Austin Clements
2014-03-22 7:56 ` Mark Walters
2014-03-22 8:35 ` Mark Walters
2014-03-22 11:44 ` Mark Walters
2014-03-12 4:09 ` [Patch v3 6/8] emacs: show: use orig-tags for tag display Mark Walters
2014-03-12 4:09 ` [Patch v3 7/8] emacs: search: use orig-tags in search Mark Walters
2014-03-12 4:09 ` [Patch v3 8/8] emacs: tree: " Mark Walters
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).