[PATCH 0/5] emacs: show: redesign unread/read logic

[PATCH 0/5] emacs: show: redesign unread/read logic

[Mark Walters]

This is the first non-WIP version of this series. The previous WIP
version is at
id:1386665847-6439-1-git-send-email-markwalters1009@gmail.com

The main changes are: all tests now pass, and tree mode is also
done. In fact tree-mode is very easy: since only one message is viewed
in the message pane at a time I think it makes sense to mark it read
immediately.

The test change is surprisingly small but relatively intrusive. Rather
than wrapping the lisp to be executed in a progn in test_emacs I wrap
it in a handler notmuch-test-progn. The syntax is not the same as
progn so maybe the name is bad: it needs an actual lisp list of
commands as its sole argument. test_emacs is updated to supply the
commands as a lisp list. It executes each command in turn but runs the
post-command-hook after each. Note a block of the form (progn (cmd1)
(cmd2)) is viewed a single command and the post-command-hook would
only run after the progn completes. This allows the caller to avoid
running the post-command-hook when needed. Similarly a (let ....) form
is only viewed as one command; in this case the calle may need to run
the post-command-hook explicitly.

It is surprising that all tests pass given the fairly substantial
unread/read changes. This might suggest that we need some extra tests.

Best wishes

Mark






Mark Walters (5):
  emacs: show: make `seen' mean user viewed whole message
  emacs: show: add an update seen function to post-command-hook
  emacs: show: mark tags changed since buffer loaded
  emacs: tree: make the tree code force the mark read update
  test: make test_emacs call post-command-hook

 emacs/notmuch-show.el |  123 +++++++++++++++++++++++++++++++++++++++++--------
 emacs/notmuch-tag.el  |  105 ++++++++++++++++++++++++++++++------------
 emacs/notmuch-tree.el |    3 +
 test/test-lib.el      |   16 ++++++
 test/test-lib.sh      |    2 +-
 5 files changed, 198 insertions(+), 51 deletions(-)

-- 
1.7.9.1

[PATCH 1/5] 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 |   73 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 71 insertions(+), 2 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 51366e9..4850bd0 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -211,6 +211,19 @@ 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)
 
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
@@ -1541,9 +1554,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

[PATCH 2/5] 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 30e84b1..51366e9 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1152,6 +1152,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)
 
@@ -1539,6 +1541,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.
 
@@ -1674,9 +1686,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)))))
@@ -1687,7 +1697,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)
@@ -1702,9 +1711,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))))
@@ -1717,9 +1724,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 ()
@@ -1730,8 +1735,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
@@ -1739,8 +1743,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 ()
@@ -1750,7 +1753,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 3/5] 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 (if strike-through is not available, eg on a terminal, inverse
video is used instead) 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).

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. For convenience an entry for the entry string in the
notmuch-tag-formats (and the corresponding notmuch-tag-deleted-formats
notmuch-tag-added-formats) is applied to all tags which do not have an
explicit match.

This means that a user can tell notmuch not to show deleted tags at
all by setting notmuch-tag-deleted-formats to
'(("" nil))
or not to show any deleted tags except "unread" by setting it to
'(("" nil)
  ("unread" (propertize tag 'face '(strike-through "red"))))

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 |   22 ++++++++--
 emacs/notmuch-tag.el  |  105 +++++++++++++++++++++++++++++++++++--------------
 test/test-lib.el      |    4 ++
 3 files changed, 96 insertions(+), 35 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 1ac80ca..30e84b1 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -341,11 +341,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 +1177,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..81ce287 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,34 +28,8 @@
 (require 'crm)
 (require 'notmuch-lib)
 
-(defcustom notmuch-tag-formats
-  '(("unread" (propertize tag 'face '(:foreground "red")))
-    ("flagged" (propertize tag 'face '(:foreground "blue"))
-     (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.
-
-For example, to replace a tag with another string, simply use
-that string as a formatting expression.  To change the foreground
-of a tag to red, use the expression
-  (propertize tag 'face '(:foreground \"red\"))
-
-See also `notmuch-tag-format-image', which can help replace tags
-with images."
-
-  :group 'notmuch-search
-  :group 'notmuch-show
+(define-widget 'notmuch-tag-format-type 'lazy
+  "Customize widget for notmuch-tag-format and friends"
   :type '(alist :key-type (string :tag "Tag")
 		:extra-offset -3
 		:value-type
@@ -82,6 +56,61 @@ with images."
 					  (string :tag "Custom")))
 			    (sexp :tag "Custom")))))
 
+(defcustom notmuch-tag-formats
+  '(("unread" (propertize tag 'face '(:foreground "red")))
+    ("flagged" (propertize tag 'face '(:foreground "blue"))
+     (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
+car is an empty string it matches all tags that do not have an
+explicit match. 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
+of a tag to red, use the expression
+  (propertize tag 'face '(:foreground \"red\"))
+
+See also `notmuch-tag-format-image', which can help replace tags
+with images."
+  :group 'notmuch-search
+  :group 'notmuch-show
+  :type 'notmuch-tag-format-type)
+
+(defcustom notmuch-tag-deleted-formats
+  '(("" (propertize tag 'face
+		   (if (display-supports-face-attributes-p '(:strike-through "red"))
+		       '(:strike-through "red")
+		     '(:inverse-video t)))))
+  "Custom formats for tags when deleted.
+
+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
+  '(("" (propertize tag 'face '(:underline "green"))))
+  "Custom formats for tags when added.
+
+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.
 
@@ -136,8 +165,24 @@ This can be used with `notmuch-tag-format-image-data'."
 </svg>")
 
 (defun notmuch-tag-format-tag (tag)
-  "Format TAG by looking into `notmuch-tag-formats'."
-  (let ((formats (assoc tag notmuch-tag-formats)))
+  "Format TAG by looking into `notmuch-tag-formats'.
+
+TAG can either be a string for a tag or a cons cell. In the
+latter case the car of the cons cell is the tag string, the cdr
+should be 'deleted or 'added to indicate whether the tag has been
+deleted or added. The format for tag is looked up in
+`notmuch-tag-formats' or `notmuch-tag-deleted-formats' or
+`notmuch-tag-added-formats' as appropriate."
+  (let* ((status (if (consp tag) (cdr tag)))
+	 (tag (if (consp tag) (car tag) tag))
+	 (status-formats (cond
+			  ((eq status 'deleted)
+			   notmuch-tag-deleted-formats)
+			  ((eq status 'added)
+			   notmuch-tag-added-formats)
+			  (t notmuch-tag-formats)))
+	 (formats (or (append (assoc tag status-formats))
+		      (append (assoc "" status-formats)))))
     (cond
      ((null formats)		;; - Tag not in `notmuch-tag-formats',
       tag)			;;   the format is the tag itself.
diff --git a/test/test-lib.el b/test/test-lib.el
index 1c9e224..a1b40b7 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -174,3 +174,7 @@ nothing."
     (dolist (form body ret)
       (setq ret (eval form))
       (notmuch-post-command))))
+
+;; hide deleted tags
+(setq notmuch-tag-deleted-formats
+      '(("" nil)))
-- 
1.7.9.1

[PATCH 4/5] emacs: tree: make the tree code force the mark read update

[Mark Walters]

Previously the tree code relied on the show buffer to do the
unread/read update. Once this is done via the post-command-hook this
won't be automatic so explicitly force the update.
---
 emacs/notmuch-tree.el |    3 +++
 1 files changed, 3 insertions(+), 0 deletions(-)

diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 8d59e65..6ec9561 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -438,6 +438,9 @@ Does NOT change the database."
 	  (setq notmuch-tree-message-window window)
 	  (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
       (when notmuch-show-mark-read-tags
+	(when (window-live-p notmuch-tree-message-window)
+	  (with-selected-window notmuch-tree-message-window
+	    (notmuch-show-mark-read)))
 	(notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
       (setq notmuch-tree-message-buffer buffer))))
 
-- 
1.7.9.1

[PATCH 5/5] test: make test_emacs call post-command-hook

[Mark Walters]

The unread/read changes will use the post-command-hook. test_emacs
does not call the post-command-hook. This adds a notmuch-test-progn
which takes a list of commands as argument and executes them in turn
but runs the post-command-hook after each one.

The caller can batch operations (ie to stop post-command-hook from
being interleaved) by wrapping the batch of operations inside a progn.

We also explicitly run the post-command-hook before getting the output
from a test; this makes sense as this will be a place the user would
be seeing the information.
---
 test/test-lib.el |   12 ++++++++++++
 test/test-lib.sh |    2 +-
 2 files changed, 13 insertions(+), 1 deletions(-)

diff --git a/test/test-lib.el b/test/test-lib.el
index d26b49f..1c9e224 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -52,11 +52,13 @@
 
 (defun test-output (&optional filename)
   "Save current buffer to file FILENAME.  Default FILENAME is OUTPUT."
+  (notmuch-post-command)
   (write-region (point-min) (point-max) (or filename "OUTPUT")))
 
 (defun test-visible-output (&optional filename)
   "Save visible text in current buffer to file FILENAME.  Default
 FILENAME is OUTPUT."
+  (notmuch-post-command)
   (let ((text (visible-buffer-string)))
     (with-temp-file (or filename "OUTPUT") (insert text))))
 
@@ -162,3 +164,13 @@ nothing."
 
      (t
       (notmuch-test-report-unexpected output expected)))))
+
+(defun notmuch-post-command ()
+  (run-hooks 'post-command-hook))
+
+(defun notmuch-test-progn (body)
+  (let (form
+	ret)
+    (dolist (form body ret)
+      (setq ret (eval form))
+      (notmuch-post-command))))
diff --git a/test/test-lib.sh b/test/test-lib.sh
index d8e0d91..e7833fc 100644
--- a/test/test-lib.sh
+++ b/test/test-lib.sh
@@ -1075,7 +1075,7 @@ test_emacs () {
 	rm -f OUTPUT
 	touch OUTPUT
 
-	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(progn $@)"
+	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(notmuch-test-progn '($@))"
 }
 
 test_python() {
-- 
1.7.9.1

[PATCH] test: make test_emacs call post-command-hook

[David Bremner]

From: Mark Walters <markwalters1009@gmail.com>

The unread/read changes will use the post-command-hook. test_emacs
does not call the post-command-hook. This adds a notmuch-test-progn
which takes a list of commands as argument and executes them in turn
but runs the post-command-hook after each one.

The caller can batch operations (ie to stop post-command-hook from
being interleaved) by wrapping the batch of operations inside a progn.

We also explicitly run the post-command-hook before getting the output
from a test; this makes sense as this will be a place the user would
be seeing the information.
---

What do you think about this alternate version?  it allows
notmuch-test-progn to have the same syntax as progn. It seems about
the same level of complexity to me; fwiw I prefer the let over the
dolist/setq.

 test/test-lib.el | 13 +++++++++++++
 test/test-lib.sh |  2 +-
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/test/test-lib.el b/test/test-lib.el
index 37fcb3d..a12ad97 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -52,11 +52,13 @@
 
 (defun test-output (&optional filename)
   "Save current buffer to file FILENAME.  Default FILENAME is OUTPUT."
+  (notmuch-post-command)
   (write-region (point-min) (point-max) (or filename "OUTPUT")))
 
 (defun test-visible-output (&optional filename)
   "Save visible text in current buffer to file FILENAME.  Default
 FILENAME is OUTPUT."
+  (notmuch-post-command)
   (let ((text (visible-buffer-string)))
     (with-temp-file (or filename "OUTPUT") (insert text))))
 
@@ -165,3 +167,14 @@ nothing."
 
      (t
       (notmuch-test-report-unexpected output expected)))))
+
+(defun notmuch-post-command ()
+  (run-hooks 'post-command-hook))
+
+(defmacro notmuch-test-progn (&rest body)
+  (cons 'progn
+	(mapcar
+	 (lambda (x) `(let ((ret ,x))
+			(notmuch-post-command)
+			ret))
+	 body)))
diff --git a/test/test-lib.sh b/test/test-lib.sh
index 78af170..27dcb59 100644
--- a/test/test-lib.sh
+++ b/test/test-lib.sh
@@ -1118,7 +1118,7 @@ test_emacs () {
 	rm -f OUTPUT
 	touch OUTPUT
 
-	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(progn $@)"
+	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(notmuch-test-progn $@)"
 }
 
 test_python() {
-- 
1.8.5.2

Re: [PATCH] test: make test_emacs call post-command-hook

[Mark Walters]

Hi

On Wed, 22 Jan 2014, David Bremner <david@tethera.net> wrote:
> From: Mark Walters <markwalters1009@gmail.com>
>
> The unread/read changes will use the post-command-hook. test_emacs
> does not call the post-command-hook. This adds a notmuch-test-progn
> which takes a list of commands as argument and executes them in turn
> but runs the post-command-hook after each one.
>
> The caller can batch operations (ie to stop post-command-hook from
> being interleaved) by wrapping the batch of operations inside a progn.
>
> We also explicitly run the post-command-hook before getting the output
> from a test; this makes sense as this will be a place the user would
> be seeing the information.
> ---
>
> What do you think about this alternate version?  it allows
> notmuch-test-progn to have the same syntax as progn. It seems about
> the same level of complexity to me; fwiw I prefer the let over the
> dolist/setq.

This looks much nicer: a macro is definitely the right way to do this. 

I might be inclined to replace the let... by a prog1 but would be happy
either way on that.

Best wishes

Mark


>
>  test/test-lib.el | 13 +++++++++++++
>  test/test-lib.sh |  2 +-
>  2 files changed, 14 insertions(+), 1 deletion(-)
>
> diff --git a/test/test-lib.el b/test/test-lib.el
> index 37fcb3d..a12ad97 100644
> --- a/test/test-lib.el
> +++ b/test/test-lib.el
> @@ -52,11 +52,13 @@
>  
>  (defun test-output (&optional filename)
>    "Save current buffer to file FILENAME.  Default FILENAME is OUTPUT."
> +  (notmuch-post-command)
>    (write-region (point-min) (point-max) (or filename "OUTPUT")))
>  
>  (defun test-visible-output (&optional filename)
>    "Save visible text in current buffer to file FILENAME.  Default
>  FILENAME is OUTPUT."
> +  (notmuch-post-command)
>    (let ((text (visible-buffer-string)))
>      (with-temp-file (or filename "OUTPUT") (insert text))))
>  
> @@ -165,3 +167,14 @@ nothing."
>  
>       (t
>        (notmuch-test-report-unexpected output expected)))))
> +
> +(defun notmuch-post-command ()
> +  (run-hooks 'post-command-hook))
> +
> +(defmacro notmuch-test-progn (&rest body)
> +  (cons 'progn
> +	(mapcar
> +	 (lambda (x) `(let ((ret ,x))
> +			(notmuch-post-command)
> +			ret))
> +	 body)))
> diff --git a/test/test-lib.sh b/test/test-lib.sh
> index 78af170..27dcb59 100644
> --- a/test/test-lib.sh
> +++ b/test/test-lib.sh
> @@ -1118,7 +1118,7 @@ test_emacs () {
>  	rm -f OUTPUT
>  	touch OUTPUT
>  
> -	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(progn $@)"
> +	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(notmuch-test-progn $@)"
>  }
>  
>  test_python() {
> -- 
> 1.8.5.2

Re: [PATCH] test: make test_emacs call post-command-hook

[Tomi Ollila]

On Thu, Jan 23 2014, Mark Walters <markwalters1009@gmail.com> wrote:

>> What do you think about this alternate version?  it allows
>> notmuch-test-progn to have the same syntax as progn. It seems about
>> the same level of complexity to me; fwiw I prefer the let over the
>> dolist/setq.
>
> This looks much nicer: a macro is definitely the right way to do this. 
>
> I might be inclined to replace the let... by a prog1 but would be happy
> either way on that.

prog1! definitely ! :D

>
> Best wishes
>
> Mark
>

Tomi

>> +(defmacro notmuch-test-progn (&rest body)
>> +  (cons 'progn
>> +	(mapcar
>> +	 (lambda (x) `(let ((ret ,x))
>> +			(notmuch-post-command)
>> +			ret))
>> +	 body)))

[PATCH] test: make test_emacs call post-command-hook

[David Bremner]

From: Mark Walters <markwalters1009@gmail.com>

The unread/read changes will use the post-command-hook. test_emacs
does not call the post-command-hook. This adds a notmuch-test-progn
which takes a list of commands as argument and executes them in turn
but runs the post-command-hook after each one.

The caller can batch operations (ie to stop post-command-hook from
being interleaved) by wrapping the batch of operations inside a progn.

We also explicitly run the post-command-hook before getting the output
from a test; this makes sense as this will be a place the user would
be seeing the information.
---

OK, OK, so the previous version re-invented prog1. That's the scheme
way ;).

 test/test-lib.el | 11 +++++++++++
 test/test-lib.sh |  2 +-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/test/test-lib.el b/test/test-lib.el
index 37fcb3d..0ee8371 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -52,11 +52,13 @@
 
 (defun test-output (&optional filename)
   "Save current buffer to file FILENAME.  Default FILENAME is OUTPUT."
+  (notmuch-post-command)
   (write-region (point-min) (point-max) (or filename "OUTPUT")))
 
 (defun test-visible-output (&optional filename)
   "Save visible text in current buffer to file FILENAME.  Default
 FILENAME is OUTPUT."
+  (notmuch-post-command)
   (let ((text (visible-buffer-string)))
     (with-temp-file (or filename "OUTPUT") (insert text))))
 
@@ -165,3 +167,12 @@ nothing."
 
      (t
       (notmuch-test-report-unexpected output expected)))))
+
+(defun notmuch-post-command ()
+  (run-hooks 'post-command-hook))
+
+(defmacro notmuch-test-progn (&rest body)
+  (cons 'progn
+	(mapcar
+	 (lambda (x) `(prog1 ,x (notmuch-post-command)))
+	 body)))
diff --git a/test/test-lib.sh b/test/test-lib.sh
index 78af170..27dcb59 100644
--- a/test/test-lib.sh
+++ b/test/test-lib.sh
@@ -1118,7 +1118,7 @@ test_emacs () {
 	rm -f OUTPUT
 	touch OUTPUT
 
-	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(progn $@)"
+	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(notmuch-test-progn $@)"
 }
 
 test_python() {
-- 
1.8.5.2

Re: [PATCH] test: make test_emacs call post-command-hook

[Tomi Ollila]

On Fri, Jan 24 2014, David Bremner <david@tethera.net> wrote:

> From: Mark Walters <markwalters1009@gmail.com>
>
> The unread/read changes will use the post-command-hook. test_emacs
> does not call the post-command-hook. This adds a notmuch-test-progn
> which takes a list of commands as argument and executes them in turn
> but runs the post-command-hook after each one.
>
> The caller can batch operations (ie to stop post-command-hook from
> being interleaved) by wrapping the batch of operations inside a progn.
>
> We also explicitly run the post-command-hook before getting the output
> from a test; this makes sense as this will be a place the user would
> be seeing the information.
> ---
>
> OK, OK, so the previous version re-invented prog1. That's the scheme
> way ;).

LGTM.

Tomi


>
>  test/test-lib.el | 11 +++++++++++
>  test/test-lib.sh |  2 +-
>  2 files changed, 12 insertions(+), 1 deletion(-)
>
> diff --git a/test/test-lib.el b/test/test-lib.el
> index 37fcb3d..0ee8371 100644
> --- a/test/test-lib.el
> +++ b/test/test-lib.el
> @@ -52,11 +52,13 @@
>  
>  (defun test-output (&optional filename)
>    "Save current buffer to file FILENAME.  Default FILENAME is OUTPUT."
> +  (notmuch-post-command)
>    (write-region (point-min) (point-max) (or filename "OUTPUT")))
>  
>  (defun test-visible-output (&optional filename)
>    "Save visible text in current buffer to file FILENAME.  Default
>  FILENAME is OUTPUT."
> +  (notmuch-post-command)
>    (let ((text (visible-buffer-string)))
>      (with-temp-file (or filename "OUTPUT") (insert text))))
>  
> @@ -165,3 +167,12 @@ nothing."
>  
>       (t
>        (notmuch-test-report-unexpected output expected)))))
> +
> +(defun notmuch-post-command ()
> +  (run-hooks 'post-command-hook))
> +
> +(defmacro notmuch-test-progn (&rest body)
> +  (cons 'progn
> +	(mapcar
> +	 (lambda (x) `(prog1 ,x (notmuch-post-command)))
> +	 body)))
> diff --git a/test/test-lib.sh b/test/test-lib.sh
> index 78af170..27dcb59 100644
> --- a/test/test-lib.sh
> +++ b/test/test-lib.sh
> @@ -1118,7 +1118,7 @@ test_emacs () {
>  	rm -f OUTPUT
>  	touch OUTPUT
>  
> -	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(progn $@)"
> +	${TEST_EMACSCLIENT} --socket-name="$EMACS_SERVER" --eval "(notmuch-test-progn $@)"
>  }
>  
>  test_python() {
> -- 
> 1.8.5.2
>
> _______________________________________________
> notmuch mailing list
> notmuch@notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch