aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStephen Berman2018-08-01 14:42:57 +0200
committerStephen Berman2018-08-01 14:42:57 +0200
commit22d463ed5ca262e1d8893b115c3f1237485fc7e0 (patch)
tree4dfed30b619e33c73f054dcd0075035b8a3d30fe
parentcabe9e5126bfed05643d595589031cce8a404255 (diff)
downloademacs-22d463ed5ca262e1d8893b115c3f1237485fc7e0.tar.gz
emacs-22d463ed5ca262e1d8893b115c3f1237485fc7e0.zip
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.
-rw-r--r--lisp/calendar/todo-mode.el81
-rw-r--r--test/lisp/calendar/todo-mode-tests.el190
2 files changed, 228 insertions, 43 deletions
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."
1860 (region (eq where 'region)) 1860 (region (eq where 'region))
1861 (here (eq where 'here)) 1861 (here (eq where 'here))
1862 diary-item) 1862 diary-item)
1863 (when copy 1863 (when (and arg here)
1864 (cond 1864 (user-error "Here insertion only valid in current category"))
1865 ((not (eq major-mode 'todo-mode)) 1865 (when (and (or copy here)
1866 (user-error "You must be in Todo mode to copy a todo item")) 1866 (or (not (eq major-mode 'todo-mode)) (todo-done-item-p)
1867 ((todo-done-item-p) 1867 (when copy (looking-at "^$"))
1868 (user-error "You cannot copy a done item as a new todo item")) 1868 (save-excursion
1869 ((looking-at "^$") 1869 (beginning-of-line)
1870 (user-error "Point must be on a todo item to copy it"))) 1870 ;; Point is on done items separator.
1871 (setq diary-item (todo-diary-item-p))) 1871 (looking-at todo-category-done))))
1872 (user-error (concat "Item " (if copy "copying" "insertion")
1873 " is not valid here")))
1874 (when copy (setq diary-item (todo-diary-item-p)))
1872 (when region 1875 (when region
1873 (let (use-empty-active-region) 1876 (let (use-empty-active-region)
1874 (unless (and todo-use-only-highlighted-region (use-region-p)) 1877 (unless (and todo-use-only-highlighted-region (use-region-p))
@@ -1876,7 +1879,6 @@ their associated keys and their effects."
1876 (let* ((obuf (current-buffer)) 1879 (let* ((obuf (current-buffer))
1877 (ocat (todo-current-category)) 1880 (ocat (todo-current-category))
1878 (opoint (point)) 1881 (opoint (point))
1879 (todo-mm (eq major-mode 'todo-mode))
1880 (cat+file (cond ((equal arg '(4)) 1882 (cat+file (cond ((equal arg '(4))
1881 (todo-read-category "Insert in category: ")) 1883 (todo-read-category "Insert in category: "))
1882 ((equal arg '(16)) 1884 ((equal arg '(16))
@@ -1931,7 +1933,6 @@ their associated keys and their effects."
1931 (unless todo-global-current-todo-file 1933 (unless todo-global-current-todo-file
1932 (setq todo-global-current-todo-file todo-current-todo-file)) 1934 (setq todo-global-current-todo-file todo-current-todo-file))
1933 (let ((buffer-read-only nil) 1935 (let ((buffer-read-only nil)
1934 (called-from-outside (not (and todo-mm (equal cat ocat))))
1935 done-only item-added) 1936 done-only item-added)
1936 (unless copy 1937 (unless copy
1937 (setq new-item 1938 (setq new-item
@@ -1955,14 +1956,8 @@ their associated keys and their effects."
1955 "\n\t" new-item nil nil 1))) 1956 "\n\t" new-item nil nil 1)))
1956 (unwind-protect 1957 (unwind-protect
1957 (progn 1958 (progn
1958 ;; Make sure the correct category is selected. There 1959 ;; If we just visited the file, no category is selected yet.
1959 ;; are two cases: (i) we just visited the file, so no 1960 (when (= (- (point-max) (point-min)) (buffer-size))
1960 ;; category is selected yet, or (ii) we invoked
1961 ;; insertion "here" from outside the category we want
1962 ;; to insert in (with priority insertion, category
1963 ;; selection is done by todo-set-item-priority).
1964 (when (or (= (- (point-max) (point-min)) (buffer-size))
1965 (and here called-from-outside))
1966 (todo-category-number cat) 1961 (todo-category-number cat)
1967 (todo-category-select)) 1962 (todo-category-select))
1968 ;; If only done items are displayed in category, 1963 ;; If only done items are displayed in category,
@@ -1973,16 +1968,7 @@ their associated keys and their effects."
1973 (setq done-only t) 1968 (setq done-only t)
1974 (todo-toggle-view-done-only)) 1969 (todo-toggle-view-done-only))
1975 (if here 1970 (if here
1976 (progn 1971 (todo-insert-with-overlays new-item)
1977 ;; If command was invoked with point in done
1978 ;; items section or outside of the current
1979 ;; category, can't insert "here", so to be
1980 ;; useful give new item top priority.
1981 (when (or (todo-done-item-section-p)
1982 called-from-outside
1983 done-only)
1984 (goto-char (point-min)))
1985 (todo-insert-with-overlays new-item))
1986 (todo-set-item-priority new-item cat t)) 1972 (todo-set-item-priority new-item cat t))
1987 (setq item-added t)) 1973 (setq item-added t))
1988 ;; If user cancels before setting priority, restore 1974 ;; If user cancels before setting priority, restore
@@ -2549,7 +2535,11 @@ whose value can be either of the symbols `raise' or `lower',
2549meaning to raise or lower the item's priority by one." 2535meaning to raise or lower the item's priority by one."
2550 (interactive) 2536 (interactive)
2551 (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower))) 2537 (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower)))
2552 (or (todo-done-item-p) (looking-at "^$"))) 2538 ;; Noop if point is not on a todo (i.e. not done) item.
2539 (or (todo-done-item-p) (looking-at "^$")
2540 ;; On done items separator.
2541 (save-excursion (beginning-of-line)
2542 (looking-at todo-category-done))))
2553 (let* ((item (or item (todo-item-string))) 2543 (let* ((item (or item (todo-item-string)))
2554 (marked (todo-marked-item-p)) 2544 (marked (todo-marked-item-p))
2555 (cat (or cat (cond ((eq major-mode 'todo-mode) 2545 (cat (or cat (cond ((eq major-mode 'todo-mode)
@@ -2697,9 +2687,13 @@ section in the category moved to."
2697 (interactive "P") 2687 (interactive "P")
2698 (let* ((cat1 (todo-current-category)) 2688 (let* ((cat1 (todo-current-category))
2699 (marked (assoc cat1 todo-categories-with-marks))) 2689 (marked (assoc cat1 todo-categories-with-marks)))
2700 ;; Noop if point is not on an item and there are no marked items. 2690 (unless
2701 (unless (and (looking-at "^$") 2691 ;; Noop if point is not on an item and there are no marked items.
2702 (not marked)) 2692 (and (or (looking-at "^$")
2693 ;; On done items separator.
2694 (save-excursion (beginning-of-line)
2695 (looking-at todo-category-done)))
2696 (not marked))
2703 (let* ((buffer-read-only) 2697 (let* ((buffer-read-only)
2704 (file1 todo-current-todo-file) 2698 (file1 todo-current-todo-file)
2705 (item (todo-item-string)) 2699 (item (todo-item-string))
@@ -2856,10 +2850,14 @@ visible."
2856 (let* ((cat (todo-current-category)) 2850 (let* ((cat (todo-current-category))
2857 (marked (assoc cat todo-categories-with-marks))) 2851 (marked (assoc cat todo-categories-with-marks)))
2858 (when marked (todo--user-error-if-marked-done-item)) 2852 (when marked (todo--user-error-if-marked-done-item))
2859 (unless (and (not marked) 2853 (unless
2860 (or (todo-done-item-p) 2854 ;; Noop if point is not on a todo (i.e. not done) item and
2861 ;; Point is between todo and done items. 2855 ;; there are no marked items.
2862 (looking-at "^$"))) 2856 (and (or (todo-done-item-p) (looking-at "^$")
2857 ;; On done items separator.
2858 (save-excursion (beginning-of-line)
2859 (looking-at todo-category-done)))
2860 (not marked))
2863 (let* ((date-string (calendar-date-string (calendar-current-date) t t)) 2861 (let* ((date-string (calendar-date-string (calendar-current-date) t t))
2864 (time-string (if todo-always-add-time-string 2862 (time-string (if todo-always-add-time-string
2865 (concat " " (substring (current-time-string) 2863 (concat " " (substring (current-time-string)
@@ -5132,6 +5130,8 @@ but the categories sexp differs from the current value of
5132 (forward-line) 5130 (forward-line)
5133 (looking-at (concat "^" 5131 (looking-at (concat "^"
5134 (regexp-quote todo-category-done)))))) 5132 (regexp-quote todo-category-done))))))
5133 ;; Point is on done items separator.
5134 (save-excursion (beginning-of-line) (looking-at todo-category-done))
5135 ;; Buffer is widened. 5135 ;; Buffer is widened.
5136 (looking-at (regexp-quote todo-category-beg))) 5136 (looking-at (regexp-quote todo-category-beg)))
5137 (goto-char (line-beginning-position)) 5137 (goto-char (line-beginning-position))
@@ -5141,8 +5141,11 @@ but the categories sexp differs from the current value of
5141 5141
5142(defun todo-item-end () 5142(defun todo-item-end ()
5143 "Move to end of current todo item and return its position." 5143 "Move to end of current todo item and return its position."
5144 ;; Items cannot end with a blank line. 5144 (unless (or
5145 (unless (looking-at "^$") 5145 ;; Items cannot end with a blank line.
5146 (looking-at "^$")
5147 ;; Point is on done items separator.
5148 (save-excursion (beginning-of-line) (looking-at todo-category-done)))
5146 (let* ((done (todo-done-item-p)) 5149 (let* ((done (todo-done-item-p))
5147 (to-lim nil) 5150 (to-lim nil)
5148 ;; For todo items, end is before the done items section, for done 5151 ;; 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 @@
25;;; Code: 25;;; Code:
26 26
27(require 'ert) 27(require 'ert)
28(require 'ert-x)
28(require 'todo-mode) 29(require 'todo-mode)
29 30
30(defvar todo-test-data-dir 31(defvar todo-test-data-dir
@@ -561,11 +562,12 @@ source file is different."
561 ;; Headers in the todo file are still hidden. 562 ;; Headers in the todo file are still hidden.
562 (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) 563 (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
563 564
564(defun todo-test--insert-item (item &optional priority) 565(defun todo-test--insert-item (item &optional priority
566 _arg diary-type date-type time where)
565 "Insert string ITEM into current category with priority PRIORITY. 567 "Insert string ITEM into current category with priority PRIORITY.
566Use defaults for all other item insertion parameters. This 568The remaining arguments (except _ARG, which is ignored) specify
567provides a noninteractive API for todo-insert-item for use in 569item insertion parameters. This provides a noninteractive API
568automatic testing." 570for todo-insert-item for use in automatic testing."
569 (cl-letf (((symbol-function 'read-from-minibuffer) 571 (cl-letf (((symbol-function 'read-from-minibuffer)
570 (lambda (_prompt) item)) 572 (lambda (_prompt) item))
571 ((symbol-function 'read-number) ; For todo-set-item-priority 573 ((symbol-function 'read-number) ; For todo-set-item-priority
@@ -581,6 +583,186 @@ automatic testing."
581 (todo-test--insert-item item 1) 583 (todo-test--insert-item item 1)
582 (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) 584 (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
583 585
586(defun todo-test--done-items-separator (&optional eol)
587 "Set up test of command interaction with done items separator.
588With non-nil argument EOL, return the position at the end of the
589separator, otherwise, return the position at the beginning."
590 (todo-test--show 1)
591 (goto-char (point-max))
592 ;; See comment about recentering in todo-test-raise-lower-priority.
593 (set-window-buffer nil (current-buffer))
594 (todo-toggle-view-done-items)
595 ;; FIXME: Point should now be on the first done item, and in batch
596 ;; testing it is, so we have to move back one line to the done items
597 ;; separator; but for some reason, in the graphical test
598 ;; environment, it stays on the last empty line of the todo items
599 ;; section, so there we have to advance one character to the done
600 ;; items separator.
601 (if (display-graphic-p)
602 (forward-char)
603 (forward-line -1))
604 (if eol (forward-char)))
605
606(ert-deftest todo-test-done-items-separator01-bol ()
607 "Test item copying and here insertion at BOL of separator.
608Both should be user errors."
609 (with-todo-test
610 (todo-test--done-items-separator)
611 (let* ((copy-err "Item copying is not valid here")
612 (here-err "Item insertion is not valid here")
613 (insert-item-test (lambda (where)
614 (should-error (todo-insert-item--basic
615 nil nil nil nil where)))))
616 (should (string= copy-err (cadr (funcall insert-item-test 'copy))))
617 (should (string= here-err (cadr (funcall insert-item-test 'here)))))))
618
619(ert-deftest todo-test-done-items-separator01-eol ()
620 "Test item copying and here insertion at EOL of separator.
621Both should be user errors."
622 (with-todo-test
623 (todo-test--done-items-separator 'eol)
624 (let* ((copy-err "Item copying is not valid here")
625 (here-err "Item insertion is not valid here")
626 (insert-item-test (lambda (where)
627 (should-error (todo-insert-item--basic
628 nil nil nil nil where)))))
629 (should (string= copy-err (cadr (funcall insert-item-test 'copy))))
630 (should (string= here-err (cadr (funcall insert-item-test 'here)))))))
631
632(ert-deftest todo-test-done-items-separator02-bol ()
633 "Test item editing commands at BOL of done items separator.
634They should all be noops."
635 (with-todo-test
636 (todo-test--done-items-separator)
637 (should-not (todo-item-done))
638 (should-not (todo-raise-item-priority))
639 (should-not (todo-lower-item-priority))
640 (should-not (called-interactively-p #'todo-set-item-priority))
641 (should-not (called-interactively-p #'todo-move-item))
642 (should-not (called-interactively-p #'todo-delete-item))
643 (should-not (called-interactively-p #'todo-edit-item))))
644
645(ert-deftest todo-test-done-items-separator02-eol ()
646 "Test item editing command at EOL of done items separator.
647They should all be noops."
648 (with-todo-test
649 (todo-test--done-items-separator 'eol)
650 (should-not (todo-item-done))
651 (should-not (todo-raise-item-priority))
652 (should-not (todo-lower-item-priority))
653 (should-not (called-interactively-p #'todo-set-item-priority))
654 (should-not (called-interactively-p #'todo-move-item))
655 (should-not (called-interactively-p #'todo-delete-item))
656 (should-not (called-interactively-p #'todo-edit-item))))
657
658(ert-deftest todo-test-done-items-separator03-bol ()
659 "Test item marking at BOL of done items separator.
660This should be a noop, adding no marks to the category."
661 (with-todo-test
662 (todo-test--done-items-separator)
663 (call-interactively #'todo-toggle-mark-item)
664 (should-not (assoc (todo-current-category) todo-categories-with-marks))))
665
666(ert-deftest todo-test-done-items-separator03-eol ()
667 "Test item marking at EOL of done items separator.
668This should be a noop, adding no marks to the category."
669 (with-todo-test
670 (todo-test--done-items-separator 'eol)
671 (call-interactively #'todo-toggle-mark-item)
672 (should-not (assoc (todo-current-category) todo-categories-with-marks))))
673
674(ert-deftest todo-test-done-items-separator04-bol ()
675 "Test moving to previous item from BOL of done items separator.
676This should move point to the last not done todo item."
677 (with-todo-test
678 (todo-test--done-items-separator)
679 (let ((last-item (save-excursion
680 ;; Move to empty line after last todo item.
681 (forward-line -1)
682 (todo-previous-item)
683 (todo-item-string))))
684 (should (string= last-item (save-excursion
685 (todo-previous-item)
686 (todo-item-string)))))))
687
688(ert-deftest todo-test-done-items-separator04-eol ()
689 "Test moving to previous item from EOL of done items separator.
690This should move point to the last not done todo item."
691 (with-todo-test
692 (todo-test--done-items-separator 'eol)
693 (let ((last-item (save-excursion
694 ;; Move to empty line after last todo item.
695 (forward-line -1)
696 (todo-previous-item)
697 (todo-item-string))))
698 (should (string= last-item (save-excursion
699 (todo-previous-item)
700 (todo-item-string)))))))
701
702(ert-deftest todo-test-done-items-separator05-bol ()
703 "Test moving to next item from BOL of done items separator.
704This should move point to the first done todo item."
705 (with-todo-test
706 (todo-test--done-items-separator)
707 (let ((first-done (save-excursion
708 ;; Move to empty line after last todo item.
709 (forward-line -1)
710 (todo-next-item)
711 (todo-item-string))))
712 (should (string= first-done (save-excursion
713 (todo-next-item)
714 (todo-item-string)))))))
715
716(ert-deftest todo-test-done-items-separator05-eol ()
717 "Test moving to next item from EOL of done items separator.
718This should move point to the first done todo item."
719 (with-todo-test
720 (todo-test--done-items-separator 'eol)
721 (let ((first-done (save-excursion
722 ;; Move to empty line after last todo item.
723 (forward-line -1)
724 (todo-next-item)
725 (todo-item-string))))
726 (should (string= first-done (save-excursion
727 (todo-next-item)
728 (todo-item-string)))))))
729
730;; Item highlighting uses hl-line-mode, which enables highlighting in
731;; post-command-hook. For some reason, in the test environment, the
732;; hook function is not automatically run, so after enabling item
733;; highlighting, use ert-simulate-command around the next command,
734;; which explicitly runs the hook function.
735(ert-deftest todo-test-done-items-separator06-bol ()
736 "Test enabling item highlighting at BOL of done items separator.
737Subsequently moving to an item should show it highlighted."
738 (with-todo-test
739 (todo-test--done-items-separator)
740 (call-interactively #'todo-toggle-item-highlighting)
741 (ert-simulate-command '(todo-previous-item))
742 (should (eq 'hl-line (get-char-property (point) 'face)))))
743
744(ert-deftest todo-test-done-items-separator06-eol ()
745 "Test enabling item highlighting at EOL of done items separator.
746Subsequently moving to an item should show it highlighted."
747 (with-todo-test
748 (todo-test--done-items-separator 'eol)
749 (todo-toggle-item-highlighting)
750 (forward-line -1)
751 (ert-simulate-command '(todo-previous-item))
752 (should (eq 'hl-line (get-char-property (point) 'face)))))
753
754(ert-deftest todo-test-done-items-separator07 ()
755 "Test item highlighting when crossing done items separator.
756The highlighting should remain enabled."
757 (with-todo-test
758 (todo-test--done-items-separator)
759 (todo-previous-item)
760 (todo-toggle-item-highlighting)
761 (todo-next-item) ; Now on empty line above separator.
762 (forward-line) ; Now on separator.
763 (ert-simulate-command '(forward-line)) ; Now on first done item.
764 (should (eq 'hl-line (get-char-property (point) 'face)))))
765
584 766
585(provide 'todo-mode-tests) 767(provide 'todo-mode-tests)
586;;; todo-mode-tests.el ends here 768;;; todo-mode-tests.el ends here