From a19a72f7d3ffd5f7f7ab73f7bac42a16a3b18446 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 17 Jan 2024 15:40:24 +0100 Subject: [PATCH] org-agenda: Fix grid lines when `org-agenda-default-appointment-duration' is non-nil * lisp/org-agenda.el (org-agenda-add-time-grid-maybe): Let-bind `org-agenda-default-appointment-duration' to nil when formatting the grid lines. Otherwise, `org-agenda-format-item' logic fails to produce the expected result. * testing/lisp/test-org-agenda.el (test-org-agenda/time-grid): Add new test set covering the bug and several simpler cases. * testing/examples/agenda-file2.org (two): New test file example. Reported-by: Detlef Steuer Link: https://orgmode.org/list/87edv5fv1w.fsf@localhost --- lisp/org-agenda.el | 6 +- testing/examples/agenda-file2.org | 8 +++ testing/lisp/test-org-agenda.el | 94 +++++++++++++++++++++++++++++++ 3 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 testing/examples/agenda-file2.org diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f08b0d830..02be114fe 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7142,7 +7142,11 @@ TODAYP is t when the current agenda view is on today." (gridtimes (nth 1 org-agenda-time-grid)) (req (car org-agenda-time-grid)) (remove (member 'remove-match req)) - new time) + new time + ;; We abuse `org-agenda-format-item' to format grid lines + ;; here. Prevent it from adding default duration, if any + ;; to the grid lines. + (org-agenda-default-appointment-duration nil)) (when (and (member 'require-timed req) (not have)) ;; don't show empty grid (throw 'exit list)) diff --git a/testing/examples/agenda-file2.org b/testing/examples/agenda-file2.org new file mode 100644 index 000000000..ec413e71e --- /dev/null +++ b/testing/examples/agenda-file2.org @@ -0,0 +1,8 @@ +* TODO one +SCHEDULED: <2024-01-17 Wed 09:30-10:00> +* TODO two +SCHEDULED: <2024-01-17 Wed 10:00-12:30> +* TODO three +SCHEDULED: <2024-01-17 Wed 13:00-15:00> +* TODO four +SCHEDULED: <2024-01-17 Wed 19:00> diff --git a/testing/lisp/test-org-agenda.el b/testing/lisp/test-org-agenda.el index 409d44192..976d88a9e 100644 --- a/testing/lisp/test-org-agenda.el +++ b/testing/lisp/test-org-agenda.el @@ -80,6 +80,100 @@ (should (= 3 (count-lines (point-min) (point-max))))) (org-test-agenda--kill-all-agendas)) +(ert-deftest test-org-agenda/time-grid () + "Test time grid settings." + (cl-assert (not org-agenda-sticky) nil "precondition violation") + (cl-assert (not (org-test-agenda--agenda-buffers)) + nil "precondition violation") + ;; Default time grid. + (org-test-at-time "2024-01-17 8:00" + (let ((org-agenda-span 'day) + (org-agenda-files `(,(expand-file-name "examples/agenda-file2.org" + org-test-dir)))) + ;; NOTE: Be aware that `org-agenda-list' may or may not display + ;; past scheduled items depending whether the date is today + ;; `org-today' or not. + (org-agenda-list nil "<2024-01-17 Fri>") + (set-buffer org-agenda-buffer-name) + (save-excursion + (goto-char (point-min)) + (should (search-forward "8:00...... now - - - - - - - - - - - - - - - - - - - - - - - - -"))) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2: 9:30-10:00 Scheduled: TODO one"))) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2:10:00-12:30 Scheduled: TODO two"))) + (save-excursion + (goto-char (point-min)) + (should (search-forward "10:00...... ----------------"))) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2:13:00-15:00 Scheduled: TODO three"))) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2:19:00...... Scheduled: TODO four")))) + (org-test-agenda--kill-all-agendas)) + ;; Custom time grid strings + (org-test-at-time "2024-01-17 8:00" + (let ((org-agenda-span 'day) + (org-agenda-files `(,(expand-file-name "examples/agenda-file2.org" + org-test-dir))) + (org-agenda-time-grid '((daily today require-timed) + (800 1000 1200 1400 1600 1800 2000) + "..." "^^^^^^^^^^^^^^" ))) + ;; NOTE: Be aware that `org-agenda-list' may or may not display + ;; past scheduled items depending whether the date is today + ;; `org-today' or not. + (org-agenda-list nil "<2024-01-17 Fri>") + (set-buffer org-agenda-buffer-name) + (save-excursion + (goto-char (point-min)) + (should (search-forward "10:00... ^^^^^^^^^^^^^^")))) + (org-test-agenda--kill-all-agendas)) + ;; Time grid remove-match + (org-test-at-time "2024-01-17 8:00" + (let ((org-agenda-span 'day) + (org-agenda-files `(,(expand-file-name "examples/agenda-file2.org" + org-test-dir))) + (org-agenda-time-grid '((today remove-match) + (800 1000 1200 1400 1600 1800 2000) + "......" "----------------" ))) + ;; NOTE: Be aware that `org-agenda-list' may or may not display + ;; past scheduled items depending whether the date is today + ;; `org-today' or not. + (org-agenda-list nil "<2024-01-17 Fri>") + (set-buffer org-agenda-buffer-name) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2: 9:30-10:00 Scheduled: TODO one"))) + (save-excursion + (goto-char (point-min)) + (should-not (search-forward "10:00...... ----------------" nil t)))) + (org-test-agenda--kill-all-agendas)) + ;; Time grid with `org-agenda-default-appointment-duration' + (org-test-at-time "2024-01-17 8:00" + (let ((org-agenda-span 'day) + (org-agenda-files `(,(expand-file-name "examples/agenda-file2.org" + org-test-dir))) + (org-agenda-time-grid '((today remove-match) + (800 1000 1200 1400 1600 1800 2000) + "......" "----------------" )) + (org-agenda-default-appointment-duration 60)) + ;; NOTE: Be aware that `org-agenda-list' may or may not display + ;; past scheduled items depending whether the date is today + ;; `org-today' or not. + (org-agenda-list nil "<2024-01-17 Fri>") + (set-buffer org-agenda-buffer-name) + (save-excursion + (goto-char (point-min)) + (should (search-forward "agenda-file2:19:00-20:00 Scheduled: TODO four"))) + ;; Bug https://list.orgmode.org/orgmode/20211119135325.7f3f85a9@hsu-hh.de/ + (save-excursion + (goto-char (point-min)) + (should (search-forward "14:00...... ----------------")))) + (org-test-agenda--kill-all-agendas))) + (ert-deftest test-org-agenda/todo-selector () "Test selecting keywords in `org-todo-list'." (cl-assert (not org-agenda-sticky) nil "precondition violation")