[elpa] externals/org a19a72f7d3: org-agenda: Fix grid lines when `org-agenda-default-appointment-duration' is non-nil

[ELPA Syncer]

branch: externals/org
commit a19a72f7d3ffd5f7f7ab73f7bac42a16a3b18446
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

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

diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index f08b0d8308..02be114fe7 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 0000000000..ec413e71e9
--- /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 409d441921..976d88a9ec 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")