[Emacs-diffs] master 22d463e: Fix todo-mode commands called on done items separator

[Stephen Berman]

branch: master
commit 22d463ed5ca262e1d8893b115c3f1237485fc7e0
Author: Stephen Berman <address@hidden>
Commit: Stephen Berman <address@hidden>

    Fix todo-mode commands called on done items separator
    
    The done items separator is not reachable by todo-mode navigation
    commands, but it is e.g. by C-n and C-p.  Ensure that invoking
    todo-mode commands with point on the separator does not result in
    unexpected results, errors or file corruption (bug#32343).
    
    * lisp/calendar/todo-mode.el (todo-insert-item--basic): Make
    copying item and inserting item "here" noops when invoked on done
    items separator.  Consolidate error handling of these cases.  Also
    restrict "here" insertion to valid positions in the current
    category, since this is simpler than the previous behavior of
    inserting as the first item, which was moreover undocumented,
    counterintuitive and superfluous.
    (todo-set-item-priority, todo-move-item, todo-item-done)
    (todo-item-start, todo-item-end): Make noops when invoked on done
    items separator.
    
    * test/lisp/calendar/todo-mode-tests.el: Require ert-x.
    (todo-test--insert-item): Add formal parameters of
    todo-insert-item--basic.
    (todo-test--done-items-separator): New function.
    (todo-test-done-items-separator01-bol)
    (todo-test-done-items-separator01-eol)
    (todo-test-done-items-separator02-bol)
    (todo-test-done-items-separator02-eol)
    (todo-test-done-items-separator03-bol)
    (todo-test-done-items-separator03-eol)
    (todo-test-done-items-separator04-bol)
    (todo-test-done-items-separator04-eol)
    (todo-test-done-items-separator05-bol)
    (todo-test-done-items-separator05-eol)
    (todo-test-done-items-separator06-bol)
    (todo-test-done-items-separator06-eol)
    (todo-test-done-items-separator07): New tests.
---
 lisp/calendar/todo-mode.el            |  81 ++++++++-------
 test/lisp/calendar/todo-mode-tests.el | 190 +++++++++++++++++++++++++++++++++-
 2 files changed, 228 insertions(+), 43 deletions(-)

diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 5161ae8..80bea25 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1860,15 +1860,18 @@ their associated keys and their effects."
          (region (eq where 'region))
          (here (eq where 'here))
          diary-item)
-      (when copy
-       (cond
-        ((not (eq major-mode 'todo-mode))
-         (user-error "You must be in Todo mode to copy a todo item"))
-        ((todo-done-item-p)
-         (user-error "You cannot copy a done item as a new todo item"))
-        ((looking-at "^$")
-         (user-error "Point must be on a todo item to copy it")))
-       (setq diary-item (todo-diary-item-p)))
+      (when (and arg here)
+        (user-error "Here insertion only valid in current category"))
+      (when (and (or copy here)
+                 (or (not (eq major-mode 'todo-mode)) (todo-done-item-p)
+                     (when copy (looking-at "^$"))
+                     (save-excursion
+                       (beginning-of-line)
+                       ;; Point is on done items separator.
+                       (looking-at todo-category-done))))
+        (user-error (concat "Item " (if copy "copying" "insertion")
+                            " is not valid here")))
+      (when copy (setq diary-item (todo-diary-item-p)))
       (when region
        (let (use-empty-active-region)
          (unless (and todo-use-only-highlighted-region (use-region-p))
@@ -1876,7 +1879,6 @@ their associated keys and their effects."
       (let* ((obuf (current-buffer))
             (ocat (todo-current-category))
             (opoint (point))
-            (todo-mm (eq major-mode 'todo-mode))
             (cat+file (cond ((equal arg '(4))
                              (todo-read-category "Insert in category: "))
                             ((equal arg '(16))
@@ -1931,7 +1933,6 @@ their associated keys and their effects."
        (unless todo-global-current-todo-file
          (setq todo-global-current-todo-file todo-current-todo-file))
        (let ((buffer-read-only nil)
-             (called-from-outside (not (and todo-mm (equal cat ocat))))
              done-only item-added)
          (unless copy
            (setq new-item
@@ -1955,14 +1956,8 @@ their associated keys and their effects."
                                                     "\n\t" new-item nil nil 
1)))
          (unwind-protect
              (progn
-               ;; Make sure the correct category is selected.  There
-               ;; are two cases: (i) we just visited the file, so no
-               ;; category is selected yet, or (ii) we invoked
-               ;; insertion "here" from outside the category we want
-               ;; to insert in (with priority insertion, category
-               ;; selection is done by todo-set-item-priority).
-               (when (or (= (- (point-max) (point-min)) (buffer-size))
-                         (and here called-from-outside))
+                ;; If we just visited the file, no category is selected yet.
+                (when (= (- (point-max) (point-min)) (buffer-size))
                  (todo-category-number cat)
                  (todo-category-select))
                ;; If only done items are displayed in category,
@@ -1973,16 +1968,7 @@ their associated keys and their effects."
                  (setq done-only t)
                  (todo-toggle-view-done-only))
                (if here
-                   (progn
-                     ;; If command was invoked with point in done
-                     ;; items section or outside of the current
-                     ;; category, can't insert "here", so to be
-                     ;; useful give new item top priority.
-                     (when (or (todo-done-item-section-p)
-                               called-from-outside
-                               done-only)
-                       (goto-char (point-min)))
-                     (todo-insert-with-overlays new-item))
+                    (todo-insert-with-overlays new-item)
                  (todo-set-item-priority new-item cat t))
                (setq item-added t))
            ;; If user cancels before setting priority, restore
@@ -2549,7 +2535,11 @@ whose value can be either of the symbols `raise' or 
`lower',
 meaning to raise or lower the item's priority by one."
   (interactive)
   (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower)))
-              (or (todo-done-item-p) (looking-at "^$")))
+               ;; Noop if point is not on a todo (i.e. not done) item.
+              (or (todo-done-item-p) (looking-at "^$")
+                   ;; On done items separator.
+                   (save-excursion (beginning-of-line)
+                                   (looking-at todo-category-done))))
     (let* ((item (or item (todo-item-string)))
           (marked (todo-marked-item-p))
           (cat (or cat (cond ((eq major-mode 'todo-mode)
@@ -2697,9 +2687,13 @@ section in the category moved to."
   (interactive "P")
   (let* ((cat1 (todo-current-category))
         (marked (assoc cat1 todo-categories-with-marks)))
-    ;; Noop if point is not on an item and there are no marked items.
-    (unless (and (looking-at "^$")
-                (not marked))
+    (unless
+        ;; Noop if point is not on an item and there are no marked items.
+        (and (or (looking-at "^$")
+                 ;; On done items separator.
+                 (save-excursion (beginning-of-line)
+                                 (looking-at todo-category-done)))
+             (not marked))
       (let* ((buffer-read-only)
             (file1 todo-current-todo-file)
             (item (todo-item-string))
@@ -2856,10 +2850,14 @@ visible."
   (let* ((cat (todo-current-category))
         (marked (assoc cat todo-categories-with-marks)))
     (when marked (todo--user-error-if-marked-done-item))
-    (unless (and (not marked)
-                (or (todo-done-item-p)
-                    ;; Point is between todo and done items.
-                    (looking-at "^$")))
+    (unless
+        ;; Noop if point is not on a todo (i.e. not done) item and
+        ;; there are no marked items.
+        (and (or (todo-done-item-p) (looking-at "^$")
+                 ;; On done items separator.
+                 (save-excursion (beginning-of-line)
+                                 (looking-at todo-category-done)))
+             (not marked))
       (let* ((date-string (calendar-date-string (calendar-current-date) t t))
             (time-string (if todo-always-add-time-string
                              (concat " " (substring (current-time-string)
@@ -5132,6 +5130,8 @@ but the categories sexp differs from the current value of
                      (forward-line)
                      (looking-at (concat "^"
                                          (regexp-quote todo-category-done))))))
+           ;; Point is on done items separator.
+           (save-excursion (beginning-of-line) (looking-at todo-category-done))
           ;; Buffer is widened.
           (looking-at (regexp-quote todo-category-beg)))
     (goto-char (line-beginning-position))
@@ -5141,8 +5141,11 @@ but the categories sexp differs from the current value of
 
 (defun todo-item-end ()
   "Move to end of current todo item and return its position."
-  ;; Items cannot end with a blank line.
-  (unless (looking-at "^$")
+  (unless (or
+           ;; Items cannot end with a blank line.
+           (looking-at "^$")
+           ;; Point is on done items separator.
+           (save-excursion (beginning-of-line) (looking-at 
todo-category-done)))
     (let* ((done (todo-done-item-p))
           (to-lim nil)
           ;; For todo items, end is before the done items section, for done
diff --git a/test/lisp/calendar/todo-mode-tests.el 
b/test/lisp/calendar/todo-mode-tests.el
index 159294f..325faef 100644
--- a/test/lisp/calendar/todo-mode-tests.el
+++ b/test/lisp/calendar/todo-mode-tests.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'ert)
+(require 'ert-x)
 (require 'todo-mode)
 
 (defvar todo-test-data-dir
@@ -561,11 +562,12 @@ source file is different."
      ;; Headers in the todo file are still hidden.
      (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
 
-(defun todo-test--insert-item (item &optional priority)
+(defun todo-test--insert-item (item &optional priority
+                                    _arg diary-type date-type time where)
   "Insert string ITEM into current category with priority PRIORITY.
-Use defaults for all other item insertion parameters.  This
-provides a noninteractive API for todo-insert-item for use in
-automatic testing."
+The remaining arguments (except _ARG, which is ignored) specify
+item insertion parameters.  This provides a noninteractive API
+for todo-insert-item for use in automatic testing."
   (cl-letf (((symbol-function 'read-from-minibuffer)
              (lambda (_prompt) item))
             ((symbol-function 'read-number) ; For todo-set-item-priority
@@ -581,6 +583,186 @@ automatic testing."
      (todo-test--insert-item item 1)
      (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
 
+(defun todo-test--done-items-separator (&optional eol)
+  "Set up test of command interaction with done items separator.
+With non-nil argument EOL, return the position at the end of the
+separator, otherwise, return the position at the beginning."
+  (todo-test--show 1)
+  (goto-char (point-max))
+  ;; See comment about recentering in todo-test-raise-lower-priority.
+  (set-window-buffer nil (current-buffer))
+  (todo-toggle-view-done-items)
+  ;; FIXME: Point should now be on the first done item, and in batch
+  ;; testing it is, so we have to move back one line to the done items
+  ;; separator; but for some reason, in the graphical test
+  ;; environment, it stays on the last empty line of the todo items
+  ;; section, so there we have to advance one character to the done
+  ;; items separator.
+  (if (display-graphic-p)
+      (forward-char)
+    (forward-line -1))
+  (if eol (forward-char)))
+
+(ert-deftest todo-test-done-items-separator01-bol ()
+  "Test item copying and here insertion at BOL of separator.
+Both should be user errors."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (let* ((copy-err "Item copying is not valid here")
+          (here-err "Item insertion is not valid here")
+          (insert-item-test (lambda (where)
+                              (should-error (todo-insert-item--basic
+                                             nil nil nil nil where)))))
+     (should (string= copy-err (cadr (funcall insert-item-test 'copy))))
+     (should (string= here-err (cadr (funcall insert-item-test 'here)))))))
+
+(ert-deftest todo-test-done-items-separator01-eol ()
+  "Test item copying and here insertion at EOL of separator.
+Both should be user errors."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (let* ((copy-err "Item copying is not valid here")
+          (here-err "Item insertion is not valid here")
+          (insert-item-test (lambda (where)
+                              (should-error (todo-insert-item--basic
+                                             nil nil nil nil where)))))
+     (should (string= copy-err (cadr (funcall insert-item-test 'copy))))
+     (should (string= here-err (cadr (funcall insert-item-test 'here)))))))
+
+(ert-deftest todo-test-done-items-separator02-bol ()
+  "Test item editing commands at BOL of done items separator.
+They should all be noops."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (should-not (todo-item-done))
+   (should-not (todo-raise-item-priority))
+   (should-not (todo-lower-item-priority))
+   (should-not (called-interactively-p #'todo-set-item-priority))
+   (should-not (called-interactively-p #'todo-move-item))
+   (should-not (called-interactively-p #'todo-delete-item))
+   (should-not (called-interactively-p #'todo-edit-item))))
+
+(ert-deftest todo-test-done-items-separator02-eol ()
+  "Test item editing command at EOL of done items separator.
+They should all be noops."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (should-not (todo-item-done))
+   (should-not (todo-raise-item-priority))
+   (should-not (todo-lower-item-priority))
+   (should-not (called-interactively-p #'todo-set-item-priority))
+   (should-not (called-interactively-p #'todo-move-item))
+   (should-not (called-interactively-p #'todo-delete-item))
+   (should-not (called-interactively-p #'todo-edit-item))))
+
+(ert-deftest todo-test-done-items-separator03-bol ()
+  "Test item marking at BOL of done items separator.
+This should be a noop, adding no marks to the category."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (call-interactively #'todo-toggle-mark-item)
+   (should-not (assoc (todo-current-category) todo-categories-with-marks))))
+
+(ert-deftest todo-test-done-items-separator03-eol ()
+  "Test item marking at EOL of done items separator.
+This should be a noop, adding no marks to the category."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (call-interactively #'todo-toggle-mark-item)
+   (should-not (assoc (todo-current-category) todo-categories-with-marks))))
+
+(ert-deftest todo-test-done-items-separator04-bol ()
+  "Test moving to previous item from BOL of done items separator.
+This should move point to the last not done todo item."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (let ((last-item (save-excursion
+                      ;; Move to empty line after last todo item.
+                      (forward-line -1)
+                      (todo-previous-item)
+                      (todo-item-string))))
+     (should (string= last-item (save-excursion
+                                  (todo-previous-item)
+                                  (todo-item-string)))))))
+
+(ert-deftest todo-test-done-items-separator04-eol ()
+  "Test moving to previous item from EOL of done items separator.
+This should move point to the last not done todo item."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (let ((last-item (save-excursion
+                      ;; Move to empty line after last todo item.
+                      (forward-line -1)
+                      (todo-previous-item)
+                      (todo-item-string))))
+     (should (string= last-item (save-excursion
+                                  (todo-previous-item)
+                                  (todo-item-string)))))))
+
+(ert-deftest todo-test-done-items-separator05-bol ()
+  "Test moving to next item from BOL of done items separator.
+This should move point to the first done todo item."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (let ((first-done (save-excursion
+                      ;; Move to empty line after last todo item.
+                      (forward-line -1)
+                      (todo-next-item)
+                      (todo-item-string))))
+     (should (string= first-done (save-excursion
+                                  (todo-next-item)
+                                  (todo-item-string)))))))
+
+(ert-deftest todo-test-done-items-separator05-eol ()
+  "Test moving to next item from EOL of done items separator.
+This should move point to the first done todo item."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (let ((first-done (save-excursion
+                      ;; Move to empty line after last todo item.
+                      (forward-line -1)
+                      (todo-next-item)
+                      (todo-item-string))))
+     (should (string= first-done (save-excursion
+                                  (todo-next-item)
+                                  (todo-item-string)))))))
+
+;; Item highlighting uses hl-line-mode, which enables highlighting in
+;; post-command-hook.  For some reason, in the test environment, the
+;; hook function is not automatically run, so after enabling item
+;; highlighting, use ert-simulate-command around the next command,
+;; which explicitly runs the hook function.
+(ert-deftest todo-test-done-items-separator06-bol ()
+  "Test enabling item highlighting at BOL of done items separator.
+Subsequently moving to an item should show it highlighted."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (call-interactively #'todo-toggle-item-highlighting)
+   (ert-simulate-command '(todo-previous-item))
+   (should (eq 'hl-line (get-char-property (point) 'face)))))
+
+(ert-deftest todo-test-done-items-separator06-eol ()
+  "Test enabling item highlighting at EOL of done items separator.
+Subsequently moving to an item should show it highlighted."
+  (with-todo-test
+   (todo-test--done-items-separator 'eol)
+   (todo-toggle-item-highlighting)
+   (forward-line -1)
+   (ert-simulate-command '(todo-previous-item))
+   (should (eq 'hl-line (get-char-property (point) 'face)))))
+
+(ert-deftest todo-test-done-items-separator07 ()
+  "Test item highlighting when crossing done items separator.
+The highlighting should remain enabled."
+  (with-todo-test
+   (todo-test--done-items-separator)
+   (todo-previous-item)
+   (todo-toggle-item-highlighting)
+   (todo-next-item)               ; Now on empty line above separator.
+   (forward-line)                 ; Now on separator.
+   (ert-simulate-command '(forward-line)) ; Now on first done item.
+   (should (eq 'hl-line (get-char-property (point) 'face)))))
+
 
 (provide 'todo-mode-tests)
 ;;; todo-mode-tests.el ends here