[PATCH WIP v3 0/3] emacs: show: change the unread handling

[PATCH WIP v3 0/3] emacs: show: change the unread handling

[Mark Walters]

This is the next iteration of this WIP patch series. v2 was at
id:1385892147-16994-1-git-send-email-markwalters1009@gmail.com

I would just like to emphasise that *all* feedback is appreciated
including "I HATE IT" etc. 

I have followed Jani's suggestion and removed the delayed updates to
unread status: it makes it harder to see if the heuristics are doing
what you want.

The first patch is completely new: it makes all tag changes in a
buffer (in particular the unread tag) clearly visible to the user: a
deleted tag is displayed with red strike-through and an added tag is
displayed underlined in green.  (This may have strange interactions with
notmuch-tag-formats in some cases.)

This makes the visual feedback when a message is marked unread very
clear: the unread tag is struck-through.

As always with the previous series lots of tests will fail for the
obvious reason that marking read is done differently and displayed
differently.

Best wishes

Mark




Mark Walters (3):
  emacs: show: mark tags changed since buffer loaded
  emacs: show: add an update seen function to post-command-hook
  emacs: show: make `seen' mean user viewed whole message

 emacs/notmuch-show.el |  136 +++++++++++++++++++++++++++++++++++++++++-------
 emacs/notmuch-tag.el  |   30 +++++++----
 2 files changed, 136 insertions(+), 30 deletions(-)

-- 
1.7.9.1

[PATCH WIP v3 1/3] emacs: show: mark tags changed since buffer loaded

[Mark Walters]

This shows any tags changed in the show buffer since it was loaded or
refreshed. By default a removed tag is displayed with strike-through
in red and an added tag is displayed underlined in green.

One nice feature is that this makes it clear when a message was unread
when you first loaded the buffer (previously the unread tag could be
removed before a user realised that it had been unread).
---
 emacs/notmuch-show.el |   34 +++++++++++++++++++++++++++++-----
 emacs/notmuch-tag.el  |   30 ++++++++++++++++++++----------
 2 files changed, 49 insertions(+), 15 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 784644c..d64d407 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -211,6 +211,18 @@ For example, if you wanted to remove an \"unread\" tag and add a
   :type '(repeat string)
   :group 'notmuch-show)
 
+(defface notmuch-show-deleted-tag-face
+  '((t :strike-through "red" :inherit 'notmuch-tag-face))
+  "Face for tags that have been removed"
+  :group 'notmuch-show
+  :group 'notmuch-faces)
+
+(defface notmuch-show-added-tag-face
+  '((t :underline "green"))
+  "Face for tags that have been added"
+  :group 'notmuch-show
+  :group 'notmuch-faces)
+
 
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
@@ -341,11 +353,21 @@ operation on the contents of the current buffer."
   "Update the displayed tags of the current message."
   (save-excursion
     (goto-char (notmuch-show-message-top))
-    (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
-	(let ((inhibit-read-only t))
-	  (replace-match (concat "("
-				 (notmuch-tag-format-tags tags)
-				 ")"))))))
+    (let* ((orig-tags (notmuch-show-get-prop :orig-tags))
+	   (all-tags (sort (delete-dups (append tags orig-tags)) #'string<))
+	   (display-tags (mapcar (lambda (tag) (cond ((and (member tag tags) (member tag orig-tags))
+						      tag)
+						     ((not (member tag tags))
+						      (cons tag 'deleted))
+						     ((not (member tag orig-tags))
+						      (cons tag 'added))))
+				 all-tags)))
+
+      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
+	  (let ((inhibit-read-only t))
+	    (replace-match (concat "("
+				   (notmuch-tag-format-tags display-tags)
+				   ")")))))))
 
 (defun notmuch-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return a cons
@@ -1167,6 +1189,8 @@ function is used."
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
+      (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
+
       ;; Set the header line to the subject of the first message.
       (setq header-line-format (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject))))
 
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index b60f46c..fac2c3b 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -137,16 +137,26 @@ This can be used with `notmuch-tag-format-image-data'."
 
 (defun notmuch-tag-format-tag (tag)
   "Format TAG by looking into `notmuch-tag-formats'."
-  (let ((formats (assoc tag notmuch-tag-formats)))
-    (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))))))))
+  (let* ((status (if (consp tag) (cdr tag)))
+	 (tag (if (consp tag) (car tag) tag))
+	 (formats (append (assoc tag notmuch-tag-formats)))
+	 (tag
+	  (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))))))))
+    (when tag
+      (cond
+       ((eq status 'deleted)
+	(notmuch-combine-face-text-property-string tag 'notmuch-show-deleted-tag-face))
+       ((eq status 'added)
+	(notmuch-combine-face-text-property-string tag 'notmuch-show-added-tag-face))
+       (t tag)))))
 
 (defun notmuch-tag-format-tags (tags)
   "Return a string representing formatted TAGS."
-- 
1.7.9.1

Re: [PATCH WIP v3 1/3] emacs: show: mark tags changed since buffer loaded

[Jani Nikula]

On Thu, 05 Dec 2013, Mark Walters <markwalters1009@gmail.com> wrote:
> This shows any tags changed in the show buffer since it was loaded or
> refreshed. By default a removed tag is displayed with strike-through
> in red and an added tag is displayed underlined in green.
>
> One nice feature is that this makes it clear when a message was unread
> when you first loaded the buffer (previously the unread tag could be
> removed before a user realised that it had been unread).

I really like how this works. Very nice!

I did notice a small wrinkle though. On a terminal the strike-through
does not work, and the appearance is that the tag was not removed (until
you refresh with '='). I don't know if you can easily adapt the face or
disable the whole feature when on terminal. Or make this an opt-in
feature. I guess some people might not like this in general, so a way to
disable might be a good idea too. Fine tuning.

BR,
Jani.




> ---
>  emacs/notmuch-show.el |   34 +++++++++++++++++++++++++++++-----
>  emacs/notmuch-tag.el  |   30 ++++++++++++++++++++----------
>  2 files changed, 49 insertions(+), 15 deletions(-)
>
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 784644c..d64d407 100644
> --- a/emacs/notmuch-show.el
> +++ b/emacs/notmuch-show.el
> @@ -211,6 +211,18 @@ For example, if you wanted to remove an \"unread\" tag and add a
>    :type '(repeat string)
>    :group 'notmuch-show)
>  
> +(defface notmuch-show-deleted-tag-face
> +  '((t :strike-through "red" :inherit 'notmuch-tag-face))
> +  "Face for tags that have been removed"
> +  :group 'notmuch-show
> +  :group 'notmuch-faces)
> +
> +(defface notmuch-show-added-tag-face
> +  '((t :underline "green"))
> +  "Face for tags that have been added"
> +  :group 'notmuch-show
> +  :group 'notmuch-faces)
> +
>  
>  (defmacro with-current-notmuch-show-message (&rest body)
>    "Evaluate body with current buffer set to the text of current message"
> @@ -341,11 +353,21 @@ operation on the contents of the current buffer."
>    "Update the displayed tags of the current message."
>    (save-excursion
>      (goto-char (notmuch-show-message-top))
> -    (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
> -	(let ((inhibit-read-only t))
> -	  (replace-match (concat "("
> -				 (notmuch-tag-format-tags tags)
> -				 ")"))))))
> +    (let* ((orig-tags (notmuch-show-get-prop :orig-tags))
> +	   (all-tags (sort (delete-dups (append tags orig-tags)) #'string<))
> +	   (display-tags (mapcar (lambda (tag) (cond ((and (member tag tags) (member tag orig-tags))
> +						      tag)
> +						     ((not (member tag tags))
> +						      (cons tag 'deleted))
> +						     ((not (member tag orig-tags))
> +						      (cons tag 'added))))
> +				 all-tags)))
> +
> +      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
> +	  (let ((inhibit-read-only t))
> +	    (replace-match (concat "("
> +				   (notmuch-tag-format-tags display-tags)
> +				   ")")))))))
>  
>  (defun notmuch-clean-address (address)
>    "Try to clean a single email ADDRESS for display. Return a cons
> @@ -1167,6 +1189,8 @@ function is used."
>  
>        (jit-lock-register #'notmuch-show-buttonise-links)
>  
> +      (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
> +
>        ;; Set the header line to the subject of the first message.
>        (setq header-line-format (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject))))
>  
> diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
> index b60f46c..fac2c3b 100644
> --- a/emacs/notmuch-tag.el
> +++ b/emacs/notmuch-tag.el
> @@ -137,16 +137,26 @@ This can be used with `notmuch-tag-format-image-data'."
>  
>  (defun notmuch-tag-format-tag (tag)
>    "Format TAG by looking into `notmuch-tag-formats'."
> -  (let ((formats (assoc tag notmuch-tag-formats)))
> -    (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))))))))
> +  (let* ((status (if (consp tag) (cdr tag)))
> +	 (tag (if (consp tag) (car tag) tag))
> +	 (formats (append (assoc tag notmuch-tag-formats)))
> +	 (tag
> +	  (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))))))))
> +    (when tag
> +      (cond
> +       ((eq status 'deleted)
> +	(notmuch-combine-face-text-property-string tag 'notmuch-show-deleted-tag-face))
> +       ((eq status 'added)
> +	(notmuch-combine-face-text-property-string tag 'notmuch-show-added-tag-face))
> +       (t tag)))))
>  
>  (defun notmuch-tag-format-tags (tags)
>    "Return a string representing formatted TAGS."
> -- 
> 1.7.9.1
>
> _______________________________________________
> notmuch mailing list
> notmuch@notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch

[PATCH WIP v3 2/3] emacs: show: add an update seen function to post-command-hook

[Mark Walters]

Add a function stub for updating seen messages to the
post-command-hook. This dummy function gets called with parameters the
start and end of the current window and can decide what to mark seen
based on that.

Since this is in the post-command-hook it should get called after most
user actions (exceptions include user resizing the window) so it
should be possible to make sure the seen status gets updated whether
the user uses notmuch commands like next-message or normal emacs
commands like scroll-up.

It also removes all of the old mark read/seen points to give a clean
slate for testing new mark read/seen algorithms.
---
 emacs/notmuch-show.el |   32 +++++++++++++++++---------------
 1 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index d64d407..7d0ac5d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1164,6 +1164,8 @@ function is used."
   (let ((inhibit-read-only t))
 
     (notmuch-show-mode)
+    (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
+
     ;; Don't track undo information for this buffer
     (set 'buffer-undo-list t)
 
@@ -1549,6 +1551,16 @@ marked as unread, i.e. the tag changes in
     (apply 'notmuch-show-tag-message
 	   (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
 
+(defun notmuch-show-do-seen (start end)
+  "Update seen status for all messages between start and end."
+  )
+
+(defun notmuch-show-command-hook ()
+  (when (eq major-mode 'notmuch-show-mode)
+    ;; We need to redisplay to get window-start and window-end correct.
+    (redisplay)
+    (notmuch-show-do-seen (window-start) (window-end))))
+
 ;; Functions for getting attributes of several messages in the current
 ;; thread.
 
@@ -1684,9 +1696,7 @@ If a prefix argument is given and this is the last message in the
 thread, navigate to the next thread in the parent search buffer."
   (interactive "P")
   (if (notmuch-show-goto-message-next)
-      (progn
-	(notmuch-show-mark-read)
-	(notmuch-show-message-adjust))
+      (notmuch-show-message-adjust)
     (if pop-at-end
 	(notmuch-show-next-thread)
       (goto-char (point-max)))))
@@ -1697,7 +1707,6 @@ thread, navigate to the next thread in the parent search buffer."
   (if (= (point) (notmuch-show-message-top))
       (notmuch-show-goto-message-previous)
     (notmuch-show-move-to-message-top))
-  (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
 
 (defun notmuch-show-next-open-message (&optional pop-at-end)
@@ -1712,9 +1721,7 @@ to show, nil otherwise."
     (while (and (setq r (notmuch-show-goto-message-next))
 		(not (notmuch-show-message-visible-p))))
     (if r
-	(progn
-	  (notmuch-show-mark-read)
-	  (notmuch-show-message-adjust))
+	(notmuch-show-message-adjust)
       (if pop-at-end
 	  (notmuch-show-next-thread)
 	(goto-char (point-max))))
@@ -1727,9 +1734,7 @@ to show, nil otherwise."
     (while (and (setq r (notmuch-show-goto-message-next))
 		(not (notmuch-show-get-prop :match))))
     (if r
-	(progn
-	  (notmuch-show-mark-read)
-	  (notmuch-show-message-adjust))
+	(notmuch-show-message-adjust)
       (goto-char (point-max)))))
 
 (defun notmuch-show-open-if-matched ()
@@ -1740,8 +1745,7 @@ to show, nil otherwise."
 (defun notmuch-show-goto-first-wanted-message ()
   "Move to the first open message and mark it read"
   (goto-char (point-min))
-  (if (notmuch-show-message-visible-p)
-      (notmuch-show-mark-read)
+  (unless (notmuch-show-message-visible-p)
     (notmuch-show-next-open-message))
   (when (eobp)
     ;; There are no matched non-excluded messages so open all matched
@@ -1749,8 +1753,7 @@ to show, nil otherwise."
     (notmuch-show-mapc 'notmuch-show-open-if-matched)
     (force-window-update)
     (goto-char (point-min))
-    (if (notmuch-show-message-visible-p)
-	(notmuch-show-mark-read)
+    (unless (notmuch-show-message-visible-p)
       (notmuch-show-next-open-message))))
 
 (defun notmuch-show-previous-open-message ()
@@ -1760,7 +1763,6 @@ to show, nil otherwise."
 		  (notmuch-show-goto-message-previous)
 		(notmuch-show-move-to-message-top))
 	      (not (notmuch-show-message-visible-p))))
-  (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
 
 (defun notmuch-show-view-raw-message ()
-- 
1.7.9.1

[PATCH WIP v3 3/3] emacs: show: make `seen' mean user viewed whole message

[Mark Walters]

This changes `seen' to mean that the user viewed `enough' of the whole
message: more precisely, a message is deemed seen if the top of the
message and either the bottom of the message or a point at least some
customisable number of lines into the message have each been visible
in the buffer at some point.

This is placed into the post-command-hook infrastructure introudced in
the previous patch.
---
 emacs/notmuch-show.el |   74 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 72 insertions(+), 2 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 7d0ac5d..6451314 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -211,6 +211,20 @@ For example, if you wanted to remove an \"unread\" tag and add a
   :type '(repeat string)
   :group 'notmuch-show)
 
+(defcustom notmuch-show-seen-lines-needed 0.75
+  "Control which messages get marked seen.
+
+A message is marked seen if both the top of the message and a
+point far \"enough\" down in the message have each been visible
+in the buffer at some point. This parameter controls the
+definition of enough.  Seeing the bottom of message is always
+deemed enough, but additionally...it an integer n then at least n
+lines of message must be visible in the window. If it is a float
+x then at least that proportion of the window must contain the
+message."
+  :type 'number
+  :group 'notmuch-show)
+
 (defface notmuch-show-deleted-tag-face
   '((t :strike-through "red" :inherit 'notmuch-tag-face))
   "Face for tags that have been removed"
@@ -1551,9 +1565,65 @@ marked as unread, i.e. the tag changes in
     (apply 'notmuch-show-tag-message
 	   (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
 
+(defun notmuch-show-update-seen (top-or-bottom)
+  "Update seen status of current message
+
+Mark that we have seen the TOP-OR-BOTTOM of current message."
+  (let* ((current (notmuch-show-get-prop :seen-local))
+	 new)
+    (unless (eq current 'both)
+      (if (eq top-or-bottom 'top)
+	  (if (eq current 'bottom)
+	      (setq new 'both)
+	    (setq new 'top))
+	(if (eq current 'top)
+	    (setq new 'both)
+	  (setq new 'bottom)))
+      (unless (eq current new)
+	(notmuch-show-set-prop :seen-local new))
+      (when (eq new 'both)
+	(notmuch-show-mark-read)))))
+
+(defun notmuch-show-do-message-seen (start end)
+  "Update seen status for the current message.
+
+A message is seen if both the top and enough of the rest of the
+message have been visible in the buffer.  Enough means either the
+bottom of the message or a point in the message more than
+LINES-NEEDED lines into the message. LINES-NEEDED is
+`notmuch-show-seen-lines-needed` if that is an integer and that
+times the current window height if it is a float."
+  (let* ((lines-needed (if (integerp notmuch-show-seen-lines-needed)
+			   notmuch-show-seen-lines-needed
+			 (truncate (* notmuch-show-seen-lines-needed (window-body-height)))))
+	 (top (notmuch-show-message-top))
+	 (bottom (notmuch-show-message-bottom)))
+    (when (notmuch-show-message-visible-p)
+      (when (>= top start)
+	(notmuch-show-update-seen 'top))
+      (when (or (<= bottom end)
+		(> (count-screen-lines top end) lines-needed))
+	(notmuch-show-update-seen 'bottom)))))
+
 (defun notmuch-show-do-seen (start end)
-  "Update seen status for all messages between start and end."
-  )
+  "Update seen status for all messages between start and end.
+
+A message is seen if both the top and enough of the rest of the
+message have been visible in the buffer. See
+`notmuch-show-do-message-seen` for the definition of enough. Seen
+is a buffer local property. The unread status is removed from all
+seen messages when the user quits the show buffer."
+  (save-excursion
+    (goto-char start)
+    (while (and (or (notmuch-show-do-message-seen start end) t)
+		(< (notmuch-show-message-bottom) end)
+		(notmuch-show-goto-message-next)))
+
+    ;; This is a work around because emacs gives weird answers for
+    ;; window-end if the buffer ends with invisible text.
+    (when (and (pos-visible-in-window-p (point-max))
+	       (notmuch-show-message-visible-p))
+      (notmuch-show-update-seen 'bottom))))
 
 (defun notmuch-show-command-hook ()
   (when (eq major-mode 'notmuch-show-mode)
-- 
1.7.9.1

Re: [PATCH WIP v3 0/3] emacs: show: change the unread handling

[Jani Nikula]

On Thu, 05 Dec 2013, Mark Walters <markwalters1009@gmail.com> wrote:
> This is the next iteration of this WIP patch series. v2 was at
> id:1385892147-16994-1-git-send-email-markwalters1009@gmail.com
>
> I would just like to emphasise that *all* feedback is appreciated
> including "I HATE IT" etc. 

I LIKE IT. :)

It's not perfect, but IMHO it's a nice, incremental improvement over
what we have, and it's discoverable: you can see what it does and
when. If anything is surprising, the user has a better chance of
explaining what happened, and what he liked and didn't.

Good work, Mark!

BR,
Jani.


PS. I didn't look at the code, I only tried it.


> I have followed Jani's suggestion and removed the delayed updates to
> unread status: it makes it harder to see if the heuristics are doing
> what you want.
>
> The first patch is completely new: it makes all tag changes in a
> buffer (in particular the unread tag) clearly visible to the user: a
> deleted tag is displayed with red strike-through and an added tag is
> displayed underlined in green.  (This may have strange interactions with
> notmuch-tag-formats in some cases.)
>
> This makes the visual feedback when a message is marked unread very
> clear: the unread tag is struck-through.
>
> As always with the previous series lots of tests will fail for the
> obvious reason that marking read is done differently and displayed
> differently.
>
> Best wishes
>
> Mark
>
>
>
>
> Mark Walters (3):
>   emacs: show: mark tags changed since buffer loaded
>   emacs: show: add an update seen function to post-command-hook
>   emacs: show: make `seen' mean user viewed whole message
>
>  emacs/notmuch-show.el |  136 +++++++++++++++++++++++++++++++++++++++++-------
>  emacs/notmuch-tag.el  |   30 +++++++----
>  2 files changed, 136 insertions(+), 30 deletions(-)
>
> -- 
> 1.7.9.1
>
> _______________________________________________
> notmuch mailing list
> notmuch@notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch