header-line for the calendar and diary (patch)

[Ryan Yeske]

Now that we have a header-line, would it be a good idea to use it for
the calendar and diary buffers rather than clobbering the mode-line?

I have modified the calendar and diary files to do this:

* In calendar-mode, the header-line is now used to display
  `calendar-header-line-format' (was `calendar-mode-line-format').

* The header line is used to print the "title" when displaying
  holidays, diary entries, the output from
  `calendar-print-other-dates' and the output from
  `list-yahrzeit-dates'.

Previously the mode-line was used for this information, which was
inconsistent with the rest of Emacs.

I have included a patch which touches the following files:

   emacs-21.1/lisp/ChangeLog
   emacs-21.1/lisp/bindings.el
   emacs-21.1/lisp/calendar/cal-hebrew.el
   emacs-21.1/lisp/calendar/cal-move.el
   emacs-21.1/lisp/calendar/calendar.el
   emacs-21.1/lisp/calendar/diary-lib.el
   emacs-21.1/lisp/calendar/holidays.el
   emacs-21.1/lisp/calendar/lunar.el

Ryan

diff -cr emacs-21.1/lisp/ChangeLog emacs-21.1-modified/lisp/ChangeLog
*** emacs-21.1/lisp/ChangeLog   Sat Oct 20 09:15:00 2001
--- emacs-21.1-modified/lisp/ChangeLog  Wed Nov  7 01:20:42 2001
***************
*** 1,3 ****
--- 1,38 ----
+ 2001-11-07  Ryan Yeske  <rcyeske@vcn.bc.ca>
+ 
+       * bindings.el (make-header-line-mouse-map): New function.
+ 
+       * calendar/calendar.el (calendar-set-header-line): Rename from
+       calendar-set-mode-line.
+       (update-calendar-header-line): Rename from
+       update-calendar-mode-line.
+       (calendar-header-line-format): Rename from
+       calendar-mode-line-format.  Use make-header-line-mouse-map instead
+       of make-mode-line-mouse-map.
+       (european-calendar): Call update-calendar-header-line instead of
+       update-calendar-mode-line.
+       (american-calendar): Likewise.
+       (generate-calendar-window): Likewise.
+       (calendar-mode): Likewise.
+ 
+       (calendar-print-other-dates): Call calendar-set-header-line
+       instead of calendar-set-mode-line.
+ 
+       * calendar/cal-hebrew.el (list-yahrzeit-dates): Likewise.
+ 
+       * calendar/lunar.el (calendar-phases-of-moon): Likewise.
+ 
+       * calendar/holidays.el (list-holidays, calendar-cursor-holidays) 
+       (list-calendar-holidays): Likewise.
+ 
+       * calendar/diary-lib.el (simple-diary-display): Likewise.
+       (fancy-diary-display): Likewise.
+       (show-all-diary-entries): Restore the header-line instead of the
+       mode-line.
+ 
+       * calendar/cal-move.el (calendar-goto-today): Call
+       update-calendar-header-line instead of update-calendar-mode-line.
+ 
  2001-10-20  Gerd Moellmann  <gerd@gnu.org>
  
        * Version 21.1 released.
diff -cr emacs-21.1/lisp/bindings.el emacs-21.1-modified/lisp/bindings.el
*** emacs-21.1/lisp/bindings.el Mon Oct 15 01:19:37 2001
--- emacs-21.1-modified/lisp/bindings.el        Wed Nov  7 00:36:25 2001
***************
*** 56,61 ****
--- 56,70 ----
      map))
  
  
+ (defun make-header-line-mouse-map (mouse function) "\
+ Return a keymap with single entry for mouse key MOUSE on the header line.
+ MOUSE is defined to run function FUNCTION with no args in the buffer
+ corresponding to the header line clicked."
+   (let ((map (make-sparse-keymap)))
+     (define-key map (vector 'header-line mouse) function)
+     map))
+ 
+ 
  (defun mode-line-toggle-read-only (event)
    "Like `toggle-read-only', for the mode-line."
    (interactive "e")
diff -cr emacs-21.1/lisp/calendar/cal-hebrew.el 
emacs-21.1-modified/lisp/calendar/cal-hebrew.el
*** emacs-21.1/lisp/calendar/cal-hebrew.el      Mon Jul 16 00:46:48 2001
--- emacs-21.1-modified/lisp/calendar/cal-hebrew.el     Wed Nov  7 00:03:14 2001
***************
*** 867,873 ****
           (h-year (extract-calendar-year h-date)))
      (set-buffer (get-buffer-create yahrzeit-buffer))
      (setq buffer-read-only nil)
!     (calendar-set-mode-line
       (format "Yahrzeit dates for %s = %s"
               (calendar-date-string death-date)
               (let ((calendar-month-name-array
--- 867,873 ----
           (h-year (extract-calendar-year h-date)))
      (set-buffer (get-buffer-create yahrzeit-buffer))
      (setq buffer-read-only nil)
!     (calendar-set-header-line
       (format "Yahrzeit dates for %s = %s"
               (calendar-date-string death-date)
               (let ((calendar-month-name-array
diff -cr emacs-21.1/lisp/calendar/cal-move.el 
emacs-21.1-modified/lisp/calendar/cal-move.el
*** emacs-21.1/lisp/calendar/cal-move.el        Sun Sep 17 10:08:04 2000
--- emacs-21.1-modified/lisp/calendar/cal-move.el       Wed Nov  7 00:03:13 2001
***************
*** 44,50 ****
    (let ((today (calendar-current-date)));; The date might have changed.
      (if (not (calendar-date-is-visible-p today))
          (generate-calendar-window)
!       (update-calendar-mode-line)
        (calendar-cursor-to-visible-date today)))
    (run-hooks 'calendar-move-hook))
  
--- 44,50 ----
    (let ((today (calendar-current-date)));; The date might have changed.
      (if (not (calendar-date-is-visible-p today))
          (generate-calendar-window)
!       (update-calendar-header-line)
        (calendar-cursor-to-visible-date today)))
    (run-hooks 'calendar-move-hook))
  
diff -cr emacs-21.1/lisp/calendar/calendar.el 
emacs-21.1-modified/lisp/calendar/calendar.el
*** emacs-21.1/lisp/calendar/calendar.el        Mon Oct  1 04:05:18 2001
--- emacs-21.1-modified/lisp/calendar/calendar.el       Wed Nov  7 01:14:49 2001
***************
*** 650,656 ****
    (setq european-calendar-style t)
    (setq calendar-date-display-form european-calendar-display-form)
    (setq diary-date-forms european-date-diary-pattern)
!   (update-calendar-mode-line))
  
  (defun american-calendar ()
    "Set the interpretation and display of dates to the American style."
--- 650,656 ----
    (setq european-calendar-style t)
    (setq calendar-date-display-form european-calendar-display-form)
    (setq diary-date-forms european-date-diary-pattern)
!   (update-calendar-header-line))
  
  (defun american-calendar ()
    "Set the interpretation and display of dates to the American style."
***************
*** 658,664 ****
    (setq european-calendar-style nil)
    (setq calendar-date-display-form american-calendar-display-form)
    (setq diary-date-forms american-date-diary-pattern)
!   (update-calendar-mode-line))
  
  ;;;###autoload
  (defcustom print-diary-entries-hook 'lpr-buffer
--- 658,664 ----
    (setq european-calendar-style nil)
    (setq calendar-date-display-form american-calendar-display-form)
    (setq diary-date-forms american-date-diary-pattern)
!   (update-calendar-header-line))
  
  ;;;###autoload
  (defcustom print-diary-entries-hook 'lpr-buffer
***************
*** 1791,1797 ****
                (let ((offset (calendar-interval mon yr month year)))
                  (and (<= offset 1) (>= offset -1)))))
           (day-in-week (calendar-day-of-week today)))
!     (update-calendar-mode-line)
      (if mon
          (generate-calendar mon yr)
          (generate-calendar month year))
--- 1791,1797 ----
                (let ((offset (calendar-interval mon yr month year)))
                  (and (<= offset 1) (>= offset -1)))))
           (day-in-week (calendar-day-of-week today)))
!     (update-calendar-header-line)
      (if mon
          (generate-calendar mon yr)
          (generate-calendar month year))
***************
*** 2035,2060 ****
  ;; Calendar mode is suitable only for specially formatted data.
  (put 'calendar-mode 'mode-class 'special)
  
! (defvar calendar-mode-line-format
    (list
     (propertize (substitute-command-keys
                "\\<calendar-mode-map>\\[scroll-calendar-left]")
               'help-echo "mouse-2: scroll left"
!              'keymap (make-mode-line-mouse-map 'mouse-2 
!                                                #'scroll-calendar-left))
     "Calendar"
     (concat
      (propertize
       (substitute-command-keys
        "\\<calendar-mode-map>\\[calendar-goto-info-node] info")
       'help-echo "mouse-2: read Info on Calendar"
!      'keymap (make-mode-line-mouse-map 'mouse-2 #'calendar-goto-info-node))
      "/"
      (propertize
       (substitute-command-keys
       "\\<calendar-mode-map>\\[calendar-other-month] other")
       'help-echo "mouse-2: choose another month"
!      'keymap (make-mode-line-mouse-map 
              'mouse-2 
              (lambda ()
                (interactive)
--- 2035,2060 ----
  ;; Calendar mode is suitable only for specially formatted data.
  (put 'calendar-mode 'mode-class 'special)
  
! (defvar calendar-header-line-format
    (list
     (propertize (substitute-command-keys
                "\\<calendar-mode-map>\\[scroll-calendar-left]")
               'help-echo "mouse-2: scroll left"
!              'keymap (make-header-line-mouse-map 'mouse-2 
!                                                  #'scroll-calendar-left))
     "Calendar"
     (concat
      (propertize
       (substitute-command-keys
        "\\<calendar-mode-map>\\[calendar-goto-info-node] info")
       'help-echo "mouse-2: read Info on Calendar"
!      'keymap (make-header-line-mouse-map 'mouse-2 #'calendar-goto-info-node))
      "/"
      (propertize
       (substitute-command-keys
       "\\<calendar-mode-map>\\[calendar-other-month] other")
       'help-echo "mouse-2: choose another month"
!      'keymap (make-header-line-mouse-map 
              'mouse-2 
              (lambda ()
                (interactive)
***************
*** 2065,2076 ****
       (substitute-command-keys
       "\\<calendar-mode-map>\\[calendar-goto-today] today")
       'help-echo "mouse-2: go to today's date"
!      'keymap (make-mode-line-mouse-map 'mouse-2 #'calendar-goto-today)))
     '(calendar-date-string (calendar-current-date) t)
     (propertize (substitute-command-keys
                "\\<calendar-mode-map>\\[scroll-calendar-right]")
               'help-echo "mouse-2: scroll right"
!              'keymap (make-mode-line-mouse-map 
                        'mouse-2 #'scroll-calendar-right)))
    "The mode line of the calendar buffer.")
  
--- 2065,2076 ----
       (substitute-command-keys
       "\\<calendar-mode-map>\\[calendar-goto-today] today")
       'help-echo "mouse-2: go to today's date"
!      'keymap (make-header-line-mouse-map 'mouse-2 #'calendar-goto-today)))
     '(calendar-date-string (calendar-current-date) t)
     (propertize (substitute-command-keys
                "\\<calendar-mode-map>\\[scroll-calendar-right]")
               'help-echo "mouse-2: scroll right"
!              'keymap (make-header-line-mouse-map 
                        'mouse-2 #'scroll-calendar-right)))
    "The mode line of the calendar buffer.")
  
***************
*** 2100,2106 ****
    (use-local-map calendar-mode-map)
    (setq buffer-read-only t)
    (setq indent-tabs-mode nil)
!   (update-calendar-mode-line)
    (make-local-hook 'activate-menubar-hook)
    (add-hook 'activate-menubar-hook 'cal-menu-update nil t)
    (make-local-variable 'calendar-mark-ring)
--- 2100,2106 ----
    (use-local-map calendar-mode-map)
    (setq buffer-read-only t)
    (setq indent-tabs-mode nil)
!   (update-calendar-header-line)
    (make-local-hook 'activate-menubar-hook)
    (add-hook 'activate-menubar-hook 'cal-menu-update nil t)
    (make-local-variable 'calendar-mark-ring)
***************
*** 2133,2146 ****
        (setq strings (cdr strings)))
      (substring s 0 length)))
  
! (defun update-calendar-mode-line ()
!   "Update the calendar mode line with the current date and date style."
    (if (bufferp (get-buffer calendar-buffer))
        (save-excursion
          (set-buffer calendar-buffer)
!         (setq mode-line-format
                (calendar-string-spread
!                calendar-mode-line-format ?  (frame-width))))))
  
  (defun calendar-window-list ()
    "List of all calendar-related windows."
--- 2133,2146 ----
        (setq strings (cdr strings)))
      (substring s 0 length)))
  
! (defun update-calendar-header-line ()
!   "Update the calendar header line with the current date and date style."
    (if (bufferp (get-buffer calendar-buffer))
        (save-excursion
          (set-buffer calendar-buffer)
!         (setq header-line-format
                (calendar-string-spread
!                calendar-header-line-format ?  (frame-width))))))
  
  (defun calendar-window-list ()
    "List of all calendar-related windows."
***************
*** 2601,2607 ****
      (save-excursion
        (set-buffer (get-buffer-create other-calendars-buffer))
        (setq buffer-read-only nil)
!       (calendar-set-mode-line
         (concat (calendar-date-string date) " (Gregorian)"))
        (erase-buffer)
        (insert
--- 2601,2607 ----
      (save-excursion
        (set-buffer (get-buffer-create other-calendars-buffer))
        (setq buffer-read-only nil)
!       (calendar-set-header-line
         (concat (calendar-date-string date) " (Gregorian)"))
        (erase-buffer)
        (insert
***************
*** 2646,2654 ****
    (interactive)
    (message (calendar-day-of-year-string (calendar-cursor-to-date t))))
  
! (defun calendar-set-mode-line (str)
!   "Set mode line to STR, centered, surrounded by dashes."
!   (setq mode-line-format
          (calendar-string-spread (list str) ?- (frame-width))))
  
  (defun calendar-mod (m n)
--- 2646,2654 ----
    (interactive)
    (message (calendar-day-of-year-string (calendar-cursor-to-date t))))
  
! (defun calendar-set-header-line (str)
!   "Set header line to STR, centered, surrounded by dashes."
!   (setq header-line-format
          (calendar-string-spread (list str) ?- (frame-width))))
  
  (defun calendar-mod (m n)
diff -cr emacs-21.1/lisp/calendar/diary-lib.el 
emacs-21.1-modified/lisp/calendar/diary-lib.el
*** emacs-21.1/lisp/calendar/diary-lib.el       Mon Jul 16 00:46:48 2001
--- emacs-21.1-modified/lisp/calendar/diary-lib.el      Wed Nov  7 00:03:12 2001
***************
*** 403,409 ****
           (msg (format "No diary entries for %s %s"
                        (concat date-string (if holiday-list ":" ""))
                        (mapconcat 'identity holiday-list "; "))))
!     (calendar-set-mode-line
       (concat "Diary for " date-string
               (if holiday-list ": " "")
               (mapconcat 'identity holiday-list "; ")))
--- 403,409 ----
           (msg (format "No diary entries for %s %s"
                        (concat date-string (if holiday-list ":" ""))
                        (mapconcat 'identity holiday-list "; "))))
!     (calendar-set-header-line
       (concat "Diary for " date-string
               (if holiday-list ": " "")
               (mapconcat 'identity holiday-list "; ")))
***************
*** 414,420 ****
              (message "%s" msg)
            (set-buffer (get-buffer-create holiday-buffer))
            (setq buffer-read-only nil)
!           (calendar-set-mode-line date-string)
            (erase-buffer)
            (insert (mapconcat 'identity holiday-list "\n"))
            (goto-char (point-min))
--- 414,420 ----
              (message "%s" msg)
            (set-buffer (get-buffer-create holiday-buffer))
            (setq buffer-read-only nil)
!           (calendar-set-header-line date-string)
            (erase-buffer)
            (insert (mapconcat 'identity holiday-list "\n"))
            (goto-char (point-min))
***************
*** 433,439 ****
      (let ((diary-modified (buffer-modified-p)))
        (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
        (setq selective-display nil)
!       (kill-local-variable 'mode-line-format)
        (set-buffer-modified-p diary-modified)))
    (if (or (not diary-entries-list)
            (and (not (cdr diary-entries-list))
--- 433,439 ----
      (let ((diary-modified (buffer-modified-p)))
        (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
        (setq selective-display nil)
!       (kill-local-variable 'header-line-format)
        (set-buffer-modified-p diary-modified)))
    (if (or (not diary-entries-list)
            (and (not (cdr diary-entries-list))
***************
*** 447,453 ****
              (message "%s" msg)
            (set-buffer (get-buffer-create holiday-buffer))
            (setq buffer-read-only nil)
!           (calendar-set-mode-line date-string)
            (erase-buffer)
            (insert (mapconcat 'identity holiday-list "\n"))
            (goto-char (point-min))
--- 447,453 ----
              (message "%s" msg)
            (set-buffer (get-buffer-create holiday-buffer))
            (setq buffer-read-only nil)
!           (calendar-set-header-line date-string)
            (erase-buffer)
            (insert (mapconcat 'identity holiday-list "\n"))
            (goto-char (point-min))
***************
*** 523,530 ****
    (save-excursion
      (set-buffer (get-buffer-create fancy-diary-buffer))
      (setq buffer-read-only nil)
!     (make-local-variable 'mode-line-format)
!     (calendar-set-mode-line "Diary Entries")
      (erase-buffer)
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
--- 523,530 ----
    (save-excursion
      (set-buffer (get-buffer-create fancy-diary-buffer))
      (setq buffer-read-only nil)
!     (make-local-variable 'header-line-format)
!     (calendar-set-header-line "Diary Entries")
      (erase-buffer)
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
***************
*** 554,563 ****
              (save-excursion
                (set-buffer diary-buffer)
                (setq heading
!                     (if (not (stringp mode-line-format))
                          "All Diary Entries"
!                       (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
!                       (substring mode-line-format
                                   (match-beginning 1) (match-end 1))))
                (copy-to-buffer temp-buffer (point-min) (point-max))
                (set-buffer temp-buffer)
--- 554,563 ----
              (save-excursion
                (set-buffer diary-buffer)
                (setq heading
!                     (if (not (stringp header-line-format))
                          "All Diary Entries"
!                       (string-match "^-*\\([^-].*[^-]\\)-*$" 
header-line-format)
!                       (substring header-line-format
                                   (match-beginning 1) (match-end 1))))
                (copy-to-buffer temp-buffer (point-min) (point-max))
                (set-buffer temp-buffer)
***************
*** 588,595 ****
                        (diary-modified (buffer-modified-p)))
                    (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
                    (setq selective-display nil)
!                   (make-local-variable 'mode-line-format)
!                   (setq mode-line-format default-mode-line-format)
                    (display-buffer (current-buffer))
                    (set-buffer-modified-p diary-modified))))
            (error "Your diary file is not readable!"))
--- 588,595 ----
                        (diary-modified (buffer-modified-p)))
                    (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
                    (setq selective-display nil)
!                   (make-local-variable 'header-line-format)
!                   (setq header-line-format default-header-line-format)
                    (display-buffer (current-buffer))
                    (set-buffer-modified-p diary-modified))))
            (error "Your diary file is not readable!"))
diff -cr emacs-21.1/lisp/calendar/holidays.el 
emacs-21.1-modified/lisp/calendar/holidays.el
*** emacs-21.1/lisp/calendar/holidays.el        Wed May  9 08:11:07 2001
--- emacs-21.1-modified/lisp/calendar/holidays.el       Wed Nov  7 00:03:11 2001
***************
*** 172,178 ****
      (save-excursion
        (set-buffer (get-buffer-create holiday-buffer))
        (setq buffer-read-only nil)
!       (calendar-set-mode-line
         (if (= y1 y2)
             (format "%s for %s" title y1)
           (format "%s for %s-%s" title y1 y2)))
--- 172,178 ----
      (save-excursion
        (set-buffer (get-buffer-create holiday-buffer))
        (setq buffer-read-only nil)
!       (calendar-set-header-line
         (if (= y1 y2)
             (format "%s for %s" title y1)
           (format "%s for %s-%s" title y1 y2)))
***************
*** 219,225 ****
            (message "%s" msg)
          (set-buffer (get-buffer-create holiday-buffer))
          (setq buffer-read-only nil)
!         (calendar-set-mode-line date-string)
          (erase-buffer)
          (insert (mapconcat 'identity holiday-list "\n"))
          (goto-char (point-min))
--- 219,225 ----
            (message "%s" msg)
          (set-buffer (get-buffer-create holiday-buffer))
          (setq buffer-read-only nil)
!         (calendar-set-header-line date-string)
          (erase-buffer)
          (insert (mapconcat 'identity holiday-list "\n"))
          (goto-char (point-min))
***************
*** 259,265 ****
        (setq buffer-read-only nil)
        (increment-calendar-month m1 y1 -1)
        (increment-calendar-month m2 y2 1)
!       (calendar-set-mode-line
         (if (= y1 y2)
             (format "Notable Dates from %s to %s, %d%%-"
                     (calendar-month-name m1) (calendar-month-name m2) y2)
--- 259,265 ----
        (setq buffer-read-only nil)
        (increment-calendar-month m1 y1 -1)
        (increment-calendar-month m2 y2 1)
!       (calendar-set-header-line
         (if (= y1 y2)
             (format "Notable Dates from %s to %s, %d%%-"
                     (calendar-month-name m1) (calendar-month-name m2) y2)
diff -cr emacs-21.1/lisp/calendar/lunar.el 
emacs-21.1-modified/lisp/calendar/lunar.el
*** emacs-21.1/lisp/calendar/lunar.el   Mon Jul 16 00:46:48 2001
--- emacs-21.1-modified/lisp/calendar/lunar.el  Wed Nov  7 00:03:03 2001
***************
*** 196,202 ****
      (increment-calendar-month m2 y2 1)
      (set-buffer (get-buffer-create lunar-phases-buffer))
      (setq buffer-read-only nil)
!     (calendar-set-mode-line
       (if (= y1 y2)
           (format "Phases of the Moon from %s to %s, %d%%-"
                   (calendar-month-name m1) (calendar-month-name m2) y2)
--- 196,202 ----
      (increment-calendar-month m2 y2 1)
      (set-buffer (get-buffer-create lunar-phases-buffer))
      (setq buffer-read-only nil)
!     (calendar-set-header-line
       (if (= y1 y2)
           (format "Phases of the Moon from %s to %s, %d%%-"
                   (calendar-month-name m1) (calendar-month-name m2) y2)