[PATCH WIP] emacs: show: redesign unread/read logic
[notmuch-archives.git] / e2 / a4a0f86b9d433e8452b44025c48f9ed2c7e842
1 Return-Path: <markwalters1009@gmail.com>\r
2 X-Original-To: notmuch@notmuchmail.org\r
3 Delivered-To: notmuch@notmuchmail.org\r
4 Received: from localhost (localhost [127.0.0.1])\r
5         by olra.theworths.org (Postfix) with ESMTP id 5249C431FCB\r
6         for <notmuch@notmuchmail.org>; Sun, 24 Nov 2013 01:39:55 -0800 (PST)\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
8 X-Spam-Flag: NO\r
9 X-Spam-Score: 0.224\r
10 X-Spam-Level: \r
11 X-Spam-Status: No, score=0.224 tagged_above=-999 required=5\r
12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
13         FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,\r
14         HS_INDEX_PARAM=0.023, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
15 Received: from olra.theworths.org ([127.0.0.1])\r
16         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
17         with ESMTP id HGMUTnX4A97j for <notmuch@notmuchmail.org>;\r
18         Sun, 24 Nov 2013 01:39:50 -0800 (PST)\r
19 Received: from mail-wg0-f53.google.com (mail-wg0-f53.google.com\r
20  [74.125.82.53])        (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
21  certificate requested) by olra.theworths.org (Postfix) with ESMTPS id\r
22  53053431FC3    for <notmuch@notmuchmail.org>; Sun, 24 Nov 2013 01:39:50 -0800\r
23  (PST)\r
24 Received: by mail-wg0-f53.google.com with SMTP id k14so149659wgh.32\r
25         for <notmuch@notmuchmail.org>; Sun, 24 Nov 2013 01:39:47 -0800 (PST)\r
26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\r
27         h=from:to:cc:subject:date:message-id;\r
28         bh=w20NEW5TIVkDcbu8+azbo1J7UzQ6FwFMS1ubObuq6ok=;\r
29         b=HP8nsDAabampXERYUwCVOF+cZjNAUz11zJGN6yUvvgaTPeAj/i/pOVjxKihaidHqJx\r
30         OBOZEfPlR/+3Y4sLMrvRkjD0RUujz2gAOvvQft0nn/JQGyJUnv2V1ma8+QiSICFk5b6N\r
31         PFssIr2j1dXgeD55apk+PBSFlUoBLc8WBh2dJpyQcLJaD5ZzBNuh4XS/n7b3Kj25Mkm1\r
32         yAlYeKi9iqF1XfJ2eTNjz0O8L0URBxLx7mdq7eyu18ZYt2VykGAvBkFOKaOrpNFEBAV/\r
33         j7qCzI0LgJ8uyVVXVnhNgyvgCyuIFjbIgz0b9uhLbjXSr0LhQMg0A5UN/9snlg7OntZN\r
34         tkvw==\r
35 X-Received: by 10.194.89.105 with SMTP id bn9mr68494wjb.82.1385285563609;\r
36         Sun, 24 Nov 2013 01:32:43 -0800 (PST)\r
37 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])\r
38         by mx.google.com with ESMTPSA id gb1sm34255955wic.0.2013.11.24.01.32.42\r
39         for <multiple recipients>\r
40         (version=TLSv1.2 cipher=RC4-SHA bits=128/128);\r
41         Sun, 24 Nov 2013 01:32:43 -0800 (PST)\r
42 From: Mark Walters <markwalters1009@gmail.com>\r
43 To: notmuch@notmuchmail.org\r
44 Subject: [PATCH WIP] emacs: show: redesign unread/read logic\r
45 Date: Sun, 24 Nov 2013 09:32:31 +0000\r
46 Message-Id: <1385285551-5158-1-git-send-email-markwalters1009@gmail.com>\r
47 X-Mailer: git-send-email 1.7.9.1\r
48 X-BeenThere: notmuch@notmuchmail.org\r
49 X-Mailman-Version: 2.1.13\r
50 Precedence: list\r
51 List-Id: "Use and development of the notmuch mail system."\r
52         <notmuch.notmuchmail.org>\r
53 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
54         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
55 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
56 List-Post: <mailto:notmuch@notmuchmail.org>\r
57 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
58 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
59         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
60 X-List-Received-Date: Sun, 24 Nov 2013 09:39:55 -0000\r
61 \r
62 The decisions of when to mark messages read in notmuch-show has caused\r
63 confusion/irritation (several discussions on irc and the mailing list\r
64 eg the thread starting at id:87hadi0xse.fsf@boo.workgroup). This is an\r
65 attempt to get some logic that people are happier with.\r
66 \r
67 Some examples of the current problems are: notmuch marks sometimes\r
68 closed messages read, notmuch does not mark messages read if you page\r
69 down through them, and notmuch removes the unread tag too soon: when\r
70 you first see the message you do not if you have read it before.\r
71 \r
72 The patch separates out two things "seeing" a message and "marking it\r
73 read".\r
74 \r
75 A message is deemed seen if both the top and bottom of the message\r
76 have both been visible in the buffer's window. This is chosen so that\r
77 just seeing 1 or 2 lines of a message at the bottom of the window does\r
78 not mark it seen. A closed message is never marked seen.\r
79 \r
80 The seen status is updated via a command-hook (run on every\r
81 command/key-press) so essentially any change which sees a message\r
82 should mark it as seen.\r
83 \r
84 By default the unread status of seen messages is not updated until the\r
85 user quits the show buffer, and the user has the option of prefix-arg\r
86 quit to exit the show buffer without updating the unread status.\r
87 \r
88 However, if the user sets the custom variable\r
89 notmuch-show-update-unread-on-seen then the unread status is updated\r
90 (ie unread tag is removed) as soon as a message is seen (in the above\r
91 sense).\r
92 ---\r
93 \r
94 This patch brings the unread handling roughly in line with what I\r
95 would expect, and is reasonably close to the suggestions from Austin\r
96 id:20131005162202.GJ21611@mit.edu and Jani\r
97 id:87vc1aho64.fsf@nikula.org. It was also clear from the discussion\r
98 that different people want different things so we will need some\r
99 customisation possibilities.\r
100 \r
101 It is a large patch: I am afraid I don't see a way round that.\r
102 \r
103 At the moment there are two things that need fixing: first tree-view\r
104 assumes the old behaviour so its displayed tags get out of sync with\r
105 the actual tags. Secondly, a lot of tests fail for the obvious reason\r
106 that the unread tag is not removed at the same time as before.\r
107 \r
108 It would be very helpful if people could test and see whether it works\r
109 as they would like, and if not say why/when it is doing the wrong\r
110 thing and what it should do in those cases.\r
111 \r
112 Best wishes\r
113 \r
114 Mark\r
115 \r
116 \r
117  emacs/notmuch-show.el |  151 ++++++++++++++++++++++++++++++++++++++++++++-----\r
118  emacs/notmuch-tree.el |   20 +++++--\r
119  2 files changed, 151 insertions(+), 20 deletions(-)\r
120 \r
121 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
122 index 784644c..1081eb0 100644\r
123 --- a/emacs/notmuch-show.el\r
124 +++ b/emacs/notmuch-show.el\r
125 @@ -168,6 +168,10 @@ each attachment handler is logged in buffers with names beginning\r
126  \" *notmuch-part*\". This option requires emacs version at least\r
127  24.3 to work.")\r
128  \r
129 +(defvar notmuch-show-seen-plist nil)\r
130 +(make-variable-buffer-local 'notmuch-show-seen-plist)\r
131 +(put 'notmuch-show-seen-plist 'permanent-local t)\r
132 +\r
133  (defcustom notmuch-show-stash-mlarchive-link-alist\r
134    '(("Gmane" . "http://mid.gmane.org/")\r
135      ("MARC" . "http://marc.info/?i=")\r
136 @@ -211,6 +215,15 @@ For example, if you wanted to remove an \"unread\" tag and add a\r
137    :type '(repeat string)\r
138    :group 'notmuch-show)\r
139  \r
140 +(defcustom notmuch-show-update-unread-on-seen nil\r
141 +  "Update unread tags when seen rathe than when exiting show buffer.\r
142 +\r
143 +A message is seen if the top and bottom of the message have both\r
144 +been visible in the buffer. When this is nil the unread status is\r
145 +updated on exiting the show buffer. When this is t the unread\r
146 +status is updated as soon as the message is seen."\r
147 +  :type 'boolean\r
148 +  :group 'notmuch-show)\r
149  \r
150  (defmacro with-current-notmuch-show-message (&rest body)\r
151    "Evaluate body with current buffer set to the text of current message"\r
152 @@ -1142,6 +1155,8 @@ function is used."\r
153    (let ((inhibit-read-only t))\r
154  \r
155      (notmuch-show-mode)\r
156 +    (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)\r
157 +\r
158      ;; Don't track undo information for this buffer\r
159      (set 'buffer-undo-list t)\r
160  \r
161 @@ -1213,6 +1228,12 @@ preferences. If invoked with a prefix argument (or RESET-STATE is\r
162  non-nil) then the state of the buffer (open/closed messages) is\r
163  reset based on the original query."\r
164    (interactive "P")\r
165 +  ;; Do not mark seen messages read if we are resetting state. The\r
166 +  ;; idea is that resetting state is asking for the view to be reset\r
167 +  ;; to the current state of the database.\r
168 +  (unless notmuch-show-update-unread-on-seen\r
169 +    (notmuch-show-mark-all-seen-read reset-state))\r
170 +\r
171    (let ((inhibit-read-only t)\r
172         (state (unless reset-state\r
173                  (notmuch-show-capture-state))))\r
174 @@ -1258,6 +1279,8 @@ reset based on the original query."\r
175  (defvar notmuch-show-mode-map\r
176        (let ((map (make-sparse-keymap)))\r
177         (set-keymap-parent map notmuch-common-keymap)\r
178 +       ;; the following overrides the common-keymap quit\r
179 +       (define-key map [remap notmuch-kill-this-buffer] 'notmuch-show-quit-and-mark-read)\r
180         (define-key map "Z" 'notmuch-tree-from-show-current-query)\r
181         (define-key map (kbd "<C-tab>") 'widget-backward)\r
182         (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)\r
183 @@ -1525,6 +1548,114 @@ marked as unread, i.e. the tag changes in\r
184      (apply 'notmuch-show-tag-message\r
185            (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))\r
186  \r
187 +(defun notmuch-show-is-unread ()\r
188 +  "Return t if current message is unread.\r
189 +\r
190 +Returns t unless applying `notmuch-show-mark-read-tags' would be\r
191 +a no-op"\r
192 +  (when notmuch-show-mark-read-tags\r
193 +    (let* ((current-tags (notmuch-show-get-tags))\r
194 +          (tag-changes (notmuch-tag-change-list notmuch-show-mark-read-tags))\r
195 +          (new-tags (notmuch-update-tags current-tags tag-changes)))\r
196 +      (not (equal current-tags new-tags)))))\r
197 +\r
198 +(defun notmuch-show-message-seen ()\r
199 +  "Return t if top and bottom of current message have been seen."\r
200 +  (eq (lax-plist-get notmuch-show-seen-plist\r
201 +                    (notmuch-show-get-message-id))\r
202 +      'both))\r
203 +\r
204 +(defun notmuch-show-mark-all-seen-read (&optional not-mark)\r
205 +  "Mark read all messages that have been seen in this buffer.\r
206 +\r
207 +If NOT-MARK then do not mark the messages read, and tell the user\r
208 +we are not marking them."\r
209 +  (if not-mark\r
210 +      (message "Not marking messages read")\r
211 +    (let ((messages-to-mark-read))\r
212 +      ;; We get a list of all message to tag read. A list means that\r
213 +      ;; we can tag all the messages in one tag operation rather than\r
214 +      ;; needing one per read message.\r
215 +      (notmuch-show-mapc\r
216 +       (lambda ()\r
217 +        (when (and (notmuch-show-message-seen) (notmuch-show-is-unread))\r
218 +          (push (notmuch-show-get-message-id) messages-to-mark-read))))\r
219 +      (when messages-to-mark-read\r
220 +       (notmuch-tag (mapconcat #'identity messages-to-mark-read " ")\r
221 +                    (notmuch-tag-change-list notmuch-show-mark-read-tags)))\r
222 +      (let ((count (length messages-to-mark-read)))\r
223 +       (cond ((> count 1)\r
224 +              (message "Marked %s messages read" count))\r
225 +             ((= count 1)\r
226 +              (message "Marked one message read"))\r
227 +             ((= count 0)\r
228 +              (message "No messages marked read")))))))\r
229 +\r
230 +(put 'notmuch-show-quit-and-mark-read 'notmuch-prefix-doc\r
231 +     "... without marking seen messages read.")\r
232 +(defun notmuch-show-quit-and-mark-read (&optional not-mark)\r
233 +  "Kill the current buffer marking seen messages read."\r
234 +  (interactive "P")\r
235 +  (unless notmuch-show-update-unread-on-seen\r
236 +    (notmuch-show-mark-all-seen-read not-mark))\r
237 +  (notmuch-kill-this-buffer))\r
238 +\r
239 +(defun notmuch-show-update-seen (top-or-bottom)\r
240 +  "Update seen status of current message\r
241 +\r
242 +Mark that we have seen the TOP-OR-BOTTOM of current message."\r
243 +  (let* ((id (notmuch-show-get-message-id))\r
244 +        (current (lax-plist-get notmuch-show-seen-plist id))\r
245 +        new)\r
246 +    (unless (eq current 'both)\r
247 +      (if (eq top-or-bottom 'top)\r
248 +         (if (eq current 'bottom)\r
249 +             (setq new 'both)\r
250 +           (setq new 'top))\r
251 +       (if (eq current 'top)\r
252 +           (setq new 'both)\r
253 +         (setq new 'bottom)))\r
254 +      (unless (eq current new)\r
255 +       (setq notmuch-show-seen-plist (lax-plist-put notmuch-show-seen-plist id new)))\r
256 +      (when (and notmuch-show-update-unread-on-seen\r
257 +                (eq new 'both))\r
258 +       (notmuch-show-mark-read)))))\r
259 +\r
260 +(defun notmuch-show-mark-message-seen (start end)\r
261 +  "Mark top and bottom of current message seen if between START and END."\r
262 +  (when (notmuch-show-message-visible-p)\r
263 +    (when (>= (notmuch-show-message-top) start)\r
264 +      (notmuch-show-update-seen 'top))\r
265 +    (when (<= (notmuch-show-message-bottom) end)\r
266 +      (notmuch-show-update-seen 'bottom))))\r
267 +\r
268 +(defun notmuch-show-mark-seen (start end)\r
269 +  "Update seen status for all open messages between start and end.\r
270 +\r
271 +A message is seen if both the top and bottom of the message have\r
272 +been visible in the buffer. Seen is a buffer local property. By\r
273 +default the unread status is removed from all seen messages when\r
274 +the user quits the show buffer. However, if\r
275 +`notmuch-show-update-unread-on-seen' is set then the unread\r
276 +status is removed as soon as the message is seen."\r
277 +  (save-excursion\r
278 +    (goto-char start)\r
279 +    (notmuch-show-mark-message-seen start end)\r
280 +    (while (and (< (notmuch-show-message-bottom) end)\r
281 +               (notmuch-show-goto-message-next))\r
282 +      (notmuch-show-mark-message-seen start end))\r
283 +    ;; This is a work around because emacs gives weird answers for\r
284 +    ;; window-end if the buffer ends with invisible text.\r
285 +    (when (and (pos-visible-in-window-p (point-max))\r
286 +              (notmuch-show-message-visible-p))\r
287 +      (notmuch-show-update-seen 'bottom))))\r
288 +\r
289 +(defun notmuch-show-command-hook ()\r
290 +  (when (eq major-mode 'notmuch-show-mode)\r
291 +    ;; We need to redisplay to get window-start and window-end correct.\r
292 +    (redisplay)\r
293 +    (notmuch-show-mark-seen (window-start) (window-end))))\r
294 +\r
295  ;; Functions for getting attributes of several messages in the current\r
296  ;; thread.\r
297  \r
298 @@ -1660,9 +1791,7 @@ If a prefix argument is given and this is the last message in the\r
299  thread, navigate to the next thread in the parent search buffer."\r
300    (interactive "P")\r
301    (if (notmuch-show-goto-message-next)\r
302 -      (progn\r
303 -       (notmuch-show-mark-read)\r
304 -       (notmuch-show-message-adjust))\r
305 +      (notmuch-show-message-adjust)\r
306      (if pop-at-end\r
307         (notmuch-show-next-thread)\r
308        (goto-char (point-max)))))\r
309 @@ -1673,7 +1802,6 @@ thread, navigate to the next thread in the parent search buffer."\r
310    (if (= (point) (notmuch-show-message-top))\r
311        (notmuch-show-goto-message-previous)\r
312      (notmuch-show-move-to-message-top))\r
313 -  (notmuch-show-mark-read)\r
314    (notmuch-show-message-adjust))\r
315  \r
316  (defun notmuch-show-next-open-message (&optional pop-at-end)\r
317 @@ -1688,9 +1816,7 @@ to show, nil otherwise."\r
318      (while (and (setq r (notmuch-show-goto-message-next))\r
319                 (not (notmuch-show-message-visible-p))))\r
320      (if r\r
321 -       (progn\r
322 -         (notmuch-show-mark-read)\r
323 -         (notmuch-show-message-adjust))\r
324 +       (notmuch-show-message-adjust)\r
325        (if pop-at-end\r
326           (notmuch-show-next-thread)\r
327         (goto-char (point-max))))\r
328 @@ -1703,9 +1829,7 @@ to show, nil otherwise."\r
329      (while (and (setq r (notmuch-show-goto-message-next))\r
330                 (not (notmuch-show-get-prop :match))))\r
331      (if r\r
332 -       (progn\r
333 -         (notmuch-show-mark-read)\r
334 -         (notmuch-show-message-adjust))\r
335 +       (notmuch-show-message-adjust)\r
336        (goto-char (point-max)))))\r
337  \r
338  (defun notmuch-show-open-if-matched ()\r
339 @@ -1716,8 +1840,7 @@ to show, nil otherwise."\r
340  (defun notmuch-show-goto-first-wanted-message ()\r
341    "Move to the first open message and mark it read"\r
342    (goto-char (point-min))\r
343 -  (if (notmuch-show-message-visible-p)\r
344 -      (notmuch-show-mark-read)\r
345 +  (unless (notmuch-show-message-visible-p)\r
346      (notmuch-show-next-open-message))\r
347    (when (eobp)\r
348      ;; There are no matched non-excluded messages so open all matched\r
349 @@ -1725,8 +1848,7 @@ to show, nil otherwise."\r
350      (notmuch-show-mapc 'notmuch-show-open-if-matched)\r
351      (force-window-update)\r
352      (goto-char (point-min))\r
353 -    (if (notmuch-show-message-visible-p)\r
354 -       (notmuch-show-mark-read)\r
355 +    (unless (notmuch-show-message-visible-p)\r
356        (notmuch-show-next-open-message))))\r
357  \r
358  (defun notmuch-show-previous-open-message ()\r
359 @@ -1736,7 +1858,6 @@ to show, nil otherwise."\r
360                   (notmuch-show-goto-message-previous)\r
361                 (notmuch-show-move-to-message-top))\r
362               (not (notmuch-show-message-visible-p))))\r
363 -  (notmuch-show-mark-read)\r
364    (notmuch-show-message-adjust))\r
365  \r
366  (defun notmuch-show-view-raw-message ()\r
367 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
368 index 8d59e65..206bd9f 100644\r
369 --- a/emacs/notmuch-tree.el\r
370 +++ b/emacs/notmuch-tree.el\r
371 @@ -487,17 +487,20 @@ Shows in split pane or whole window according to value of\r
372    (when (notmuch-tree-scroll-message-window)\r
373      (notmuch-tree-next-matching-message)))\r
374  \r
375 -(defun notmuch-tree-quit ()\r
376 +(defun notmuch-tree-quit (&optional forget-seen)\r
377    "Close the split view or exit tree."\r
378 -  (interactive)\r
379 -  (unless (notmuch-tree-close-message-window)\r
380 +  (interactive "P")\r
381 +  (unless (notmuch-tree-close-message-window forget-seen)\r
382      (kill-buffer (current-buffer))))\r
383  \r
384 -(defun notmuch-tree-close-message-window ()\r
385 +(defun notmuch-tree-close-message-window (&optional forget-seen)\r
386    "Close the message-window. Return t if close succeeds."\r
387 -  (interactive)\r
388 +  (interactive "P")\r
389    (when (and (window-live-p notmuch-tree-message-window)\r
390              (eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))\r
391 +    (unless notmuch-show-update-unread-on-seen\r
392 +      (with-selected-window notmuch-tree-message-window\r
393 +       (notmuch-show-mark-all-seen-read forget-seen)))\r
394      (delete-window notmuch-tree-message-window)\r
395      (unless (get-buffer-window-list notmuch-tree-message-buffer)\r
396        (kill-buffer notmuch-tree-message-buffer))\r
397 @@ -784,6 +787,12 @@ This function inserts a collection of several complete threads as\r
398  passed to it by notmuch-tree-process-filter."\r
399    (mapc 'notmuch-tree-insert-forest-thread forest))\r
400  \r
401 +(defun notmuch-tree-command-hook ()\r
402 +  (when (eq major-mode 'notmuch-tree-mode)\r
403 +    (when (window-live-p notmuch-tree-message-window)\r
404 +      (with-selected-window notmuch-tree-message-window\r
405 +       (notmuch-show-command-hook)))))\r
406 +\r
407  (defun notmuch-tree-mode ()\r
408    "Major mode displaying messages (as opposed to threads) of of a notmuch search.\r
409  \r
410 @@ -853,6 +862,7 @@ This is is a helper function for notmuch-tree. The arguments are\r
411  the same as for the function notmuch-tree."\r
412    (interactive)\r
413    (notmuch-tree-mode)\r
414 +  (add-hook 'post-command-hook #'notmuch-tree-command-hook nil t)\r
415    (setq notmuch-tree-basic-query basic-query)\r
416    (setq notmuch-tree-query-context query-context)\r
417    (setq notmuch-tree-target-msg target)\r
418 -- \r
419 1.7.9.1\r
420 \r