mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

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 <steuer@hsu-hh.de>
Link: https://orgmode.org/list/87edv5fv1w.fsf@localhost
This commit is contained in:
Ihor Radchenko 2024-01-17 15:40:24 +01:00
parent 4ce2ad4eb1
commit a19a72f7d3
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
3 changed files with 107 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/org-agenda.el
View File

@ -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))

8
testing/examples/agenda-file2.org Normal file
View File

@ -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>

94
testing/lisp/test-org-agenda.el
View File

@ -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")