[PATCH WIP] emacs: show: redesign unread/read logic
Mark Walters
markwalters1009 at gmail.com
Sun Nov 24 01:32:31 PST 2013
The decisions of when to mark messages read in notmuch-show has caused
confusion/irritation (several discussions on irc and the mailing list
eg the thread starting at id:87hadi0xse.fsf at boo.workgroup). This is an
attempt to get some logic that people are happier with.
Some examples of the current problems are: notmuch marks sometimes
closed messages read, notmuch does not mark messages read if you page
down through them, and notmuch removes the unread tag too soon: when
you first see the message you do not if you have read it before.
The patch separates out two things "seeing" a message and "marking it
read".
A message is deemed seen if both the top and bottom of the message
have both been visible in the buffer's window. This is chosen so that
just seeing 1 or 2 lines of a message at the bottom of the window does
not mark it seen. A closed message is never marked seen.
The seen status is updated via a command-hook (run on every
command/key-press) so essentially any change which sees a message
should mark it as seen.
By default the unread status of seen messages is not updated until the
user quits the show buffer, and the user has the option of prefix-arg
quit to exit the show buffer without updating the unread status.
However, if the user sets the custom variable
notmuch-show-update-unread-on-seen then the unread status is updated
(ie unread tag is removed) as soon as a message is seen (in the above
sense).
---
This patch brings the unread handling roughly in line with what I
would expect, and is reasonably close to the suggestions from Austin
id:20131005162202.GJ21611 at mit.edu and Jani
id:87vc1aho64.fsf at nikula.org. It was also clear from the discussion
that different people want different things so we will need some
customisation possibilities.
It is a large patch: I am afraid I don't see a way round that.
At the moment there are two things that need fixing: first tree-view
assumes the old behaviour so its displayed tags get out of sync with
the actual tags. Secondly, a lot of tests fail for the obvious reason
that the unread tag is not removed at the same time as before.
It would be very helpful if people could test and see whether it works
as they would like, and if not say why/when it is doing the wrong
thing and what it should do in those cases.
Best wishes
Mark
emacs/notmuch-show.el | 151 ++++++++++++++++++++++++++++++++++++++++++++-----
emacs/notmuch-tree.el | 20 +++++--
2 files changed, 151 insertions(+), 20 deletions(-)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 784644c..1081eb0 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -168,6 +168,10 @@ each attachment handler is logged in buffers with names beginning
\" *notmuch-part*\". This option requires emacs version at least
24.3 to work.")
+(defvar notmuch-show-seen-plist nil)
+(make-variable-buffer-local 'notmuch-show-seen-plist)
+(put 'notmuch-show-seen-plist 'permanent-local t)
+
(defcustom notmuch-show-stash-mlarchive-link-alist
'(("Gmane" . "http://mid.gmane.org/")
("MARC" . "http://marc.info/?i=")
@@ -211,6 +215,15 @@ For example, if you wanted to remove an \"unread\" tag and add a
:type '(repeat string)
:group 'notmuch-show)
+(defcustom notmuch-show-update-unread-on-seen nil
+ "Update unread tags when seen rathe than when exiting show buffer.
+
+A message is seen if the top and bottom of the message have both
+been visible in the buffer. When this is nil the unread status is
+updated on exiting the show buffer. When this is t the unread
+status is updated as soon as the message is seen."
+ :type 'boolean
+ :group 'notmuch-show)
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
@@ -1142,6 +1155,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)
@@ -1213,6 +1228,12 @@ preferences. If invoked with a prefix argument (or RESET-STATE is
non-nil) then the state of the buffer (open/closed messages) is
reset based on the original query."
(interactive "P")
+ ;; Do not mark seen messages read if we are resetting state. The
+ ;; idea is that resetting state is asking for the view to be reset
+ ;; to the current state of the database.
+ (unless notmuch-show-update-unread-on-seen
+ (notmuch-show-mark-all-seen-read reset-state))
+
(let ((inhibit-read-only t)
(state (unless reset-state
(notmuch-show-capture-state))))
@@ -1258,6 +1279,8 @@ reset based on the original query."
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-common-keymap)
+ ;; the following overrides the common-keymap quit
+ (define-key map [remap notmuch-kill-this-buffer] 'notmuch-show-quit-and-mark-read)
(define-key map "Z" 'notmuch-tree-from-show-current-query)
(define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
@@ -1525,6 +1548,114 @@ 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-is-unread ()
+ "Return t if current message is unread.
+
+Returns t unless applying `notmuch-show-mark-read-tags' would be
+a no-op"
+ (when notmuch-show-mark-read-tags
+ (let* ((current-tags (notmuch-show-get-tags))
+ (tag-changes (notmuch-tag-change-list notmuch-show-mark-read-tags))
+ (new-tags (notmuch-update-tags current-tags tag-changes)))
+ (not (equal current-tags new-tags)))))
+
+(defun notmuch-show-message-seen ()
+ "Return t if top and bottom of current message have been seen."
+ (eq (lax-plist-get notmuch-show-seen-plist
+ (notmuch-show-get-message-id))
+ 'both))
+
+(defun notmuch-show-mark-all-seen-read (&optional not-mark)
+ "Mark read all messages that have been seen in this buffer.
+
+If NOT-MARK then do not mark the messages read, and tell the user
+we are not marking them."
+ (if not-mark
+ (message "Not marking messages read")
+ (let ((messages-to-mark-read))
+ ;; We get a list of all message to tag read. A list means that
+ ;; we can tag all the messages in one tag operation rather than
+ ;; needing one per read message.
+ (notmuch-show-mapc
+ (lambda ()
+ (when (and (notmuch-show-message-seen) (notmuch-show-is-unread))
+ (push (notmuch-show-get-message-id) messages-to-mark-read))))
+ (when messages-to-mark-read
+ (notmuch-tag (mapconcat #'identity messages-to-mark-read " ")
+ (notmuch-tag-change-list notmuch-show-mark-read-tags)))
+ (let ((count (length messages-to-mark-read)))
+ (cond ((> count 1)
+ (message "Marked %s messages read" count))
+ ((= count 1)
+ (message "Marked one message read"))
+ ((= count 0)
+ (message "No messages marked read")))))))
+
+(put 'notmuch-show-quit-and-mark-read 'notmuch-prefix-doc
+ "... without marking seen messages read.")
+(defun notmuch-show-quit-and-mark-read (&optional not-mark)
+ "Kill the current buffer marking seen messages read."
+ (interactive "P")
+ (unless notmuch-show-update-unread-on-seen
+ (notmuch-show-mark-all-seen-read not-mark))
+ (notmuch-kill-this-buffer))
+
+(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* ((id (notmuch-show-get-message-id))
+ (current (lax-plist-get notmuch-show-seen-plist id))
+ 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)
+ (setq notmuch-show-seen-plist (lax-plist-put notmuch-show-seen-plist id new)))
+ (when (and notmuch-show-update-unread-on-seen
+ (eq new 'both))
+ (notmuch-show-mark-read)))))
+
+(defun notmuch-show-mark-message-seen (start end)
+ "Mark top and bottom of current message seen if between START and END."
+ (when (notmuch-show-message-visible-p)
+ (when (>= (notmuch-show-message-top) start)
+ (notmuch-show-update-seen 'top))
+ (when (<= (notmuch-show-message-bottom) end)
+ (notmuch-show-update-seen 'bottom))))
+
+(defun notmuch-show-mark-seen (start end)
+ "Update seen status for all open messages between start and end.
+
+A message is seen if both the top and bottom of the message have
+been visible in the buffer. Seen is a buffer local property. By
+default the unread status is removed from all seen messages when
+the user quits the show buffer. However, if
+`notmuch-show-update-unread-on-seen' is set then the unread
+status is removed as soon as the message is seen."
+ (save-excursion
+ (goto-char start)
+ (notmuch-show-mark-message-seen start end)
+ (while (and (< (notmuch-show-message-bottom) end)
+ (notmuch-show-goto-message-next))
+ (notmuch-show-mark-message-seen start end))
+ ;; 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)
+ ;; We need to redisplay to get window-start and window-end correct.
+ (redisplay)
+ (notmuch-show-mark-seen (window-start) (window-end))))
+
;; Functions for getting attributes of several messages in the current
;; thread.
@@ -1660,9 +1791,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)))))
@@ -1673,7 +1802,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)
@@ -1688,9 +1816,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))))
@@ -1703,9 +1829,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 ()
@@ -1716,8 +1840,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
@@ -1725,8 +1848,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 ()
@@ -1736,7 +1858,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 ()
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 8d59e65..206bd9f 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -487,17 +487,20 @@ Shows in split pane or whole window according to value of
(when (notmuch-tree-scroll-message-window)
(notmuch-tree-next-matching-message)))
-(defun notmuch-tree-quit ()
+(defun notmuch-tree-quit (&optional forget-seen)
"Close the split view or exit tree."
- (interactive)
- (unless (notmuch-tree-close-message-window)
+ (interactive "P")
+ (unless (notmuch-tree-close-message-window forget-seen)
(kill-buffer (current-buffer))))
-(defun notmuch-tree-close-message-window ()
+(defun notmuch-tree-close-message-window (&optional forget-seen)
"Close the message-window. Return t if close succeeds."
- (interactive)
+ (interactive "P")
(when (and (window-live-p notmuch-tree-message-window)
(eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))
+ (unless notmuch-show-update-unread-on-seen
+ (with-selected-window notmuch-tree-message-window
+ (notmuch-show-mark-all-seen-read forget-seen)))
(delete-window notmuch-tree-message-window)
(unless (get-buffer-window-list notmuch-tree-message-buffer)
(kill-buffer notmuch-tree-message-buffer))
@@ -784,6 +787,12 @@ This function inserts a collection of several complete threads as
passed to it by notmuch-tree-process-filter."
(mapc 'notmuch-tree-insert-forest-thread forest))
+(defun notmuch-tree-command-hook ()
+ (when (eq major-mode 'notmuch-tree-mode)
+ (when (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (notmuch-show-command-hook)))))
+
(defun notmuch-tree-mode ()
"Major mode displaying messages (as opposed to threads) of of a notmuch search.
@@ -853,6 +862,7 @@ This is is a helper function for notmuch-tree. The arguments are
the same as for the function notmuch-tree."
(interactive)
(notmuch-tree-mode)
+ (add-hook 'post-command-hook #'notmuch-tree-command-hook nil t)
(setq notmuch-tree-basic-query basic-query)
(setq notmuch-tree-query-context query-context)
(setq notmuch-tree-target-msg target)
--
1.7.9.1
More information about the notmuch
mailing list