comparison lisp/calendar/calendar.el @ 31730:719a230f8091

Docstring fixes. (calendar-make-alist): Don't quote lambda. (calendar-star-date): Use make-local-variable.

31729:3f1d7c3629aa

  :group 'diary)

;;;###autoload
(defcustom number-of-diary-entries 1
  "*Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command M-x diary is used,
or if the value of the variable `view-diary-entries-initially' is t.  For
example, if the default value 1 is used, then only the current day's diary
entries will be displayed.  If the value 2 is used, then both the current
day's and the next day's entries will be displayed.

  :type 'string
  :group 'diary)

;;;###autoload
(defcustom sexp-diary-entry-symbol "%%"
  "*The string used to indicate a sexp diary entry in diary-file.
See the documentation for the function `list-sexp-diary-entries'."
  :type 'string
  :group 'diary)

;;;###autoload

;;;###autoload
(defcustom mark-diary-entries-hook nil
  "*List of functions called after marking diary entries in the calendar.

A function `mark-included-diary-files' is also provided for use as the
mark-diary-entries-hook; it enables you to use shared diary files together
with your own.  The files included are specified in the diary file by lines
of the form
        #include \"filename\"
This is recursive; that is, #include directives in files thus included are
obeyed.  You can change the \"#include\" to some other string by changing the

(put 'calendar-holidays 'risky-local-variable t)
(defcustom calendar-holidays
  (append general-holidays local-holidays other-holidays
          christian-holidays hebrew-holidays islamic-holidays
          oriental-holidays solar-holidays)
  "*List of notable days for the command M-x holidays.

Additional holidays are easy to add to the list, just put them in the list
`other-holidays' in your .emacs file.  Similarly, by setting any of
`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
`islamic-holidays', `oriental-holidays', or `solar-holidays' to nil in your

    (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
    (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
                               MONTH on the Gregorian calendar (0 for Sunday,
                               etc.); K<0 means count back from the end of the
                               month. An optional parameter DAY means the Kth
                               DAYNAME after/before MONTH DAY.
    (holiday-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
    (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
    (holiday-julian MONTH DAY STRING)  a fixed date on the Julian calendar
    (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression

(defsubst extract-calendar-year (date)
  "Extract the year part of DATE which has the form (month day year)."
  (car (cdr (cdr date))))

(defsubst calendar-leap-year-p (year)
  "Returns t if YEAR is a Gregorian leap year."
  (and (zerop (% year 4))
       (or (not (zerop (% year 100)))
           (zerop (% year 400)))))

;; The foregoing is a bit faster, but not as clear as the following:

and the minus sign are automatically prefixes.  The window is replotted as
necessary to display the desired date.

Diary entries can be marked on the calendar or displayed in another window.

Use M-x describe-mode for details of the key bindings in the calendar window.

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

          (delete-window window))
         (t (set-buffer buffer)
            (bury-buffer))))))

(defun calendar-current-date ()
  "Returns the current date in a list (month day year)."
  (let ((now (decode-time)))
    (list (nth 4 now) (nth 3 now) (nth 5 now))))

(defun calendar-cursor-to-date (&optional error)
  "Returns a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
ERROR is t, otherwise just returns nil."
  (let* ((segment (/ (current-column) 25))
         (month (% (+ displayed-month segment -1) 12))
         (month (if (= 0 month) 12 month))

    (while (not (funcall acceptable value))
      (setq value (read-minibuffer prompt initial-contents)))
    value))

(defun calendar-read-date (&optional noday)
  "Prompt for Gregorian date.  Returns a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
\(month nil year); if NODAY is any other non-nil value the value returned is
\(month year) "
  (let* ((year (calendar-read
                "Year (>0): "
                (lambda (x) (> x 0))
                (int-to-string (extract-calendar-year
                                (calendar-current-date)))))

  "The number of months difference between MON1, YR1 and MON2, YR2."
  (+ (* 12 (- yr2 yr1))
     (- mon2 mon1)))

(defun calendar-day-name (date &optional width absolute)
  "Returns a string with the name of the day of the week of DATE.
If WIDTH is non-nil, return just the first WIDTH characters of the name.
If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week
rather than a date."
  (let ((string (aref calendar-day-name-array
		      (if absolute date (calendar-day-of-week date)))))

  "Make an assoc list corresponding to SEQUENCE.
Start at index 1, unless optional START-INDEX is provided.
If FILTER is provided, apply it to each item in the list."
  (let ((index (if start-index (1- start-index) 0)))
    (mapcar
     '(lambda (x)
        (setq index (1+ index))
        (cons (if filter (funcall filter x) x)
              index))
     (append sequence nil))))

	    (setq i (1+ i)))
	  result)
      string)))

(defun calendar-day-of-week (date)
  "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
  (% (calendar-absolute-from-gregorian date) 7))

(defun calendar-unmark ()
  "Delete all diary/holiday marks/highlighting from the calendar."
  (interactive)
  (setq mark-holidays-in-calendar nil)
  (setq mark-diary-entries-in-calendar nil)
  (redraw-calendar))

(defun calendar-date-is-visible-p (date)
  "Returns t if DATE is legal and is visible in the calendar window."
  (let ((gap (calendar-interval
              displayed-month displayed-year
              (extract-calendar-month date) (extract-calendar-year date))))
    (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))

(defun calendar-date-is-legal-p (date)
  "Returns t if DATE is a legal date."
  (let ((month (extract-calendar-month date))
        (day (extract-calendar-day date))
        (year (extract-calendar-year date)))
    (and (<= 1 month) (<= month 12)
         (<= 1 day) (<= day (calendar-last-day-of-month month year))
         (<= 1 year))))

(defun calendar-date-equal (date1 date2)
  "Returns t if the DATE1 and DATE2 are the same."
  (and
   (= (extract-calendar-month date1) (extract-calendar-month date2))
   (= (extract-calendar-day date1) (extract-calendar-day date2))
   (= (extract-calendar-year date1) (extract-calendar-year date2))))

	    (overlay-put
             (make-overlay (1- (point)) (1+ (point))) 'face mark))))))

(defun calendar-star-date ()
  "Replace the date under the cursor in the calendar window with asterisks.
This function can be used with the today-visible-calendar-hook run after the
calendar window has been prepared."
  (let ((buffer-read-only nil))
    (make-variable-buffer-local 'calendar-starred-day)
    (forward-char 1)
    (setq calendar-starred-day
          (string-to-int
           (buffer-substring (point) (- (point) 2))))
    (delete-char -2)

    (set-buffer-modified-p nil)))

(defun calendar-mark-today ()
  "Mark the date under the cursor in the calendar window.
The date is marked with calendar-today-marker.  This function can be used with
the today-visible-calendar-hook run after the calendar window has been
prepared."
  (mark-visible-calendar-date
   (calendar-cursor-to-date)
   calendar-today-marker))

(defun calendar-date-compare (date1 date2)
  "Returns t if DATE1 is before DATE2, nil otherwise.
The actual dates are in the car of DATE1 and DATE2."
  (< (calendar-absolute-from-gregorian (car date1))
     (calendar-absolute-from-gregorian (car date2))))

(defun calendar-date-string (date &optional abbreviate nodayname)

         (month (int-to-string month))
         (year (int-to-string (extract-calendar-year date))))
    (mapconcat 'eval calendar-date-display-form "")))

(defun calendar-dayname-on-or-before (dayname date)
  "Returns the absolute date of the DAYNAME on or before absolute DATE.
DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.

Note: Applying this function to d+6 gives us the DAYNAME on or after an
absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
absolute date d, applying it to d-1 gives the DAYNAME previous to absolute

31730:719a230f8091

  :group 'diary)

;;;###autoload
(defcustom number-of-diary-entries 1
  "*Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command \\[diary] is used,
or if the value of the variable `view-diary-entries-initially' is t.  For
example, if the default value 1 is used, then only the current day's diary
entries will be displayed.  If the value 2 is used, then both the current
day's and the next day's entries will be displayed.

  :type 'string
  :group 'diary)

;;;###autoload
(defcustom sexp-diary-entry-symbol "%%"
  "*The string used to indicate a sexp diary entry in `diary-file'.
See the documentation for the function `list-sexp-diary-entries'."
  :type 'string
  :group 'diary)

;;;###autoload

;;;###autoload
(defcustom mark-diary-entries-hook nil
  "*List of functions called after marking diary entries in the calendar.

A function `mark-included-diary-files' is also provided for use as the
`mark-diary-entries-hook'; it enables you to use shared diary files together
with your own.  The files included are specified in the diary file by lines
of the form
        #include \"filename\"
This is recursive; that is, #include directives in files thus included are
obeyed.  You can change the \"#include\" to some other string by changing the

(put 'calendar-holidays 'risky-local-variable t)
(defcustom calendar-holidays
  (append general-holidays local-holidays other-holidays
          christian-holidays hebrew-holidays islamic-holidays
          oriental-holidays solar-holidays)
  "*List of notable days for the command \\[holidays].

Additional holidays are easy to add to the list, just put them in the list
`other-holidays' in your .emacs file.  Similarly, by setting any of
`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
`islamic-holidays', `oriental-holidays', or `solar-holidays' to nil in your

    (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
    (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
                               MONTH on the Gregorian calendar (0 for Sunday,
                               etc.); K<0 means count back from the end of the
                               month.  An optional parameter DAY means the Kth
                               DAYNAME after/before MONTH DAY.
    (holiday-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
    (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
    (holiday-julian MONTH DAY STRING)  a fixed date on the Julian calendar
    (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression

(defsubst extract-calendar-year (date)
  "Extract the year part of DATE which has the form (month day year)."
  (car (cdr (cdr date))))

(defsubst calendar-leap-year-p (year)
  "Return t if YEAR is a Gregorian leap year."
  (and (zerop (% year 4))
       (or (not (zerop (% year 100)))
           (zerop (% year 400)))))

;; The foregoing is a bit faster, but not as clear as the following:

and the minus sign are automatically prefixes.  The window is replotted as
necessary to display the desired date.

Diary entries can be marked on the calendar or displayed in another window.

Use \\[describe-mode] for details of the key bindings in the calendar window.

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

          (delete-window window))
         (t (set-buffer buffer)
            (bury-buffer))))))

(defun calendar-current-date ()
  "Return the current date in a list (month day year)."
  (let ((now (decode-time)))
    (list (nth 4 now) (nth 3 now) (nth 5 now))))

(defun calendar-cursor-to-date (&optional error)
  "Return a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
ERROR is t, otherwise just returns nil."
  (let* ((segment (/ (current-column) 25))
         (month (% (+ displayed-month segment -1) 12))
         (month (if (= 0 month) 12 month))

    (while (not (funcall acceptable value))
      (setq value (read-minibuffer prompt initial-contents)))
    value))

(defun calendar-read-date (&optional noday)
  "Prompt for Gregorian date.  Return a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
\(month nil year); if NODAY is any other non-nil value the value returned is
\(month year)"
  (let* ((year (calendar-read
                "Year (>0): "
                (lambda (x) (> x 0))
                (int-to-string (extract-calendar-year
                                (calendar-current-date)))))

  "The number of months difference between MON1, YR1 and MON2, YR2."
  (+ (* 12 (- yr2 yr1))
     (- mon2 mon1)))

(defun calendar-day-name (date &optional width absolute)
  "Return a string with the name of the day of the week of DATE.
If WIDTH is non-nil, return just the first WIDTH characters of the name.
If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week
rather than a date."
  (let ((string (aref calendar-day-name-array
		      (if absolute date (calendar-day-of-week date)))))

  "Make an assoc list corresponding to SEQUENCE.
Start at index 1, unless optional START-INDEX is provided.
If FILTER is provided, apply it to each item in the list."
  (let ((index (if start-index (1- start-index) 0)))
    (mapcar
     (lambda (x)
        (setq index (1+ index))
        (cons (if filter (funcall filter x) x)
              index))
     (append sequence nil))))

	    (setq i (1+ i)))
	  result)
      string)))

(defun calendar-day-of-week (date)
  "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
  (% (calendar-absolute-from-gregorian date) 7))

(defun calendar-unmark ()
  "Delete all diary/holiday marks/highlighting from the calendar."
  (interactive)
  (setq mark-holidays-in-calendar nil)
  (setq mark-diary-entries-in-calendar nil)
  (redraw-calendar))

(defun calendar-date-is-visible-p (date)
  "Return t if DATE is legal and is visible in the calendar window."
  (let ((gap (calendar-interval
              displayed-month displayed-year
              (extract-calendar-month date) (extract-calendar-year date))))
    (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))

(defun calendar-date-is-legal-p (date)
  "Return t if DATE is a legal date."
  (let ((month (extract-calendar-month date))
        (day (extract-calendar-day date))
        (year (extract-calendar-year date)))
    (and (<= 1 month) (<= month 12)
         (<= 1 day) (<= day (calendar-last-day-of-month month year))
         (<= 1 year))))

(defun calendar-date-equal (date1 date2)
  "Return t if the DATE1 and DATE2 are the same."
  (and
   (= (extract-calendar-month date1) (extract-calendar-month date2))
   (= (extract-calendar-day date1) (extract-calendar-day date2))
   (= (extract-calendar-year date1) (extract-calendar-year date2))))

	    (overlay-put
             (make-overlay (1- (point)) (1+ (point))) 'face mark))))))

(defun calendar-star-date ()
  "Replace the date under the cursor in the calendar window with asterisks.
This function can be used with the `today-visible-calendar-hook' run after the
calendar window has been prepared."
  (let ((inhibit-read-only t))
    (make-local-variable 'calendar-starred-day)
    (forward-char 1)
    (setq calendar-starred-day
          (string-to-int
           (buffer-substring (point) (- (point) 2))))
    (delete-char -2)

    (set-buffer-modified-p nil)))

(defun calendar-mark-today ()
  "Mark the date under the cursor in the calendar window.
The date is marked with calendar-today-marker.  This function can be used with
the `today-visible-calendar-hook' run after the calendar window has been
prepared."
  (mark-visible-calendar-date
   (calendar-cursor-to-date)
   calendar-today-marker))

(defun calendar-date-compare (date1 date2)
  "Return t if DATE1 is before DATE2, nil otherwise.
The actual dates are in the car of DATE1 and DATE2."
  (< (calendar-absolute-from-gregorian (car date1))
     (calendar-absolute-from-gregorian (car date2))))

(defun calendar-date-string (date &optional abbreviate nodayname)

         (month (int-to-string month))
         (year (int-to-string (extract-calendar-year date))))
    (mapconcat 'eval calendar-date-display-form "")))

(defun calendar-dayname-on-or-before (dayname date)
  "Return the absolute date of the DAYNAME on or before absolute DATE.
DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.

Note: Applying this function to d+6 gives us the DAYNAME on or after an
absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
absolute date d, applying it to d-1 gives the DAYNAME previous to absolute