1004 lines
42 KiB
EmacsLisp
1004 lines
42 KiB
EmacsLisp
;;; todo-mode-tests.el --- tests for todo-mode.el -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2017-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Stephen Berman <stephen.berman@gmx.net>
|
|
;; Keywords: calendar
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'ert-x)
|
|
(require 'todo-mode)
|
|
|
|
(defvar todo-test-file-1 (ert-resource-file "todo-test-1.todo")
|
|
"Todo mode test file.")
|
|
|
|
(defvar todo-test-archive-1 (ert-resource-file "todo-test-1.toda")
|
|
"Todo Archive mode test file.")
|
|
|
|
(defmacro with-todo-test (&rest body)
|
|
"Set up an isolated `todo-mode' test environment."
|
|
(declare (debug (body)))
|
|
`(ert-with-temp-directory todo-test-home
|
|
(let* (;; Since we change HOME, clear this to avoid a conflict
|
|
;; e.g. if Emacs runs within the user's home directory.
|
|
(abbreviated-home-dir nil)
|
|
(process-environment (cons (format "HOME=%s" todo-test-home)
|
|
process-environment))
|
|
(todo-directory (ert-resource-directory))
|
|
(todo-default-todo-file (todo-short-file-name
|
|
(car (funcall todo-files-function)))))
|
|
(unwind-protect
|
|
(progn ,@body)
|
|
;; Restore pre-test-run state of test files.
|
|
(dolist (f (directory-files todo-directory))
|
|
(let ((buf (get-file-buffer f)))
|
|
(when buf
|
|
(with-current-buffer buf
|
|
(restore-buffer-modified-p nil)
|
|
(kill-buffer)))))))))
|
|
|
|
(defun todo-test--show (num &optional archive)
|
|
"Display category NUM of test todo file.
|
|
With non-nil ARCHIVE argument, display test archive file category."
|
|
(let* ((file (if archive todo-test-archive-1 todo-test-file-1))
|
|
(buf (find-file-noselect file)))
|
|
(set-buffer buf)
|
|
(if archive (todo-archive-mode) (todo-mode))
|
|
(setq todo-category-number num)
|
|
(todo-category-select)
|
|
(goto-char (point-min))))
|
|
|
|
;; (defun todo-test-get-archive (num)
|
|
;; "Display category NUM of todo archive test file."
|
|
;; (let ((archive-buf (find-file-noselect todo-test-archive-1)))
|
|
;; (set-buffer archive-buf)
|
|
;; (todo-archive-mode)
|
|
;; (setq todo-category-number num)
|
|
;; (todo-category-select)))
|
|
|
|
(defun todo-test--is-current-buffer (filename)
|
|
"Return non-nil if FILENAME's buffer is current."
|
|
(let ((bufname (buffer-file-name (current-buffer))))
|
|
(and bufname (equal (file-truename bufname) filename))))
|
|
|
|
(ert-deftest todo-test-todo-quit01 ()
|
|
"Test the behavior of todo-quit with archive and todo files.
|
|
Invoking todo-quit in todo-archive-mode should make the
|
|
corresponding todo-mode category current, if it exits, otherwise
|
|
the current todo-mode category. Quitting todo-mode without an
|
|
intermediate buffer switch should not make the archive buffer
|
|
current again."
|
|
(with-todo-test
|
|
(todo-test--show 2 'archive)
|
|
(let ((cat-name (todo-current-category)))
|
|
(todo-quit)
|
|
(should (todo-test--is-current-buffer todo-test-file-1))
|
|
(should (equal (todo-current-category) cat-name))
|
|
(todo-test--show 1 'archive)
|
|
(setq cat-name (todo-current-category))
|
|
(todo-quit)
|
|
(should (todo-test--is-current-buffer todo-test-file-1))
|
|
(should (equal todo-category-number 1))
|
|
(todo-forward-category) ; Category 2 in todo file now current.
|
|
(todo-test--show 3 'archive) ; No corresponding category in todo file.
|
|
(setq cat-name (todo-current-category))
|
|
(todo-quit)
|
|
(should (todo-test--is-current-buffer todo-test-file-1))
|
|
(should (equal todo-category-number 2))
|
|
(todo-quit)
|
|
(should-not (todo-test--is-current-buffer todo-test-archive-1)))))
|
|
|
|
(ert-deftest todo-test-todo-quit02 () ; bug#27121
|
|
"Test the behavior of todo-quit with todo and non-todo buffers.
|
|
If the buffer made current by invoking todo-quit in a todo-mode
|
|
buffer is buried by quit-window, the todo-mode buffer should not
|
|
become current."
|
|
(with-todo-test
|
|
(todo-show)
|
|
(should (todo-test--is-current-buffer todo-test-file-1))
|
|
(let ((dir (dired default-directory)))
|
|
(todo-show)
|
|
(todo-quit)
|
|
(should (equal (current-buffer) dir))
|
|
(quit-window)
|
|
(should-not (todo-test--is-current-buffer todo-test-file-1)))))
|
|
|
|
(ert-deftest todo-test-item-highlighting () ; bug#27133
|
|
"Test whether `todo-toggle-item-highlighting' highlights whole item.
|
|
In particular, all lines of a multiline item should be highlighted."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(todo-toggle-item-highlighting)
|
|
(let ((end (1- (todo-item-end)))
|
|
(beg (todo-item-start)))
|
|
(should (eq (get-char-property beg 'face) 'hl-line))
|
|
(should (eq (get-char-property end 'face) 'hl-line))
|
|
(should (> (count-lines beg end) 1))
|
|
(should (eq (next-single-char-property-change beg 'face) (1+ end))))
|
|
(todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun).
|
|
|
|
(ert-deftest todo-test-revert-buffer01 () ; bug#27609
|
|
"Test whether todo-mode buffer remains read-only after reverting."
|
|
(with-todo-test
|
|
(todo-show)
|
|
(let ((opoint (point)))
|
|
(should (equal buffer-read-only t))
|
|
(todo-revert-buffer nil t)
|
|
(should (equal buffer-read-only t))
|
|
(should (eq (point) opoint)))))
|
|
|
|
(ert-deftest todo-test-revert-buffer02 () ; bug#27609
|
|
"Test whether todo-archive-mode buffer remains read-only after reverting."
|
|
(with-todo-test
|
|
(todo-test--show 1 'archive)
|
|
(let ((opoint (point)))
|
|
(should (equal buffer-read-only t))
|
|
(todo-revert-buffer nil t)
|
|
(should (equal buffer-read-only t))
|
|
(should (eq (point) opoint)))))
|
|
|
|
(ert-deftest todo-test-raise-lower-priority ()
|
|
"Test the behavior of todo-{raise,lower}-item-priority."
|
|
(with-todo-test
|
|
;; (todo-show)
|
|
(todo-test--show 1)
|
|
(goto-char (point-min))
|
|
(let ((p1 (point))
|
|
(s1 (todo-item-string))
|
|
p2 s2 p3 p4)
|
|
;; First item in category.
|
|
(should (equal p1 (todo-item-start)))
|
|
(todo-next-item)
|
|
(setq p2 (point))
|
|
;; Second item in category.
|
|
(setq s2 (todo-item-string))
|
|
;; Second item is lower.
|
|
(should (> p2 p1))
|
|
;; Case 1: lowering priority.
|
|
(todo-previous-item)
|
|
(todo-lower-item-priority)
|
|
;; Now what was the first item is the second and vice versa.
|
|
(setq p1 (point))
|
|
(should (equal s1 (todo-item-string)))
|
|
(todo-previous-item)
|
|
(setq p2 (point))
|
|
(should (equal s2 (todo-item-string)))
|
|
(should (> p1 p2))
|
|
;; Case 2: raising priority.
|
|
(todo-next-item)
|
|
(todo-raise-item-priority)
|
|
;; Now what had become the second item is again the first and
|
|
;; vice versa.
|
|
(setq p1 (point))
|
|
(should (equal s1 (todo-item-string)))
|
|
(todo-next-item)
|
|
(setq p2 (point))
|
|
(should (equal s2 (todo-item-string)))
|
|
(should (> p2 p1))
|
|
;; Case 3: empty line (bug#27609).
|
|
(goto-char (point-max))
|
|
;; The last line in the category is always empty.
|
|
(should-not (todo-item-string))
|
|
(todo-raise-item-priority)
|
|
;; Raising item priority on the empty string is a noop.
|
|
(should (equal (point) (point-max)))
|
|
(todo-lower-item-priority)
|
|
;; Lowering item priority on the empty string is a noop.
|
|
(should (equal (point) (point-max)))
|
|
;; Case 4: done item (bug#27609).
|
|
;; todo-toggle-view-done-items recenters the window if point is
|
|
;; not visible, so we have to make sure the todo-mode buffer is
|
|
;; in a live window in the test run to avoid failing with (error
|
|
;; "`recenter'ing a window that does not display ;; current-buffer.").
|
|
;; (But this is not necessary in todo-test-toggle-item-header01
|
|
;; below -- why not, or why is it here? Note that without
|
|
;; setting window buffer, the test only fails on the first run --
|
|
;; on rerunning it passes.)
|
|
(set-window-buffer nil (current-buffer))
|
|
(todo-toggle-view-done-items)
|
|
(todo-next-item)
|
|
;; Now the current item is the first done item.
|
|
(should (todo-done-item-p))
|
|
(setq p3 (point))
|
|
(todo-raise-item-priority)
|
|
;; Raising item priority on a done item is a noop.
|
|
(should (eq (point) p3))
|
|
(todo-lower-item-priority)
|
|
;; Lowering item priority on a done item is a noop.
|
|
(should (eq (point) p3))
|
|
;; Case 5: raising first item and lowering last item.
|
|
(goto-char (point-min)) ; Now on first item.
|
|
;; Changing item priority moves point to todo-item-start, so move
|
|
;; it away from there for the test.
|
|
(end-of-line)
|
|
(setq p4 (point))
|
|
(todo-raise-item-priority)
|
|
;; Raising priority of first item is a noop.
|
|
(should (equal (point) p4))
|
|
(goto-char (point-max))
|
|
(todo-previous-item) ; Now on last item.
|
|
(end-of-line)
|
|
(setq p4 (point))
|
|
(todo-lower-item-priority)
|
|
(should (equal (point) p4)))))
|
|
|
|
(ert-deftest todo-test-todo-mark-unmark-category () ; bug#27609
|
|
"Test behavior of todo-mark-category and todo-unmark-category."
|
|
(with-todo-test
|
|
(todo-show)
|
|
(let ((cat (todo-current-category)))
|
|
(todo-mark-category)
|
|
(should (equal (todo-get-count 'todo cat)
|
|
(cdr (assoc cat todo-categories-with-marks))))
|
|
(todo-unmark-category)
|
|
(should-not (assoc cat todo-categories-with-marks)))))
|
|
|
|
(defun todo-test--move-item (cat &optional priority file)
|
|
"Move item(s) to category CAT with priority PRIORITY (for todo item).
|
|
This provides a noninteractive API for todo-move-item for use in
|
|
automatic testing."
|
|
(let ((cat0 (car (nth (1- cat) todo-categories)))
|
|
(file0 (or file todo-current-todo-file)))
|
|
(cl-letf (((symbol-function 'todo-read-category)
|
|
(lambda (_prompt &optional _match-type _file) (cons cat0 file0)))
|
|
((symbol-function 'read-number) ; For todo-set-item-priority
|
|
(lambda (_prompt &optional _default) (or priority 1))))
|
|
(todo-move-item))))
|
|
|
|
(ert-deftest todo-test-move-item01 ()
|
|
"Test moving a todo item to another category with a given priority."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let* ((cat1 (todo-current-category))
|
|
(cat2 (car (nth 1 todo-categories)))
|
|
(cat1-todo (todo-get-count 'todo cat1))
|
|
(cat2-todo (todo-get-count 'todo cat2))
|
|
(item (todo-item-string)))
|
|
(todo-test--move-item 2 3)
|
|
(should (equal (todo-current-category) cat2))
|
|
(should (equal (todo-item-string) item))
|
|
(should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
|
|
"3 "))
|
|
(todo-backward-category) ; Go to first category again.
|
|
(should-error (search-forward item))
|
|
(should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
|
|
(should (= (todo-get-count 'todo cat2) (1+ cat2-todo))))))
|
|
|
|
(ert-deftest todo-test-move-item02 () ; bug#27609
|
|
"Test moving a marked todo item to previous category."
|
|
(with-todo-test
|
|
(todo-test--show 2)
|
|
(let* ((cat2 (todo-current-category))
|
|
(cat1 (car (nth 0 todo-categories)))
|
|
(cat2-todo (todo-get-count 'todo cat2))
|
|
(cat1-todo (todo-get-count 'todo cat1))
|
|
(item (todo-item-string)))
|
|
;; If todo-toggle-mark-item is not called interactively, its
|
|
;; optional prefix argument evaluates to nil and this raises a
|
|
;; wrong-type-argument error.
|
|
(call-interactively 'todo-toggle-mark-item)
|
|
(todo-test--move-item 1)
|
|
(should (equal (todo-current-category) cat1))
|
|
(should (equal (todo-item-string) item))
|
|
(should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
|
|
"1 "))
|
|
(todo-forward-category) ; Go to second category again.
|
|
(should-error (search-forward item))
|
|
(should (= (todo-get-count 'todo cat1) (1+ cat1-todo)))
|
|
(should (= (todo-get-count 'todo cat2) (1- cat2-todo))))))
|
|
|
|
(ert-deftest todo-test-move-item03 () ; bug#27609
|
|
"Test moving a done item to another category.
|
|
In the new category it should be the first done item."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let* ((cat1 (todo-current-category))
|
|
(cat2 (car (nth 1 todo-categories)))
|
|
(cat1-done (todo-get-count 'done cat1))
|
|
(cat2-done (todo-get-count 'done cat2)))
|
|
(goto-char (point-max))
|
|
(set-window-buffer nil (current-buffer)) ; Why is this necessary?
|
|
(todo-toggle-view-done-items)
|
|
(todo-next-item)
|
|
(let ((item (todo-item-string)))
|
|
(todo-test--move-item 2)
|
|
(should (equal (todo-current-category) cat2))
|
|
(should (equal (todo-item-string) item))
|
|
(should (todo-done-item-p))
|
|
(forward-line -1)
|
|
(should (looking-at todo-category-done))
|
|
(todo-backward-category)
|
|
(should-error (search-forward item))
|
|
(should (= (todo-get-count 'done cat1) (1- cat1-done)))
|
|
(should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
|
|
|
|
(ert-deftest todo-test-move-item04 () ; bug#27609
|
|
"Test moving both a todo and a done item to another category.
|
|
In the new category the todo item should have the provided
|
|
priority and the done item should be the first done item."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let* ((cat1 (todo-current-category))
|
|
(cat2 (car (nth 1 todo-categories)))
|
|
(cat1-todo (todo-get-count 'todo cat1))
|
|
(cat2-todo (todo-get-count 'todo cat2))
|
|
(cat1-done (todo-get-count 'done cat1))
|
|
(cat2-done (todo-get-count 'done cat2))
|
|
(todo-item (todo-item-string)))
|
|
(call-interactively 'todo-toggle-mark-item)
|
|
(goto-char (point-max))
|
|
;; Why is this necessary here but not below?
|
|
(set-window-buffer nil (current-buffer))
|
|
(todo-toggle-view-done-items)
|
|
(todo-next-item)
|
|
(let ((done-item (todo-item-string)))
|
|
(call-interactively 'todo-toggle-mark-item)
|
|
(todo-test--move-item 2 3)
|
|
(should (equal (todo-current-category) cat2))
|
|
;; Point should be on the moved todo item.
|
|
(should (equal (todo-item-string) todo-item))
|
|
;; Done items section should be visible and the move done item
|
|
;; should be at the top of it.
|
|
(should (search-forward done-item))
|
|
(should (todo-done-item-p))
|
|
(forward-line -1)
|
|
(should (looking-at todo-category-done))
|
|
;; Make sure marked items are no longer in first category.
|
|
(todo-backward-category)
|
|
(should-error (search-forward todo-item))
|
|
(todo-toggle-view-done-items)
|
|
(should-error (search-forward done-item))
|
|
(should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
|
|
(should (= (todo-get-count 'todo cat2) (1+ cat2-todo)))
|
|
(should (= (todo-get-count 'done cat1) (1- cat1-done)))
|
|
(should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
|
|
|
|
(ert-deftest todo-test-move-item05 () ; bug#27609
|
|
"Test moving multiple todo and done items to another category.
|
|
Both types of item should be moved en bloc to the new category,
|
|
and the top todo item should have the provided priority and
|
|
the top done item should be the first done item."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let* ((cat1 (todo-current-category))
|
|
(cat2 (car (nth 1 todo-categories)))
|
|
(cat1-todo (todo-get-count 'todo cat1))
|
|
(cat2-todo (todo-get-count 'todo cat2))
|
|
(cat1-done (todo-get-count 'done cat1))
|
|
(cat2-done (todo-get-count 'done cat2))
|
|
(todo-items (buffer-string))
|
|
(done-items (prog2 (todo-toggle-view-done-only)
|
|
(buffer-string)
|
|
(todo-toggle-view-done-only))))
|
|
;; Why is this necessary here but not below?
|
|
(set-window-buffer nil (current-buffer))
|
|
(todo-toggle-view-done-items)
|
|
(todo-mark-category)
|
|
(todo-test--move-item 2 3)
|
|
(should (equal (todo-current-category) cat2))
|
|
;; Point should be at the start of the first moved todo item.
|
|
(should (looking-at (regexp-quote todo-items)))
|
|
;; Done items section should be visible and the move done item
|
|
;; should be at the top of it.
|
|
(should (search-forward done-items))
|
|
(goto-char (match-beginning 0))
|
|
(should (todo-done-item-p))
|
|
(forward-line -1)
|
|
(should (looking-at todo-category-done))
|
|
;; Make sure marked items are no longer in first category. Since
|
|
;; cat1 now contains no todo or done items but does have archived
|
|
;; items, todo-backward-category would skip it by default, so
|
|
;; prevent this. (FIXME: Without this let-binding,
|
|
;; todo-backward-category selects the nonempty cat4 and this test
|
|
;; fails as expected when run interactively but not in a batch
|
|
;; run -- why?)
|
|
(let (todo-skip-archived-categories)
|
|
(todo-backward-category))
|
|
(should (eq (point-min) (point-max))) ; All todo items were moved.
|
|
;; This passes when run interactively but fails in a batch run:
|
|
;; the message is displayed but (current-message) evaluates to
|
|
;; nil.
|
|
;; (todo-toggle-view-done-items) ; All done items were moved.
|
|
;; (let ((msg (current-message)))
|
|
;; (should (equal msg "There are no done items in this category.")))
|
|
(todo-toggle-view-done-only)
|
|
(should (eq (point-min) (point-max))) ; All done items were moved.
|
|
(should (= (todo-get-count 'todo cat1) 0))
|
|
(should (= (todo-get-count 'todo cat2) (+ cat1-todo cat2-todo)))
|
|
(should (= (todo-get-count 'done cat1) 0))
|
|
(should (= (todo-get-count 'done cat2) (+ cat1-done cat2-done))))))
|
|
|
|
(ert-deftest todo-test-toggle-item-header01 () ; bug#27609
|
|
"Test toggling item header from an empty category."
|
|
(with-todo-test
|
|
(todo-test--show 3)
|
|
(should (eq (point-min) (point-max))) ; Category is empty.
|
|
(todo-toggle-item-header)
|
|
(todo-backward-category)
|
|
;; Header is hidden.
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
(todo-forward-category)
|
|
(todo-toggle-item-header)
|
|
(todo-backward-category)
|
|
;; Header is shown.
|
|
(should-not (todo-get-overlay 'header))))
|
|
|
|
;; FIXME: This test doesn't show the effect of the display overlay on
|
|
;; calling todo-next-item in todo-mode: When using Todo mode, the
|
|
;; display engine moves point out of the overlay, but here point does
|
|
;; not get moved, even when display-graphic-p.
|
|
(ert-deftest todo-test-toggle-item-header02 () ; bug#27609
|
|
"Test navigating between items with hidden header."
|
|
;; This makes no difference for testing todo-next-item.
|
|
;; (skip-unless (display-graphic-p))
|
|
(with-todo-test
|
|
(todo-test--show 2)
|
|
(let* ((start0 (point))
|
|
(find-start (lambda ()
|
|
(re-search-forward
|
|
(concat todo-date-string-start
|
|
todo-date-pattern
|
|
"\\( " diary-time-regexp "\\)?"
|
|
(regexp-quote todo-nondiary-end) "?")
|
|
(pos-eol) t)
|
|
(forward-char)
|
|
(point)))
|
|
(start1 (save-excursion (funcall find-start)))
|
|
(start2 (save-excursion (todo-next-item) (funcall find-start))))
|
|
(should (looking-at todo-item-start))
|
|
(todo-toggle-item-header)
|
|
;; Point hasn't changed...
|
|
(should (eq (point) start0))
|
|
(should (looking-at todo-item-start))
|
|
(todo-next-item)
|
|
;; FIXME: This should (and when using todo-mode does) put point
|
|
;; at the start of the item's test, not at todo-item-start, like
|
|
;; todo-previous-item below. But the following tests fail; why?
|
|
;; (N.B.: todo-backward-item, called by todo-previous-item,
|
|
;; explicitly moves point forward to where it needs to be because
|
|
;; otherwise the display engine moves it backward.)
|
|
;; (should (eq (point) start2))
|
|
;; (should-not (looking-at todo-item-start))
|
|
;; And these pass, though they shouldn't:
|
|
(should-not (eq (point) start2))
|
|
(should (looking-at todo-item-start))
|
|
(todo-previous-item)
|
|
;; ...but now it has.
|
|
(should (eq (point) start1))
|
|
(should-not (looking-at todo-item-start))
|
|
;; This fails just like the above.
|
|
;; (todo-next-item)
|
|
;; (should (eq (point) start2))
|
|
;; (should-not (looking-at todo-item-start))
|
|
;; This is the status quo but is it desirable?
|
|
(todo-toggle-item-header)
|
|
(should (eq (point) start1))
|
|
(should-not (looking-at todo-item-start)))))
|
|
|
|
(ert-deftest todo-test-toggle-item-header03 () ; bug#27609
|
|
"Test display of hidden item header when changing item's priority."
|
|
(with-todo-test
|
|
(todo-test--show 2)
|
|
(todo-toggle-item-header)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
(todo-lower-item-priority)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
(todo-raise-item-priority)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
;; Set priority noninteractively.
|
|
(cl-letf (((symbol-function 'read-number)
|
|
(lambda (_prompt &optional _default) 3)))
|
|
(todo-item-undone))
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
|
|
|
|
(ert-deftest todo-test-toggle-item-header04 () ; bug#27609
|
|
"Test display of hidden item header under todo-item-(un)done."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let ((item (todo-item-string)))
|
|
(todo-toggle-item-header)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
(todo-item-done)
|
|
;; Without set-window-buffer here this test passes when run
|
|
;; interactively but fails in a batch run.
|
|
(set-window-buffer nil (current-buffer))
|
|
(todo-toggle-view-done-items)
|
|
(should (search-forward item))
|
|
(todo-item-start)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
|
|
;; Set priority for todo-item-undone noninteractively.
|
|
(cl-letf (((symbol-function 'read-number)
|
|
(lambda (_prompt &optional _default) 1)))
|
|
(todo-item-undone))
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
|
|
|
|
(ert-deftest todo-test-toggle-item-header05 () ; bug#27609
|
|
"Test display of hidden item header under todo-move-item."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(todo-toggle-item-header)
|
|
(todo-test--move-item 2 3)
|
|
(should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
|
|
|
|
(ert-deftest todo-test-toggle-item-header06 () ; bug#27609
|
|
"Test display of hidden item header under (un)archiving.
|
|
The relocated item's header should take on the display status of
|
|
headers in the goal file, even when the display status in the
|
|
source file is different."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(todo-toggle-item-header)
|
|
(todo-toggle-view-done-only) ; Go to first (i.e. top) done item.
|
|
(let ((item (todo-item-string)))
|
|
(todo-archive-done-item)
|
|
(todo-toggle-view-done-only) ; To display all items on unarchiving.
|
|
(todo-find-archive)
|
|
(should (equal (todo-item-string) item)) ; The just archived item.
|
|
;; The archive file headers are displayed by default.
|
|
(should-not (todo-get-overlay 'header))
|
|
(todo-unarchive-items)
|
|
;; 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
|
|
_arg diary-type date-type time where)
|
|
"Insert string ITEM into current category with priority PRIORITY.
|
|
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 &rest _) item))
|
|
((symbol-function 'read-number) ; For todo-set-item-priority
|
|
(lambda (_prompt &optional _default) (or priority 1))))
|
|
(todo-insert-item--basic nil diary-type date-type time where)))
|
|
|
|
(ert-deftest todo-test-toggle-item-header07 () ; bug#27609
|
|
"Test display of hidden item header under todo-insert-item."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(todo-toggle-item-header)
|
|
(let ((item "Test display of hidden item header under todo-insert-item."))
|
|
(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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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 () ; bug#32343
|
|
"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)))))
|
|
|
|
(ert-deftest todo-test-current-file-in-edit-mode () ; bug#32437
|
|
"Test the value of todo-current-todo-file in todo-edit-mode."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
;; The preceding calls todo-mode but does not run pre-command-hook
|
|
;; in the test environment, thus failing to set
|
|
;; todo-global-current-todo-file, which is needed for the test
|
|
;; after todo-edit-item--text. So force the hook function to run.
|
|
(ert-simulate-command '(todo-mode))
|
|
(let ((curfile todo-current-todo-file))
|
|
(should (equal curfile todo-test-file-1))
|
|
(todo-edit-item--text 'multiline)
|
|
(should (equal todo-current-todo-file curfile))
|
|
(todo-edit-quit)
|
|
(todo-edit-file)
|
|
(should (equal todo-current-todo-file curfile))
|
|
(todo-edit-quit))
|
|
(todo-find-archive)
|
|
(let ((curfile todo-current-todo-file))
|
|
(should (equal curfile todo-test-archive-1))
|
|
(todo-edit-file)
|
|
(should (equal todo-current-todo-file curfile)))))
|
|
|
|
(ert-deftest todo-test-edit-quit () ; bug#32437
|
|
"Test result of exiting todo-edit-mode on a whole file.
|
|
Exiting should return to the same todo-mode or todo-archive-mode
|
|
buffer from which the editing command was invoked."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(let ((buf (current-buffer)))
|
|
(todo-edit-file)
|
|
(todo-edit-quit)
|
|
(should (eq (current-buffer) buf))
|
|
(should (eq major-mode 'todo-mode))
|
|
(todo-find-archive)
|
|
(let ((buf (current-buffer)))
|
|
(todo-edit-file)
|
|
(todo-edit-quit)
|
|
(should (eq (current-buffer) buf))
|
|
(should (eq major-mode 'todo-archive-mode))))))
|
|
|
|
(defun todo-test--add-file (file cat)
|
|
"Add file FILE with category CAT to todo-files and show it.
|
|
This provides a noninteractive API for todo-add-file for use in
|
|
automatic testing."
|
|
(let ((file0 (ert-resource-file (concat file ".todo")))
|
|
todo-add-item-if-new-category) ; Don't need an item in cat.
|
|
(cl-letf (((symbol-function 'todo-read-file-name)
|
|
(lambda (_prompt) file0))
|
|
((symbol-function 'todo-read-category)
|
|
(lambda (_prompt &optional _match-type _file) (cons cat file0))))
|
|
(call-interactively 'todo-add-file) ; Interactive to call todo-show.
|
|
(todo-add-category file0 cat))))
|
|
|
|
(defun todo-test--delete-file ()
|
|
"Delete current todo file without prompting."
|
|
(cl-letf (((symbol-function 'yes-or-no-p)
|
|
(lambda (_prompt) t)))
|
|
(todo-delete-file)))
|
|
|
|
(ert-deftest todo-test-add-and-delete-file () ; bug#32627
|
|
"Test adding a new todo file and then deleting it.
|
|
Calling todo-show should display the last current todo file, not
|
|
necessarily the new file. After deleting the new file, todo-show
|
|
should display the previously current (or default) todo file."
|
|
(with-todo-test
|
|
(todo-show)
|
|
(should (equal todo-current-todo-file todo-test-file-1))
|
|
(let* ((file (concat todo-directory "todo-test-2.todo"))
|
|
(file-nb (file-name-base file))
|
|
(cat "cat21"))
|
|
(todo-test--add-file file-nb cat) ; Add new file and show it.
|
|
(should (equal todo-current-todo-file file))
|
|
(todo-quit) ; Quitting todo-mode displays previous buffer.
|
|
(should (equal todo-current-todo-file todo-test-file-1))
|
|
(switch-to-buffer "*scratch*")
|
|
(todo-show) ; Show the last current todo-file (not the new one).
|
|
(should (equal todo-current-todo-file todo-test-file-1))
|
|
(switch-to-buffer (get-file-buffer file)) ; Back to new file.
|
|
(should (equal todo-current-todo-file file))
|
|
(todo-test--delete-file)
|
|
(todo-show) ; Back to old file.
|
|
(should (equal todo-current-todo-file todo-test-file-1))
|
|
(delete-file (concat file "~")))))
|
|
|
|
(ert-deftest todo-test-edit-item-date-month () ; bug#42976 #3 and #4
|
|
"Test incrementing and decrementing the month of an item's date.
|
|
If the change in month crosses a year boundary, the year of the
|
|
item's date should be adjusted accordingly."
|
|
(with-todo-test
|
|
(todo-test--show 4)
|
|
(let ((current-prefix-arg t) ; For todo-edit-item--header.
|
|
(get-date (lambda ()
|
|
(save-excursion
|
|
(todo-date-string-matcher (pos-eol))
|
|
(buffer-substring-no-properties (match-beginning 1)
|
|
(match-end 0))))))
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 0)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 1)
|
|
(should (equal (funcall get-date) "Feb 1, 2020"))
|
|
(todo-edit-item--header 'month -1)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month -1)
|
|
(should (equal (funcall get-date) "Dec 1, 2019"))
|
|
(todo-edit-item--header 'month 1)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 12)
|
|
(should (equal (funcall get-date) "Jan 1, 2021"))
|
|
(todo-edit-item--header 'month -12)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month -13)
|
|
(should (equal (funcall get-date) "Dec 1, 2018"))
|
|
(todo-edit-item--header 'month 7)
|
|
(should (equal (funcall get-date) "Jul 1, 2019"))
|
|
(todo-edit-item--header 'month 6)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 23)
|
|
(should (equal (funcall get-date) "Dec 1, 2021"))
|
|
(todo-edit-item--header 'month -23)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 24)
|
|
(should (equal (funcall get-date) "Jan 1, 2022"))
|
|
(todo-edit-item--header 'month -24)
|
|
(should (equal (funcall get-date) "Jan 1, 2020"))
|
|
(todo-edit-item--header 'month 25)
|
|
(should (equal (funcall get-date) "Feb 1, 2022"))
|
|
(todo-edit-item--header 'month -25)
|
|
(should (equal (funcall get-date) "Jan 1, 2020")))))
|
|
|
|
(ert-deftest todo-test-multiline-item-indentation-1 ()
|
|
"Test inserting a multine item containing a hard line break.
|
|
After insertion the second line of the item should begin with a
|
|
tab character."
|
|
(with-todo-test
|
|
(let* ((item0 "Test inserting a multine item")
|
|
(item1 "containing a hard line break.")
|
|
(item (concat item0 "\n" item1)))
|
|
(todo-test--show 1)
|
|
(todo-test--insert-item item 1)
|
|
(re-search-forward (concat todo-date-string-start todo-date-pattern
|
|
(regexp-quote todo-nondiary-end) " ")
|
|
(pos-eol) t)
|
|
(should (looking-at (regexp-quote (concat item0 "\n\t" item1)))))))
|
|
|
|
(ert-deftest todo-test-multiline-item-indentation-2 () ; bug#43068
|
|
"Test editing an item by adding text on a new line.
|
|
After quitting todo-edit-mode the second line of the item should
|
|
begin with a tab character."
|
|
(with-todo-test
|
|
(todo-test--show 2)
|
|
(let* ((item0 (todo-item-string))
|
|
(item1 "Second line."))
|
|
(todo-edit-item--text 'multiline)
|
|
(insert (concat "\n" item1))
|
|
(todo-edit-quit)
|
|
(goto-char (pos-bol))
|
|
(should (looking-at (regexp-quote (concat item0 "\n\t" item1)))))))
|
|
|
|
(ert-deftest todo-test-multiline-item-indentation-3 ()
|
|
"Test adding an unindented new line to an item using todo-edit-file.
|
|
Attempting to quit todo-edit-mode should signal a user-error,
|
|
since all non-initial item lines must begin with whitespace."
|
|
(with-todo-test
|
|
(todo-test--show 2)
|
|
(let* ((item0 (todo-item-string))
|
|
(item1 "Second line."))
|
|
(todo-edit-file)
|
|
(should (looking-at (regexp-quote item0)))
|
|
(goto-char (pos-eol))
|
|
(insert (concat "\n" item1))
|
|
(should-error (todo-edit-quit) :type 'user-error))))
|
|
|
|
(ert-deftest todo-test-item-insertion-with-priority-1 ()
|
|
"Test inserting new item when point is not on a todo item.
|
|
When point is on the empty line at the end of the todo items
|
|
section, insertion with priority setting should succeed."
|
|
(with-todo-test
|
|
(todo-test--show 1)
|
|
(goto-char (point-max))
|
|
;; Now point should not be on a todo item.
|
|
(should-not (todo-item-start))
|
|
(let ((item "Point was on empty line at end of todo items section."))
|
|
(todo-test--insert-item item 1)
|
|
;; Move point to item that was just inserted.
|
|
(goto-char (point-min))
|
|
(re-search-forward (concat todo-date-string-start todo-date-pattern
|
|
(regexp-quote todo-nondiary-end) " ")
|
|
(pos-eol) t)
|
|
(should (looking-at (regexp-quote item))))))
|
|
|
|
(ert-deftest todo-test-item-insertion-with-priority-2 ()
|
|
"Test inserting new item when point is not on a todo item.
|
|
When point is on the empty line at the end of the done items
|
|
section, insertion with priority setting should succeed."
|
|
(with-todo-test
|
|
(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)
|
|
(todo-next-item)
|
|
(goto-char (point-max))
|
|
;; Now point should be at end of done items section, so not be on a
|
|
;; todo item.
|
|
(should (todo-done-item-section-p))
|
|
(should-not (todo-item-start))
|
|
(let ((item "Point was on empty line at end of done items section."))
|
|
(todo-test--insert-item item 1)
|
|
;; Move point to item that was just inserted.
|
|
(goto-char (point-min))
|
|
(re-search-forward (concat todo-date-string-start todo-date-pattern
|
|
(regexp-quote todo-nondiary-end) " ")
|
|
(pos-eol) t)
|
|
(should (looking-at (regexp-quote item))))))
|
|
|
|
(ert-deftest todo-test-item-insertion-with-priority-3 ()
|
|
"Test inserting new item when point is not on a todo item.
|
|
When point is on a done item, insertion with priority setting
|
|
should succeed."
|
|
(with-todo-test
|
|
(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)
|
|
(todo-next-item)
|
|
;; Now point should be on first done item.
|
|
(should (and (todo-item-start) (todo-done-item-section-p)))
|
|
(let ((item "Point was on a done item."))
|
|
(todo-test--insert-item item 1)
|
|
;; Move point to item that was just inserted.
|
|
(goto-char (point-min))
|
|
(re-search-forward (concat todo-date-string-start todo-date-pattern
|
|
(regexp-quote todo-nondiary-end) " ")
|
|
(pos-eol) t)
|
|
(should (looking-at (regexp-quote item))))))
|
|
|
|
(provide 'todo-mode-tests)
|
|
;;; todo-mode-tests.el ends here
|