Fix the date in the calendar mode line (bug#80069)

* lisp/calendar/calendar.el (calendar-redraw)
(calendar-other-month): Make sure that the mode line is updated
after cursor motion in case 'date' is used in
'calendar-mode-line-format'.
(calendar-set-date-style): Delete call to
calendar-update-mode-line because it is called in calendar-draw.
(calendar-generate-window): Delete calls to
calendar-update-mode-line and calendar-cursor-to-visible-date.
It's better for the caller to do it.
(calendar-basic-setup): Update cursor position and mode line.
* lisp/calendar/cal-move.el (calendar-goto-today): Delete
calendar-update-mode-line because calendar-move-hook is called
last.  This is consistent with other cal-move commands.
* test/lisp/calendar/calendar-tests.el
(calendar-test-date-in-mode-line): New test.

3 files changed, 42 insertions, 13 deletions

diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index aad05f572d6..43eeb694854 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -102,7 +102,6 @@ Returns the list (month day year) giving the cursor position."
   (let ((today (calendar-current-date))) ; the date might have changed
     (if (not (calendar-date-is-visible-p today))
         (calendar-generate-window)
-      (calendar-update-mode-line)
       (calendar-cursor-to-visible-date today)))
   (run-hooks 'calendar-move-hook))
 
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 6805a84a80d..d4d38981b68 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1029,8 +1029,7 @@ The valid styles are described in the documentation of `calendar-date-style'."
         (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
         diary-date-forms
         (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
-  (calendar-redraw)
-  (calendar-update-mode-line))
+  (calendar-redraw))
 
 (defcustom diary-show-holidays-flag t
   "Non-nil means include holidays in the diary display.
@@ -1356,8 +1355,8 @@ display the generated calendar."
            ;; behavior as before in the non-wide case (see below).
            (split-height-threshold 1000)
            (split-width-threshold calendar-split-width-threshold)
-           (date (if arg (calendar-read-date t)
-                   (calendar-current-date)))
+           (today (calendar-current-date))
+           (date (if arg (calendar-read-date t) today))
            (month (calendar-extract-month date))
            (year (calendar-extract-year date)))
       (calendar-increment-month month year (- calendar-offset))
@@ -1406,6 +1405,9 @@ display the generated calendar."
             ;; Switch to the lower window with the calendar buffer.
             (select-window win))))
       (calendar-generate-window month year)
+      (calendar-cursor-to-visible-date
+       (if (calendar-date-is-visible-p today) today (list month 1 year)))
+      (calendar-update-mode-line)
       (if (and calendar-view-diary-initially-flag
                (calendar-date-is-visible-p date))
           ;; Do not clobber the calendar with the diary, if the diary
@@ -1430,14 +1432,9 @@ Optional integers MON and YR are used instead of today's date."
          (month (calendar-extract-month today))
          ;; (day (calendar-extract-day today))
          (year (calendar-extract-year today))
-         (today-visible (or (not mon)
-                            (<= (abs (calendar-interval mon yr month year)) 1)))
          (in-calendar-window (with-current-buffer (window-buffer)
                                (derived-mode-p 'calendar-mode))))
     (calendar-generate (or mon month) (or yr year))
-    (calendar-cursor-to-visible-date
-     (if today-visible today (list displayed-month 1 displayed-year)))
-    (calendar-update-mode-line)
     (set-buffer-modified-p nil)
     ;; Don't do any window-related stuff if we weren't called from a
     ;; window displaying the calendar.
@@ -1453,7 +1450,7 @@ Optional integers MON and YR are used instead of today's date."
          (calendar-mark-holidays))
     (unwind-protect
         (if calendar-mark-diary-entries (diary-mark-entries))
-      (run-hooks (if today-visible
+      (run-hooks (if (calendar-date-is-visible-p today)
                      'calendar-today-visible-hook
                    'calendar-today-invisible-hook)))))
 
@@ -1577,7 +1574,8 @@ first INDENT characters on the line."
     (with-current-buffer buf
       (let ((cursor-date (calendar-cursor-to-nearest-date)))
         (calendar-generate-window displayed-month displayed-year)
-        (calendar-cursor-to-visible-date cursor-date))
+        (calendar-cursor-to-visible-date cursor-date)
+        (calendar-update-mode-line))
       (when (window-live-p (get-buffer-window))
         (set-window-point (get-buffer-window) (point))))))
 
@@ -2073,7 +2071,8 @@ EVENT is an event like `last-nonmenu-event'."
          (cond
           ((calendar-date-is-visible-p old-date) old-date)
           ((calendar-date-is-visible-p today) today)
-          (t (list month 1 year))))))))
+          (t (list month 1 year))))
+        (calendar-update-mode-line)))))
 
 (defun calendar-set-mark (arg &optional event)
   "Mark the date under the cursor, or jump to marked date.
diff --git a/test/lisp/calendar/calendar-tests.el b/test/lisp/calendar/calendar-tests.el
index 2aef0bf827b..5fd974f952f 100644
--- a/test/lisp/calendar/calendar-tests.el
+++ b/test/lisp/calendar/calendar-tests.el
@@ -30,5 +30,36 @@
   (should (eq (calendar-date-is-valid-p (list 1 2)) nil))
   (should (eq (calendar-date-is-valid-p (list 5 1 2025)) t)))
 
+(ert-deftest calendar-test-date-in-calendar-mode-line ()
+  "Test whether the calendar mode line displays `date' correctly."
+  (save-window-excursion
+    (unwind-protect
+        (let* ((calendar-mode-line-format (list '(calendar-date-string date)))
+               (calendar-move-hook '(calendar-update-mode-line))
+               (today (calendar-current-date))
+               (month (calendar-extract-month today))
+               (year (calendar-extract-year today))
+               (cursor-date (calendar-gregorian-from-absolute
+                             (1+ (calendar-absolute-from-gregorian today)))))
+          (calendar)
+          (should (equal (string-trim mode-line-format)
+                         (calendar-date-string today)))
+          (calendar-forward-day 1)
+          (should (equal (string-trim mode-line-format)
+                         (calendar-date-string cursor-date)))
+          (calendar-goto-today)
+          (should (equal (string-trim mode-line-format)
+                         (calendar-date-string today)))
+          (calendar-cursor-to-visible-date cursor-date)
+          (calendar-redraw)
+          (should (equal (string-trim mode-line-format)
+                         (calendar-date-string cursor-date)))
+          (calendar-cursor-to-visible-date cursor-date)
+          (calendar-scroll-left)
+          (calendar-other-month month year)
+          (should (equal (string-trim mode-line-format)
+                         (calendar-date-string cursor-date))))
+      (kill-buffer calendar-buffer))))
+
 (provide 'calendar-tests)
 ;;; calendar-tests.el ends here