comparison lisp/calendar/calendar.el @ 92697:001682fd0516

(diary-file, hebrew-holidays-1) (hebrew-holidays-2, hebrew-holidays-3, hebrew-holidays-4) (calendar, calendar-basic-setup, calendar-mode-map, calendar-set-mark) (calendar-version): Doc fixes. (calendar-absolute-from-gregorian): Use zerop. (calendar-mode-line-format): Make it a defcustom.

92696:f656dd57b318

;; [e-mail] with the SUBJECT "send-paper-cal" (no quotes) and
;; the message BODY containing your mailing address (snail).

;;; Code:

(defvar displayed-month)
(defvar displayed-year)

(require 'cal-loaddefs)
(require 'cal-menu)

with the remainder of the line being the diary entry string for
that date.  MONTH and DAY are one or two digit numbers, YEAR is a
number and may be written in full or abbreviated to the final two
digits (if `abbreviated-calendar-year' is non-nil).  MONTHNAME
and DAYNAME can be spelled in full (as specified by the variables
`calendar-month-name-array' and `calendar-day-name-array'),
abbreviated (as specified by `calendar-month-abbrev-array' and
`calendar-day-abbrev-array') with or without a period,
capitalized or not.  Any of DAY, MONTH, or MONTHNAME, YEAR can be
`*' which matches any day, month, or year, respectively. If the
date does not contain a year, it is generic and applies to any
year.  A DAYNAME entry applies to the appropriate day of the week
in every week.

The European style (in which the day precedes the month) can be

                        (calendar-julian-from-absolute
                         (calendar-absolute-from-gregorian
                          (list m 1 y))))))
             (if (zerop (% (1+ year) 4))
                 22
               21))) "\"Tal Umatar\" (evening)"))))
;;;###autoload
(put 'hebrew-holidays-1 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-2

                   7)
                6)
             11 10))
       "Tzom Teveth"))
    (if all-hebrew-calendar-holidays
        (holiday-hebrew 11 15 "Tu B'Shevat"))))
;;;###autoload
(put 'hebrew-holidays-2 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-3

                      (calendar-dayname-on-or-before
                       6 (calendar-absolute-from-hebrew
                          (list 11 16 h-year))))))
                  (day (extract-calendar-day s-s)))
             day))
         "Shabbat Shirah"))))
;;;###autoload
(put 'hebrew-holidays-3 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-4

                    (y displayed-year)
                    (year))
               (increment-calendar-month m y -1)
               (let ((year (extract-calendar-year
                            (calendar-julian-from-absolute
                             (calendar-absolute-from-gregorian
                              (list m 1 y))))))
                 (= 21 (% year 28)))))
        (holiday-julian 3 26 "Kiddush HaHamah"))
    (if all-hebrew-calendar-holidays
        (holiday-tisha-b-av-etc))))
;;;###autoload
(put 'hebrew-holidays-4 'risky-local-variable t)

;;;###autoload
(defcustom hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
				hebrew-holidays-3 hebrew-holidays-4)
  "Jewish holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload

           ,mon (1+ (mod macro-y 12))
           ,yr (/ macro-y 12))
     (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
     (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc

(defun calendar-increment-month (n &optional mon yr)
  "Return the Nth month after MON/YR.
The return value is a pair (MONTH . YEAR).
MON defaults to `displayed-month'.  YR defaults to `displayed-year'."
  (unless mon (setq mon displayed-month))

;;    60   calendar-absolute-from-julian
;;    50   calendar-absolute-from-hebrew
;;    43   calendar-date-equal
;;    38   calendar-gregorian-from-absolute
;;     .
;;     .
;;     .
;;
;; The use of these seven macros eliminates the overhead of 92% of the function
;; calls; it's faster this way.

(defsubst extract-calendar-month (date)

           (zerop (% year 400)))))

;; The foregoing is a bit faster, but not as clear as the following:
;;
;;(defsubst calendar-leap-year-p (year)
;;  "Returns t if YEAR is a Gregorian leap year."
;;  (or
;;    (and (=  (% year   4) 0)
;;         (/= (% year 100) 0))
;;    (= (% year 400) 0)))

(defsubst calendar-last-day-of-month (month year)
  "The last day in MONTH during YEAR."
  (if (and (= month 2) (calendar-leap-year-p year))
      29

DATE is a list of the form (month day year).  A negative year is
interpreted as BC; -1 being 1 BC, and so on.  Dates before 12/31/1 BC
return negative results."
  (let ((year (extract-calendar-year date))
        offset-years)
    (cond ((= year 0)
           (error "There was no year zero"))
          ((> year 0)
           (setq offset-years (1- year))
           (+ (calendar-day-number date) ; Days this year
              (* 365 offset-years)       ; + Days in prior years
              (/ offset-years 4)         ; + Julian leap years
              (- (/ offset-years 100))   ; - century years
              (/ offset-years 400)))     ; + Gregorian leap years
          (t
           ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).

              (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC

;;;###autoload
(defun calendar (&optional arg)
  "Choose between the one frame, two frame, or basic calendar displays.
If called with an optional prefix argument, prompts for month and year.

The original function `calendar' has been renamed `calendar-basic-setup'.
See the documentation of that function for more information."
  (interactive "P")
  (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))

(defun calendar-basic-setup (&optional arg)
  "Display a three-month calendar in another window.
The three months appear side by side, with the current month in the middle
surrounded by the previous and next months.  The cursor is put on today's date.

If called with an optional prefix argument, prompts for month and year.

This function is suitable for execution in a .emacs file; appropriate setting
of the variable `view-diary-entries-initially' will cause the diary entries for
the current date to be displayed in another window.  The value of the variable
`number-of-diary-entries' controls the number of days of diary entries

The Gregorian calendar is assumed.

After loading the calendar, the hooks given by the variable
`calendar-load-hook' are run.  This is the place to add key bindings to the
calendar-mode-map.

After preparing the calendar window initially, the hooks given by the variable
`initial-calendar-window-hook' are run.

The hooks given by the variable `today-visible-calendar-hook' are run

    (update-calendar-mode-line)
    (calendar-cursor-to-visible-date
     (if today-visible today (list displayed-month 1 displayed-year)))
    (set-buffer-modified-p nil)
    ;; Don't do any window-related stuff if we weren't called from a
    ;; window displaying the calendar
    (when in-calendar-window
      (if (or (one-window-p t) (not (window-full-width-p)))
          ;; Don't mess with the window size, but ensure that the first
          ;; line is fully visible
          (set-window-vscroll nil 0)
        ;; Adjust the window to exactly fit the displayed calendar
        (fit-window-to-buffer nil nil calendar-minimum-window-height))
      (sit-for 0))
    (if (and (boundp 'font-lock-mode)
	     font-lock-mode)
	(font-lock-fontify-buffer))

  "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
The calendar is inserted at the top of the buffer in which point is currently
located, but indented INDENT spaces.  The indentation is done from the first
character on the line and does not disturb the first INDENT characters on the
line."
  (let* ((blank-days;; at start of month
          (mod
           (- (calendar-day-of-week (list month 1 year))
              calendar-week-start-day)
           7))
	 (last (calendar-last-day-of-month month year)))
   (goto-char (point-min))
   (calendar-insert-indented
    (calendar-string-spread
     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
    indent t)
   (calendar-insert-indented "" indent);; Go to proper spot
   ;; Use the first two characters of each day to head the columns.
   (dotimes (i 7)
     (insert
      (let ((string
             (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t)))
        (if enable-multibyte-characters
            (truncate-string-to-width string 2)
          (substring string 0 2)))
      " "))
   (calendar-insert-indented "" 0 t);; Force onto following line
   (calendar-insert-indented "" indent);; Go to proper spot
   ;; Add blank days before the first of the month
   (dotimes (idummy blank-days) (insert "   "))
   ;; Put in the days of the month
   (calendar-for-loop i from 1 to last do
      (insert (format "%2d " i))
      (add-text-properties
       (- (point) 3) (1- (point))
       '(mouse-face highlight
	 help-echo "mouse-2: menu of operations for this date"))
      (and (zerop (mod (+ i blank-days) 7))
           (/= i last)
           (calendar-insert-indented "" 0 t)    ;; Force onto following line
           (calendar-insert-indented "" indent)))));; Go to proper spot

(defun calendar-insert-indented (string indent &optional newline)
  "Insert STRING at column INDENT.
If the optional parameter NEWLINE is t, leave point at start of next line,
inserting a newline if there was no next line; otherwise, leave point after

    (define-key map [down-mouse-3]
      (easy-menu-binding cal-menu-context-mouse-menu))
    (define-key map [down-mouse-2]
      (easy-menu-binding cal-menu-global-mouse-menu))

    map))

(defun describe-calendar-mode ()
  "Create a help buffer with a brief description of the `calendar-mode'."
  (interactive)
  (help-setup-xref (list #'describe-calendar-mode) (interactive-p))

    (print-help-return-message)))

;; Calendar mode is suitable only for specially formatted data.
(put 'calendar-mode 'mode-class 'special)

(defvar calendar-mode-line-format
  (list
   (propertize "<"
	       'help-echo "mouse-1: previous month"
	       'mouse-face 'mode-line-highlight
	       'keymap (make-mode-line-mouse-map 'mouse-1

evaluated and concatenated together, evenly separated by blanks.  The variable
`date' is available for use as the date under (or near) the cursor; `date'
defaults to the current date if it is otherwise undefined.  Here is an example
value that has the Hebrew date, the day number/days remaining in the year,
and the ISO week/year numbers in the mode.  When `calendar-move-hook' is set
to `update-calendar-mode-line', these mode line shows these values for the date
under the cursor:

      (list
       \"\"
       '(calendar-hebrew-date-string date)

       '(let* ((d (calendar-absolute-from-gregorian date))
               (iso-date (calendar-iso-from-absolute d)))
          (format \"ISO week %d of %d\"
            (extract-calendar-month iso-date)
            (extract-calendar-year iso-date)))
       \"\"))")

(defun mouse-calendar-other-month (event)
  "Display a three-month calendar centered around a specified month and year."
  (interactive "e")
  (save-selected-window

        indent-tabs-mode nil)
  (use-local-map calendar-mode-map)
  (update-calendar-mode-line)
  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'calendar-starred-day)
  (make-local-variable 'displayed-month) ;; Month in middle of window.
  (make-local-variable 'displayed-year)  ;; Year in middle of window.
  ;; Most functions only work if displayed-month and displayed-year are set,
  ;; so let's make sure they're always set.  Most likely, this will be reset
  ;; soon in generate-calendar, but better safe than sorry.
  (unless (boundp 'displayed-month) (setq displayed-month 1))
  (unless (boundp 'displayed-year)  (setq displayed-year  2001))

possible.  Each item of STRINGS is evaluated before concatenation so it can
actually be an expression that evaluates to a string.  If LENGTH is too short,
the STRINGS are just concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
;; Addison-Wesley, Reading, MA, 1989
  (let* ((strings (mapcar 'eval
                          (if (< (length strings) 2)
                              (append (list "") strings (list ""))
                            strings)))
         (n (- length (length (apply 'concat strings))))

    (if (or (not diary-buffer)
            (not (buffer-modified-p diary-buffer))
            (yes-or-no-p
             "Diary modified; do you really want to exit the calendar? "))
        ;; Need to do this multiple times because one time can replace some
        ;; calendar-related buffers with other calendar-related buffers
        (mapc (lambda (x)
                (mapc 'calendar-hide-window (calendar-window-list)))
              (calendar-window-list)))))

(defun calendar-hide-window (window)

;;(defun calendar-gregorian-from-absolute (date)
;;  "Compute the list (month day year) corresponding to the absolute DATE.
;;The absolute date is the number of days elapsed since the (imaginary)
;;Gregorian date Sunday, December 31, 1 BC."
;;  (let* ((approx (/ date 366));; Approximation from below.
;;         (year                ;; Search forward from the approximation.
;;          (+ approx
;;             (calendar-sum y approx
;;                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
;;                  1)))
;;         (month         ;; Search forward from January.
;;          (1+ (calendar-sum m 1
;;                   (> date
;;                      (calendar-absolute-from-gregorian
;;                       (list m (calendar-last-day-of-month m year) year)))
;;                   1)))
;;         (day           ;; Calculate the day by subtraction.
;;          (- date
;;             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
;;    (list month day year)))

(defun calendar-gregorian-from-absolute (date)
  "Compute the list (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC.  This function does not
handle dates in years BC."
;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
;; Clamen, Software--Practice and Experience, Volume 23, Number 4
;; (April, 1993), pages 383-404 for an explanation.
  (let* ((d0 (1- date))
         (n400 (/ d0 146097))
         (d1 (% d0 146097))
         (n100 (/ d1 36524))
         (d2 (% d1 36524))

        (t (list month 1 year)))))))

(defun calendar-set-mark (arg)
  "Mark the date under the cursor, or jump to marked date.
With no prefix argument, push current date onto marked date ring.
With argument, jump to mark, pop it, and put point at end of ring."
  (interactive "P")
  (let ((date (calendar-cursor-to-date t)))
    (if (null arg)
        (progn
          (push date calendar-mark-ring)

	      " -?[0-9]+")
     . font-lock-function-name-face) ; month and year
    (,(regexp-opt
       (list (substring (aref calendar-day-name-array 6) 0 2)
	     (substring (aref calendar-day-name-array 0) 0 2)))
     ;; Saturdays and Sundays are hilited differently.
     . font-lock-comment-face)
    ;; First two chars of each day are used in the calendar.
    (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))
     . font-lock-reference-face))
  "Default keywords to highlight in Calendar mode.")

(defun calendar-day-name (date &optional abbrev absolute)
  "Return a string with the name of the day of the week of DATE.

                (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
                    (and (listp mark) (> (length mark) 0) mark)   ; attr list
                    (and (facep mark) mark)                       ; face-name
                    diary-entry-marker))
          (cond
           ;; face or an attr-list that contained a face
           ((facep mark)
            (overlay-put
             (make-overlay (1- (point)) (1+ (point))) 'face mark))
           ;; single-char
           ((and (stringp mark) (= (length mark) 1))
            (let ((inhibit-read-only t))
              (forward-char 1)
              ;; Insert before delete so as to better preserve markers.
              (insert mark)
              (delete-char 1)
              (forward-char -2)))
           (t ;; attr list
            (let ((temp-face
                   (make-symbol
                    (apply 'concat "temp-"
                           (mapcar (lambda (sym)
                                     (cond

                                      ((numberp sym) (number-to-string sym))
                                      (t sym)))
                                   mark))))
                  (faceinfo mark))
              (make-face temp-face)
              ;; Remove :face info from the mark, copy the face info into
              ;; temp-face
              (while (setq faceinfo (memq :face faceinfo))
                (copy-face (read (nth 1 faceinfo)) temp-face)
                (setcar faceinfo nil)
                (setcar (cdr faceinfo) nil))
              (setq mark (delq nil mark))
              ;; Apply the font aspects
              (apply 'set-face-attribute temp-face nil mark)
              (overlay-put
               (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))

(defun calendar-star-date ()

  "Non-negative remainder of M/N with N instead of 0."
  (1+ (mod (1- m) n)))


(defun calendar-version ()
  (interactive)
  (message "GNU Emacs %s" emacs-version))

(make-obsolete 'calendar-version 'emacs-version "23.1")

92697:001682fd0516

;; [e-mail] with the SUBJECT "send-paper-cal" (no quotes) and
;; the message BODY containing your mailing address (snail).

;;; Code:


(require 'cal-loaddefs)
(require 'cal-menu)

with the remainder of the line being the diary entry string for
that date.  MONTH and DAY are one or two digit numbers, YEAR is a
number and may be written in full or abbreviated to the final two
digits (if `abbreviated-calendar-year' is non-nil).  MONTHNAME
and DAYNAME can be spelt in full (as specified by the variables
`calendar-month-name-array' and `calendar-day-name-array'),
abbreviated (as specified by `calendar-month-abbrev-array' and
`calendar-day-abbrev-array') with or without a period,
capitalized or not.  Any of DAY, MONTH, or MONTHNAME, YEAR can be
`*' which matches any day, month, or year, respectively.  If the
date does not contain a year, it is generic and applies to any
year.  A DAYNAME entry applies to the appropriate day of the week
in every week.

The European style (in which the day precedes the month) can be

                        (calendar-julian-from-absolute
                         (calendar-absolute-from-gregorian
                          (list m 1 y))))))
             (if (zerop (% (1+ year) 4))
                 22
               21))) "\"Tal Umatar\" (evening)")))
  "Component of the default value of `hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-1 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-2

                   7)
                6)
             11 10))
       "Tzom Teveth"))
    (if all-hebrew-calendar-holidays
        (holiday-hebrew 11 15 "Tu B'Shevat")))
  "Component of the default value of `hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-2 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-3

                      (calendar-dayname-on-or-before
                       6 (calendar-absolute-from-hebrew
                          (list 11 16 h-year))))))
                  (day (extract-calendar-day s-s)))
             day))
         "Shabbat Shirah")))
  "Component of the default value of `hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-3 'risky-local-variable t)

;;;###autoload
(defvar hebrew-holidays-4

                    (y displayed-year)
                    (year))
               (increment-calendar-month m y -1)
               (let ((year (extract-calendar-year
                            (calendar-julian-from-absolute
                            cd - (calendar-absolute-from-gregorian
                              (list m 1 y))))))
                 (= 21 (% year 28)))))
        (holiday-julian 3 26 "Kiddush HaHamah"))
    (if all-hebrew-calendar-holidays
        (holiday-tisha-b-av-etc)))
    "Component of the default value of `hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-4 'risky-local-variable t)

;;;###autoload
(defcustom hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
                                   hebrew-holidays-3 hebrew-holidays-4)
  "Jewish holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload

           ,mon (1+ (mod macro-y 12))
           ,yr (/ macro-y 12))
     (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
     (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc

(defvar displayed-month)
(defvar displayed-year)

(defun calendar-increment-month (n &optional mon yr)
  "Return the Nth month after MON/YR.
The return value is a pair (MONTH . YEAR).
MON defaults to `displayed-month'.  YR defaults to `displayed-year'."
  (unless mon (setq mon displayed-month))

;;    60   calendar-absolute-from-julian
;;    50   calendar-absolute-from-hebrew
;;    43   calendar-date-equal
;;    38   calendar-gregorian-from-absolute
;;     .
;;
;; The use of these seven macros eliminates the overhead of 92% of the function
;; calls; it's faster this way.

(defsubst extract-calendar-month (date)

           (zerop (% year 400)))))

;; The foregoing is a bit faster, but not as clear as the following:
;;
;;(defsubst calendar-leap-year-p (year)
;;  "Return t if YEAR is a Gregorian leap year."
;;  (or
;;   (and (zerop (% year 4))
;;        (not (zerop (% year 100))))
;;   (zerop (% year 400)))

(defsubst calendar-last-day-of-month (month year)
  "The last day in MONTH during YEAR."
  (if (and (= month 2) (calendar-leap-year-p year))
      29

DATE is a list of the form (month day year).  A negative year is
interpreted as BC; -1 being 1 BC, and so on.  Dates before 12/31/1 BC
return negative results."
  (let ((year (extract-calendar-year date))
        offset-years)
    (cond ((zerop year)
           (error "There was no year zero"))
          ((> year 0)
           (setq offset-years (1- year))
           (+ (calendar-day-number date) ; days this year
              (* 365 offset-years)       ; + days in prior years
              (/ offset-years 4)         ; + Julian leap years
              (- (/ offset-years 100))   ; - century years
              (/ offset-years 400)))     ; + Gregorian leap years
          (t
           ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).

              (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC

;;;###autoload
(defun calendar (&optional arg)
  "Choose between the one frame, two frame, or basic calendar displays.
If called with an optional prefix argument ARG, prompts for month and year.

The original function `calendar' has been renamed `calendar-basic-setup'.
See the documentation of that function for more information."
  (interactive "P")
  (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))

(defun calendar-basic-setup (&optional arg)
  "Display a three-month calendar in another window.
The three months appear side by side, with the current month in the middle
surrounded by the previous and next months.  The cursor is put on today's date.

If called with an optional prefix argument ARG, prompts for month and year.

This function is suitable for execution in a .emacs file; appropriate setting
of the variable `view-diary-entries-initially' will cause the diary entries for
the current date to be displayed in another window.  The value of the variable
`number-of-diary-entries' controls the number of days of diary entries

The Gregorian calendar is assumed.

After loading the calendar, the hooks given by the variable
`calendar-load-hook' are run.  This is the place to add key bindings to the
`calendar-mode-map'.

After preparing the calendar window initially, the hooks given by the variable
`initial-calendar-window-hook' are run.

The hooks given by the variable `today-visible-calendar-hook' are run

    (update-calendar-mode-line)
    (calendar-cursor-to-visible-date
     (if today-visible today (list displayed-month 1 displayed-year)))
    (set-buffer-modified-p nil)
    ;; Don't do any window-related stuff if we weren't called from a
    ;; window displaying the calendar.
    (when in-calendar-window
      (if (or (one-window-p t) (not (window-full-width-p)))
          ;; Don't mess with the window size, but ensure that the first
          ;; line is fully visible.
          (set-window-vscroll nil 0)
        ;; Adjust the window to exactly fit the displayed calendar.
        (fit-window-to-buffer nil nil calendar-minimum-window-height))
      (sit-for 0))
    (if (and (boundp 'font-lock-mode)
	     font-lock-mode)
	(font-lock-fontify-buffer))

  "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
The calendar is inserted at the top of the buffer in which point is currently
located, but indented INDENT spaces.  The indentation is done from the first
character on the line and does not disturb the first INDENT characters on the
line."
  (let* ((blank-days                    ; at start of month
          (mod
           (- (calendar-day-of-week (list month 1 year))
              calendar-week-start-day)
           7))
	 (last (calendar-last-day-of-month month year)))
   (goto-char (point-min))
   (calendar-insert-indented
    (calendar-string-spread
     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
    indent t)
   (calendar-insert-indented "" indent) ; go to proper spot
   ;; Use the first two characters of each day to head the columns.
   (dotimes (i 7)
     (insert
      (let ((string
             (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t)))
        (if enable-multibyte-characters
            (truncate-string-to-width string 2)
          (substring string 0 2)))
      " "))
   (calendar-insert-indented "" 0 t)    ; force onto following line
   (calendar-insert-indented "" indent) ; go to proper spot
   ;; Add blank days before the first of the month.
   (dotimes (idummy blank-days) (insert "   "))
   ;; Put in the days of the month.
   (calendar-for-loop i from 1 to last do
      (insert (format "%2d " i))
      (add-text-properties
       (- (point) 3) (1- (point))
       '(mouse-face highlight
	 help-echo "mouse-2: menu of operations for this date"))
      (and (zerop (mod (+ i blank-days) 7))
           (/= i last)
           (calendar-insert-indented "" 0 t) ; force onto following line
           (calendar-insert-indented "" indent))))) ; go to proper spot

(defun calendar-insert-indented (string indent &optional newline)
  "Insert STRING at column INDENT.
If the optional parameter NEWLINE is t, leave point at start of next line,
inserting a newline if there was no next line; otherwise, leave point after

    (define-key map [down-mouse-3]
      (easy-menu-binding cal-menu-context-mouse-menu))
    (define-key map [down-mouse-2]
      (easy-menu-binding cal-menu-global-mouse-menu))

    map)
  "Keymap for `calendar-mode'.")

(defun describe-calendar-mode ()
  "Create a help buffer with a brief description of the `calendar-mode'."
  (interactive)
  (help-setup-xref (list #'describe-calendar-mode) (interactive-p))

    (print-help-return-message)))

;; Calendar mode is suitable only for specially formatted data.
(put 'calendar-mode 'mode-class 'special)

;; After calendar-mode-map.
(defcustom calendar-mode-line-format
  (list
   (propertize "<"
	       'help-echo "mouse-1: previous month"
	       'mouse-face 'mode-line-highlight
	       'keymap (make-mode-line-mouse-map 'mouse-1

evaluated and concatenated together, evenly separated by blanks.  The variable
`date' is available for use as the date under (or near) the cursor; `date'
defaults to the current date if it is otherwise undefined.  Here is an example
value that has the Hebrew date, the day number/days remaining in the year,
and the ISO week/year numbers in the mode.  When `calendar-move-hook' is set
to `update-calendar-mode-line', the mode line shows these values for the date
under the cursor:

      (list
       \"\"
       '(calendar-hebrew-date-string date)

       '(let* ((d (calendar-absolute-from-gregorian date))
               (iso-date (calendar-iso-from-absolute d)))
          (format \"ISO week %d of %d\"
            (extract-calendar-month iso-date)
            (extract-calendar-year iso-date)))
       \"\"))"
  :type 'sexp
  :group 'calendar)

(defun mouse-calendar-other-month (event)
  "Display a three-month calendar centered around a specified month and year."
  (interactive "e")
  (save-selected-window

        indent-tabs-mode nil)
  (use-local-map calendar-mode-map)
  (update-calendar-mode-line)
  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'calendar-starred-day)
  (make-local-variable 'displayed-month) ; month in middle of window
  (make-local-variable 'displayed-year)  ; year in middle of window
  ;; Most functions only work if displayed-month and displayed-year are set,
  ;; so let's make sure they're always set.  Most likely, this will be reset
  ;; soon in generate-calendar, but better safe than sorry.
  (unless (boundp 'displayed-month) (setq displayed-month 1))
  (unless (boundp 'displayed-year)  (setq displayed-year  2001))

possible.  Each item of STRINGS is evaluated before concatenation so it can
actually be an expression that evaluates to a string.  If LENGTH is too short,
the STRINGS are just concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
;; Addison-Wesley, Reading, MA, 1989.
  (let* ((strings (mapcar 'eval
                          (if (< (length strings) 2)
                              (append (list "") strings (list ""))
                            strings)))
         (n (- length (length (apply 'concat strings))))

    (if (or (not diary-buffer)
            (not (buffer-modified-p diary-buffer))
            (yes-or-no-p
             "Diary modified; do you really want to exit the calendar? "))
        ;; Need to do this multiple times because one time can replace some
        ;; calendar-related buffers with other calendar-related buffers.
        (mapc (lambda (x)
                (mapc 'calendar-hide-window (calendar-window-list)))
              (calendar-window-list)))))

(defun calendar-hide-window (window)

;;(defun calendar-gregorian-from-absolute (date)
;;  "Compute the list (month day year) corresponding to the absolute DATE.
;;The absolute date is the number of days elapsed since the (imaginary)
;;Gregorian date Sunday, December 31, 1 BC."
;;  (let* ((approx (/ date 366)) ; approximation from below
;;         (year                ; search forward from the approximation
;;          (+ approx
;;             (calendar-sum y approx
;;                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
;;                  1)))
;;         (month                         ; search forward from January
;;          (1+ (calendar-sum m 1
;;                   (> date
;;                      (calendar-absolute-from-gregorian
;;                       (list m (calendar-last-day-of-month m year) year)))
;;                   1)))
;;         (day                      ; calculate the day by subtraction
;;          (- date
;;             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
;;    (list month day year)))

(defun calendar-gregorian-from-absolute (date)
  "Compute the list (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC.  This function does not
handle dates in years BC."
  ;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
  ;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
  ;; Clamen, Software--Practice and Experience, Volume 23, Number 4
  ;; (April, 1993), pages 383-404 for an explanation.
  (let* ((d0 (1- date))
         (n400 (/ d0 146097))
         (d1 (% d0 146097))
         (n100 (/ d1 36524))
         (d2 (% d1 36524))

        (t (list month 1 year)))))))

(defun calendar-set-mark (arg)
  "Mark the date under the cursor, or jump to marked date.
With no prefix argument, push current date onto marked date ring.
With argument ARG, jump to mark, pop it, and put point at end of ring."
  (interactive "P")
  (let ((date (calendar-cursor-to-date t)))
    (if (null arg)
        (progn
          (push date calendar-mark-ring)

	      " -?[0-9]+")
     . font-lock-function-name-face) ; month and year
    (,(regexp-opt
       (list (substring (aref calendar-day-name-array 6) 0 2)
	     (substring (aref calendar-day-name-array 0) 0 2)))
     ;; Saturdays and Sundays are highlighted differently.
     . font-lock-comment-face)
    ;; First two chars of each day are used in the calendar.
    (,(regexp-opt (mapcar (lambda (x) (substring x 0 2))
                          calendar-day-name-array))
     . font-lock-reference-face))
  "Default keywords to highlight in Calendar mode.")

(defun calendar-day-name (date &optional abbrev absolute)
  "Return a string with the name of the day of the week of DATE.

                (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
                    (and (listp mark) (> (length mark) 0) mark)   ; attr list
                    (and (facep mark) mark)                       ; face-name
                    diary-entry-marker))
          (cond
           ;; Face or an attr-list that contained a face.
           ((facep mark)
            (overlay-put
             (make-overlay (1- (point)) (1+ (point))) 'face mark))
           ;; Single-character.
           ((and (stringp mark) (= (length mark) 1))
            (let ((inhibit-read-only t))
              (forward-char 1)
              ;; Insert before delete so as to better preserve markers.
              (insert mark)
              (delete-char 1)
              (forward-char -2)))
           (t                           ; attr list
            (let ((temp-face
                   (make-symbol
                    (apply 'concat "temp-"
                           (mapcar (lambda (sym)
                                     (cond

                                      ((numberp sym) (number-to-string sym))
                                      (t sym)))
                                   mark))))
                  (faceinfo mark))
              (make-face temp-face)
              ;; Remove :face info from mark, copy the face info into temp-face.
              (while (setq faceinfo (memq :face faceinfo))
                (copy-face (read (nth 1 faceinfo)) temp-face)
                (setcar faceinfo nil)
                (setcar (cdr faceinfo) nil))
              (setq mark (delq nil mark))
              ;; Apply the font aspects.
              (apply 'set-face-attribute temp-face nil mark)
              (overlay-put
               (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))

(defun calendar-star-date ()

  "Non-negative remainder of M/N with N instead of 0."
  (1+ (mod (1- m) n)))


(defun calendar-version ()
  "Display the Calendar version."
  (interactive)
  (message "GNU Emacs %s" emacs-version))

(make-obsolete 'calendar-version 'emacs-version "23.1")