diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 5161ae8d668..80bea25acd8 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 159294f8162..325faeff514 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