(blink-matching-open): Get rid of text props from
[bpt/emacs.git] / lisp / calendar / calendar.el
CommitLineData
3afbc435 1;;; calendar.el --- calendar functions
fd7fa35a 2
f059e122 3;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
0663481f 4;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
3a801d0c 5
fd7fa35a 6;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
d1493acd 7;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
e9571d2a 8;; Keywords: calendar
3076647c 9;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
fd7fa35a 10
ecaa0527
RS
11;; This file is part of GNU Emacs.
12
e555fdd8
RS
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
ecaa0527 18;; GNU Emacs is distributed in the hope that it will be useful,
e555fdd8
RS
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
b578f267 24;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
ecaa0527 27
fd7fa35a
ER
28;;; Commentary:
29
811a8484
JW
30;; This collection of functions implements a calendar window. It
31;; generates a calendar for the current month, together with the
32;; previous and coming months, or for any other three-month period.
33;; The calendar can be scrolled forward and backward in the window to
34;; show months in the past or future; the cursor can move forward and
35;; backward by days, weeks, or months, making it possible, for
36;; instance, to jump to the date a specified number of days, weeks, or
37;; months from the date under the cursor. The user can display a list
38;; of holidays and other notable days for the period shown; the
39;; notable days can be marked on the calendar, if desired. The user
40;; can also specify that dates having corresponding diary entries (in
41;; a file that the user specifies) be marked; the diary entries for
42;; any date can be viewed in a separate window. The diary and the
43;; notable days can be viewed independently of the calendar. Dates
44;; can be translated from the (usual) Gregorian calendar to the day of
45;; the year/days remaining in year, to the ISO commercial calendar, to
46;; the Julian (old style) calendar, to the Hebrew calendar, to the
47;; Islamic calendar, to the Baha'i calendar, to the French
48;; Revolutionary calendar, to the Mayan calendar, to the Chinese
49;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
50;; the astronomical (Julian) day number. When floating point is
51;; available, times of sunrise/sunset can be displayed, as can the
52;; phases of the moon. Appointment notification for diary entries is
3076647c 53;; available. Calendar printing via LaTeX is available.
7e1dae73
JB
54
55;; The following files are part of the calendar/diary code:
56
3076647c 57;; appt.el Appointment notification
327b6868 58;; cal-china.el Chinese calendar
3076647c
ER
59;; cal-coptic.el Coptic/Ethiopic calendars
60;; cal-dst.el Daylight savings time rules
61;; cal-hebrew.el Hebrew calendar
327b6868 62;; cal-islam.el Islamic calendar
811a8484 63;; cal-bahai.el Baha'i calendar
3076647c
ER
64;; cal-iso.el ISO calendar
65;; cal-julian.el Julian/astronomical calendars
66;; cal-mayan.el Mayan calendars
6a2aa94c 67;; cal-menu.el Menu support
7086b78e 68;; cal-move.el Movement in the calendar
a45eee72 69;; cal-persia.el Persian calendar
3076647c 70;; cal-tex.el Calendars in LaTeX
bcbb4a0a 71;; cal-x.el X-windows dedicated frame functions
f5e13137 72;; diary-lib.el Diary functions
7e1dae73 73;; holidays.el Holiday functions
7e1dae73 74;; lunar.el Phases of the moon
3076647c 75;; solar.el Sunrise/sunset, equinoxes/solstices
ecaa0527 76
ecaa0527 77;; Technical details of all the calendrical calculations can be found in
fffaba77
PE
78;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
79;; and Nachum Dershowitz, Cambridge University Press (2001).
7e1dae73 80
a96a5fca 81;; An earlier version of the technical details appeared in
ecaa0527
RS
82;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
83;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
fffaba77 84;; pages 899-928, and in ``Calendrical Calculations, Part II: Three Historical
7e1dae73 85;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
e4c61e50
JB
86;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
87;; pages 383-404.
7e1dae73
JB
88
89;; Hard copies of these two papers can be obtained by sending email to
90;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
91;; the message BODY containing your mailing address (snail).
ecaa0527 92
a96a5fca
PE
93;; Comments, corrections, and improvements should be sent to
94;; Edward M. Reingold Department of Computer Science
95;; (217) 333-6733 University of Illinois at Urbana-Champaign
96;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
97;; Urbana, Illinois 61801
98
fd7fa35a 99;;; Code:
ecaa0527 100
f059e122 101(eval-when-compile
d4ff5db9
DL
102 (defvar displayed-month)
103 (defvar displayed-year)
104 (defvar calendar-month-name-array)
105 (defvar calendar-starred-day))
106
e555fdd8
RS
107(defun calendar-version ()
108 (interactive)
3076647c 109 (message "Version 6, October 12, 1995"))
e555fdd8 110
b032077a
RS
111(defgroup calendar nil
112 "Calendar and time management support."
113 :group 'applications)
114
115(defgroup diary nil
116 "Emacs diary."
117 :group 'calendar)
118
119(defgroup appt nil
120 "Appointment notification."
121 :group 'calendar)
122
123(defgroup holidays nil
124 "Holidays support in calendar."
125 :group 'calendar
126 :prefix "calendar-"
127 :group 'local)
128
129(defgroup chinese-calendar nil
130 "Chinese calendar support."
131 :group 'calendar)
132
133(defgroup calendar-tex nil
134 "Options for printing calendar with LaTeX."
135 :prefix "cal-tex-"
136 :group 'calendar)
137
138(defgroup calendar-hooks nil
139 "Calendar hooks."
140 :prefix "calendar-"
141 :group 'calendar)
142
143
0663481f
GM
144(defconst calendar-buffer "*Calendar*"
145 "Name of the buffer used for the calendar.")
146
cba0c253 147;;;###autoload
b032077a 148(defcustom calendar-offset 0
cba0c253
ER
149 "*The offset of the principal month from the center of the calendar window.
1500 means the principal month is in the center (default), -1 means on the left,
151+1 means on the right. Larger (or smaller) values push the principal month off
b032077a
RS
152the screen."
153 :type 'integer
154 :group 'calendar)
cba0c253 155
7e1dae73 156;;;###autoload
b032077a 157(defcustom view-diary-entries-initially nil
1293540e 158 "*Non-nil means display current date's diary entries on entry to calendar.
ecaa0527
RS
159The diary is displayed in another window when the calendar is first displayed,
160if the current date is visible. The number of days of diary entries displayed
1293540e
GM
161is governed by the variable `number-of-diary-entries'. This variable can
162be overridden by the value of `calendar-setup'."
b032077a
RS
163 :type 'boolean
164 :group 'diary)
ecaa0527 165
7e1dae73 166;;;###autoload
b032077a 167(defcustom number-of-diary-entries 1
ecaa0527 168 "*Specifies how many days of diary entries are to be displayed initially.
3cbb4860 169This variable affects the diary display when the command \\[diary] is used,
ecaa0527
RS
170or if the value of the variable `view-diary-entries-initially' is t. For
171example, if the default value 1 is used, then only the current day's diary
172entries will be displayed. If the value 2 is used, then both the current
e555fdd8
RS
173day's and the next day's entries will be displayed.
174
175The value can also be a vector such as [0 2 2 2 2 4 1]; this value
176says to display no diary entries on Sunday, the display the entries
177for the current date and the day after on Monday through Thursday,
178display Friday through Monday's entries on Friday, and display only
179Saturday's entries on Saturday.
180
181This variable does not affect the diary display with the `d' command
182from the calendar; in that case, the prefix argument controls the
b032077a
RS
183number of days of diary entries displayed."
184 :type '(choice (integer :tag "Entries")
185 (vector :value [0 0 0 0 0 0 0]
186 (integer :tag "Sunday")
187 (integer :tag "Monday")
188 (integer :tag "Tuesday")
189 (integer :tag "Wednesday")
190 (integer :tag "Thursday")
191 (integer :tag "Friday")
192 (integer :tag "Saturday")))
193 :group 'diary)
ecaa0527 194
7e1dae73 195;;;###autoload
b032077a 196(defcustom mark-diary-entries-in-calendar nil
e555fdd8 197 "*Non-nil means mark dates with diary entries, in the calendar window.
b032077a
RS
198The marking symbol is specified by the variable `diary-entry-marker'."
199 :type 'boolean
200 :group 'diary)
ecaa0527 201
7e1e5cf1
SS
202;;;###autoload
203(defcustom calendar-remove-frame-by-deleting nil
204 "*Determine how the calendar mode removes a frame no longer needed.
205If nil, make an icon of the frame. If non-nil, delete the frame."
206 :type 'boolean
207 :group 'view)
208
75eb05f6 209(defvar diary-face 'diary
5d22135b 210 "Face name to use for diary entries.")
75eb05f6 211(defface diary
ea81d57e
DN
212 '((((min-colors 88) (class color) (background light))
213 :foreground "red1")
214 (((class color) (background light))
42121c23 215 :foreground "red")
ea81d57e
DN
216 (((min-colors 88) (class color) (background dark))
217 :foreground "yellow1")
9c887ada 218 (((class color) (background dark))
42121c23 219 :foreground "yellow")
9c887ada 220 (t
1fd714a4 221 :weight bold))
9c887ada
MB
222 "Face for highlighting diary entries."
223 :group 'diary)
75eb05f6
MB
224;; backward-compatibility alias
225(put 'diary-face 'face-alias 'diary)
9c887ada 226
75eb05f6 227(defface calendar-today
9c887ada
MB
228 '((t (:underline t)))
229 "Face for indicating today's date."
230 :group 'diary)
75eb05f6
MB
231;; backward-compatibility alias
232(put 'calendar-today-face 'face-alias 'calendar-today)
9c887ada 233
75eb05f6 234(defface holiday
9c887ada 235 '((((class color) (background light))
42121c23 236 :background "pink")
9c887ada 237 (((class color) (background dark))
42121c23 238 :background "chocolate4")
9c887ada 239 (t
42121c23 240 :inverse-video t))
9c887ada
MB
241 "Face for indicating dates that have holidays."
242 :group 'diary)
75eb05f6
MB
243;; backward-compatibility alias
244(put 'holiday-face 'face-alias 'holiday)
a69e7dae 245
f5f57411
SM
246(eval-after-load "facemenu"
247 '(progn
75eb05f6
MB
248 (add-to-list 'facemenu-unlisted-faces 'diary)
249 (add-to-list 'facemenu-unlisted-faces 'calendar-today)
250 (add-to-list 'facemenu-unlisted-faces 'holiday)))
f5f57411 251
b032077a 252(defcustom diary-entry-marker
13f0f988 253 (if (not (display-color-p))
6a2aa94c 254 "+"
75eb05f6 255 'diary)
a69e7dae
RS
256 "*How to mark dates that have diary entries.
257The value can be either a single-character string or a face."
b032077a
RS
258 :type '(choice string face)
259 :group 'diary)
6a2aa94c 260
b032077a 261(defcustom calendar-today-marker
13f0f988 262 (if (not (display-color-p))
6a2aa94c 263 "="
75eb05f6 264 'calendar-today)
a69e7dae
RS
265 "*How to mark today's date in the calendar.
266The value can be either a single-character string or a face.
267Marking today's date is done only if you set up `today-visible-calendar-hook'
268to request that."
b032077a
RS
269 :type '(choice string face)
270 :group 'calendar)
6a2aa94c 271
b032077a 272(defcustom calendar-holiday-marker
13f0f988 273 (if (not (display-color-p))
6a2aa94c 274 "*"
75eb05f6 275 'holiday)
a69e7dae
RS
276 "*How to mark notable dates in the calendar.
277The value can be either a single-character string or a face."
b032077a
RS
278 :type '(choice string face)
279 :group 'calendar)
ecaa0527 280
7e1dae73 281;;;###autoload
b032077a 282(defcustom view-calendar-holidays-initially nil
e555fdd8 283 "*Non-nil means display holidays for current three month period on entry.
354d0644 284The holidays are displayed in another window when the calendar is first
b032077a
RS
285displayed."
286 :type 'boolean
287 :group 'holidays)
ecaa0527 288
e5d77022 289;;;###autoload
b032077a 290(defcustom mark-holidays-in-calendar nil
e555fdd8 291 "*Non-nil means mark dates of holidays in the calendar window.
b032077a
RS
292The marking symbol is specified by the variable `calendar-holiday-marker'."
293 :type 'boolean
294 :group 'holidays)
ecaa0527 295
e5d77022 296;;;###autoload
b032077a 297(defcustom all-hebrew-calendar-holidays nil
354d0644 298 "*If nil, show only major holidays from the Hebrew calendar.
e555fdd8 299This means only those Jewish holidays that appear on secular calendars.
354d0644 300
b032077a
RS
301If t, show all the holidays that would appear in a complete Hebrew calendar."
302 :type 'boolean
303 :group 'holidays)
ecaa0527 304
e5d77022 305;;;###autoload
b032077a 306(defcustom all-christian-calendar-holidays nil
354d0644 307 "*If nil, show only major holidays from the Christian calendar.
e555fdd8 308This means only those Christian holidays that appear on secular calendars.
354d0644 309
e555fdd8 310If t, show all the holidays that would appear in a complete Christian
b032077a
RS
311calendar."
312 :type 'boolean
313 :group 'holidays)
ecaa0527 314
e5d77022 315;;;###autoload
b032077a 316(defcustom all-islamic-calendar-holidays nil
354d0644 317 "*If nil, show only major holidays from the Islamic calendar.
e555fdd8 318This means only those Islamic holidays that appear on secular calendars.
354d0644 319
e555fdd8 320If t, show all the holidays that would appear in a complete Islamic
b032077a
RS
321calendar."
322 :type 'boolean
323 :group 'holidays)
ecaa0527 324
d13c1378
JB
325(defcustom diary-file-name-prefix-function (function (lambda (str) str))
326 "*The function that will take a diary file name and return the desired prefix."
808052d6 327 :type 'function
d13c1378
JB
328 :group 'diary)
329
811a8484
JW
330;;;###autoload
331(defcustom all-bahai-calendar-holidays nil
332 "*If nil, show only major holidays from the Baha'i calendar.
333These are the days on which work and school must be suspended.
334
335If t, show all the holidays that would appear in a complete Baha'i
336calendar."
337 :type 'boolean
338 :group 'holidays)
339
7e1dae73 340;;;###autoload
b032077a 341(defcustom calendar-load-hook nil
7e1dae73 342 "*List of functions to be called after the calendar is first loaded.
b032077a
RS
343This is the place to add key bindings to `calendar-mode-map'."
344 :type 'hook
345 :group 'calendar-hooks)
7e1dae73
JB
346
347;;;###autoload
b032077a 348(defcustom initial-calendar-window-hook nil
ecaa0527
RS
349 "*List of functions to be called when the calendar window is first opened.
350The functions invoked are called after the calendar window is opened, but
351once opened is never called again. Leaving the calendar with the `q' command
b032077a
RS
352and reentering it will cause these functions to be called again."
353 :type 'hook
354 :group 'calendar-hooks)
ecaa0527 355
7e1dae73 356;;;###autoload
b032077a 357(defcustom today-visible-calendar-hook nil
ecaa0527
RS
358 "*List of functions called whenever the current date is visible.
359This can be used, for example, to replace today's date with asterisks; a
360function `calendar-star-date' is included for this purpose:
361 (setq today-visible-calendar-hook 'calendar-star-date)
6b1abbd1 362It can also be used to mark the current date with `calendar-today-marker';
6a2aa94c 363a function is also provided for this:
ecaa0527
RS
364 (setq today-visible-calendar-hook 'calendar-mark-today)
365
366The corresponding variable `today-invisible-calendar-hook' is the list of
367functions called when the calendar function was called when the current
368date is not visible in the window.
369
370Other than the use of the provided functions, the changing of any
371characters in the calendar buffer by the hooks may cause the failure of the
b032077a
RS
372functions that move by days and weeks."
373 :type 'hook
374 :group 'calendar-hooks)
ecaa0527 375
7e1dae73 376;;;###autoload
b032077a 377(defcustom today-invisible-calendar-hook nil
ecaa0527
RS
378 "*List of functions called whenever the current date is not visible.
379
380The corresponding variable `today-visible-calendar-hook' is the list of
381functions called when the calendar function was called when the current
382date is visible in the window.
383
384Other than the use of the provided functions, the changing of any
385characters in the calendar buffer by the hooks may cause the failure of the
b032077a
RS
386functions that move by days and weeks."
387 :type 'hook
388 :group 'calendar-hooks)
ecaa0527 389
5c9705e5
RS
390;;;###autoload
391(defcustom calendar-move-hook nil
392 "*List of functions called whenever the cursor moves in the calendar.
393
7e1e5cf1 394For example,
5c9705e5
RS
395
396 (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
397
398redisplays the diary for whatever date the cursor is moved to."
399 :type 'hook
400 :group 'calendar-hooks)
401
7e1dae73 402;;;###autoload
b032077a 403(defcustom diary-file "~/diary"
ecaa0527
RS
404 "*Name of the file in which one's personal diary of dates is kept.
405
2c8811d4
GM
406The file's entries are lines beginning with any of the forms
407specified by the variable `american-date-diary-pattern', by default:
ecaa0527
RS
408
409 MONTH/DAY
410 MONTH/DAY/YEAR
411 MONTHNAME DAY
412 MONTHNAME DAY, YEAR
413 DAYNAME
414
2c8811d4
GM
415with the remainder of the line being the diary entry string for
416that date. MONTH and DAY are one or two digit numbers, YEAR is a
417number and may be written in full or abbreviated to the final two
418digits (if `abbreviated-calendar-year' is non-nil). MONTHNAME
419and DAYNAME can be spelled in full (as specified by the variables
420`calendar-month-name-array' and `calendar-day-name-array'),
421abbreviated (as specified by `calendar-month-abbrev-array' and
422`calendar-day-abbrev-array') with or without a period,
423capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be
424`*' which matches any day, month, or year, respectively. If the
425date does not contain a year, it is generic and applies to any
426year. A DAYNAME entry applies to the appropriate day of the week
427in every week.
428
429The European style (in which the day precedes the month) can be
430used instead, if you execute `european-calendar' when in the
431calendar, or set `european-calendar-style' to t in your .emacs
432file. The European forms (see `european-date-diary-pattern') are
ecaa0527
RS
433
434 DAY/MONTH
435 DAY/MONTH/YEAR
436 DAY MONTHNAME
437 DAY MONTHNAME YEAR
438 DAYNAME
439
440To revert to the default American style from the European style, execute
441`american-calendar' in the calendar.
442
6b1abbd1
RS
443A diary entry can be preceded by the character
444`diary-nonmarking-symbol' (ordinarily `&') to make that entry
445nonmarking--that is, it will not be marked on dates in the calendar
446window but will appear in a diary window.
ecaa0527
RS
447
448Multiline diary entries are made by indenting lines after the first with
449either a TAB or one or more spaces.
450
451Lines not in one the above formats are ignored. Here are some sample diary
452entries (in the default American style):
453
454 12/22/1988 Twentieth wedding anniversary!!
455 &1/1. Happy New Year!
456 10/22 Ruth's birthday.
457 21: Payday
458 Tuesday--weekly meeting with grad students at 10am
459 Supowit, Shen, Bitner, and Kapoor to attend.
460 1/13/89 Friday the thirteenth!!
461 &thu 4pm squash game with Lloyd.
462 mar 16 Dad's birthday
463 April 15, 1989 Income tax due.
464 &* 15 time cards due.
465
466If the first line of a diary entry consists only of the date or day name with
e555fdd8
RS
467no trailing blanks or punctuation, then that line is not displayed in the
468diary window; only the continuation lines is shown. For example, the
ecaa0527
RS
469single diary entry
470
471 02/11/1989
472 Bill Blattner visits Princeton today
473 2pm Cognitive Studies Committee meeting
474 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
475 4:00pm Jamie Tappenden
476 7:30pm Dinner at George and Ed's for Alan Ryan
477 7:30-10:00pm dance at Stewart Country Day School
478
479will appear in the diary window without the date line at the beginning. This
480facility allows the diary window to look neater, but can cause confusion if
481used with more than one day's entries displayed.
482
483Diary entries can be based on Lisp sexps. For example, the diary entry
484
485 %%(diary-block 11 1 1990 11 10 1990) Vacation
486
811a8484
JW
487causes the diary entry \"Vacation\" to appear from November 1 through
488November 10, 1990. Other functions available are `diary-float',
489`diary-anniversary', `diary-cyclic', `diary-day-of-year',
490`diary-iso-date', `diary-french-date', `diary-hebrew-date',
491`diary-islamic-date', `diary-bahai-date', `diary-mayan-date',
7086b78e 492`diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date',
c21eb13d 493`diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset',
811a8484
JW
494`diary-phases-of-moon', `diary-parasha', `diary-omer',
495`diary-rosh-hodesh', and `diary-sabbath-candles'. See the
496documentation for the function `list-sexp-diary-entries' for more
497details.
ecaa0527 498
811a8484
JW
499Diary entries based on the Hebrew, the Islamic and/or the Baha'i
500calendar are also possible, but because these are somewhat slow, they
501are ignored unless you set the `nongregorian-diary-listing-hook' and
502the `nongregorian-diary-marking-hook' appropriately. See the
503documentation for these functions for details.
ecaa0527
RS
504
505Diary files can contain directives to include the contents of other files; for
b032077a
RS
506details, see the documentation for the variable `list-diary-entries-hook'."
507 :type 'file
508 :group 'diary)
ecaa0527 509
7e1dae73 510;;;###autoload
b032077a
RS
511(defcustom diary-nonmarking-symbol "&"
512 "*Symbol indicating that a diary entry is not to be marked in the calendar."
513 :type 'string
514 :group 'diary)
ecaa0527 515
7e1dae73 516;;;###autoload
b032077a
RS
517(defcustom hebrew-diary-entry-symbol "H"
518 "*Symbol indicating a diary entry according to the Hebrew calendar."
519 :type 'string
520 :group 'diary)
ecaa0527 521
7e1dae73 522;;;###autoload
b032077a
RS
523(defcustom islamic-diary-entry-symbol "I"
524 "*Symbol indicating a diary entry according to the Islamic calendar."
525 :type 'string
526 :group 'diary)
ecaa0527 527
811a8484
JW
528;;;###autoload
529(defcustom bahai-diary-entry-symbol "B"
530 "*Symbol indicating a diary entry according to the Baha'i calendar."
531 :type 'string
532 :group 'diary)
533
7e1dae73 534;;;###autoload
b032077a 535(defcustom diary-include-string "#include"
354d0644 536 "*The string indicating inclusion of another file of diary entries.
b032077a
RS
537See the documentation for the function `include-other-diary-files'."
538 :type 'string
539 :group 'diary)
ecaa0527 540
d13c1378
JB
541(defcustom diary-glob-file-regexp-prefix "^\\#"
542 "*The regular expression that gets pre-pended to each of the attribute-regexp's for file-wide specifiers."
543 :type 'regexp
544 :group 'diary)
545
2c8811d4
GM
546(defcustom diary-face-attrs
547 '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
548 (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
549 (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
550 (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int)
551 (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
552 (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
553 (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
554 (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
555 (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
556 (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
557 (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
558 (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
559 ;; Unsupported.
560;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
561;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
562 )
563 "*A list of (regexp regnum attr attrtype) lists where the
564regexp says how to find the tag, the regnum says which
565parenthetical sub-regexp this regexp looks for, and the attr says
566which attribute of the face (or that this _is_ a face) is being
567modified."
d13c1378
JB
568 :type 'sexp
569 :group 'diary)
570
571(defcustom diary-file-name-prefix nil
2c8811d4 572 "If non-nil each diary entry is prefixed with the name of the file where it is defined."
d13c1378
JB
573 :type 'boolean
574 :group 'diary)
575
7e1dae73 576;;;###autoload
b032077a 577(defcustom sexp-diary-entry-symbol "%%"
3cbb4860 578 "*The string used to indicate a sexp diary entry in `diary-file'.
b032077a
RS
579See the documentation for the function `list-sexp-diary-entries'."
580 :type 'string
581 :group 'diary)
ecaa0527 582
7e1dae73 583;;;###autoload
b032077a 584(defcustom abbreviated-calendar-year t
354d0644 585 "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
811a8484
JW
586For the Gregorian calendar; similarly for the Hebrew, Islamic and
587Baha'i calendars. If this variable is nil, years must be written in
588full."
b032077a
RS
589 :type 'boolean
590 :group 'diary)
ecaa0527 591
7e1dae73 592;;;###autoload
b032077a 593(defcustom european-calendar-style nil
354d0644
JB
594 "*Use the European style of dates in the diary and in any displays.
595If this variable is t, a date 1/2/1990 would be interpreted as February 1,
2c8811d4
GM
5961990. The default European date styles (see `european-date-diary-pattern')
597are
ecaa0527
RS
598
599 DAY/MONTH
600 DAY/MONTH/YEAR
601 DAY MONTHNAME
602 DAY MONTHNAME YEAR
603 DAYNAME
604
2c8811d4
GM
605Names can be capitalized or not, written in full (as specified by the
606variable `calendar-day-name-array'), or abbreviated (as specified by
1293540e
GM
607`calendar-day-abbrev-array') with or without a period. To take effect,
608this variable should be set before the calendar package and its associates
609are loaded. Otherwise, use one of the functions `european-calendar' or
610`american-calendar' to force the appropriate update."
b032077a
RS
611 :type 'boolean
612 :group 'diary)
ecaa0527 613
7e1dae73 614;;;###autoload
b032077a 615(defcustom american-date-diary-pattern
ecaa0527
RS
616 '((month "/" day "[^/0-9]")
617 (month "/" day "/" year "[^0-9]")
618 (monthname " *" day "[^,0-9]")
619 (monthname " *" day ", *" year "[^0-9]")
620 (dayname "\\W"))
621 "*List of pseudo-patterns describing the American patterns of date used.
b032077a
RS
622See the documentation of `diary-date-forms' for an explanation."
623 :type '(repeat (choice (cons :tag "Backup"
624 :value (backup . nil)
625 (const backup)
626 (repeat (list :inline t :format "%v"
627 (symbol :tag "Keyword")
628 (choice symbol regexp))))
629 (repeat (list :inline t :format "%v"
630 (symbol :tag "Keyword")
631 (choice symbol regexp)))))
632 :group 'diary)
ecaa0527 633
7e1dae73 634;;;###autoload
b032077a 635(defcustom european-date-diary-pattern
ecaa0527
RS
636 '((day "/" month "[^/0-9]")
637 (day "/" month "/" year "[^0-9]")
bb0541f8 638 (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
ecaa0527
RS
639 (day " *" monthname " *" year "[^0-9]")
640 (dayname "\\W"))
641 "*List of pseudo-patterns describing the European patterns of date used.
b032077a
RS
642See the documentation of `diary-date-forms' for an explanation."
643 :type '(repeat (choice (cons :tag "Backup"
644 :value (backup . nil)
645 (const backup)
646 (repeat (list :inline t :format "%v"
647 (symbol :tag "Keyword")
648 (choice symbol regexp))))
649 (repeat (list :inline t :format "%v"
650 (symbol :tag "Keyword")
651 (choice symbol regexp)))))
652 :group 'diary)
653
654(defcustom diary-date-forms
ecaa0527
RS
655 (if european-calendar-style
656 european-date-diary-pattern
657 american-date-diary-pattern)
658 "*List of pseudo-patterns describing the forms of date used in the diary.
8c64a298 659The patterns on the list must be MUTUALLY EXCLUSIVE and should not match
ecaa0527
RS
660any portion of the diary entry itself, just the date component.
661
662A pseudo-pattern is a list of regular expressions and the keywords `month',
663`day', `year', `monthname', and `dayname'. The keyword `monthname' will
2c8811d4
GM
664match the name of the month (see `calendar-month-name-array'), capitalized
665or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
666followed by a period or not; it will also match `*'. Similarly, `dayname'
667will match the name of the day (see `calendar-day-name-array'), capitalized or
668not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
669followed by a period or not. The keywords `month', `day', and `year' will
670match those numerical values, preceded by arbitrarily many zeros; they will
671also match `*'.
ecaa0527
RS
672
673The matching of the diary entries with the date forms is done with the
674standard syntax table from Fundamental mode, but with the `*' changed so
675that it is a word constituent.
676
677If, to be mutually exclusive, a pseudo-pattern must match a portion of the
678diary entry itself, the first element of the pattern MUST be `backup'. This
7e1dae73
JB
679directive causes the date recognizer to back up to the beginning of the
680current word of the diary entry, so in no case can the pattern match more than
b032077a
RS
681a portion of the first word of the diary entry."
682 :type '(repeat (choice (cons :tag "Backup"
683 :value (backup . nil)
684 (const backup)
685 (repeat (list :inline t :format "%v"
686 (symbol :tag "Keyword")
687 (choice symbol regexp))))
688 (repeat (list :inline t :format "%v"
689 (symbol :tag "Keyword")
690 (choice symbol regexp)))))
691 :group 'diary)
ecaa0527 692
7e1dae73 693;;;###autoload
b032077a 694(defcustom european-calendar-display-form
7e1dae73 695 '((if dayname (concat dayname ", ")) day " " monthname " " year)
354d0644 696 "*Pseudo-pattern governing the way a date appears in the European style.
5d22135b 697See the documentation of `calendar-date-display-form' for an explanation."
b032077a
RS
698 :type 'sexp
699 :group 'calendar)
ecaa0527 700
7e1dae73 701;;;###autoload
b032077a 702(defcustom american-calendar-display-form
7e1dae73 703 '((if dayname (concat dayname ", ")) monthname " " day ", " year)
354d0644 704 "*Pseudo-pattern governing the way a date appears in the American style.
b032077a
RS
705See the documentation of `calendar-date-display-form' for an explanation."
706 :type 'sexp
707 :group 'calendar)
ecaa0527 708
b032077a 709(defcustom calendar-date-display-form
ecaa0527
RS
710 (if european-calendar-style
711 european-calendar-display-form
712 american-calendar-display-form)
354d0644
JB
713 "*Pseudo-pattern governing the way a date appears.
714
715Used by the function `calendar-date-string', a pseudo-pattern is a list of
716expressions that can involve the keywords `month', `day', and `year', all
717numbers in string form, and `monthname' and `dayname', both alphabetic
718strings. For example, the ISO standard would use the pseudo- pattern
ecaa0527
RS
719
720 '(year \"-\" month \"-\" day)
721
722while a typical American form would be
723
724 '(month \"/\" day \"/\" (substring year -2))
725
726and
727
728 '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
729
730would give the usual American style in fixed-length fields.
731
b032077a
RS
732See the documentation of the function `calendar-date-string'."
733 :type 'sexp
734 :group 'calendar)
ecaa0527
RS
735
736(defun european-calendar ()
737 "Set the interpretation and display of dates to the European style."
738 (interactive)
739 (setq european-calendar-style t)
740 (setq calendar-date-display-form european-calendar-display-form)
741 (setq diary-date-forms european-date-diary-pattern)
742 (update-calendar-mode-line))
743
744(defun american-calendar ()
745 "Set the interpretation and display of dates to the American style."
746 (interactive)
747 (setq european-calendar-style nil)
748 (setq calendar-date-display-form american-calendar-display-form)
749 (setq diary-date-forms american-date-diary-pattern)
750 (update-calendar-mode-line))
751
7e1dae73 752;;;###autoload
b032077a 753(defcustom print-diary-entries-hook 'lpr-buffer
354d0644
JB
754 "*List of functions called after a temporary diary buffer is prepared.
755The buffer shows only the diary entries currently visible in the diary
756buffer. The default just does the printing. Other uses might include, for
757example, rearranging the lines into order by day and time, saving the buffer
b032077a
RS
758instead of deleting it, or changing the function used to do the printing."
759 :type 'hook
760 :group 'diary)
ecaa0527 761
e5d77022 762;;;###autoload
b032077a 763(defcustom list-diary-entries-hook nil
354d0644
JB
764 "*List of functions called after diary file is culled for relevant entries.
765It is to be used for diary entries that are not found in the diary file.
ecaa0527
RS
766
767A function `include-other-diary-files' is provided for use as the value of
768this hook. This function enables you to use shared diary files together
6b1abbd1 769with your own. The files included are specified in the diary file by lines
ecaa0527
RS
770of the form
771
772 #include \"filename\"
773
774This is recursive; that is, #include directives in files thus included are
775obeyed. You can change the \"#include\" to some other string by changing
776the variable `diary-include-string'. When you use `include-other-diary-files'
777as part of the list-diary-entries-hook, you will probably also want to use the
6b1abbd1 778function `mark-included-diary-files' as part of `mark-diary-entries-hook'.
ecaa0527
RS
779
780For example, you could use
781
782 (setq list-diary-entries-hook
7e1dae73 783 '(include-other-diary-files sort-diary-entries))
ecaa0527
RS
784 (setq diary-display-hook 'fancy-diary-display)
785
6b1abbd1 786in your `.emacs' file to cause the fancy diary buffer to be displayed with
ecaa0527 787diary entries from various included files, each day's entries sorted into
b032077a
RS
788lexicographic order."
789 :type 'hook
3d880a4b 790 :options '(include-other-diary-files sort-diary-entries)
b032077a 791 :group 'diary)
ecaa0527 792
e5d77022 793;;;###autoload
b032077a 794(defcustom diary-hook nil
34fa2dc2 795 "*List of functions called after the display of the diary.
b032077a
RS
796Can be used for appointment notification."
797 :type 'hook
798 :group 'diary)
34fa2dc2
RS
799
800;;;###autoload
b032077a 801(defcustom diary-display-hook nil
ecaa0527 802 "*List of functions that handle the display of the diary.
e555fdd8 803If nil (the default), `simple-diary-display' is used. Use `ignore' for no
34fa2dc2 804diary display.
ecaa0527
RS
805
806Ordinarily, this just displays the diary buffer (with holidays indicated in
807the mode line), if there are any relevant entries. At the time these
808functions are called, the variable `diary-entries-list' is a list, in order
809by date, of all relevant diary entries in the form of ((MONTH DAY YEAR)
810STRING), where string is the diary entry for the given date. This can be
34fa2dc2
RS
811used, for example, a different buffer for display (perhaps combined with
812holidays), or produce hard copy output.
ecaa0527
RS
813
814A function `fancy-diary-display' is provided as an alternative
815choice for this hook; this function prepares a special noneditable diary
816buffer with the relevant diary entries that has neat day-by-day arrangement
817with headings. The fancy diary buffer will show the holidays unless the
818variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy
819diary buffer will not show days for which there are no diary entries, even
820if that day is a holiday; if you want such days to be shown in the fancy
b032077a
RS
821diary buffer, set the variable `diary-list-include-blanks' to t."
822 :type 'hook
3d880a4b 823 :options '(fancy-diary-display)
b032077a 824 :group 'diary)
ecaa0527 825
e5d77022 826;;;###autoload
b032077a 827(defcustom nongregorian-diary-listing-hook nil
354d0644 828 "*List of functions called for listing diary file and included files.
811a8484
JW
829As the files are processed for diary entries, these functions are used
830to cull relevant entries. You can use either or both of
831`list-hebrew-diary-entries', `list-islamic-diary-entries' and
832`list-bahai-diary-entries'. The documentation for these functions
b032077a
RS
833describes the style of such diary entries."
834 :type 'hook
811a8484
JW
835 :options '(list-hebrew-diary-entries
836 list-islamic-diary-entries
837 list-bahai-diary-entries)
b032077a 838 :group 'diary)
ecaa0527 839
7e1dae73 840;;;###autoload
b032077a 841(defcustom mark-diary-entries-hook nil
ecaa0527
RS
842 "*List of functions called after marking diary entries in the calendar.
843
844A function `mark-included-diary-files' is also provided for use as the
3cbb4860 845`mark-diary-entries-hook'; it enables you to use shared diary files together
6b1abbd1 846with your own. The files included are specified in the diary file by lines
ecaa0527
RS
847of the form
848 #include \"filename\"
849This is recursive; that is, #include directives in files thus included are
850obeyed. You can change the \"#include\" to some other string by changing the
851variable `diary-include-string'. When you use `mark-included-diary-files' as
852part of the mark-diary-entries-hook, you will probably also want to use the
b032077a
RS
853function `include-other-diary-files' as part of `list-diary-entries-hook'."
854 :type 'hook
3d880a4b 855 :options '(mark-included-diary-files)
b032077a 856 :group 'diary)
ecaa0527 857
e5d77022 858;;;###autoload
b032077a 859(defcustom nongregorian-diary-marking-hook nil
354d0644 860 "*List of functions called for marking diary file and included files.
811a8484
JW
861As the files are processed for diary entries, these functions are used
862to cull relevant entries. You can use either or both of
863`mark-hebrew-diary-entries', `mark-islamic-diary-entries' and
864`mark-bahai-diary-entries'. The documentation for these functions
b032077a
RS
865describes the style of such diary entries."
866 :type 'hook
811a8484
JW
867 :options '(mark-hebrew-diary-entries
868 mark-islamic-diary-entries
869 mark-bahai-diary-entries)
b032077a 870 :group 'diary)
ecaa0527 871
e5d77022 872;;;###autoload
b032077a 873(defcustom diary-list-include-blanks nil
354d0644 874 "*If nil, do not include days with no diary entry in the list of diary entries.
ac96331d 875Such days will then not be shown in the fancy diary buffer, even if they
b032077a
RS
876are holidays."
877 :type 'boolean
878 :group 'diary)
ecaa0527 879
7e1dae73 880;;;###autoload
b032077a 881(defcustom holidays-in-diary-buffer t
e555fdd8
RS
882 "*Non-nil means include holidays in the diary display.
883The holidays appear in the mode line of the diary buffer, or in the
354d0644 884fancy diary buffer next to the date. This slows down the diary functions
b032077a
RS
885somewhat; setting it to nil makes the diary display faster."
886 :type 'boolean
887 :group 'holidays)
ecaa0527 888
2ec778d0
RS
889(defvar calendar-mark-ring nil)
890
e555fdd8
RS
891;;;###autoload
892(put 'general-holidays 'risky-local-variable t)
7e1dae73 893;;;###autoload
b032077a 894(defcustom general-holidays
354d0644
JB
895 '((holiday-fixed 1 1 "New Year's Day")
896 (holiday-float 1 1 3 "Martin Luther King Day")
11f23ea2 897 (holiday-fixed 2 2 "Groundhog Day")
354d0644
JB
898 (holiday-fixed 2 14 "Valentine's Day")
899 (holiday-float 2 1 3 "President's Day")
900 (holiday-fixed 3 17 "St. Patrick's Day")
9e32719f 901 (holiday-fixed 4 1 "April Fools' Day")
354d0644
JB
902 (holiday-float 5 0 2 "Mother's Day")
903 (holiday-float 5 1 -1 "Memorial Day")
904 (holiday-fixed 6 14 "Flag Day")
905 (holiday-float 6 0 3 "Father's Day")
906 (holiday-fixed 7 4 "Independence Day")
907 (holiday-float 9 1 1 "Labor Day")
908 (holiday-float 10 1 2 "Columbus Day")
909 (holiday-fixed 10 31 "Halloween")
910 (holiday-fixed 11 11 "Veteran's Day")
911 (holiday-float 11 4 4 "Thanksgiving"))
912 "*General holidays. Default value is for the United States.
b032077a
RS
913See the documentation for `calendar-holidays' for details."
914 :type 'sexp
915 :group 'holidays)
ecaa0527 916
7086b78e
ER
917;;;###autoload
918(put 'oriental-holidays 'risky-local-variable t)
919;;;###autoload
b032077a 920(defcustom oriental-holidays
7086b78e
ER
921 '((if (fboundp 'atan)
922 (holiday-chinese-new-year)))
923 "*Oriental holidays.
b032077a
RS
924See the documentation for `calendar-holidays' for details."
925 :type 'sexp
926 :group 'holidays)
7086b78e 927
e555fdd8
RS
928;;;###autoload
929(put 'local-holidays 'risky-local-variable t)
7e1dae73 930;;;###autoload
b032077a 931(defcustom local-holidays nil
7e1dae73 932 "*Local holidays.
b032077a
RS
933See the documentation for `calendar-holidays' for details."
934 :type 'sexp
935 :group 'holidays)
7e1dae73 936
e555fdd8
RS
937;;;###autoload
938(put 'other-holidays 'risky-local-variable t)
7e1dae73 939;;;###autoload
b032077a 940(defcustom other-holidays nil
7e1dae73 941 "*User defined holidays.
b032077a
RS
942See the documentation for `calendar-holidays' for details."
943 :type 'sexp
944 :group 'holidays)
ecaa0527 945
e555fdd8
RS
946;;;###autoload
947(put 'hebrew-holidays-1 'risky-local-variable t)
7e1dae73 948;;;###autoload
97344751 949(defvar hebrew-holidays-1
354d0644 950 '((holiday-rosh-hashanah-etc)
ecaa0527 951 (if all-hebrew-calendar-holidays
354d0644
JB
952 (holiday-julian
953 11
954 (let* ((m displayed-month)
955 (y displayed-year)
956 (year))
957 (increment-calendar-month m y -1)
958 (let ((year (extract-calendar-year
959 (calendar-julian-from-absolute
960 (calendar-absolute-from-gregorian
961 (list m 1 y))))))
962 (if (zerop (% (1+ year) 4))
963 22
97344751
RS
964 21))) "\"Tal Umatar\" (evening)"))))
965
e555fdd8
RS
966;;;###autoload
967(put 'hebrew-holidays-2 'risky-local-variable t)
97344751
RS
968;;;###autoload
969(defvar hebrew-holidays-2
970 '((if all-hebrew-calendar-holidays
354d0644
JB
971 (holiday-hanukkah)
972 (holiday-hebrew 9 25 "Hanukkah"))
ecaa0527 973 (if all-hebrew-calendar-holidays
354d0644
JB
974 (holiday-hebrew
975 10
976 (let ((h-year (extract-calendar-year
977 (calendar-hebrew-from-absolute
978 (calendar-absolute-from-gregorian
979 (list displayed-month 28 displayed-year))))))
980 (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
981 7)
982 6)
983 11 10))
984 "Tzom Teveth"))
ecaa0527 985 (if all-hebrew-calendar-holidays
97344751
RS
986 (holiday-hebrew 11 15 "Tu B'Shevat"))))
987
e555fdd8
RS
988;;;###autoload
989(put 'hebrew-holidays-3 'risky-local-variable t)
97344751 990;;;###autoload
d7fa63b2 991(defvar hebrew-holidays-3
97344751 992 '((if all-hebrew-calendar-holidays
354d0644 993 (holiday-hebrew
ecaa0527
RS
994 11
995 (let ((m displayed-month)
996 (y displayed-year))
997 (increment-calendar-month m y 1)
998 (let* ((h-year (extract-calendar-year
999 (calendar-hebrew-from-absolute
1000 (calendar-absolute-from-gregorian
1001 (list m
1002 (calendar-last-day-of-month m y)
1003 y)))))
1004 (s-s
1005 (calendar-hebrew-from-absolute
1006 (if (=
1007 (% (calendar-absolute-from-hebrew
1008 (list 7 1 h-year))
1009 7)
1010 6)
1011 (calendar-dayname-on-or-before
1012 6 (calendar-absolute-from-hebrew
1013 (list 11 17 h-year)))
1014 (calendar-dayname-on-or-before
1015 6 (calendar-absolute-from-hebrew
1016 (list 11 16 h-year))))))
1017 (day (extract-calendar-day s-s)))
1018 day))
97344751
RS
1019 "Shabbat Shirah"))))
1020
e555fdd8
RS
1021;;;###autoload
1022(put 'hebrew-holidays-4 'risky-local-variable t)
97344751
RS
1023;;;###autoload
1024(defvar hebrew-holidays-4
1025 '((holiday-passover-etc)
ecaa0527
RS
1026 (if (and all-hebrew-calendar-holidays
1027 (let* ((m displayed-month)
1028 (y displayed-year)
1029 (year))
1030 (increment-calendar-month m y -1)
1031 (let ((year (extract-calendar-year
1032 (calendar-julian-from-absolute
1033 (calendar-absolute-from-gregorian
1034 (list m 1 y))))))
1035 (= 21 (% year 28)))))
354d0644 1036 (holiday-julian 3 26 "Kiddush HaHamah"))
ecaa0527 1037 (if all-hebrew-calendar-holidays
97344751
RS
1038 (holiday-tisha-b-av-etc))))
1039
e555fdd8
RS
1040;;;###autoload
1041(put 'hebrew-holidays 'risky-local-variable t)
97344751 1042;;;###autoload
b032077a 1043(defcustom hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
97344751 1044 hebrew-holidays-3 hebrew-holidays-4)
7e1dae73 1045 "*Jewish holidays.
b032077a
RS
1046See the documentation for `calendar-holidays' for details."
1047 :type 'sexp
1048 :group 'holidays)
7e1dae73 1049
e555fdd8
RS
1050;;;###autoload
1051(put 'christian-holidays 'risky-local-variable t)
7e1dae73 1052;;;###autoload
b032077a 1053(defcustom christian-holidays
7e1dae73 1054 '((if all-christian-calendar-holidays
354d0644 1055 (holiday-fixed 1 6 "Epiphany"))
d1493acd
GM
1056 (holiday-easter-etc 0 "Easter Sunday")
1057 (holiday-easter-etc -2 "Good Friday")
1058 (holiday-easter-etc -46 "Ash Wednesday")
1059 (if all-christian-calendar-holidays
1060 (holiday-easter-etc -63 "Septuagesima Sunday"))
1061 (if all-christian-calendar-holidays
1062 (holiday-easter-etc -56 "Sexagesima Sunday"))
1063 (if all-christian-calendar-holidays
1064 (holiday-easter-etc -49 "Shrove Sunday"))
1065 (if all-christian-calendar-holidays
1066 (holiday-easter-etc -48 "Shrove Monday"))
1067 (if all-christian-calendar-holidays
1068 (holiday-easter-etc -47 "Shrove Tuesday"))
1069 (if all-christian-calendar-holidays
1070 (holiday-easter-etc -14 "Passion Sunday"))
1071 (if all-christian-calendar-holidays
1072 (holiday-easter-etc -7 "Palm Sunday"))
1073 (if all-christian-calendar-holidays
1074 (holiday-easter-etc -3 "Maundy Thursday"))
1075 (if all-christian-calendar-holidays
1076 (holiday-easter-etc 35 "Rogation Sunday"))
1077 (if all-christian-calendar-holidays
1078 (holiday-easter-etc 39 "Ascension Day"))
1079 (if all-christian-calendar-holidays
1080 (holiday-easter-etc 49 "Pentecost (Whitsunday)"))
1081 (if all-christian-calendar-holidays
1082 (holiday-easter-etc 50 "Whitmonday"))
1083 (if all-christian-calendar-holidays
1084 (holiday-easter-etc 56 "Trinity Sunday"))
1085 (if all-christian-calendar-holidays
1086 (holiday-easter-etc 60 "Corpus Christi"))
7e1dae73 1087 (if all-christian-calendar-holidays
354d0644 1088 (holiday-greek-orthodox-easter))
7e1dae73 1089 (if all-christian-calendar-holidays
354d0644 1090 (holiday-fixed 8 15 "Assumption"))
7e1dae73 1091 (if all-christian-calendar-holidays
d1493acd 1092 (holiday-advent 0 "Advent"))
354d0644 1093 (holiday-fixed 12 25 "Christmas")
7e1dae73 1094 (if all-christian-calendar-holidays
354d0644 1095 (holiday-julian 12 25 "Eastern Orthodox Christmas")))
7e1dae73 1096 "*Christian holidays.
b032077a
RS
1097See the documentation for `calendar-holidays' for details."
1098 :type 'sexp
1099 :group 'holidays)
ecaa0527 1100
e555fdd8
RS
1101;;;###autoload
1102(put 'islamic-holidays 'risky-local-variable t)
7e1dae73 1103;;;###autoload
b032077a 1104(defcustom islamic-holidays
354d0644
JB
1105 '((holiday-islamic
1106 1 1
1107 (format "Islamic New Year %d"
1108 (let ((m displayed-month)
1109 (y displayed-year))
1110 (increment-calendar-month m y 1)
1111 (extract-calendar-year
1112 (calendar-islamic-from-absolute
1113 (calendar-absolute-from-gregorian
1114 (list
1115 m (calendar-last-day-of-month m y) y)))))))
ecaa0527 1116 (if all-islamic-calendar-holidays
354d0644 1117 (holiday-islamic 1 10 "Ashura"))
ecaa0527 1118 (if all-islamic-calendar-holidays
354d0644 1119 (holiday-islamic 3 12 "Mulad-al-Nabi"))
ecaa0527 1120 (if all-islamic-calendar-holidays
354d0644 1121 (holiday-islamic 7 26 "Shab-e-Mi'raj"))
ecaa0527 1122 (if all-islamic-calendar-holidays
354d0644
JB
1123 (holiday-islamic 8 15 "Shab-e-Bara't"))
1124 (holiday-islamic 9 1 "Ramadan Begins")
ecaa0527 1125 (if all-islamic-calendar-holidays
354d0644 1126 (holiday-islamic 9 27 "Shab-e Qadr"))
ecaa0527 1127 (if all-islamic-calendar-holidays
354d0644 1128 (holiday-islamic 10 1 "Id-al-Fitr"))
ecaa0527 1129 (if all-islamic-calendar-holidays
354d0644 1130 (holiday-islamic 12 10 "Id-al-Adha")))
7e1dae73 1131 "*Islamic holidays.
b032077a
RS
1132See the documentation for `calendar-holidays' for details."
1133 :type 'sexp
1134 :group 'holidays)
7e1dae73 1135
811a8484
JW
1136;;;###autoload
1137(put 'bahai-holidays 'risky-local-variable t)
1138;;;###autoload
1139(defcustom bahai-holidays
1140 '((holiday-fixed
1141 3 21
1142 (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844))))
1143 (holiday-fixed 4 21 "First Day of Ridvan")
1144 (if all-bahai-calendar-holidays
1145 (holiday-fixed 4 22 "Second Day of Ridvan"))
1146 (if all-bahai-calendar-holidays
1147 (holiday-fixed 4 23 "Third Day of Ridvan"))
1148 (if all-bahai-calendar-holidays
1149 (holiday-fixed 4 24 "Fourth Day of Ridvan"))
1150 (if all-bahai-calendar-holidays
1151 (holiday-fixed 4 25 "Fifth Day of Ridvan"))
1152 (if all-bahai-calendar-holidays
1153 (holiday-fixed 4 26 "Sixth Day of Ridvan"))
1154 (if all-bahai-calendar-holidays
1155 (holiday-fixed 4 27 "Seventh Day of Ridvan"))
1156 (if all-bahai-calendar-holidays
1157 (holiday-fixed 4 28 "Eighth Day of Ridvan"))
1158 (holiday-fixed 4 29 "Ninth Day of Ridvan")
1159 (if all-bahai-calendar-holidays
1160 (holiday-fixed 4 30 "Tenth Day of Ridvan"))
1161 (if all-bahai-calendar-holidays
1162 (holiday-fixed 5 1 "Eleventh Day of Ridvan"))
1163 (holiday-fixed 5 2 "Twelfth Day of Ridvan")
1164 (holiday-fixed 5 23 "Declaration of the Bab")
1165 (holiday-fixed 5 29 "Ascension of Baha'u'llah")
1166 (holiday-fixed 7 9 "Martyrdom of the Bab")
1167 (holiday-fixed 10 20 "Birth of the Bab")
1168 (holiday-fixed 11 12 "Birth of Baha'u'llah")
1169 (if all-bahai-calendar-holidays
1170 (holiday-fixed 11 26 "Day of the Covenant"))
1171 (if all-bahai-calendar-holidays
1172 (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
1173 "*Baha'i holidays.
1174See the documentation for `calendar-holidays' for details."
1175 :type 'sexp
1176 :group 'holidays)
1177
e555fdd8
RS
1178;;;###autoload
1179(put 'solar-holidays 'risky-local-variable t)
7e1dae73 1180;;;###autoload
b032077a 1181(defcustom solar-holidays
7e1dae73
JB
1182 '((if (fboundp 'atan)
1183 (solar-equinoxes-solstices))
3b92bdd2
RS
1184 (if (progn
1185 (require 'cal-dst)
1186 t)
354d0644 1187 (funcall
3b92bdd2 1188 'holiday-sexp
354d0644
JB
1189 calendar-daylight-savings-starts
1190 '(format "Daylight Savings Time Begins %s"
1191 (if (fboundp 'atan)
1192 (solar-time-string
8a7cdf3a
ER
1193 (/ calendar-daylight-savings-starts-time (float 60))
1194 calendar-standard-time-zone-name)
354d0644
JB
1195 ""))))
1196 (funcall
1197 'holiday-sexp
1198 calendar-daylight-savings-ends
1199 '(format "Daylight Savings Time Ends %s"
1200 (if (fboundp 'atan)
1201 (solar-time-string
8a7cdf3a
ER
1202 (/ calendar-daylight-savings-ends-time (float 60))
1203 calendar-daylight-time-zone-name)
354d0644 1204 ""))))
7e1dae73 1205 "*Sun-related holidays.
b032077a
RS
1206See the documentation for `calendar-holidays' for details."
1207 :type 'sexp
1208 :group 'holidays)
7e1dae73 1209
e555fdd8
RS
1210;;;###autoload
1211(put 'calendar-holidays 'risky-local-variable t)
b032077a 1212(defcustom calendar-holidays
354d0644
JB
1213 (append general-holidays local-holidays other-holidays
1214 christian-holidays hebrew-holidays islamic-holidays
811a8484 1215 bahai-holidays oriental-holidays solar-holidays)
3cbb4860 1216 "*List of notable days for the command \\[holidays].
7e1dae73 1217
811a8484
JW
1218Additional holidays are easy to add to the list, just put them in the
1219list `other-holidays' in your .emacs file. Similarly, by setting any
1220of `general-holidays', `local-holidays' `christian-holidays',
1221`hebrew-holidays', `islamic-holidays', `bahai-holidays',
1222`oriental-holidays', or `solar-holidays' to nil in your .emacs file,
1223you can eliminate unwanted categories of holidays. The intention is
1224that (in the US) `local-holidays' be set in site-init.el and
7086b78e 1225`other-holidays' be set by the user.
7e1dae73 1226
354d0644
JB
1227Entries on the list are expressions that return (possibly empty) lists of
1228items of the form ((month day year) string) of a holiday in the in the
1229three-month period centered around `displayed-month' of `displayed-year'.
1230Several basic functions are provided for this purpose:
1231
1232 (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
1233 (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
1234 MONTH on the Gregorian calendar (0 for Sunday,
1235 etc.); K<0 means count back from the end of the
3cbb4860 1236 month. An optional parameter DAY means the Kth
354d0644
JB
1237 DAYNAME after/before MONTH DAY.
1238 (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
1239 (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
811a8484 1240 (holiday-bahai MONTH DAY STRING) a fixed date on the Baha'i calendar
354d0644
JB
1241 (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar
1242 (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
7e1dae73
JB
1243 in the variable `year'; if it evaluates to
1244 a visible date, that's the holiday; if it
354d0644
JB
1245 evaluates to nil, there's no holiday. STRING
1246 is an expression in the variable `date'.
ecaa0527
RS
1247
1248For example, to add Bastille Day, celebrated in France on July 14, add
1249
354d0644 1250 (holiday-fixed 7 14 \"Bastille Day\")
ecaa0527
RS
1251
1252to the list. To add Hurricane Supplication Day, celebrated in the Virgin
1253Islands on the fourth Monday in August, add
1254
354d0644 1255 (holiday-float 8 1 4 \"Hurricane Supplication Day\")
ecaa0527
RS
1256
1257to the list (the last Monday would be specified with `-1' instead of `4').
7e1dae73 1258To add the last day of Hanukkah to the list, use
ecaa0527 1259
354d0644 1260 (holiday-hebrew 10 2 \"Last day of Hanukkah\")
ecaa0527
RS
1261
1262since the Hebrew months are numbered with 1 starting from Nisan, while to
1263add the Islamic feast celebrating Mohammed's birthday use
1264
354d0644 1265 (holiday-islamic 3 12 \"Mohammed's Birthday\")
ecaa0527
RS
1266
1267since the Islamic months are numbered from 1 starting with Muharram. To
811a8484
JW
1268add an entry for the Baha'i festival of Ridvan, use
1269
1270 (holiday-bahai 2 13 \"Festival of Ridvan\")
1271
1272since the Baha'i months are numbered from 1 starting with Baha. To
ecaa0527
RS
1273add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
1274
354d0644 1275 (holiday-julian 4 2 \"Jefferson's Birthday\")
ecaa0527 1276
354d0644
JB
1277To include a holiday conditionally, use the sexp form or a conditional. For
1278example, to include American presidential elections, which occur on the first
1279Tuesday after the first Monday in November of years divisible by 4, add
ecaa0527 1280
354d0644 1281 (holiday-sexp
78e37e9c 1282 '(if (zerop (% year 4))
354d0644
JB
1283 (calendar-gregorian-from-absolute
1284 (1+ (calendar-dayname-on-or-before
1285 1 (+ 6 (calendar-absolute-from-gregorian
1286 (list 11 1 year)))))))
1287 \"US Presidential Election\")
7e1dae73
JB
1288
1289or
1290
ecaa0527 1291 (if (zerop (% displayed-year 4))
354d0644 1292 (holiday-fixed 11
ecaa0527
RS
1293 (extract-calendar-day
1294 (calendar-gregorian-from-absolute
1295 (1+ (calendar-dayname-on-or-before
1296 1 (+ 6 (calendar-absolute-from-gregorian
1297 (list 11 1 displayed-year)))))))
1298 \"US Presidential Election\"))
1299
1300to the list. To include the phases of the moon, add
1301
1302 (lunar-phases)
1303
354d0644
JB
1304to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
1305you've written to return a (possibly empty) list of the relevant VISIBLE dates
1306with descriptive strings such as
ecaa0527 1307
b032077a
RS
1308 (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )."
1309 :type 'sexp
1310 :group 'holidays)
ecaa0527 1311
ecaa0527
RS
1312(defconst holiday-buffer "*Holidays*"
1313 "Name of the buffer used for the displaying the holidays.")
1314
1315(defconst fancy-diary-buffer "*Fancy Diary Entries*"
1316 "Name of the buffer used for the optional fancy display of the diary.")
1317
726669d8
ER
1318(defconst other-calendars-buffer "*Other Calendars*"
1319 "Name of the buffer used for the display of date on other calendars.")
1320
cba0c253
ER
1321(defconst lunar-phases-buffer "*Phases of Moon*"
1322 "Name of the buffer used for the lunar phases.")
1323
ecaa0527 1324(defmacro increment-calendar-month (mon yr n)
18db8896
GM
1325 "Increment the variables MON and YR by N months.
1326Forward if N is positive or backward if N is negative.
1327A negative YR is interpreted as BC; -1 being 1 BC, and so on."
1328 `(let (macro-y)
1329 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
1330 (setq macro-y (+ (* ,yr 12) ,mon -1 ,n)
1331 ,mon (1+ (mod macro-y 12))
1332 ,yr (/ macro-y 12))
1333 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1334 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
ecaa0527
RS
1335
1336(defmacro calendar-for-loop (var from init to final do &rest body)
1337 "Execute a for loop."
7e1e5cf1
SS
1338 `(let ((,var (1- ,init)))
1339 (while (>= ,final (setq ,var (1+ ,var)))
1340 ,@body)))
ecaa0527
RS
1341
1342(defmacro calendar-sum (index initial condition expression)
354d0644 1343 "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
7e1e5cf1
SS
1344 `(let ((,index ,initial)
1345 (sum 0))
1346 (while ,condition
1347 (setq sum (+ sum ,expression))
1348 (setq ,index (1+ ,index)))
1349 sum))
ecaa0527 1350
cba0c253
ER
1351;; The following are in-line for speed; they can be called thousands of times
1352;; when looking up holidays or processing the diary. Here, for example, are
1353;; the numbers of calls to calendar/diary/holiday functions in preparing the
e5d77022
JB
1354;; fancy diary display, for a moderately complex diary file, with functions
1355;; used instead of macros. There were a total of 10000 such calls:
1356;;
1357;; 1934 extract-calendar-month
1358;; 1852 extract-calendar-year
1359;; 1819 extract-calendar-day
1360;; 845 calendar-leap-year-p
1361;; 837 calendar-day-number
1362;; 775 calendar-absolute-from-gregorian
1363;; 346 calendar-last-day-of-month
1364;; 286 hebrew-calendar-last-day-of-month
1365;; 188 hebrew-calendar-leap-year-p
1366;; 180 hebrew-calendar-elapsed-days
1367;; 163 hebrew-calendar-last-month-of-year
1368;; 66 calendar-date-compare
1369;; 65 hebrew-calendar-days-in-year
1370;; 60 calendar-absolute-from-julian
1371;; 50 calendar-absolute-from-hebrew
1372;; 43 calendar-date-equal
1373;; 38 calendar-gregorian-from-absolute
1374;; .
1375;; .
1376;; .
1377;;
1378;; The use of these seven macros eliminates the overhead of 92% of the function
cba0c253 1379;; calls; it's faster this way.
e5d77022 1380
cba0c253 1381(defsubst extract-calendar-month (date)
ecaa0527 1382 "Extract the month part of DATE which has the form (month day year)."
cba0c253 1383 (car date))
ecaa0527 1384
cba0c253 1385(defsubst extract-calendar-day (date)
ecaa0527 1386 "Extract the day part of DATE which has the form (month day year)."
cba0c253 1387 (car (cdr date)))
ecaa0527 1388
cba0c253 1389(defsubst extract-calendar-year (date)
ecaa0527 1390 "Extract the year part of DATE which has the form (month day year)."
cba0c253 1391 (car (cdr (cdr date))))
ecaa0527 1392
cba0c253 1393(defsubst calendar-leap-year-p (year)
18db8896
GM
1394 "Return t if YEAR is a Gregorian leap year.
1395A negative year is interpreted as BC; -1 being 1 BC, and so on."
1396 ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
1397 (if (< year 0) (setq year (1- (abs year))))
cba0c253
ER
1398 (and (zerop (% year 4))
1399 (or (not (zerop (% year 100)))
1400 (zerop (% year 400)))))
1401
354d0644
JB
1402;; The foregoing is a bit faster, but not as clear as the following:
1403;;
cba0c253 1404;;(defsubst calendar-leap-year-p (year)
7e1dae73
JB
1405;; "Returns t if YEAR is a Gregorian leap year."
1406;; (or
1407;; (and (= (% year 4) 0)
1408;; (/= (% year 100) 0))
1409;; (= (% year 400) 0)))
e5d77022 1410
cba0c253 1411(defsubst calendar-last-day-of-month (month year)
e5d77022 1412 "The last day in MONTH during YEAR."
cba0c253
ER
1413 (if (and (= month 2) (calendar-leap-year-p year))
1414 29
1415 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
1416
1417;; An explanation of the calculation can be found in PascAlgorithms by
1418;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
1419
1420(defsubst calendar-day-number (date)
e5d77022
JB
1421 "Return the day number within the year of the date DATE.
1422For example, (calendar-day-number '(1 1 1987)) returns the value 1,
1423while (calendar-day-number '(12 31 1980)) returns 366."
cba0c253
ER
1424 (let* ((month (extract-calendar-month date))
1425 (day (extract-calendar-day date))
1426 (year (extract-calendar-year date))
1427 (day-of-year (+ day (* 31 (1- month)))))
1428 (if (> month 2)
1429 (progn
1430 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
1431 (if (calendar-leap-year-p year)
e5d77022 1432 (setq day-of-year (1+ day-of-year)))))
cba0c253
ER
1433 day-of-year))
1434
1435(defsubst calendar-absolute-from-gregorian (date)
e5d77022 1436 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
18db8896
GM
1437The Gregorian date Sunday, December 31, 1 BC is imaginary.
1438DATE is a list of the form (month day year). A negative year is
1439interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
1440return negative results."
1441 (let ((year (extract-calendar-year date))
1442 offset-years)
1443 (cond ((= year 0)
1444 (error "There was no year zero"))
1445 ((> year 0)
1446 (setq offset-years (1- year))
1447 (+ (calendar-day-number date) ; Days this year
1448 (* 365 offset-years) ; + Days in prior years
1449 (/ offset-years 4) ; + Julian leap years
1450 (- (/ offset-years 100)) ; - century years
1451 (/ offset-years 400))) ; + Gregorian leap years
1452 (t
1453 ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
1454 (setq offset-years (abs (1+ year)))
1455 (- (calendar-day-number date)
1456 (* 365 offset-years)
1457 (/ offset-years 4)
1458 (- (/ offset-years 100))
1459 (/ offset-years 400)
1460 (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
e5d77022 1461
7086b78e
ER
1462(autoload 'calendar-goto-today "cal-move"
1463 "Reposition the calendar window so the current date is visible."
1464 t)
1465
1466(autoload 'calendar-forward-month "cal-move"
1467 "Move the cursor forward ARG months."
1468 t)
1469
1470(autoload 'calendar-forward-year "cal-move"
1471 "Move the cursor forward by ARG years."
1472 t)
1473
1474(autoload 'calendar-backward-month "cal-move"
1475 "Move the cursor backward by ARG months."
1476 t)
1477
1478(autoload 'calendar-backward-year "cal-move"
1479 "Move the cursor backward ARG years."
1480 t)
1481
1482(autoload 'scroll-calendar-left "cal-move"
1483 "Scroll the displayed calendar left by ARG months."
1484 t)
1485
1486(autoload 'scroll-calendar-right "cal-move"
1487 "Scroll the displayed calendar window right by ARG months."
1488 t)
1489
1490(autoload 'scroll-calendar-left-three-months "cal-move"
1491 "Scroll the displayed calendar window left by 3*ARG months."
1492 t)
1493
1494(autoload 'scroll-calendar-right-three-months "cal-move"
1495 "Scroll the displayed calendar window right by 3*ARG months."
1496 t)
1497
1498(autoload 'calendar-cursor-to-nearest-date "cal-move"
1499 "Move the cursor to the closest date."
1500 t)
1501
1502(autoload 'calendar-forward-day "cal-move"
1503 "Move the cursor forward ARG days."
1504 t)
1505
1506(autoload 'calendar-backward-day "cal-move"
1507 "Move the cursor back ARG days."
1508 t)
1509
1510(autoload 'calendar-forward-week "cal-move"
1511 "Move the cursor forward ARG weeks."
1512 t)
1513
1514(autoload 'calendar-backward-week "cal-move"
1515 "Move the cursor back ARG weeks."
1516 t)
1517
1518(autoload 'calendar-beginning-of-week "cal-move"
1519 "Move the cursor back ARG calendar-week-start-day's."
1520 t)
1521
1522(autoload 'calendar-end-of-week "cal-move"
1523 "Move the cursor forward ARG calendar-week-start-day+6's."
1524 t)
1525
1526(autoload 'calendar-beginning-of-month "cal-move"
1527 "Move the cursor backward ARG month beginnings."
1528 t)
1529
1530(autoload 'calendar-end-of-month "cal-move"
1531 "Move the cursor forward ARG month ends."
1532 t)
1533
1534(autoload 'calendar-beginning-of-year "cal-move"
1535 "Move the cursor backward ARG year beginnings."
1536 t)
1537
1538(autoload 'calendar-end-of-year "cal-move"
1539 "Move the cursor forward ARG year beginnings."
1540 t)
1541
1542(autoload 'calendar-cursor-to-visible-date "cal-move"
1543 "Move the cursor to DATE that is on the screen."
1544 t)
1545
1546(autoload 'calendar-goto-date "cal-move"
1547 "Move cursor to DATE."
1548 t)
1549
8923d271
GM
1550(autoload 'calendar-goto-day-of-year "cal-move"
1551 "Move cursor to day of year."
1552 t)
1553
945e6102
GM
1554(autoload 'calendar-only-one-frame-setup "cal-x"
1555 "Start calendar and display it in a dedicated frame.")
1556
7086b78e
ER
1557(autoload 'calendar-one-frame-setup "cal-x"
1558 "Start calendar and display it in a dedicated frame together with the diary.")
1559
1560(autoload 'calendar-two-frame-setup "cal-x"
1561 "Start calendar and diary in separate, dedicated frames.")
7e1e5cf1 1562
7086b78e 1563;;;###autoload
1293540e
GM
1564(defcustom calendar-setup nil
1565 "The frame setup of the calendar.
1566The choices are: `one-frame' (calendar and diary together in one separate,
1567dedicated frame); `two-frames' (calendar and diary in separate, dedicated
1568frames); `calendar-only' (calendar in a separate, dedicated frame); with
0663481f 1569any other value the current frame is used. Using any of the first
1293540e
GM
1570three options overrides the value of `view-diary-entries-initially'."
1571 :type '(choice
1572 (const :tag "calendar and diary in separate frame" one-frame)
1573 (const :tag "calendar and diary each in own frame" two-frames)
1574 (const :tag "calendar in separate frame" calendar-only)
1575 (const :tag "use current frame" nil))
1576 :group 'calendar)
7086b78e 1577
0663481f
GM
1578(defcustom calendar-minimum-window-height 8
1579 "Minimum height `generate-calendar-window' should use for calendar window."
1580 :type 'integer
1581 :version "22.1"
1582 :group 'calendar)
1583
94b304d7 1584;;;###autoload
ecaa0527 1585(defun calendar (&optional arg)
7086b78e 1586 "Choose between the one frame, two frame, or basic calendar displays.
bc461571
EZ
1587If called with an optional prefix argument, prompts for month and year.
1588
1589The original function `calendar' has been renamed `calendar-basic-setup'.
1590See the documentation of that function for more information."
7086b78e
ER
1591 (interactive "P")
1592 (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
1593 ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
a4410177
KH
1594 ((equal calendar-setup 'calendar-only)
1595 (calendar-only-one-frame-setup arg))
7086b78e
ER
1596 (t (calendar-basic-setup arg))))
1597
1598(defun calendar-basic-setup (&optional arg)
ecaa0527
RS
1599 "Display a three-month calendar in another window.
1600The three months appear side by side, with the current month in the middle
1601surrounded by the previous and next months. The cursor is put on today's date.
1602
7e1dae73
JB
1603If called with an optional prefix argument, prompts for month and year.
1604
ecaa0527
RS
1605This function is suitable for execution in a .emacs file; appropriate setting
1606of the variable `view-diary-entries-initially' will cause the diary entries for
1607the current date to be displayed in another window. The value of the variable
1608`number-of-diary-entries' controls the number of days of diary entries
1609displayed upon initial display of the calendar.
1610
ecaa0527
RS
1611Once in the calendar window, future or past months can be moved into view.
1612Arbitrary months can be displayed, or the calendar can be scrolled forward
1613or backward.
1614
1615The cursor can be moved forward or backward by one day, one week, one month,
1616or one year. All of these commands take prefix arguments which, when negative,
1617cause movement in the opposite direction. For convenience, the digit keys
1618and the minus sign are automatically prefixes. The window is replotted as
1619necessary to display the desired date.
1620
1621Diary entries can be marked on the calendar or displayed in another window.
1622
3cbb4860 1623Use \\[describe-mode] for details of the key bindings in the calendar window.
ecaa0527
RS
1624
1625The Gregorian calendar is assumed.
1626
7e1dae73 1627After loading the calendar, the hooks given by the variable
2b803765 1628`calendar-load-hook' are run. This is the place to add key bindings to the
7e1dae73
JB
1629calendar-mode-map.
1630
ecaa0527
RS
1631After preparing the calendar window initially, the hooks given by the variable
1632`initial-calendar-window-hook' are run.
1633
1634The hooks given by the variable `today-visible-calendar-hook' are run
a69472b3 1635every time the calendar window gets scrolled, if the current date is visible
ecaa0527
RS
1636in the window. If it is not visible, the hooks given by the variable
1637`today-invisible-calendar-hook' are run. Thus, for example, setting
1638`today-visible-calendar-hook' to 'calendar-star-date will cause today's date
1639to be replaced by asterisks to highlight it whenever it is in the window."
1640 (interactive "P")
ecaa0527
RS
1641 (set-buffer (get-buffer-create calendar-buffer))
1642 (calendar-mode)
ecd42d42 1643 (let* ((pop-up-windows t)
7e1dae73 1644 (split-height-threshold 1000)
cba0c253
ER
1645 (date (if arg
1646 (calendar-read-date t)
1647 (calendar-current-date)))
1648 (month (extract-calendar-month date))
1649 (year (extract-calendar-year date)))
ecaa0527 1650 (pop-to-buffer calendar-buffer)
cba0c253 1651 (increment-calendar-month month year (- calendar-offset))
7e1dae73
JB
1652 (generate-calendar-window month year)
1653 (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
1654 (view-diary-entries
1655 (if (vectorp number-of-diary-entries)
1656 (aref number-of-diary-entries (calendar-day-of-week date))
1657 number-of-diary-entries))))
1658 (let* ((diary-buffer (get-file-buffer diary-file))
1659 (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
1660 (split-height-threshold (if diary-window 2 1000)))
1661 (if view-calendar-holidays-initially
1662 (list-calendar-holidays)))
ecaa0527
RS
1663 (run-hooks 'initial-calendar-window-hook))
1664
fb30f0ce 1665(autoload 'view-diary-entries "diary-lib"
ecaa0527 1666 "Prepare and display a buffer with diary entries.
6b1abbd1 1667Searches your diary file for entries that match ARG days starting with
ecaa0527
RS
1668the date indicated by the cursor position in the displayed three-month
1669calendar."
1670 t)
1671
791b8dea
GM
1672(autoload 'view-other-diary-entries "diary-lib"
1673 "Prepare and display buffer of diary entries from an alternative diary file.
1674Searches for entries that match ARG days, starting with the date indicated
1675by the cursor position in the displayed three-month calendar.
1676D-FILE specifies the file to use as the diary file."
1677 t)
1678
7e1dae73
JB
1679(autoload 'calendar-sunrise-sunset "solar"
1680 "Local time of sunrise and sunset for date under cursor."
1681 t)
1682
1683(autoload 'calendar-phases-of-moon "lunar"
1684 "Create a buffer of the phases of the moon for the current calendar window."
1685 t)
1686
1687(autoload 'calendar-print-french-date "cal-french"
6a2aa94c 1688 "Show the French Revolutionary calendar equivalent of the date under the cursor."
7e1dae73
JB
1689 t)
1690
1691(autoload 'calendar-goto-french-date "cal-french"
1692 "Move cursor to French Revolutionary date."
1693 t)
1694
6a2aa94c 1695(autoload 'calendar-french-date-string "cal-french"
7086b78e 1696 "String of French Revolutionary date of Gregorian date."
6a2aa94c
RS
1697 t)
1698
1699(autoload 'calendar-mayan-date-string "cal-mayan"
7086b78e 1700 "String of Mayan date of Gregorian date."
6a2aa94c
RS
1701 t)
1702
7e1dae73 1703(autoload 'calendar-print-mayan-date "cal-mayan"
6a2aa94c 1704 "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor."
7e1dae73
JB
1705 t)
1706
1707(autoload 'calendar-goto-mayan-long-count-date "cal-mayan"
1708 "Move cursor to Mayan long count date."
1709 t)
1710
1711(autoload 'calendar-next-haab-date "cal-mayan"
1712 "Move cursor to next instance of Mayan Haab date."
1713 t)
1714
1715(autoload 'calendar-previous-haab-date "cal-mayan"
1716 "Move cursor to previous instance of Mayan Haab date."
1717 t)
1718
1719(autoload 'calendar-next-tzolkin-date "cal-mayan"
1720 "Move cursor to next instance of Mayan Tzolkin date."
1721 t)
1722
1723(autoload 'calendar-previous-tzolkin-date "cal-mayan"
1724 "Move cursor to previous instance of Mayan Tzolkin date."
1725 t)
1726
1727(autoload 'calendar-next-calendar-round-date "cal-mayan"
a69472b3 1728 "Move cursor to next instance of Mayan Haab/Tzolkin combination."
7e1dae73
JB
1729 t)
1730
1731(autoload 'calendar-previous-calendar-round-date "cal-mayan"
a69472b3 1732 "Move cursor to previous instance of Mayan Haab/Tzolkin combination."
7e1dae73
JB
1733 t)
1734
327b6868 1735(autoload 'calendar-goto-chinese-date "cal-china"
6cf0fb79 1736 "Move cursor to Chinese date."
7086b78e
ER
1737 t)
1738
327b6868 1739(autoload 'calendar-print-chinese-date "cal-china"
7086b78e
ER
1740 "Show the Chinese date equivalents of date."
1741 t)
1742
327b6868 1743(autoload 'calendar-chinese-date-string "cal-china"
7086b78e
ER
1744 "String of Chinese date of Gregorian date."
1745 t)
1746
d1b8adf7 1747(autoload 'calendar-absolute-from-astro "cal-julian"
6cf0fb79 1748 "Absolute date of astronomical (Julian) day number D."
d1b8adf7 1749 t )
6cf0fb79 1750
14fcc701
KH
1751(autoload 'calendar-astro-from-absolute "cal-julian"
1752 "Astronomical (Julian) day number of absolute date D.")
1753
6cf0fb79
ER
1754(autoload 'calendar-astro-date-string "cal-julian"
1755 "String of astronomical (Julian) day number of Gregorian date."
1756 t)
1757
435d749c 1758(autoload 'calendar-goto-astro-day-number "cal-julian"
6cf0fb79
ER
1759 "Move cursor to astronomical (Julian) day number."
1760 t)
1761
d1b8adf7
GM
1762(autoload 'calendar-print-astro-day-number "cal-julian"
1763 "Show the astro date equivalents of date."
1764 t)
1765
6dcba8a3
RS
1766(autoload 'calendar-julian-from-absolute "cal-julian"
1767 "Compute the Julian (month day year) corresponding to the absolute DATE.
1768The absolute date is the number of days elapsed since the (imaginary)
1769Gregorian date Sunday, December 31, 1 BC.")
1770
7086b78e
ER
1771(autoload 'calendar-goto-julian-date "cal-julian"
1772 "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
1773 t)
1774
2b3f69c8
RS
1775(autoload 'calendar-print-julian-date "cal-julian"
1776 "Show the Julian calendar equivalent of the date under the cursor."
1777 t)
1778
07986bc4
RS
1779(autoload 'calendar-julian-date-string "cal-julian"
1780 "String of Julian date of Gregorian DATE.
1781Defaults to today's date if DATE is not given.
bfca0f6b 1782Driven by the variable `calendar-date-display-form'.")
07986bc4 1783
7086b78e
ER
1784(autoload 'calendar-goto-iso-date "cal-iso"
1785 "Move cursor to ISO date."
1786 t)
1787
fb60b3e1
GM
1788(autoload 'calendar-goto-iso-week "cal-iso"
1789 "Move cursor to start of ISO week."
1790 t)
1791
7086b78e
ER
1792(autoload 'calendar-print-iso-date "cal-iso"
1793 "Show the ISO date equivalents of date."
1794 t)
1795
1796(autoload 'calendar-iso-date-string "cal-iso"
1797 "String of ISO date of Gregorian date."
1798 t)
1799
93867648
GM
1800(autoload 'calendar-goto-islamic-date "cal-islam"
1801 "Move cursor to Islamic date."
1802 t)
1803
327b6868 1804(autoload 'calendar-print-islamic-date "cal-islam"
7086b78e
ER
1805 "Show the Islamic date equivalents of date."
1806 t)
1807
327b6868 1808(autoload 'calendar-islamic-date-string "cal-islam"
7086b78e
ER
1809 "String of Islamic date of Gregorian date."
1810 t)
1811
811a8484
JW
1812(autoload 'calendar-print-bahai-date "cal-bahai"
1813 "Show the Baha'i date equivalents of date."
1814 t)
1815
1816(autoload 'calendar-bahai-date-string "cal-bahai"
1817 "String of Baha'i date of Gregorian date."
1818 t)
1819
7086b78e 1820(autoload 'calendar-goto-hebrew-date "cal-hebrew"
8f00bdf5 1821 "Move cursor to Hebrew date."
7086b78e
ER
1822 t)
1823
1824(autoload 'calendar-print-hebrew-date "cal-hebrew"
1825 "Show the Hebrew date equivalents of date."
1826 t)
1827
1828(autoload 'calendar-hebrew-date-string "cal-hebrew"
1829 "String of Hebrew date of Gregorian date."
1830 t)
1831
1832(autoload 'calendar-goto-coptic-date "cal-coptic"
8f00bdf5 1833 "Move cursor to Coptic date."
7086b78e
ER
1834 t)
1835
1836(autoload 'calendar-print-coptic-date "cal-coptic"
1837 "Show the Coptic date equivalents of date."
1838 t)
1839
1840(autoload 'calendar-coptic-date-string "cal-coptic"
1841 "String of Coptic date of Gregorian date."
1842 t)
1843
1844(autoload 'calendar-goto-ethiopic-date "cal-coptic"
8f00bdf5 1845 "Move cursor to Ethiopic date."
7086b78e
ER
1846 t)
1847
1848(autoload 'calendar-print-ethiopic-date "cal-coptic"
1849 "Show the Ethiopic date equivalents of date."
1850 t)
1851
1852(autoload 'calendar-ethiopic-date-string "cal-coptic"
1853 "String of Ethiopic date of Gregorian date."
1854 t)
1855
a45eee72 1856(autoload 'calendar-goto-persian-date "cal-persia"
8f00bdf5 1857 "Move cursor to Persian date."
c21eb13d
ER
1858 t)
1859
a45eee72 1860(autoload 'calendar-print-persian-date "cal-persia"
c21eb13d
ER
1861 "Show the Persian date equivalents of date."
1862 t)
1863
a45eee72 1864(autoload 'calendar-persian-date-string "cal-persia"
c21eb13d
ER
1865 "String of Persian date of Gregorian date."
1866 t)
1867
fb30f0ce 1868(autoload 'show-all-diary-entries "diary-lib"
6b1abbd1
RS
1869 "Show all of the diary entries in the diary file.
1870This function gets rid of the selective display of the diary file so that
ecaa0527
RS
1871all entries, not just some, are visible. If there is no diary buffer, one
1872is created."
1873 t)
1874
fb30f0ce 1875(autoload 'mark-diary-entries "diary-lib"
ecaa0527 1876 "Mark days in the calendar window that have diary entries.
6b1abbd1 1877Each entry in diary file visible in the calendar window is marked."
ecaa0527
RS
1878 t)
1879
fb30f0ce 1880(autoload 'make-diary-entry "diary-lib"
7086b78e
ER
1881 "Insert a diary entry STRING which may be NONMARKING in FILE."
1882 t)
1883
fb30f0ce 1884(autoload 'insert-diary-entry "diary-lib"
ecaa0527
RS
1885 "Insert a diary entry for the date indicated by point."
1886 t)
1887
fb30f0ce 1888(autoload 'insert-weekly-diary-entry "diary-lib"
ecaa0527
RS
1889 "Insert a weekly diary entry for the day of the week indicated by point."
1890 t)
1891
354d0644 1892
fb30f0ce 1893(autoload 'insert-monthly-diary-entry "diary-lib"
ecaa0527
RS
1894 "Insert a monthly diary entry for the day of the month indicated by point."
1895 t)
1896
fb30f0ce 1897(autoload 'insert-yearly-diary-entry "diary-lib"
ecaa0527
RS
1898 "Insert an annual diary entry for the day of the year indicated by point."
1899 t)
1900
fb30f0ce 1901(autoload 'insert-anniversary-diary-entry "diary-lib"
ecaa0527
RS
1902 "Insert an anniversary diary entry for the date indicated by point."
1903 t)
1904
fb30f0ce 1905(autoload 'insert-block-diary-entry "diary-lib"
ecaa0527
RS
1906 "Insert a block diary entry for the dates indicated by point and mark."
1907 t)
1908
fb30f0ce 1909(autoload 'insert-cyclic-diary-entry "diary-lib"
ecaa0527
RS
1910 "Insert a cyclic diary entry starting at the date indicated by point."
1911 t)
1912
7086b78e 1913(autoload 'insert-hebrew-diary-entry "cal-hebrew"
ecaa0527
RS
1914 "Insert a diary entry for the Hebrew date corresponding to the date
1915indicated by point."
1916 t)
1917
7086b78e 1918(autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew"
ecaa0527
RS
1919 "Insert a monthly diary entry for the day of the Hebrew month corresponding
1920to the date indicated by point."
1921 t)
1922
7086b78e 1923(autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew"
ecaa0527
RS
1924 "Insert an annual diary entry for the day of the Hebrew year corresponding
1925to the date indicated by point."
1926 t)
1927
327b6868 1928(autoload 'insert-islamic-diary-entry "cal-islam"
ecaa0527
RS
1929 "Insert a diary entry for the Islamic date corresponding to the date
1930indicated by point."
1931 t)
1932
327b6868 1933(autoload 'insert-monthly-islamic-diary-entry "cal-islam"
ecaa0527
RS
1934 "Insert a monthly diary entry for the day of the Islamic month corresponding
1935to the date indicated by point."
1936 t)
1937
327b6868 1938(autoload 'insert-yearly-islamic-diary-entry "cal-islam"
ecaa0527
RS
1939 "Insert an annual diary entry for the day of the Islamic year corresponding
1940to the date indicated by point."
1941 t)
1942
811a8484
JW
1943(autoload 'insert-bahai-diary-entry "cal-bahai"
1944 "Insert a diary entry for the Baha'i date corresponding to the date
1945indicated by point."
1946 t)
1947
1948(autoload 'insert-monthly-bahai-diary-entry "cal-bahai"
1949 "Insert a monthly diary entry for the day of the Baha'i month corresponding
1950to the date indicated by point."
1951 t)
1952
1953(autoload 'insert-yearly-bahai-diary-entry "cal-bahai"
1954 "Insert an annual diary entry for the day of the Baha'i year corresponding
1955to the date indicated by point."
1956 t)
1957
ecaa0527
RS
1958(autoload 'list-calendar-holidays "holidays"
1959 "Create a buffer containing the holidays for the current calendar window.
1960The holidays are those in the list `calendar-notable-days'. Returns t if any
1961holidays are found, nil if not."
1962 t)
1963
3076647c
ER
1964(autoload 'cal-tex-cursor-month "cal-tex"
1965 "Make a buffer with LaTeX commands for the month cursor is on.
1966Optional prefix argument specifies number of months to be produced.
1967Calendar is condensed onto one page.")
1968
1969(autoload 'cal-tex-cursor-month-landscape "cal-tex"
1970 "Make a buffer with LaTeX commands for the month cursor is on.
1971Optional prefix argument specifies number of months to be produced.")
1972
1973(autoload 'cal-tex-cursor-day "cal-tex"
1974 "Make a buffer with LaTeX commands for the day cursor is on.")
1975
1976(autoload 'cal-tex-cursor-week "cal-tex"
5a2c140a
RS
1977 "Make a buffer with LaTeX commands for a two-page one-week calendar.
1978It applies to the week that point is in.
1979Optional prefix argument specifies number of weeks.
1980Holidays are included if `cal-tex-holidays' is t.")
1981
7e1e5cf1 1982(autoload 'cal-tex-cursor-week2 "cal-tex"
5a2c140a
RS
1983 "Make a buffer with LaTeX commands for a two-page one-week calendar.
1984It applies to the week that point is in.
1985Optional prefix argument specifies number of weeks.
1986Holidays are included if `cal-tex-holidays' is t.")
1987
1988(autoload 'cal-tex-cursor-week-iso "cal-tex"
1989 "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar.
07e4feff 1990Optional prefix argument specifies number of weeks.
5a2c140a
RS
1991Diary entries are included if `cal-tex-diary' is t.
1992Holidays are included if `cal-tex-holidays' is t.")
1993
1994(autoload 'cal-tex-cursor-week-monday "cal-tex"
1995 "Make a buffer with LaTeX commands for a two-page one-week calendar.
1996It applies to the week that point is in, and starts on Monday.
1997Optional prefix argument specifies number of weeks.
1998Holidays are included if `cal-tex-holidays' is t.")
1999
2000(autoload 'cal-tex-cursor-filofax-2week "cal-tex"
2001 "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor.
2002Optional prefix argument specifies number of weeks.
2003Diary entries are included if cal-tex-diary is t.
2004Holidays are included if `cal-tex-holidays' is t.")
2005
2006(autoload 'cal-tex-cursor-filofax-week "cal-tex"
2007 "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
2008Optional prefix argument specifies number of weeks.
7e1e5cf1 2009Weeks start on Monday.
5a2c140a
RS
2010Diary entries are included if cal-tex-diary is t.
2011Holidays are included if `cal-tex-holidays' is t.")
3076647c 2012
9018e77d
KH
2013(autoload 'cal-tex-cursor-filofax-daily "cal-tex"
2014 "Day-per-page Filofax style calendar for week indicated by cursor.
7e1e5cf1 2015Optional prefix argument specifies number of weeks. Weeks start on Monday.
9018e77d
KH
2016Diary entries are included if `cal-tex-diary' is t.
2017Holidays are included if `cal-tex-holidays' is t.")
2018
3076647c
ER
2019(autoload 'cal-tex-cursor-year "cal-tex"
2020 "Make a buffer with LaTeX commands for a year's calendar.
a69472b3 2021Optional prefix argument specifies number of years.")
3076647c
ER
2022
2023(autoload 'cal-tex-cursor-year-landscape "cal-tex"
2024 "Make a buffer with LaTeX commands for a year's calendar (landscape).
2025Optional prefix argument specifies number of years.")
2026
2027(autoload 'cal-tex-cursor-filofax-year "cal-tex"
2028 "Make a buffer with LaTeX commands for a year's calendar (Filofax).
2029Optional prefix argument specifies number of years.")
2030
ecaa0527
RS
2031(autoload 'mark-calendar-holidays "holidays"
2032 "Mark notable days in the calendar window."
2033 t)
2034
2035(autoload 'calendar-cursor-holidays "holidays"
2036 "Find holidays for the date specified by the cursor in the calendar window."
2037 t)
2038
7e1dae73
JB
2039(defun generate-calendar-window (&optional mon yr)
2040 "Generate the calendar window for the current date.
2041Or, for optional MON, YR."
ecaa0527 2042 (let* ((buffer-read-only nil)
ecaa0527
RS
2043 (today (calendar-current-date))
2044 (month (extract-calendar-month today))
2045 (day (extract-calendar-day today))
2046 (year (extract-calendar-year today))
7e1dae73
JB
2047 (today-visible
2048 (or (not mon)
2049 (let ((offset (calendar-interval mon yr month year)))
2050 (and (<= offset 1) (>= offset -1)))))
0663481f
GM
2051 (day-in-week (calendar-day-of-week today))
2052 (in-calendar-window (eq (window-buffer (selected-window))
2053 (get-buffer calendar-buffer))))
ecaa0527 2054 (update-calendar-mode-line)
7e1dae73
JB
2055 (if mon
2056 (generate-calendar mon yr)
0663481f 2057 (generate-calendar month year))
ecaa0527
RS
2058 (calendar-cursor-to-visible-date
2059 (if today-visible today (list displayed-month 1 displayed-year)))
2060 (set-buffer-modified-p nil)
0663481f
GM
2061 ;; Don't do any window-related stuff if we weren't called from a
2062 ;; window displaying the calendar
2063 (when in-calendar-window
2064 (if (or (one-window-p t) (/= (frame-width) (window-width)))
2065 ;; Don't mess with the window size, but ensure that the first
2066 ;; line is fully visible
2067 (set-window-vscroll nil 0)
2068 ;; Adjust the window to exactly fit the displayed calendar
2069 (fit-window-to-buffer nil nil calendar-minimum-window-height))
2070 (sit-for 0))
d13c1378
JB
2071 (if (and (boundp 'font-lock-mode)
2072 font-lock-mode)
5d22135b 2073 (font-lock-fontify-buffer))
ecaa0527 2074 (and mark-holidays-in-calendar
d519ea8a 2075;;; (calendar-date-is-legal-p today) ; useful for BC dates
ecaa0527 2076 (mark-calendar-holidays)
0663481f 2077 (and in-calendar-window (sit-for 0)))
ecaa0527
RS
2078 (unwind-protect
2079 (if mark-diary-entries-in-calendar (mark-diary-entries))
2080 (if today-visible
2081 (run-hooks 'today-visible-calendar-hook)
2082 (run-hooks 'today-invisible-calendar-hook)))))
2083
2084(defun generate-calendar (month year)
4c635ea3
GM
2085 "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
2086;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
2087;;; Note that while calendars for years BC could be displayed as it
0663481f 2088;;; stands, almost all other calendar functions (eg holidays) would
4c635ea3
GM
2089;;; at best have unpredictable results for such dates.
2090 (if (< (+ month (* 12 (1- year))) 2)
0663481f 2091 (error "Months before January, 1 AD cannot be displayed"))
4c635ea3
GM
2092 (setq displayed-month month
2093 displayed-year year)
ecaa0527
RS
2094 (erase-buffer)
2095 (increment-calendar-month month year -1)
2096 (calendar-for-loop i from 0 to 2 do
2097 (generate-calendar-month month year (+ 5 (* 25 i)))
2098 (increment-calendar-month month year 1)))
2099
2100(defun generate-calendar-month (month year indent)
2101 "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
f2172a68
EZ
2102The calendar is inserted at the top of the buffer in which point is currently
2103located, but indented INDENT spaces. The indentation is done from the first
2104character on the line and does not disturb the first INDENT characters on the
4c635ea3 2105line."
d8a200a7 2106 (let* ((blank-days;; at start of month
b6c0aabf 2107 (mod
d8a200a7
RS
2108 (- (calendar-day-of-week (list month 1 year))
2109 calendar-week-start-day)
2110 7))
2111 (last (calendar-last-day-of-month month year)))
2112 (goto-char (point-min))
2113 (calendar-insert-indented
2114 (calendar-string-spread
cbecb9f9 2115 (list (format "%s %d" (calendar-month-name month) year)) ? 20)
d8a200a7
RS
2116 indent t)
2117 (calendar-insert-indented "" indent);; Go to proper spot
2c8811d4 2118 ;; Use the first two characters of each day to head the columns.
d8a200a7 2119 (calendar-for-loop i from 0 to 6 do
2c8811d4
GM
2120 (insert
2121 (let ((string
2122 (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t)))
2123 (if enable-multibyte-characters
2124 (truncate-string-to-width string 2)
2125 (substring string 0 2)))
2126 " "))
d8a200a7
RS
2127 (calendar-insert-indented "" 0 t);; Force onto following line
2128 (calendar-insert-indented "" indent);; Go to proper spot
2129 ;; Add blank days before the first of the month
2130 (calendar-for-loop i from 1 to blank-days do (insert " "))
2131 ;; Put in the days of the month
2132 (calendar-for-loop i from 1 to last do
2133 (insert (format "%2d " i))
218abc51
EZ
2134 (add-text-properties
2135 (- (point) 3) (1- (point))
2136 '(mouse-face highlight
2137 help-echo "mouse-2: menu of operations for this date"))
b6c0aabf 2138 (and (zerop (mod (+ i blank-days) 7))
d8a200a7
RS
2139 (/= i last)
2140 (calendar-insert-indented "" 0 t) ;; Force onto following line
2141 (calendar-insert-indented "" indent)))));; Go to proper spot
ecaa0527
RS
2142
2143(defun calendar-insert-indented (string indent &optional newline)
2144 "Insert STRING at column INDENT.
2145If the optional parameter NEWLINE is t, leave point at start of next line,
2146inserting a newline if there was no next line; otherwise, leave point after
2147the inserted text. Value is always t."
2148 ;; Try to move to that column.
2149 (move-to-column indent)
2150 ;; If line is too short, indent out to that column.
2151 (if (< (current-column) indent)
2152 (indent-to indent))
2153 (insert string)
2154 ;; Advance to next line, if requested.
2155 (if newline
2156 (progn
2157 (end-of-line)
2158 (if (eobp)
2159 (newline)
2160 (forward-line 1))))
2161 t)
2162
2163(defun redraw-calendar ()
cea82f86 2164 "Redraw the calendar display, if `calendar-buffer' is live."
ecaa0527 2165 (interactive)
cea82f86 2166 (if (get-buffer calendar-buffer)
3ee0c967 2167 (with-current-buffer calendar-buffer
7a099c43 2168 (let ((cursor-date (calendar-cursor-to-nearest-date)))
3ee0c967
GM
2169 (generate-calendar-window displayed-month displayed-year)
2170 (calendar-cursor-to-visible-date cursor-date)))))
b924026d
GM
2171
2172;;;###autoload
2173(defcustom calendar-week-start-day 0
2174 "*The day of the week on which a week in the calendar begins.
21750 means Sunday (default), 1 means Monday, and so on.
2176
2177If you change this variable directly (without using customize)
2178after starting `calendar', you should call `redraw-calendar' to
2179update the calendar display to reflect the change, otherwise
2180movement commands will not work correctly."
2181 :type 'integer
2182 :set (lambda (sym val)
2183 (set sym val)
2184 (redraw-calendar))
2185 :group 'calendar)
ecaa0527 2186
b032077a
RS
2187(defcustom calendar-debug-sexp nil
2188 "*Turn debugging on when evaluating a sexp in the diary or holiday list."
2189 :type 'boolean
2190 :group 'calendar)
354d0644 2191
ecaa0527
RS
2192(defvar calendar-mode-map nil)
2193(if calendar-mode-map
2194 nil
2195 (setq calendar-mode-map (make-sparse-keymap))
d24f1b15 2196 (require 'cal-menu)
ecaa0527
RS
2197 (calendar-for-loop i from 0 to 9 do
2198 (define-key calendar-mode-map (int-to-string i) 'digit-argument))
2199 (let ((l (list 'narrow-to-region 'mark-word 'mark-sexp 'mark-paragraph
6b39e127 2200 'mark-defun 'mark-whole-buffer 'mark-page
8f12817f
ER
2201 'downcase-region 'upcase-region 'kill-region
2202 'copy-region-as-kill 'capitalize-region 'write-region)))
6b39e127
RS
2203 (while l
2204 (substitute-key-definition (car l) 'calendar-not-implemented
2205 calendar-mode-map global-map)
2206 (setq l (cdr l))))
ecaa0527 2207 (define-key calendar-mode-map "-" 'negative-argument)
cdbcbc6a 2208 (define-key calendar-mode-map ">" 'scroll-calendar-right)
ecaa0527 2209 (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right)
0d336f18 2210 (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months)
ff4373ed 2211 (define-key calendar-mode-map "\ev" 'scroll-calendar-right-three-months)
cdbcbc6a 2212 (define-key calendar-mode-map "<" 'scroll-calendar-left)
ecaa0527 2213 (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left)
0d336f18 2214 (define-key calendar-mode-map [next] 'scroll-calendar-left-three-months)
ff4373ed 2215 (define-key calendar-mode-map "\C-v" 'scroll-calendar-left-three-months)
ecaa0527
RS
2216 (define-key calendar-mode-map "\C-b" 'calendar-backward-day)
2217 (define-key calendar-mode-map "\C-p" 'calendar-backward-week)
7e1dae73 2218 (define-key calendar-mode-map "\e{" 'calendar-backward-month)
ecaa0527
RS
2219 (define-key calendar-mode-map "\C-x[" 'calendar-backward-year)
2220 (define-key calendar-mode-map "\C-f" 'calendar-forward-day)
2221 (define-key calendar-mode-map "\C-n" 'calendar-forward-week)
e9c78f07
RS
2222 (define-key calendar-mode-map [left] 'calendar-backward-day)
2223 (define-key calendar-mode-map [up] 'calendar-backward-week)
2224 (define-key calendar-mode-map [right] 'calendar-forward-day)
2225 (define-key calendar-mode-map [down] 'calendar-forward-week)
7e1dae73 2226 (define-key calendar-mode-map "\e}" 'calendar-forward-month)
ecaa0527
RS
2227 (define-key calendar-mode-map "\C-x]" 'calendar-forward-year)
2228 (define-key calendar-mode-map "\C-a" 'calendar-beginning-of-week)
2229 (define-key calendar-mode-map "\C-e" 'calendar-end-of-week)
2230 (define-key calendar-mode-map "\ea" 'calendar-beginning-of-month)
2231 (define-key calendar-mode-map "\ee" 'calendar-end-of-month)
2232 (define-key calendar-mode-map "\e<" 'calendar-beginning-of-year)
2233 (define-key calendar-mode-map "\e>" 'calendar-end-of-year)
2234 (define-key calendar-mode-map "\C-@" 'calendar-set-mark)
5e2a0ae4 2235 ;; Many people are used to typing C-SPC and getting C-@.
e68e61b5 2236 (define-key calendar-mode-map [?\C- ] 'calendar-set-mark)
ecaa0527 2237 (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
7e1dae73
JB
2238 (define-key calendar-mode-map "\e=" 'calendar-count-days-region)
2239 (define-key calendar-mode-map "gd" 'calendar-goto-date)
8923d271 2240 (define-key calendar-mode-map "gD" 'calendar-goto-day-of-year)
7e1dae73
JB
2241 (define-key calendar-mode-map "gj" 'calendar-goto-julian-date)
2242 (define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number)
2243 (define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date)
2244 (define-key calendar-mode-map "gi" 'calendar-goto-islamic-date)
811a8484 2245 (define-key calendar-mode-map "gb" 'calendar-goto-bahai-date)
7086b78e
ER
2246 (define-key calendar-mode-map "gC" 'calendar-goto-chinese-date)
2247 (define-key calendar-mode-map "gk" 'calendar-goto-coptic-date)
2248 (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date)
c21eb13d 2249 (define-key calendar-mode-map "gp" 'calendar-goto-persian-date)
7e1dae73 2250 (define-key calendar-mode-map "gc" 'calendar-goto-iso-date)
fb60b3e1 2251 (define-key calendar-mode-map "gw" 'calendar-goto-iso-week)
7e1dae73
JB
2252 (define-key calendar-mode-map "gf" 'calendar-goto-french-date)
2253 (define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date)
2254 (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
2255 (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date)
2256 (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date)
2257 (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date)
2258 (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date)
2259 (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date)
14f1a889
ER
2260 (define-key calendar-mode-map "Aa" 'appt-add)
2261 (define-key calendar-mode-map "Ad" 'appt-delete)
7e1dae73
JB
2262 (define-key calendar-mode-map "S" 'calendar-sunrise-sunset)
2263 (define-key calendar-mode-map "M" 'calendar-phases-of-moon)
2264 (define-key calendar-mode-map " " 'scroll-other-window)
0663481f 2265 (define-key calendar-mode-map (kbd "DEL") 'scroll-other-window-down)
ecaa0527 2266 (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar)
899b130e 2267 (define-key calendar-mode-map "." 'calendar-goto-today)
7e1dae73
JB
2268 (define-key calendar-mode-map "o" 'calendar-other-month)
2269 (define-key calendar-mode-map "q" 'exit-calendar)
2270 (define-key calendar-mode-map "a" 'list-calendar-holidays)
2271 (define-key calendar-mode-map "h" 'calendar-cursor-holidays)
2272 (define-key calendar-mode-map "x" 'mark-calendar-holidays)
2273 (define-key calendar-mode-map "u" 'calendar-unmark)
2274 (define-key calendar-mode-map "m" 'mark-diary-entries)
2275 (define-key calendar-mode-map "d" 'view-diary-entries)
46e07c15 2276 (define-key calendar-mode-map "D" 'view-other-diary-entries)
7e1dae73
JB
2277 (define-key calendar-mode-map "s" 'show-all-diary-entries)
2278 (define-key calendar-mode-map "pd" 'calendar-print-day-of-year)
7086b78e
ER
2279 (define-key calendar-mode-map "pC" 'calendar-print-chinese-date)
2280 (define-key calendar-mode-map "pk" 'calendar-print-coptic-date)
2281 (define-key calendar-mode-map "pe" 'calendar-print-ethiopic-date)
c21eb13d 2282 (define-key calendar-mode-map "pp" 'calendar-print-persian-date)
7e1dae73
JB
2283 (define-key calendar-mode-map "pc" 'calendar-print-iso-date)
2284 (define-key calendar-mode-map "pj" 'calendar-print-julian-date)
2285 (define-key calendar-mode-map "pa" 'calendar-print-astro-day-number)
2286 (define-key calendar-mode-map "ph" 'calendar-print-hebrew-date)
2287 (define-key calendar-mode-map "pi" 'calendar-print-islamic-date)
811a8484 2288 (define-key calendar-mode-map "pb" 'calendar-print-bahai-date)
7e1dae73
JB
2289 (define-key calendar-mode-map "pf" 'calendar-print-french-date)
2290 (define-key calendar-mode-map "pm" 'calendar-print-mayan-date)
726669d8 2291 (define-key calendar-mode-map "po" 'calendar-print-other-dates)
7e1dae73
JB
2292 (define-key calendar-mode-map "id" 'insert-diary-entry)
2293 (define-key calendar-mode-map "iw" 'insert-weekly-diary-entry)
2294 (define-key calendar-mode-map "im" 'insert-monthly-diary-entry)
2295 (define-key calendar-mode-map "iy" 'insert-yearly-diary-entry)
2296 (define-key calendar-mode-map "ia" 'insert-anniversary-diary-entry)
2297 (define-key calendar-mode-map "ib" 'insert-block-diary-entry)
2298 (define-key calendar-mode-map "ic" 'insert-cyclic-diary-entry)
2299 (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry)
2300 (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry)
2301 (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry)
2302 (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry)
2303 (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry)
2304 (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry)
811a8484
JW
2305 (define-key calendar-mode-map "iBd" 'insert-bahai-diary-entry)
2306 (define-key calendar-mode-map "iBm" 'insert-monthly-bahai-diary-entry)
2307 (define-key calendar-mode-map "iBy" 'insert-yearly-bahai-diary-entry)
3076647c
ER
2308 (define-key calendar-mode-map "?" 'calendar-goto-info-node)
2309 (define-key calendar-mode-map "tm" 'cal-tex-cursor-month)
2310 (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape)
2311 (define-key calendar-mode-map "td" 'cal-tex-cursor-day)
2312 (define-key calendar-mode-map "tw1" 'cal-tex-cursor-week)
2313 (define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2)
5a2c140a
RS
2314 (define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso)
2315 (define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday)
9018e77d 2316 (define-key calendar-mode-map "tfd" 'cal-tex-cursor-filofax-daily)
5a2c140a
RS
2317 (define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week)
2318 (define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week)
3076647c
ER
2319 (define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year)
2320 (define-key calendar-mode-map "ty" 'cal-tex-cursor-year)
2321 (define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape))
ecaa0527
RS
2322
2323(defun describe-calendar-mode ()
5d22135b 2324 "Create a help buffer with a brief description of the `calendar-mode'."
ecaa0527
RS
2325 (interactive)
2326 (with-output-to-temp-buffer "*Help*"
2327 (princ
2328 (format
2329 "Calendar Mode:\nFor a complete description, type %s\n%s\n"
2330 (substitute-command-keys
2331 "\\<calendar-mode-map>\\[describe-mode] from within the calendar")
2332 (substitute-command-keys "\\{calendar-mode-map}")))
ddbfcbde
KH
2333 (save-excursion
2334 (set-buffer standard-output)
2335 (help-mode))
ecaa0527
RS
2336 (print-help-return-message)))
2337
2338;; Calendar mode is suitable only for specially formatted data.
2339(put 'calendar-mode 'mode-class 'special)
2340
2341(defvar calendar-mode-line-format
7e1dae73 2342 (list
d4ff5db9
DL
2343 (propertize (substitute-command-keys
2344 "\\<calendar-mode-map>\\[scroll-calendar-left]")
2345 'help-echo "mouse-2: scroll left"
a9dd908b 2346 'mouse-face 'mode-line-highlight
f059e122 2347 'keymap (make-mode-line-mouse-map 'mouse-2
989a6aa7 2348 'mouse-scroll-calendar-left))
7e1dae73 2349 "Calendar"
d4ff5db9
DL
2350 (concat
2351 (propertize
2352 (substitute-command-keys
2353 "\\<calendar-mode-map>\\[calendar-goto-info-node] info")
2354 'help-echo "mouse-2: read Info on Calendar"
a9dd908b 2355 'mouse-face 'mode-line-highlight
f059e122 2356 'keymap (make-mode-line-mouse-map 'mouse-2 'calendar-goto-info-node))
d4ff5db9
DL
2357 "/"
2358 (propertize
2359 (substitute-command-keys
2360 "\\<calendar-mode-map>\\[calendar-other-month] other")
2361 'help-echo "mouse-2: choose another month"
a9dd908b 2362 'mouse-face 'mode-line-highlight
f059e122 2363 'keymap (make-mode-line-mouse-map
989a6aa7 2364 'mouse-2 'mouse-calendar-other-month))
d4ff5db9
DL
2365 "/"
2366 (propertize
2367 (substitute-command-keys
2368 "\\<calendar-mode-map>\\[calendar-goto-today] today")
2369 'help-echo "mouse-2: go to today's date"
a9dd908b 2370 'mouse-face 'mode-line-highlight
d0b56ec5 2371 'keymap (make-mode-line-mouse-map 'mouse-2 #'calendar-goto-today)))
7e1dae73 2372 '(calendar-date-string (calendar-current-date) t)
d4ff5db9
DL
2373 (propertize (substitute-command-keys
2374 "\\<calendar-mode-map>\\[scroll-calendar-right]")
2375 'help-echo "mouse-2: scroll right"
a9dd908b 2376 'mouse-face 'mode-line-highlight
f059e122 2377 'keymap (make-mode-line-mouse-map
989a6aa7 2378 'mouse-2 'mouse-scroll-calendar-right)))
a39f5a80
RS
2379 "The mode line of the calendar buffer.
2380
2381This must be a list of items that evaluate to strings--those strings are
2382evaluated and concatenated together, evenly separated by blanks. The variable
2383`date' is available for use as the date under (or near) the cursor; `date'
2384defaults to the current date if it is otherwise undefined. Here is an example
8c64a298 2385value that has the Hebrew date, the day number/days remaining in the year,
a39f5a80
RS
2386and the ISO week/year numbers in the mode. When calendar-move-hook is set to
2387'update-calendar-mode-line, these mode line shows these values for the date
2388under the cursor:
2389
2390 (list
2391 \"\"
2392 '(calendar-hebrew-date-string date)
2393 '(let* ((year (extract-calendar-year date))
2394 (d (calendar-day-number date))
2395 (days-remaining
2396 (- (calendar-day-number (list 12 31 year)) d)))
2397 (format \"%d/%d\" d days-remaining))
2398 '(let* ((d (calendar-absolute-from-gregorian date))
2399 (iso-date (calendar-iso-from-absolute d)))
2400 (format \"ISO week %d of %d\"
2401 (extract-calendar-month iso-date)
2402 (extract-calendar-year iso-date)))
2403 \"\"))
2404")
ecaa0527 2405
989a6aa7
RS
2406(defun mouse-scroll-calendar-left (event)
2407 "Scroll the displayed calendar left by one month.
2408Maintains the relative position of the cursor
2409with respect to the calendar as well as possible."
2410 (interactive "e")
2411 (save-selected-window
2412 (select-window (posn-window (event-start event)))
2413 (scroll-calendar-left 1)))
2414
2415(defun mouse-scroll-calendar-right (event)
2416 "Scroll the displayed calendar right by one month.
2417Maintains the relative position of the cursor
2418with respect to the calendar as well as possible."
2419 (interactive "e")
2420 (save-selected-window
2421 (select-window (posn-window (event-start event)))
2422 (scroll-calendar-right 1)))
2423
2424(defun mouse-calendar-other-month (event)
2425 "Display a three-month calendar centered around a specified month and year."
2426 (interactive "e")
2427 (save-selected-window
2428 (select-window (posn-window (event-start event)))
2429 (call-interactively 'calendar-other-month)))
2430
cba0c253
ER
2431(defun calendar-goto-info-node ()
2432 "Go to the info node for the calendar."
2433 (interactive)
2434 (require 'info)
83ff5106
RS
2435 (let ((where (save-window-excursion
2436 (Info-find-emacs-command-nodes 'calendar))))
cba0c253 2437 (if (not where)
3afbc435 2438 (error "Couldn't find documentation for the calendar")
83ff5106
RS
2439 (let (same-window-buffer-names)
2440 (info))
cba0c253
ER
2441 (Info-find-node (car (car where)) (car (cdr (car where)))))))
2442
5d22135b
MR
2443
2444
ecaa0527 2445(defun calendar-mode ()
7e1dae73 2446 "A major mode for the calendar window.
ecaa0527 2447
cba0c253
ER
2448For a complete description, type \
2449\\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar.
ecaa0527 2450
cba0c253 2451\\<calendar-mode-map>\\{calendar-mode-map}"
ecaa0527
RS
2452 (kill-all-local-variables)
2453 (setq major-mode 'calendar-mode)
2454 (setq mode-name "Calendar")
2455 (use-local-map calendar-mode-map)
2456 (setq buffer-read-only t)
2457 (setq indent-tabs-mode nil)
7e1dae73 2458 (update-calendar-mode-line)
d24f1b15 2459 (add-hook 'activate-menubar-hook 'cal-menu-update nil t)
ecaa0527 2460 (make-local-variable 'calendar-mark-ring)
ecaa0527 2461 (make-local-variable 'displayed-month);; Month in middle of window.
5d22135b
MR
2462 (make-local-variable 'displayed-year) ;; Year in middle of window.
2463 (set (make-local-variable 'font-lock-defaults)
ca0113b8
LK
2464 '(calendar-font-lock-keywords t))
2465 (run-mode-hooks 'calendar-mode-hook))
ecaa0527 2466
7e1dae73 2467(defun calendar-string-spread (strings char length)
cbecb9f9
ER
2468 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
2469The effect is like mapconcat but the separating pieces are as balanced as
2470possible. Each item of STRINGS is evaluated before concatenation so it can
2471actually be an expression that evaluates to a string. If LENGTH is too short,
2472the STRINGS are just concatenated and the result truncated."
7e1dae73
JB
2473;; The algorithm is based on equation (3.25) on page 85 of Concrete
2474;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
2475;; Addison-Wesley, Reading, MA, 1989
cbecb9f9
ER
2476 (let* ((strings (mapcar 'eval
2477 (if (< (length strings) 2)
2478 (append (list "") strings (list ""))
2479 strings)))
7e1dae73
JB
2480 (n (- length (length (apply 'concat strings))))
2481 (m (1- (length strings)))
2482 (s (car strings))
2483 (strings (cdr strings))
2484 (i 0))
2485 (while strings
2486 (setq s (concat s
2487 (make-string (max 0 (/ (+ n i) m)) char)
2488 (car strings)))
2489 (setq i (1+ i))
2490 (setq strings (cdr strings)))
2491 (substring s 0 length)))
2492
ecaa0527
RS
2493(defun update-calendar-mode-line ()
2494 "Update the calendar mode line with the current date and date style."
2495 (if (bufferp (get-buffer calendar-buffer))
2496 (save-excursion
2497 (set-buffer calendar-buffer)
2498 (setq mode-line-format
7e1dae73 2499 (calendar-string-spread
a39f5a80
RS
2500 (let ((date (condition-case nil
2501 (calendar-cursor-to-nearest-date)
2502 (error (calendar-current-date)))))
2503 (mapcar 'eval calendar-mode-line-format))
2504 ? (frame-width)))
2505 (force-mode-line-update))))
ecaa0527 2506
cba0c253
ER
2507(defun calendar-window-list ()
2508 "List of all calendar-related windows."
2509 (let ((calendar-buffers (calendar-buffer-list))
2510 list)
d4ff5db9
DL
2511 (walk-windows (lambda (w)
2512 (if (memq (window-buffer w) calendar-buffers)
2513 (setq list (cons w list))))
cba0c253
ER
2514 nil t)
2515 list))
2516
2517(defun calendar-buffer-list ()
2518 "List of all calendar-related buffers."
2519 (let* ((diary-buffer (get-file-buffer diary-file))
2520 (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
9c73a356
ER
2521 fancy-diary-buffer diary-buffer calendar-buffer
2522 other-calendars-buffer))
cba0c253
ER
2523 (buffer-list nil)
2524 b)
2525 (while buffers
2526 (setq b (car buffers))
2527 (setq b (cond ((stringp b) (get-buffer b))
2528 ((bufferp b) b)
2529 (t nil)))
2530 (if b (setq buffer-list (cons b buffer-list)))
2531 (setq buffers (cdr buffers)))
2532 buffer-list))
2533
ecaa0527 2534(defun exit-calendar ()
cba0c253 2535 "Get out of the calendar window and hide it and related buffers."
ecaa0527 2536 (interactive)
cba0c253 2537 (let* ((diary-buffer (get-file-buffer diary-file)))
38023020
ER
2538 (if (or (not diary-buffer)
2539 (not (buffer-modified-p diary-buffer))
2540 (yes-or-no-p
2541 "Diary modified; do you really want to exit the calendar? "))
cba0c253
ER
2542 ;; Need to do this multiple times because one time can replace some
2543 ;; calendar-related buffers with other calendar-related buffers
2544 (mapcar (lambda (x)
2545 (mapcar 'calendar-hide-window (calendar-window-list)))
2546 (calendar-window-list)))))
2547
2548(defun calendar-hide-window (window)
2549 "Hide WINDOW if it is calendar-related."
2550 (let ((buffer (if (window-live-p window) (window-buffer window))))
2551 (if (memq buffer (calendar-buffer-list))
2552 (cond
13f0f988 2553 ((and (display-multi-frame-p)
cba0c253
ER
2554 (eq 'icon (cdr (assoc 'visibility
2555 (frame-parameters
2556 (window-frame window))))))
2557 nil)
13f0f988 2558 ((and (display-multi-frame-p) (window-dedicated-p window))
7e1e5cf1
SS
2559 (if calendar-remove-frame-by-deleting
2560 (delete-frame (window-frame window))
2561 (iconify-frame (window-frame window))))
cba0c253
ER
2562 ((not (and (select-window window) (one-window-p window)))
2563 (delete-window window))
2564 (t (set-buffer buffer)
2565 (bury-buffer))))))
ecaa0527 2566
ecaa0527 2567(defun calendar-current-date ()
3cbb4860 2568 "Return the current date in a list (month day year)."
d8396371
RS
2569 (let ((now (decode-time)))
2570 (list (nth 4 now) (nth 3 now) (nth 5 now))))
ecaa0527 2571
ffd82264 2572(defun calendar-cursor-to-date (&optional error)
3cbb4860 2573 "Return a list (month day year) of current cursor position.
ffd82264
RS
2574If cursor is not on a specific date, signals an error if optional parameter
2575ERROR is t, otherwise just returns nil."
c93b9aae
ER
2576 (let* ((segment (/ (current-column) 25))
2577 (month (% (+ displayed-month segment -1) 12))
2578 (month (if (= 0 month) 12 month))
2579 (year
2580 (cond
2581 ((and (= 12 month) (= segment 0)) (1- displayed-year))
2582 ((and (= 1 month) (= segment 2)) (1+ displayed-year))
2583 (t displayed-year))))
7086b78e 2584 (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
c93b9aae
ER
2585 (< 2 (count-lines (point-min) (point))))
2586 (save-excursion
7086b78e
ER
2587 (if (not (looking-at " "))
2588 (re-search-backward "[^0-9]"))
c93b9aae 2589 (list month
027a4b6b 2590 (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
c93b9aae 2591 year))
21c8986e
ER
2592 (if (looking-at "\\*")
2593 (save-excursion
2594 (re-search-backward "[^*]")
2595 (if (looking-at ".\\*\\*")
3a7f8079 2596 (list month calendar-starred-day year)
21c8986e
ER
2597 (if error (error "Not on a date!"))))
2598 (if error (error "Not on a date!"))))))
ecaa0527 2599
354d0644
JB
2600;; The following version of calendar-gregorian-from-absolute is preferred for
2601;; reasons of clarity, BUT it's much slower than the version that follows it.
2602
2603;;(defun calendar-gregorian-from-absolute (date)
2604;; "Compute the list (month day year) corresponding to the absolute DATE.
2605;;The absolute date is the number of days elapsed since the (imaginary)
2606;;Gregorian date Sunday, December 31, 1 BC."
2607;; (let* ((approx (/ date 366));; Approximation from below.
2608;; (year ;; Search forward from the approximation.
2609;; (+ approx
2610;; (calendar-sum y approx
2611;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
2612;; 1)))
2613;; (month ;; Search forward from January.
2614;; (1+ (calendar-sum m 1
2615;; (> date
2616;; (calendar-absolute-from-gregorian
2617;; (list m (calendar-last-day-of-month m year) year)))
2618;; 1)))
2619;; (day ;; Calculate the day by subtraction.
2620;; (- date
2621;; (1- (calendar-absolute-from-gregorian (list month 1 year))))))
2622;; (list month day year)))
2623
ecaa0527
RS
2624(defun calendar-gregorian-from-absolute (date)
2625 "Compute the list (month day year) corresponding to the absolute DATE.
2626The absolute date is the number of days elapsed since the (imaginary)
18db8896
GM
2627Gregorian date Sunday, December 31, 1 BC. This function does not
2628handle dates in years BC."
354d0644
JB
2629;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
2630;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
2631;; Clamen, Software--Practice and Experience, Volume 23, Number 4
2632;; (April, 1993), pages 383-404 for an explanation.
2633 (let* ((d0 (1- date))
2634 (n400 (/ d0 146097))
2635 (d1 (% d0 146097))
2636 (n100 (/ d1 36524))
2637 (d2 (% d1 36524))
2638 (n4 (/ d2 1461))
2639 (d3 (% d2 1461))
2640 (n1 (/ d3 365))
2641 (day (1+ (% d3 365)))
2642 (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
2643 (if (or (= n100 4) (= n1 4))
2644 (list 12 31 year)
2645 (let ((year (1+ year))
2646 (month 1))
2647 (while (let ((mdays (calendar-last-day-of-month month year)))
2648 (and (< mdays day)
2649 (setq day (- day mdays))))
2650 (setq month (1+ month)))
2651 (list month day year)))))
ecaa0527 2652
ecaa0527
RS
2653(defun calendar-other-month (month year)
2654 "Display a three-month calendar centered around MONTH and YEAR."
ecd42d42 2655 (interactive (calendar-read-date 'noday))
ecaa0527
RS
2656 (if (and (= month displayed-month)
2657 (= year displayed-year))
2658 nil
2659 (let ((old-date (calendar-cursor-to-date))
2660 (today (calendar-current-date)))
7e1dae73 2661 (generate-calendar-window month year)
ecaa0527
RS
2662 (calendar-cursor-to-visible-date
2663 (cond
2664 ((calendar-date-is-visible-p old-date) old-date)
2665 ((calendar-date-is-visible-p today) today)
2666 (t (list month 1 year)))))))
2667
2668(defun calendar-set-mark (arg)
2669 "Mark the date under the cursor, or jump to marked date.
2670With no prefix argument, push current date onto marked date ring.
2671With argument, jump to mark, pop it, and put point at end of ring."
2672 (interactive "P")
ffd82264 2673 (let ((date (calendar-cursor-to-date t)))
ecaa0527
RS
2674 (if (null arg)
2675 (progn
2676 (setq calendar-mark-ring (cons date calendar-mark-ring))
2677 ;; Since the top of the mark ring is the marked date in the
2678 ;; calendar, the mark ring in the calendar is one longer than
2679 ;; in other buffers to get the same effect.
2680 (if (> (length calendar-mark-ring) (1+ mark-ring-max))
2681 (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
2682 (message "Mark set"))
2683 (if (null calendar-mark-ring)
2684 (error "No mark set in this buffer")
2685 (calendar-goto-date (car calendar-mark-ring))
2686 (setq calendar-mark-ring
2687 (cdr (nconc calendar-mark-ring (list date))))))))
2688
2689(defun calendar-exchange-point-and-mark ()
2690 "Exchange the current cursor position with the marked date."
2691 (interactive)
2692 (let ((mark (car calendar-mark-ring))
ffd82264 2693 (date (calendar-cursor-to-date t)))
ecaa0527
RS
2694 (if (null mark)
2695 (error "No mark set in this buffer")
2696 (setq calendar-mark-ring (cons date (cdr calendar-mark-ring)))
2697 (calendar-goto-date mark))))
2698
2699(defun calendar-count-days-region ()
2700 "Count the number of days (inclusive) between point and the mark."
2701 (interactive)
2702 (let* ((days (- (calendar-absolute-from-gregorian
ffd82264 2703 (calendar-cursor-to-date t))
ecaa0527
RS
2704 (calendar-absolute-from-gregorian
2705 (or (car calendar-mark-ring)
2706 (error "No mark set in this buffer")))))
2707 (days (1+ (if (> days 0) days (- days)))))
2708 (message "Region has %d day%s (inclusive)"
2709 days (if (> days 1) "s" ""))))
2710
2711(defun calendar-not-implemented ()
2712 "Not implemented."
2713 (interactive)
2714 (error "%s not available in the calendar"
2715 (global-key-binding (this-command-keys))))
2716
2717(defun calendar-read (prompt acceptable &optional initial-contents)
2718 "Return an object read from the minibuffer.
2719Prompt with the string PROMPT and use the function ACCEPTABLE to decide if
2720entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS
2721is a string to insert in the minibuffer before reading."
2722 (let ((value (read-minibuffer prompt initial-contents)))
2723 (while (not (funcall acceptable value))
2724 (setq value (read-minibuffer prompt initial-contents)))
2725 value))
2726
cba0c253 2727(defun calendar-read-date (&optional noday)
3cbb4860 2728 "Prompt for Gregorian date. Return a list (month day year).
cba0c253 2729If optional NODAY is t, does not ask for day, but just returns
ae58b7ad 2730\(month nil year); if NODAY is any other non-nil value the value returned is
3cbb4860 2731\(month year)"
7e1dae73 2732 (let* ((year (calendar-read
4c635ea3
GM
2733 "Year (>0): "
2734 (lambda (x) (> x 0))
7e1dae73
JB
2735 (int-to-string (extract-calendar-year
2736 (calendar-current-date)))))
2737 (month-array calendar-month-name-array)
2738 (completion-ignore-case t)
78e37e9c 2739 (month (cdr (assoc-string
7e1dae73
JB
2740 (completing-read
2741 "Month name: "
2742 (mapcar 'list (append month-array nil))
bf51dce3 2743 nil t)
78e37e9c 2744 (calendar-make-alist month-array 1) t)))
cba0c253 2745 (last (calendar-last-day-of-month month year)))
ecd42d42
ER
2746 (if noday
2747 (if (eq noday t)
2748 (list month nil year)
2749 (list month year))
2750 (list month
2751 (calendar-read (format "Day (1-%d): " last)
d4ff5db9 2752 (lambda (x) (and (< 0 x) (<= x last))))
ecd42d42 2753 year))))
7e1dae73 2754
ecaa0527 2755(defun calendar-interval (mon1 yr1 mon2 yr2)
18db8896
GM
2756 "The number of months difference between MON1, YR1 and MON2, YR2.
2757The result is positive if the second date is later than the first.
2758Negative years are interpreted as years BC; -1 being 1 BC, and so on."
2759 (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
2760 (if (< yr2 0) (setq yr2 (1+ yr2)))
ecaa0527
RS
2761 (+ (* 12 (- yr2 yr1))
2762 (- mon2 mon1)))
2763
2c8811d4
GM
2764(defvar calendar-abbrev-length 3
2765 "*Length of abbreviations to be used for day and month names.
2766See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
2767
d8a200a7 2768(defvar calendar-day-name-array
b642d11e 2769 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
2c8811d4
GM
2770 "*Array of capitalized strings giving, in order, the day names.
2771The first two characters of each string will be used to head the
2772day columns in the calendar. See also the variable
2773`calendar-day-abbrev-array'.")
2774
2775(defvar calendar-day-abbrev-array
2776 [nil nil nil nil nil nil nil]
2777 "*Array of capitalized strings giving the abbreviated day names.
2778The order should be the same as that of the full names specified
2779in `calendar-day-name-array'. These abbreviations may be used
2780instead of the full names in the diary file. Do not include a
2781trailing `.' in the strings specified in this variable, though
2782you may use such in the diary file. If any element of this array
fffaba77 2783is nil, then the abbreviation will be constructed as the first
2c8811d4 2784`calendar-abbrev-length' characters of the corresponding full name.")
ecaa0527 2785
d8a200a7 2786(defvar calendar-month-name-array
ecaa0527 2787 ["January" "February" "March" "April" "May" "June"
b642d11e 2788 "July" "August" "September" "October" "November" "December"]
2c8811d4
GM
2789 "*Array of capitalized strings giving, in order, the month names.
2790See also the variable `calendar-month-abbrev-array'.")
2791
2792(defvar calendar-month-abbrev-array
2793 [nil nil nil nil nil nil nil nil nil nil nil nil]
2794 "*Array of capitalized strings giving the abbreviated month names.
2795The order should be the same as that of the full names specified
2796in `calendar-month-name-array'. These abbreviations are used in
2797the calendar menu entries, and can also be used in the diary
2798file. Do not include a trailing `.' in the strings specified in
2799this variable, though you may use such in the diary file. If any
2800element of this array is nil, then the abbreviation will be
2801constructed as the first `calendar-abbrev-length' characters of the
2802corresponding full name.")
2803
2804(defun calendar-abbrev-construct (abbrev full &optional period)
2805 "Internal calendar function to return a complete abbreviation array.
2806ABBREV is an array of abbreviations, FULL the corresponding array
2807of full names. The return value is the ABBREV array, with any nil
2808elements replaced by the first three characters taken from the
2809corresponding element of FULL. If optional argument PERIOD is non-nil,
2810each element returned has a final `.' character."
3d880a4b 2811 (let (elem array name)
2c8811d4 2812 (dotimes (i (length full))
3d880a4b
GM
2813 (setq name (aref full i)
2814 elem (or (aref abbrev i)
2815 (substring name 0
2816 (min calendar-abbrev-length (length name))))
2c8811d4
GM
2817 elem (format "%s%s" elem (if period "." ""))
2818 array (append array (list elem))))
2819 (vconcat array)))
ecaa0527 2820
5d22135b 2821(defvar calendar-font-lock-keywords
f5f57411
SM
2822 `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
2823 " -?[0-9]+")
2824 . font-lock-function-name-face) ; month and year
2825 (,(regexp-opt
2826 (list (substring (aref calendar-day-name-array 6) 0 2)
2827 (substring (aref calendar-day-name-array 0) 0 2)))
2828 ;; Saturdays and Sundays are hilited differently.
2829 . font-lock-comment-face)
2c8811d4 2830 ;; First two chars of each day are used in the calendar.
f5f57411
SM
2831 (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))
2832 . font-lock-reference-face))
5d22135b
MR
2833 "Default keywords to highlight in Calendar mode.")
2834
2c8811d4 2835(defun calendar-day-name (date &optional abbrev absolute)
e0dfc625 2836 "Return a string with the name of the day of the week of DATE.
2c8811d4
GM
2837DATE should be a list in the format (MONTH DAY YEAR), unless the
2838optional argument ABSOLUTE is non-nil, in which case DATE should
2839be an integer in the range 0 to 6 corresponding to the day of the
2840week. Day names are taken from the variable `calendar-day-name-array',
2841unless the optional argument ABBREV is non-nil, in which case
2842the variable `calendar-day-abbrev-array' is used."
2843 (aref (if abbrev
2844 (calendar-abbrev-construct calendar-day-abbrev-array
2845 calendar-day-name-array)
2846 calendar-day-name-array)
2847 (if absolute date (calendar-day-of-week date))))
2848
2849(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
ecaa0527 2850 "Make an assoc list corresponding to SEQUENCE.
2c8811d4
GM
2851Each element of sequence will be associated with an integer, starting
2852from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
2853is supplied, the function `calendar-abbrev-construct' is used to
2854construct abbreviations corresponding to the elements in SEQUENCE.
2855Each abbreviation is entered into the alist with the same
2856association index as the full name it represents.
2857If FILTER is provided, apply it to each key in the alist."
2858 (let ((index 0)
2859 (offset (or start-index 1))
2860 (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
2861 (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
2862 'period)))
2863 alist elem)
8923d271 2864 (dotimes (i (length sequence) (reverse alist))
2c8811d4
GM
2865 (setq index (+ i offset)
2866 elem (elt sequence i)
2867 alist
2868 (cons (cons (if filter (funcall filter elem) elem) index) alist))
2869 (if aseq
2870 (setq elem (elt aseq i)
2871 alist (cons (cons (if filter (funcall filter elem) elem)
2872 index) alist)))
2873 (if aseqp
2874 (setq elem (elt aseqp i)
2875 alist (cons (cons (if filter (funcall filter elem) elem)
2876 index) alist))))))
2877
2878(defun calendar-month-name (month &optional abbrev)
2879 "Return a string with the name of month number MONTH.
2880Months are numbered from one. Month names are taken from the
2881variable `calendar-month-name-array', unless the optional
2882argument ABBREV is non-nil, in which case
2883`calendar-month-abbrev-array' is used."
2884 (aref (if abbrev
2885 (calendar-abbrev-construct calendar-month-abbrev-array
2886 calendar-month-name-array)
2887 calendar-month-name-array)
2888 (1- month)))
ecaa0527
RS
2889
2890(defun calendar-day-of-week (date)
18db8896
GM
2891 "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
2892DATE is a list of the form (month day year). A negative year is
2893interpreted as BC; -1 being 1 BC, and so on."
2894 (mod (calendar-absolute-from-gregorian date) 7))
ecaa0527 2895
ecaa0527 2896(defun calendar-unmark ()
6a2aa94c 2897 "Delete all diary/holiday marks/highlighting from the calendar."
ecaa0527 2898 (interactive)
ecaa0527 2899 (setq mark-holidays-in-calendar nil)
6a2aa94c
RS
2900 (setq mark-diary-entries-in-calendar nil)
2901 (redraw-calendar))
ecaa0527
RS
2902
2903(defun calendar-date-is-visible-p (date)
9f556e44 2904 "Return t if DATE is valid and is visible in the calendar window."
ecaa0527
RS
2905 (let ((gap (calendar-interval
2906 displayed-month displayed-year
2907 (extract-calendar-month date) (extract-calendar-year date))))
2908 (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))
2909
2910(defun calendar-date-is-legal-p (date)
9f556e44 2911 "Return t if DATE is a valid date."
ecaa0527
RS
2912 (let ((month (extract-calendar-month date))
2913 (day (extract-calendar-day date))
2914 (year (extract-calendar-year date)))
2915 (and (<= 1 month) (<= month 12)
2916 (<= 1 day) (<= day (calendar-last-day-of-month month year))
9f556e44 2917 ;; BC dates left as non-valid, to suppress errors from
18db8896
GM
2918 ;; complex holiday algorithms not suitable for years BC.
2919 ;; Note there are side effects on calendar navigation.
ecaa0527
RS
2920 (<= 1 year))))
2921
2922(defun calendar-date-equal (date1 date2)
3cbb4860 2923 "Return t if the DATE1 and DATE2 are the same."
ecaa0527
RS
2924 (and
2925 (= (extract-calendar-month date1) (extract-calendar-month date2))
2926 (= (extract-calendar-day date1) (extract-calendar-day date2))
2927 (= (extract-calendar-year date1) (extract-calendar-year date2))))
2928
2929(defun mark-visible-calendar-date (date &optional mark)
6a2aa94c 2930 "Mark DATE in the calendar window with MARK.
d13c1378 2931MARK is a single-character string, a list of face attributes/values, or a face.
5d22135b 2932MARK defaults to `diary-entry-marker'."
ecaa0527
RS
2933 (if (calendar-date-is-legal-p date)
2934 (save-excursion
2935 (set-buffer calendar-buffer)
2936 (calendar-cursor-to-visible-date date)
3ee0c967
GM
2937 (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
2938 (and (listp mark) (> (length mark) 0) mark) ; attr list
2939 (and (facep mark) mark) ; face-name
2940 diary-entry-marker)))
2941 (if (facep mark)
2942 (progn ; face or an attr-list that contained a face
2943 (overlay-put
2944 (make-overlay (1- (point)) (1+ (point))) 'face mark))
2945 (if (and (stringp mark)
2946 (= (length mark) 1)) ; single-char
2947 (let ((buffer-read-only nil))
2948 (forward-char 1)
2949 (delete-char 1)
2950 (insert mark)
2951 (forward-char -2))
2952 (let ; attr list
2953 ((temp-face
75eb05f6 2954 (make-symbol (apply 'concat "temp-"
3ee0c967 2955 (mapcar '(lambda (sym)
1293540e
GM
2956 (cond ((symbolp sym) (symbol-name sym))
2957 ((numberp sym) (int-to-string sym))
2958 (t sym))) mark))))
2959 (faceinfo mark))
3ee0c967
GM
2960 (make-face temp-face)
2961 ;; Remove :face info from the mark, copy the face info into temp-face
2962 (while (setq faceinfo (memq :face faceinfo))
2963 (copy-face (read (nth 1 faceinfo)) temp-face)
2964 (setcar faceinfo nil)
2965 (setcar (cdr faceinfo) nil))
2966 (setq mark (delq nil mark))
2967 ;; Apply the font aspects
2968 (apply 'set-face-attribute temp-face nil mark)
2969 (overlay-put
2970 (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))
ecaa0527
RS
2971
2972(defun calendar-star-date ()
2973 "Replace the date under the cursor in the calendar window with asterisks.
3cbb4860 2974This function can be used with the `today-visible-calendar-hook' run after the
ecaa0527 2975calendar window has been prepared."
3cbb4860
SM
2976 (let ((inhibit-read-only t))
2977 (make-local-variable 'calendar-starred-day)
ecaa0527 2978 (forward-char 1)
c00f638d 2979 (setq calendar-starred-day
027a4b6b 2980 (string-to-number
7e1dae73 2981 (buffer-substring (point) (- (point) 2))))
ecaa0527
RS
2982 (delete-char -2)
2983 (insert "**")
2984 (backward-char 1)
2985 (set-buffer-modified-p nil)))
2986
2987(defun calendar-mark-today ()
6a2aa94c 2988 "Mark the date under the cursor in the calendar window.
5d22135b 2989The date is marked with `calendar-today-marker'. This function can be used with
3cbb4860 2990the `today-visible-calendar-hook' run after the calendar window has been
6a2aa94c
RS
2991prepared."
2992 (mark-visible-calendar-date
2993 (calendar-cursor-to-date)
2994 calendar-today-marker))
ecaa0527
RS
2995
2996(defun calendar-date-compare (date1 date2)
3cbb4860 2997 "Return t if DATE1 is before DATE2, nil otherwise.
ecaa0527
RS
2998The actual dates are in the car of DATE1 and DATE2."
2999 (< (calendar-absolute-from-gregorian (car date1))
3000 (calendar-absolute-from-gregorian (car date2))))
3001
3002(defun calendar-date-string (date &optional abbreviate nodayname)
3003 "A string form of DATE, driven by the variable `calendar-date-display-form'.
2c8811d4
GM
3004An optional parameter ABBREVIATE, when non-nil, causes the month
3005and day names to be abbreviated as specified by
3006`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
3007respectively. An optional parameter NODAYNAME, when t, omits the
3008name of the day of the week."
ecaa0527 3009 (let* ((dayname
2c8811d4
GM
3010 (unless nodayname
3011 (calendar-day-name date abbreviate)))
ecaa0527 3012 (month (extract-calendar-month date))
2c8811d4 3013 (monthname (calendar-month-name month abbreviate))
ecaa0527
RS
3014 (day (int-to-string (extract-calendar-day date)))
3015 (month (int-to-string month))
3016 (year (int-to-string (extract-calendar-year date))))
3017 (mapconcat 'eval calendar-date-display-form "")))
3018
3019(defun calendar-dayname-on-or-before (dayname date)
3cbb4860 3020 "Return the absolute date of the DAYNAME on or before absolute DATE.
ecaa0527
RS
3021DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
3022
3023Note: Applying this function to d+6 gives us the DAYNAME on or after an
3024absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to
3025absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
3026date d, and applying it to d+7 gives the DAYNAME following absolute date d."
3027 (- date (% (- date dayname) 7)))
3028
04d5d338
PE
3029(defun calendar-nth-named-absday (n dayname month year &optional day)
3030 "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
3031A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0,
3032return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
3033If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
3034
3035If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
3036 (if (> n 0)
3037 (+ (* 7 (1- n))
3038 (calendar-dayname-on-or-before
3039 dayname
3040 (+ 6 (calendar-absolute-from-gregorian
3041 (list month (or day 1) year)))))
3042 (+ (* 7 (1+ n))
3043 (calendar-dayname-on-or-before
3044 dayname
3045 (calendar-absolute-from-gregorian
3046 (list month
3047 (or day (calendar-last-day-of-month month year))
3048 year))))))
3049
354d0644
JB
3050(defun calendar-nth-named-day (n dayname month year &optional day)
3051 "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
3052A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0,
3053return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
3054If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
3055
3056If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
ecaa0527 3057 (calendar-gregorian-from-absolute
04d5d338 3058 (calendar-nth-named-absday n dayname month year day)))
ecaa0527 3059
6a2aa94c
RS
3060(defun calendar-day-of-year-string (&optional date)
3061 "String of day number of year of Gregorian DATE.
3062Defaults to today's date if DATE is not given."
3063 (let* ((d (or date (calendar-current-date)))
3064 (year (extract-calendar-year d))
3065 (day (calendar-day-number d))
3066 (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
3067 (format "Day %d of %d; %d day%s remaining in the year"
3068 day year days-remaining (if (= days-remaining 1) "" "s"))))
3069
726669d8
ER
3070(defun calendar-print-other-dates ()
3071 "Show dates on other calendars for date under the cursor."
3072 (interactive)
3073 (let* ((date (calendar-cursor-to-date t)))
3074 (save-excursion
3075 (set-buffer (get-buffer-create other-calendars-buffer))
3076 (setq buffer-read-only nil)
3077 (calendar-set-mode-line
3078 (concat (calendar-date-string date) " (Gregorian)"))
3079 (erase-buffer)
3080 (insert
3081 (mapconcat 'identity
3082 (list (calendar-day-of-year-string date)
3083 (format "ISO date: %s" (calendar-iso-date-string date))
3084 (format "Julian date: %s"
3085 (calendar-julian-date-string date))
3086 (format
3087 "Astronomical (Julian) day number (at noon UTC): %s.0"
3088 (calendar-astro-date-string date))
3089 (format "Fixed (RD) date: %s"
3090 (calendar-absolute-from-gregorian date))
3091 (format "Hebrew date (before sunset): %s"
3092 (calendar-hebrew-date-string date))
3093 (format "Persian date: %s"
3094 (calendar-persian-date-string date))
3095 (let ((i (calendar-islamic-date-string date)))
3096 (if (not (string-equal i ""))
3097 (format "Islamic date (before sunset): %s" i)))
811a8484
JW
3098 (let ((b (calendar-bahai-date-string date)))
3099 (if (not (string-equal b ""))
3100 (format "Baha'i date (before sunset): %s" b)))
726669d8
ER
3101 (format "Chinese date: %s"
3102 (calendar-chinese-date-string date))
3103 (let ((c (calendar-coptic-date-string date)))
3104 (if (not (string-equal c ""))
3105 (format "Coptic date: %s" c)))
3106 (let ((e (calendar-ethiopic-date-string date)))
3107 (if (not (string-equal e ""))
3108 (format "Ethiopic date: %s" e)))
3109 (let ((f (calendar-french-date-string date)))
3110 (if (not (string-equal f ""))
3111 (format "French Revolutionary date: %s" f)))
3112 (format "Mayan date: %s"
3113 (calendar-mayan-date-string date)))
3114 "\n"))
3115 (goto-char (point-min))
3116 (set-buffer-modified-p nil)
3117 (setq buffer-read-only t)
3118 (display-buffer other-calendars-buffer))))
3119
7e1dae73 3120(defun calendar-print-day-of-year ()
6a2aa94c 3121 "Show day number in year/days remaining in year for date under the cursor."
ecaa0527 3122 (interactive)
ffd82264 3123 (message (calendar-day-of-year-string (calendar-cursor-to-date t))))
ecaa0527 3124
7e1dae73
JB
3125(defun calendar-set-mode-line (str)
3126 "Set mode line to STR, centered, surrounded by dashes."
3127 (setq mode-line-format
d519ea8a
GM
3128 (calendar-string-spread
3129 (list str) ?-
3130 ;; As per doc of window-width, total visible mode-line length.
3131 (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges))))))
7e1dae73 3132
7086b78e
ER
3133(defun calendar-mod (m n)
3134 "Non-negative remainder of M/N with N instead of 0."
3135 (1+ (mod (1- m) n)))
7e1dae73
JB
3136
3137(run-hooks 'calendar-load-hook)
ecaa0527
RS
3138
3139(provide 'calendar)
3140
b578f267
EN
3141;;; Local variables:
3142;;; byte-compile-dynamic: t
3143;;; End:
3144
ab5796a9 3145;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
94b304d7 3146;;; calendar.el ends here