path: root/tests/test-org-agenda-config-skip-functions.el

;;; test-org-agenda-config-skip-functions.el --- Tests for org-agenda skip functions -*- lexical-binding: t; -*-

;;; Commentary:
;; Tests for the agenda skip functions in org-agenda-config.el:
;; - cj/org-skip-subtree-if-habit
;; - cj/org-skip-subtree-if-priority
;; - cj/org-skip-subtree-if-keyword
;; - cj/org-agenda-skip-subtree-if-not-overdue
;;
;; Also covers the "d" command's SCHEDULE block config -- the skip-function
;; that filters CANCELLED entries from the forward-looking agenda.
;;
;; Uses dynamic timestamp generation (no hardcoded dates) via testutil-org.

;;; Code:

(require 'ert)
(require 'org)

(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory))
(require 'testutil-org)

(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
(require 'org-agenda-config)

;; Suppress org-mode hooks that load packages unavailable in batch mode
(defmacro test-org-agenda--with-org-buffer (content &rest body)
  "Execute BODY in a temp org buffer with CONTENT, point at first heading.
Suppresses org-mode hooks to avoid loading packages not available in batch."
  (declare (indent 1))
  `(with-temp-buffer
     (let ((org-mode-hook nil)
           (text-mode-hook nil))
       (org-mode))
     (insert ,content)
     (goto-char (point-min))
     ,@body))

;;; ---------- cj/org-skip-subtree-if-habit ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-skip-habit-normal-habit-entry-skips ()
  "Entry with STYLE=habit should return subtree-end (skip)."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Daily exercise\n"
              ":PROPERTIES:\n"
              ":STYLE: habit\n"
              ":END:\n")
    (should (integerp (cj/org-skip-subtree-if-habit)))))

(ert-deftest test-org-agenda-config-skip-habit-normal-non-habit-style-keeps ()
  "Entry with STYLE set to something other than habit should return nil (keep)."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Regular task\n"
              ":PROPERTIES:\n"
              ":STYLE: other\n"
              ":END:\n")
    (should (null (cj/org-skip-subtree-if-habit)))))

(ert-deftest test-org-agenda-config-skip-habit-normal-no-style-property-keeps ()
  "Entry with no STYLE property should return nil (keep)."
  (test-org-agenda--with-org-buffer "* TODO Task without style\n"
    (should (null (cj/org-skip-subtree-if-habit)))))

;;; Boundary Cases

(ert-deftest test-org-agenda-config-skip-habit-boundary-returns-subtree-end-position ()
  "Return value should be the position after the entire subtree."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Habit task\n"
              ":PROPERTIES:\n"
              ":STYLE: habit\n"
              ":END:\n"
              "** Sub-heading\n"
              "Some content\n"
              "* Next task\n")
    (let ((skip-pos (cj/org-skip-subtree-if-habit)))
      (should (integerp skip-pos))
      ;; Skip position should be past the sub-heading content
      (should (> skip-pos (point)))
      ;; But not past the next top-level heading
      (goto-char (point-min))
      (re-search-forward "^\\* Next task")
      (beginning-of-line)
      (should (<= skip-pos (point))))))

;;; ---------- cj/org-skip-subtree-if-priority ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-skip-priority-normal-matching-priority-skips ()
  "Entry with priority A should be skipped when filtering for A."
  (test-org-agenda--with-org-buffer "* TODO [#A] Important task\n"
    (should (integerp (cj/org-skip-subtree-if-priority ?A)))))

(ert-deftest test-org-agenda-config-skip-priority-normal-different-priority-keeps ()
  "Entry with priority B should not be skipped when filtering for A."
  (test-org-agenda--with-org-buffer "* TODO [#B] Normal task\n"
    (should (null (cj/org-skip-subtree-if-priority ?A)))))

(ert-deftest test-org-agenda-config-skip-priority-normal-no-priority-keeps ()
  "Entry with no priority cookie should not be skipped."
  (test-org-agenda--with-org-buffer "* TODO Plain task\n"
    (should (null (cj/org-skip-subtree-if-priority ?A)))))

(ert-deftest test-org-agenda-config-skip-priority-normal-filter-b-skips-b ()
  "Entry with priority B should be skipped when filtering for B."
  (test-org-agenda--with-org-buffer "* TODO [#B] Normal task\n"
    (should (integerp (cj/org-skip-subtree-if-priority ?B)))))

(ert-deftest test-org-agenda-config-skip-priority-normal-filter-c-skips-c ()
  "Entry with priority C should be skipped when filtering for C."
  (test-org-agenda--with-org-buffer "* TODO [#C] Low priority task\n"
    (should (integerp (cj/org-skip-subtree-if-priority ?C)))))

;;; ---------- cj/org-skip-subtree-if-keyword ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-skip-keyword-normal-matching-keyword-skips ()
  "Entry with TODO keyword in list should return subtree-end (skip)."
  (test-org-agenda--with-org-buffer "* TODO Some task\n"
    (should (integerp (cj/org-skip-subtree-if-keyword '("TODO"))))))

(ert-deftest test-org-agenda-config-skip-keyword-normal-done-in-list-skips ()
  "Entry with DONE keyword in list should return subtree-end (skip)."
  (test-org-agenda--with-org-buffer "* DONE Completed task\n"
    (should (integerp (cj/org-skip-subtree-if-keyword '("DONE"))))))

(ert-deftest test-org-agenda-config-skip-keyword-normal-keyword-not-in-list-keeps ()
  "Entry with keyword not in filter list should return nil (keep)."
  (test-org-agenda--with-org-buffer "* TODO Some task\n"
    (should (null (cj/org-skip-subtree-if-keyword '("DONE" "CANCELLED"))))))

(ert-deftest test-org-agenda-config-skip-keyword-normal-no-keyword-keeps ()
  "Entry with no TODO keyword should return nil (keep)."
  (test-org-agenda--with-org-buffer "* Just a heading\n"
    (should (null (cj/org-skip-subtree-if-keyword '("TODO" "DONE"))))))

;;; Boundary Cases

(ert-deftest test-org-agenda-config-skip-keyword-boundary-multiple-keywords-in-list ()
  "Filter list with multiple keywords should match any of them."
  (test-org-agenda--with-org-buffer "* DONE Finished task\n"
    (should (integerp (cj/org-skip-subtree-if-keyword '("TODO" "DONE" "CANCELLED"))))))

;;; ---------- cj/org-agenda-skip-subtree-if-not-overdue ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-skip-overdue-normal-past-scheduled-keeps ()
  "Entry scheduled in the past with TODO keyword is overdue — keep it."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Overdue task\n"
              "SCHEDULED: " (test-org-timestamp-days-ago 7) "\n")
    (should (null (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-normal-future-scheduled-skips ()
  "Entry scheduled in the future is not overdue — skip it."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Future task\n"
              "SCHEDULED: " (test-org-timestamp-days-ahead 7) "\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-normal-past-deadline-keeps ()
  "Entry with past deadline and TODO keyword is overdue — keep it."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Missed deadline\n"
              "DEADLINE: " (test-org-timestamp-days-ago 3) "\n")
    (should (null (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-normal-done-task-skips ()
  "Done task should be skipped even if overdue."
  (test-org-agenda--with-org-buffer
      (concat "* DONE Completed task\n"
              "SCHEDULED: " (test-org-timestamp-days-ago 7) "\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-normal-habit-skips ()
  "Habit should be skipped even if overdue."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Daily habit\n"
              "SCHEDULED: " (test-org-timestamp-days-ago 7) "\n"
              ":PROPERTIES:\n"
              ":STYLE: habit\n"
              ":END:\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-normal-no-todo-keyword-skips ()
  "Entry without a TODO keyword should be skipped."
  (test-org-agenda--with-org-buffer
      (concat "* Just a heading\n"
              "SCHEDULED: " (test-org-timestamp-days-ago 7) "\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

;;; Boundary Cases

(ert-deftest test-org-agenda-config-skip-overdue-boundary-today-scheduled-skips ()
  "Entry scheduled today is NOT overdue (not strictly before today) — skip."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Today task\n"
              "SCHEDULED: " (test-org-timestamp-today) "\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-boundary-no-date-skips ()
  "Entry with TODO but no scheduled/deadline date — not overdue, skip."
  (test-org-agenda--with-org-buffer "* TODO Undated task\n"
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

(ert-deftest test-org-agenda-config-skip-overdue-boundary-future-deadline-skips ()
  "Entry with future deadline is not overdue — skip."
  (test-org-agenda--with-org-buffer
      (concat "* TODO Future deadline\n"
              "DEADLINE: " (test-org-timestamp-days-ahead 14) "\n")
    (should (integerp (cj/org-agenda-skip-subtree-if-not-overdue)))))

;;; ---------- "d" command SCHEDULE block: CANCELLED skip ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-schedule-block-skips-cancelled ()
  "Normal: main-agenda \"d\" SCHEDULE block has a skip-function for CANCELLED.
This is the configuration check that locks in the fix for the
CANCELLED-in-schedule bug: without the skip-function form on the
(agenda ...) block, cancelled tasks render in the schedule view."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (agenda-block (seq-find (lambda (b) (eq (car b) 'agenda)) blocks))
         (opts (nth 2 agenda-block))
         (skip-form (cadr (assoc 'org-agenda-skip-function opts))))
    (should (equal skip-form
                   '(quote (org-agenda-skip-entry-if 'todo '("CANCELLED")))))))

;;; Boundary Cases

(ert-deftest test-org-agenda-config-schedule-cancelled-skip-scoped-to-agenda-block ()
  "Boundary: only the (agenda ...) block carries the CANCELLED skip.
The fix is deliberately scoped to the SCHEDULE block; the overdue/hi-pri/
priority-B blocks must not pick up the same skip-function form."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (non-agenda (seq-remove (lambda (b) (eq (car b) 'agenda)) blocks))
         (cancelled-form '(quote (org-agenda-skip-entry-if 'todo '("CANCELLED")))))
    (dolist (b non-agenda)
      (let* ((opts (nth 2 b))
             (skip (cadr (assoc 'org-agenda-skip-function opts))))
        (should-not (equal skip cancelled-form))))))

;;; ---------- prefix-format extracted into a defvar ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-prefix-format-extracted-to-defvar ()
  "Normal: every block of the \"d\" command references the shared prefix
format symbol rather than inlining the literal string.  Catches a
regression where one block diverges from the others on the format."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry)))
    (should (boundp 'cj/--main-agenda-prefix-format))
    (should (stringp cj/--main-agenda-prefix-format))
    (dolist (b blocks)
      (let* ((opts (nth 2 b))
             (fmt-form (cadr (assoc 'org-agenda-prefix-format opts))))
        (should (eq fmt-form 'cj/--main-agenda-prefix-format))))))

;;; ---------- VERIFICATION and IN-PROGRESS blocks ----------

;;; Normal Cases

(ert-deftest test-org-agenda-config-d-command-has-six-blocks-in-expected-order ()
  "Normal: the \"d\" command runs six blocks in the expected order --
OVERDUE -> HIGH PRIORITY -> VERIFICATION -> SCHEDULE -> IN-PROGRESS -> PRIORITY B."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (shapes (mapcar (lambda (b) (list (car b) (cadr b))) blocks)))
    (should (equal shapes
                   '((alltodo "")
                     (tags "PRIORITY=\"A\"")
                     (todo "VERIFY")
                     (agenda "")
                     (todo "DOING")
                     (alltodo ""))))))

(ert-deftest test-org-agenda-config-verify-block-options ()
  "Normal: the VERIFY block carries the VERIFICATION header, the shared
prefix format, and the habit skip function."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (verify (seq-find
                  (lambda (b) (and (eq (car b) 'todo)
                                   (equal (cadr b) "VERIFY")))
                  blocks))
         (opts (nth 2 verify)))
    (should verify)
    (should (eq (cadr (assoc 'org-agenda-overriding-header opts))
                'cj/main-agenda-verify-title))
    (should (equal cj/main-agenda-verify-title "VERIFICATION"))
    (should (eq (cadr (assoc 'org-agenda-prefix-format opts))
                'cj/--main-agenda-prefix-format))
    (should (equal (cadr (assoc 'org-agenda-skip-function opts))
                   ''cj/org-skip-subtree-if-habit))))

(ert-deftest test-org-agenda-config-doing-block-options ()
  "Normal: the DOING block carries the IN-PROGRESS header, the shared
prefix format, and the habit skip function."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (doing (seq-find
                 (lambda (b) (and (eq (car b) 'todo)
                                  (equal (cadr b) "DOING")))
                 blocks))
         (opts (nth 2 doing)))
    (should doing)
    (should (eq (cadr (assoc 'org-agenda-overriding-header opts))
                'cj/main-agenda-doing-title))
    (should (equal cj/main-agenda-doing-title "IN-PROGRESS"))
    (should (eq (cadr (assoc 'org-agenda-prefix-format opts))
                'cj/--main-agenda-prefix-format))
    (should (equal (cadr (assoc 'org-agenda-skip-function opts))
                   ''cj/org-skip-subtree-if-habit))))

;;; Boundary Cases

(ert-deftest test-org-agenda-config-verify-block-includes-scheduled-entries ()
  "Boundary: the VERIFY block has no scheduled/deadline skip, so a VERIFY
task with a scheduled date appears here as well as in the SCHEDULE block.
Mirrors the HIGH PRIORITY block's behaviour."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (verify (seq-find
                  (lambda (b) (and (eq (car b) 'todo)
                                   (equal (cadr b) "VERIFY")))
                  blocks))
         (opts (nth 2 verify))
         (skip (cadr (assoc 'org-agenda-skip-function opts))))
    ;; Single skip function (no compound `or' with scheduled/deadline).
    (should (equal skip ''cj/org-skip-subtree-if-habit))))

(ert-deftest test-org-agenda-config-doing-block-includes-scheduled-entries ()
  "Boundary: same contract as VERIFY -- no scheduled/deadline skip, so a
DOING task with a scheduled date appears in both blocks."
  (let* ((entry (assoc "d" org-agenda-custom-commands))
         (blocks (nth 2 entry))
         (doing (seq-find
                 (lambda (b) (and (eq (car b) 'todo)
                                  (equal (cadr b) "DOING")))
                 blocks))
         (opts (nth 2 doing))
         (skip (cadr (assoc 'org-agenda-skip-function opts))))
    (should (equal skip ''cj/org-skip-subtree-if-habit))))

(provide 'test-org-agenda-config-skip-functions)
;;; test-org-agenda-config-skip-functions.el ends here