; Fix missing sentence end double space in NEWS.
[emacs.git] / lisp / calendar / calendar.el
Commit [+]AuthorDateLineData
3afbc435 Pavel Janík2001-07-16 07:46:48 +00001;;; calendar.el --- calendar functions
fd7fa35a Eric S. Raymond1992-07-17 08:15:29 +00002
7e09ef09
PE
Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 1988-1995, 1997, 2000-2015 Free Software Foundation,
4;; Inc.
3a801d0c Eric S. Raymond1992-07-22 04:22:42 +00005
fd7fa35a Eric S. Raymond1992-07-17 08:15:29 +00006;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
aff88519 Glenn Morris2005-10-08 04:49:48 +00007;; Maintainer: Glenn Morris <rgm@gnu.org>
e9571d2a Eric S. Raymond1993-03-18 21:29:42 +00008;; Keywords: calendar
3076647c Edward M. Reingold1995-10-12 15:27:07 +00009;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
fd7fa35a Eric S. Raymond1992-07-17 08:15:29 +000010
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +000011;; This file is part of GNU Emacs.
12
2ed66575 Glenn Morris2008-05-06 03:07:58 +000013;; GNU Emacs is free software: you can redistribute it and/or modify
e555fdd8 Richard M. Stallman1994-04-07 20:31:17 +000014;; it under the terms of the GNU General Public License as published by
2ed66575
GM
Glenn Morris2008-05-06 03:07:58 +000015;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
e555fdd8 Richard M. Stallman1994-04-07 20:31:17 +000017
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +000018;; GNU Emacs is distributed in the hope that it will be useful,
e555fdd8
RS
Richard M. Stallman1994-04-07 20:31:17 +000019;; 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
2ed66575 Glenn Morris2008-05-06 03:07:58 +000024;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +000025
fd7fa35a
ER
Eric S. Raymond1992-07-17 08:15:29 +000026;;; Commentary:
27
811a8484
JW
John Wiegley2004-05-08 12:42:07 +000028;; This collection of functions implements a calendar window. It
29;; generates a calendar for the current month, together with the
30;; previous and coming months, or for any other three-month period.
31;; The calendar can be scrolled forward and backward in the window to
32;; show months in the past or future; the cursor can move forward and
33;; backward by days, weeks, or months, making it possible, for
34;; instance, to jump to the date a specified number of days, weeks, or
35;; months from the date under the cursor. The user can display a list
36;; of holidays and other notable days for the period shown; the
37;; notable days can be marked on the calendar, if desired. The user
38;; can also specify that dates having corresponding diary entries (in
39;; a file that the user specifies) be marked; the diary entries for
40;; any date can be viewed in a separate window. The diary and the
41;; notable days can be viewed independently of the calendar. Dates
42;; can be translated from the (usual) Gregorian calendar to the day of
43;; the year/days remaining in year, to the ISO commercial calendar, to
44;; the Julian (old style) calendar, to the Hebrew calendar, to the
6818b449 Glenn Morris2012-02-17 22:08:15 -050045;; Islamic calendar, to the Bahá'í calendar, to the French
811a8484
JW
John Wiegley2004-05-08 12:42:07 +000046;; Revolutionary calendar, to the Mayan calendar, to the Chinese
47;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +000048;; the astronomical (Julian) day number. Times of sunrise/sunset can
49;; be displayed, as can the phases of the moon. Appointment
50;; notification for diary entries is available. Calendar printing via
51;; LaTeX is available.
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +000052
53;; The following files are part of the calendar/diary code:
54
aea566be Glenn Morris2008-04-01 02:46:29 +000055;; appt.el Appointment notification
6818b449 Glenn Morris2012-02-17 22:08:15 -050056;; cal-bahai.el Bahá'í calendar
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +000057;; cal-china.el Chinese calendar
58;; cal-coptic.el Coptic/Ethiopic calendars
59;; cal-dst.el Daylight saving time rules
60;; cal-french.el French revolutionary calendar
61;; cal-hebrew.el Hebrew calendar
62;; cal-html.el Calendars in HTML
63;; cal-islam.el Islamic calendar
64;; cal-iso.el ISO calendar
65;; cal-julian.el Julian/astronomical calendars
66;; cal-mayan.el Mayan calendars
67;; cal-menu.el Menu support
68;; cal-move.el Movement in the calendar
69;; cal-persia.el Persian calendar
70;; cal-tex.el Calendars in LaTeX
71;; cal-x.el Dedicated frame functions
72;; calendar.el This file
73;; diary-lib.el Diary functions
74;; holidays.el Holiday functions
75;; lunar.el Phases of the moon
76;; solar.el Sunrise/sunset, equinoxes/solstices
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +000077
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +000078;; Technical details of all the calendrical calculations can be found in
fffaba77
PE
Paul Eggert2005-03-30 16:55:58 +000079;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
80;; and Nachum Dershowitz, Cambridge University Press (2001).
7e1dae73 Jim Blandy1992-08-12 12:50:10 +000081
a96a5fca Paul Eggert1997-12-16 19:12:36 +000082;; An earlier version of the technical details appeared in
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +000083;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
84;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
fffaba77 Paul Eggert2005-03-30 16:55:58 +000085;; pages 899-928, and in ``Calendrical Calculations, Part II: Three Historical
7e1dae73 Jim Blandy1992-08-12 12:50:10 +000086;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
e4c61e50
JB
Jim Blandy1993-05-03 22:56:42 +000087;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
88;; pages 383-404.
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +000089
90;; Hard copies of these two papers can be obtained by sending email to
91;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
92;; the message BODY containing your mailing address (snail).
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +000093
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +000094
95;; A note on free variables:
96
97;; The calendar passes around a few dynamically bound variables, which
98;; unfortunately have rather common names. They are meant to be
99;; available for external functions, so the names can't be changed.
100
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000101;; displayed-month, displayed-year: bound in calendar-generate, the
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +0000102;; central month of the 3 month calendar window
103;; original-date, number: bound in diary-list-entries, the arguments
104;; with which that function was called.
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000105;; date, entry: bound in diary-list-sexp-entries (qv)
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +0000106
107;; Bound in diary-list-entries:
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000108;; diary-entries-list: use in d-l, appt.el, and by diary-add-to-list
40802b08 Glenn Morris2008-03-15 03:00:17 +0000109;; diary-saved-point: only used in diary-lib.el, passed to the display func
df3b40c1
GM
Glenn Morris2008-03-16 01:22:58 +0000110;; date-string: only used in diary-lib.el
111;; list-only: don't modify the diary-buffer, just return a list of entries
112;; file-glob-attrs: yuck
40802b08 Glenn Morris2008-03-15 03:00:17 +0000113
fd7fa35a Eric S. Raymond1992-07-17 08:15:29 +0000114;;; Code:
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000115
e8a11b22 Glenn Morris2009-11-10 08:11:47 +0000116(load "cal-loaddefs" nil t)
f62611de Glenn Morris2008-03-08 03:47:03 +0000117
94b73aef Glenn Morris2008-04-05 18:55:09 +0000118;; Avoid recursive load of calendar when loading cal-menu. Yuck.
f21811af Glenn Morris2008-03-26 03:13:55 +0000119(provide 'calendar)
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000120(require 'cal-menu)
121
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000122(defgroup calendar nil
123 "Calendar and time management support."
1244fe39 Glenn Morris2008-04-10 03:41:41 +0000124 :prefix "calendar-"
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000125 :group 'applications)
126
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000127(defgroup calendar-hooks nil
128 "Calendar hooks."
129 :prefix "calendar-"
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000130 :group 'calendar)
131
1f1e454e
GM
Glenn Morris2008-04-12 03:11:03 +0000132(defgroup calendar-faces nil
133 "Calendar faces."
134 :prefix "calendar-"
135 :group 'calendar)
136
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000137(defcustom calendar-offset 0
138 "The offset of the principal month from the center of the calendar window.
1390 means the principal month is in the center (default), -1 means on the left,
140+1 means on the right. Larger (or smaller) values push the principal month off
141the screen."
142 :type 'integer
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000143 :group 'calendar)
144
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000145(defcustom calendar-setup nil
146 "The frame setup of the calendar.
147The choices are: `one-frame' (calendar and diary together in one separate,
148dedicated frame); `two-frames' (calendar and diary in separate, dedicated
149frames); `calendar-only' (calendar in a separate, dedicated frame); with
150any other value the current frame is used. Using any of the first
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000151three options overrides the value of `calendar-view-diary-initially-flag'."
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000152 :type '(choice
153 (const :tag "calendar and diary in separate frame" one-frame)
154 (const :tag "calendar and diary each in own frame" two-frames)
155 (const :tag "calendar in separate frame" calendar-only)
156 (const :tag "use current frame" nil))
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000157 :group 'calendar)
158
f62611de Glenn Morris2008-03-08 03:47:03 +0000159(defcustom calendar-minimum-window-height 8
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000160 "Minimum height `calendar-generate-window' should use for calendar window."
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000161 :type 'integer
162 :version "22.1"
163 :group 'calendar)
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000164
58ae51ae
GM
Glenn Morris2009-10-10 20:50:39 +0000165;; See discussion in bug#1806.
166(defcustom calendar-split-width-threshold nil
167 "Value to use for `split-width-threshold' when creating a calendar.
168This only affects frames wider than the default value of
169`split-width-threshold'."
170 :type '(choice (const nil)
171 (integer))
172 :version "23.2"
173 :group 'calendar)
174
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000175(defcustom calendar-week-start-day 0
176 "The day of the week on which a week in the calendar begins.
1770 means Sunday (default), 1 means Monday, and so on.
0663481f Glenn Morris2005-02-27 20:25:48 +0000178
f62611de Glenn Morris2008-03-08 03:47:03 +0000179If you change this variable directly (without using customize)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000180after starting `calendar', you should call `calendar-redraw' to
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000181update the calendar display to reflect the change, otherwise
182movement commands will not work correctly."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000183 :type 'integer
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000184 ;; Change the initialize so that if you reload calendar.el, it will not
185 ;; cause a redraw (which may fail, e.g. with "invalid byte-code in
186 ;; calendar.elc" because of the "byte-compile-dynamic").
187 :initialize 'custom-initialize-default
188 :set (lambda (sym val)
189 (set sym val)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000190 (calendar-redraw))
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000191 :group 'calendar)
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +0000192
397e316b
IL
Ingo Lohmar2015-08-02 17:20:53 +0200193(defcustom calendar-weekend-days '(0 6)
194 "Days of the week considered weekend days.
1950 means Sunday, 1 means Monday, and so on.
196
197Determines which day headers are fontified with
198`calendar-weekend-header'."
199 :type '(repeat integer)
200 :version "25.1"
201 :group 'calendar)
202
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000203(defcustom calendar-view-diary-initially-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000204 "Non-nil means display current date's diary entries on entry to calendar.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000205The diary is displayed in another window when the calendar is first displayed,
206if the current date is visible. The number of days of diary entries displayed
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000207is governed by the variable `diary-number-of-entries'. This variable can
1293540e Glenn Morris2004-01-11 22:26:46 +0000208be overridden by the value of `calendar-setup'."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000209 :type 'boolean
210 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000211
6ed17433 Glenn Morris2009-02-08 01:52:01 +0000212;; FIXME :set
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000213(defcustom calendar-mark-diary-entries-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000214 "Non-nil means mark dates with diary entries, in the calendar window.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000215The marking symbol is specified by the variable `diary-entry-marker'."
216 :type 'boolean
217 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000218
f49f2a9e Glenn Morris2008-03-25 03:42:55 +0000219(defcustom calendar-remove-frame-by-deleting t
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000220 "Determine how the calendar mode removes a frame no longer needed.
7e1e5cf1
SS
Sam Steingold1999-11-12 16:05:16 +0000221If nil, make an icon of the frame. If non-nil, delete the frame."
222 :type 'boolean
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +0000223 :version "23.1" ; changed from nil to t
224 :group 'view
225 :group 'calendar)
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +0000226
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000227(defface calendar-today
228 '((t (:underline t)))
1f1e454e Glenn Morris2008-04-12 03:11:03 +0000229 "Face for indicating today's date in the calendar.
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000230See the variable `calendar-today-marker'."
1f1e454e Glenn Morris2008-04-12 03:11:03 +0000231 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000232
75eb05f6 Miles Bader2005-06-10 10:43:42 +0000233(defface diary
ea81d57e
DN
Dan Nicolaescu2005-04-08 14:26:13 +0000234 '((((min-colors 88) (class color) (background light))
235 :foreground "red1")
236 (((class color) (background light))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000237 :foreground "red")
ea81d57e
DN
Dan Nicolaescu2005-04-08 14:26:13 +0000238 (((min-colors 88) (class color) (background dark))
239 :foreground "yellow1")
9c887ada Miles Bader2000-11-03 03:30:49 +0000240 (((class color) (background dark))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000241 :foreground "yellow")
9c887ada Miles Bader2000-11-03 03:30:49 +0000242 (t
1fd714a4 Richard M. Stallman2001-12-31 20:44:44 +0000243 :weight bold))
1f1e454e
GM
Glenn Morris2008-04-12 03:11:03 +0000244 "Face for highlighting diary entries.
245Used to mark diary entries in the calendar (see `diary-entry-marker'),
246and to highlight the date header in the fancy diary."
247 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000248
75eb05f6 Miles Bader2005-06-10 10:43:42 +0000249(defface holiday
9c887ada Miles Bader2000-11-03 03:30:49 +0000250 '((((class color) (background light))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000251 :background "pink")
9c887ada Miles Bader2000-11-03 03:30:49 +0000252 (((class color) (background dark))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000253 :background "chocolate4")
9c887ada Miles Bader2000-11-03 03:30:49 +0000254 (t
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000255 :inverse-video t))
1f1e454e
GM
Glenn Morris2008-04-12 03:11:03 +0000256 "Face for indicating in the calendar dates that have holidays.
257See `calendar-holiday-marker'."
258 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000259
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400260(defface calendar-weekday-header '((t :inherit font-lock-constant-face))
261 "Face used for weekday column headers in the calendar.
262See also the face `calendar-weekend-header'."
263 :version "24.4"
264 :group 'calendar-faces)
265
266(defface calendar-weekend-header '((t :inherit font-lock-comment-face))
267 "Face used for weekend column headers in the calendar.
268See also the face `calendar-weekday-header'."
269 :version "24.4"
270 :group 'calendar-faces)
271
272(defface calendar-month-header '((t :inherit font-lock-function-name-face))
273 "Face used for month headers in the calendar."
274 :version "24.4"
275 :group 'calendar-faces)
276
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000277;; These briefly checked font-lock-mode, but that is broken, since it
278;; is a buffer-local variable, and which buffer happens to be current
279;; when this file is loaded shouldn't make a difference. One could
280;; perhaps check global-font-lock-mode, or font-lock-global-modes; but
281;; this feature doesn't use font-lock, so there's no real reason it
282;; should respect those either. See bug#2199.
283;; They also used to check display-color-p, but that is a problem if
284;; loaded from --daemon. Since BW displays are rare now, this was
285;; also taken out. The way to keep it would be to have nil mean do a
286;; runtime check whenever this variable is used.
287(defcustom diary-entry-marker 'diary
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000288 "How to mark dates that have diary entries.
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000289The value can be either a single-character string (e.g. \"+\") or a face."
290 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000291 :group 'diary
292 :version "23.1")
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +0000293
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000294(defcustom calendar-today-marker 'calendar-today
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000295 "How to mark today's date in the calendar.
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000296The value can be either a single-character string (e.g. \"=\") or a face.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000297Used by `calendar-mark-today'."
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000298 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000299 :group 'calendar
300 :version "23.1")
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +0000301
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000302(defcustom calendar-holiday-marker 'holiday
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000303 "How to mark notable dates in the calendar.
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000304The value can be either a single-character string (e.g. \"*\") or a face."
305 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000306 :group 'holidays
307 :version "23.1")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000308
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000309(defcustom calendar-view-holidays-initially-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000310 "Non-nil means display holidays for current three month period on entry.
354d0644 Jim Blandy1993-06-22 03:22:12 +0000311The holidays are displayed in another window when the calendar is first
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000312displayed."
313 :type 'boolean
314 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000315
6ed17433 Glenn Morris2009-02-08 01:52:01 +0000316;; FIXME :set
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000317(defcustom calendar-mark-holidays-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000318 "Non-nil means mark dates of holidays in the calendar window.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000319The marking symbol is specified by the variable `calendar-holiday-marker'."
320 :type 'boolean
321 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000322
c8a9e437
GM
Glenn Morris2007-03-27 02:36:25 +0000323(defcustom calendar-mode-hook nil
324 "Hook run when entering `calendar-mode'."
325 :type 'hook
326 :group 'calendar-hooks)
327
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000328(defcustom calendar-load-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000329 "List of functions to be called after the calendar is first loaded.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000330This is the place to add key bindings to `calendar-mode-map'."
331 :type 'hook
332 :group 'calendar-hooks)
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000333
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000334(defcustom calendar-initial-window-hook nil
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000335 "List of functions to be called when the calendar window is created.
acab8b97 Glenn Morris2008-03-18 03:35:58 +0000336Quitting the calendar and re-entering it will cause these functions
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000337to be called again."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000338 :type 'hook
339 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000340
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000341(defcustom calendar-today-visible-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000342 "List of functions called whenever the current date is visible.
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +0000343To mark today's date, add the function `calendar-mark-today'.
344To replace the date with asterisks, add the function `calendar-star-date'.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000345See also `calendar-today-invisible-hook'.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000346
acab8b97
GM
Glenn Morris2008-03-18 03:35:58 +0000347In general, be careful about changing characters in the calendar buffer,
348since it may cause the movement commands to fail."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000349 :type 'hook
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000350 :options '(calendar-mark-today calendar-star-date)
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000351 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000352
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000353(defcustom calendar-today-invisible-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000354 "List of functions called whenever the current date is not visible.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000355See also `calendar-today-visible-hook'."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000356 :type 'hook
357 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000358
5c9705e5 Richard M. Stallman1999-08-28 15:18:39 +0000359(defcustom calendar-move-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000360 "List of functions called whenever the cursor moves in the calendar.
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +0000361For example,
5c9705e5 Richard M. Stallman1999-08-28 15:18:39 +0000362
875a5d0e Paul Eggert2015-08-24 23:39:33 -0700363 (add-hook \\='calendar-move-hook (lambda () (diary-view-entries 1)))
5c9705e5
RS
Richard M. Stallman1999-08-28 15:18:39 +0000364
365redisplays the diary for whatever date the cursor is moved to."
366 :type 'hook
bb715837 Glenn Morris2008-06-17 05:56:48 +0000367 :options '(calendar-update-mode-line)
5c9705e5
RS
Richard M. Stallman1999-08-28 15:18:39 +0000368 :group 'calendar-hooks)
369
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000370(defcustom calendar-date-echo-text
371 "mouse-2: general menu\nmouse-3: menu for this date"
372 "String displayed when the cursor is over a date in the calendar.
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000373Can be either a fixed string, or a lisp expression that returns one.
374When this expression is evaluated, DAY, MONTH, and YEAR are
bb715837 Glenn Morris2008-06-17 05:56:48 +0000375integers appropriate to the relevant date. For example, to
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000376display the ISO date:
377
378 (setq calendar-date-echo-text '(format \"ISO date: %s\"
379 (calendar-iso-date-string
380 (list month day year))))
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000381Changing this variable without using customize has no effect on
382pre-existing calendar windows."
383 :group 'calendar
384 :initialize 'custom-initialize-default
385 :risky t
386 :set (lambda (sym val)
387 (set sym val)
388 (calendar-redraw))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000389 :type '(choice (string :tag "Fixed string")
390 (sexp :value
391 (format "ISO date: %s"
392 (calendar-iso-date-string
393 (list month day year)))))
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000394 :version "23.1")
395
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000396
397(defvar calendar-month-digit-width nil
398 "Width of the region with numbers in each month in the calendar.")
399
400(defvar calendar-month-width nil
401 "Full width of each month in the calendar.")
402
403(defvar calendar-right-margin nil
404 "Right margin of the calendar.")
405
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000406(defvar calendar-month-edges nil
407 "Alist of month edge columns.
408Each element has the form (N LEFT FIRST LAST RIGHT), where
409LEFT is the leftmost column associated with month segment N,
410FIRST and LAST are the first and last columns with day digits in,
411and LAST is the rightmost column.")
412
413(defun calendar-month-edges (segment)
414 "Compute the month edge columns for month SEGMENT.
415Returns a list (LEFT FIRST LAST RIGHT), where LEFT is the
416leftmost column associated with a month, FIRST and LAST are the
417first and last columns with day digits in, and LAST is the
418rightmost column."
419 ;; The leftmost column with a digit in it in this month segment.
420 (let* ((first (+ calendar-left-margin
421 (* segment calendar-month-width)))
422 ;; The rightmost column with a digit in it in this month segment.
423 (last (+ first (1- calendar-month-digit-width)))
424 (left (if (eq segment 0)
425 0
426 (+ calendar-left-margin
427 (* segment calendar-month-width)
428 (- (/ calendar-intermonth-spacing 2)))))
429 ;; The rightmost edge of this month segment, dividing the
430 ;; space between months in two.
431 (right (+ calendar-left-margin
432 (* (1+ segment) calendar-month-width)
433 (- (/ calendar-intermonth-spacing 2)))))
434 (list left first last right)))
435
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000436(defun calendar-recompute-layout-variables ()
437 "Recompute some layout-related calendar \"constants\"."
438 (setq calendar-month-digit-width (+ (* 6 calendar-column-width)
439 calendar-day-digit-width)
440 calendar-month-width (+ (* 7 calendar-column-width)
441 calendar-intermonth-spacing)
442 calendar-right-margin (+ calendar-left-margin
443 (* 3 (* 7 calendar-column-width))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000444 (* 2 calendar-intermonth-spacing))
445 calendar-month-edges nil)
446 (dotimes (i 3)
447 (push (cons i (calendar-month-edges i)) calendar-month-edges))
448 (setq calendar-month-edges (reverse calendar-month-edges)))
0c74d40b Glenn Morris2008-06-21 19:28:09 +0000449
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000450(defun calendar-set-layout-variable (symbol value &optional minmax)
451 "Set SYMBOL's value to VALUE, an integer.
452A positive/negative MINMAX enforces a minimum/maximum value.
453Then redraw the calendar, if necessary."
454 (let ((oldvalue (symbol-value symbol)))
455 (custom-set-default symbol (if minmax
456 (if (< minmax 0)
457 (min value (- minmax))
458 (max value minmax))
459 value))
460 (unless (equal value oldvalue)
461 (calendar-recompute-layout-variables)
462 (calendar-redraw))))
463
464(defcustom calendar-left-margin 5
465 "Empty space to the left of the first month in the calendar."
466 :group 'calendar
467 :initialize 'custom-initialize-default
468 :set 'calendar-set-layout-variable
469 :type 'integer
470 :version "23.1")
471
472;; Or you can view it as columns of width 2, with 1 space, no space
473;; after the last column, and a 5 space gap between month.
474;; FIXME check things work if this is odd.
475(defcustom calendar-intermonth-spacing 4
476 "Space between months in the calendar. Minimum value is 1."
477 :group 'calendar
478 :initialize 'custom-initialize-default
479 :set (lambda (sym val)
480 (calendar-set-layout-variable sym val 1))
481 :type 'integer
482 :version "23.1")
483
b1c172fe Glenn Morris2008-06-26 03:41:20 +0000484;; FIXME calendar-month-column-width?
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000485(defcustom calendar-column-width 3
486 "Width of each day column in the calendar. Minimum value is 3."
487 :initialize 'custom-initialize-default
488 :set (lambda (sym val)
489 (calendar-set-layout-variable sym val 3))
490 :type 'integer
491 :version "23.1")
492
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400493(defun calendar-day-header-construct (&optional width)
494 "Return the default value for `calendar-day-header-array'.
495WIDTH defaults to `calendar-day-header-width'."
496 (or width (setq width calendar-day-header-width))
497 (calendar-abbrev-construct (if (<= width calendar-abbrev-length)
498 calendar-day-abbrev-array
499 calendar-day-name-array)
500 width))
501
502;; FIXME better to use a format spec?
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000503(defcustom calendar-day-header-width 2
504 "Width of the day column headers in the calendar.
505Must be at least one less than `calendar-column-width'."
506 :group 'calendar
507 :initialize 'custom-initialize-default
508 :set (lambda (sym val)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400509 (or (calendar-customized-p 'calendar-day-header-array)
510 (setq calendar-day-header-array
511 (calendar-day-header-construct val)))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000512 (calendar-set-layout-variable sym val (- 1 calendar-column-width)))
513 :type 'integer
514 :version "23.1")
515
516;; FIXME a format specifier instead?
517(defcustom calendar-day-digit-width 2
518 "Width of the day digits in the calendar. Minimum value is 2."
519 :group 'calendar
520 :initialize 'custom-initialize-default
521 :set (lambda (sym val)
522 (calendar-set-layout-variable sym val 2))
523 :type 'integer
524 :version "23.1")
525
5cbaccfe Glenn Morris2008-06-26 06:57:29 +0000526(defcustom calendar-intermonth-header nil
3ab44929 Glenn Morris2012-10-08 00:05:21 -0700527 "Header text to display in the space to the left of each calendar month.
5cbaccfe
GM
Glenn Morris2008-06-26 06:57:29 +0000528See `calendar-intermonth-text'."
529 :group 'calendar
530 :initialize 'custom-initialize-default
531 :risky t
532 :set (lambda (sym val)
533 (set sym val)
534 (calendar-redraw))
535 :type '(choice (const nil :tag "Nothing")
536 (string :tag "Fixed string")
537 (sexp :value
538 (propertize "WK" 'font-lock-face
539 'font-lock-function-name-face)))
540 :version "23.1")
541
542(defcustom calendar-intermonth-text nil
543 "Text to display in the space to the left of each calendar month.
544Can be nil, a fixed string, or a lisp expression that returns a string.
545When the expression is evaluated, the variables DAY, MONTH and YEAR
546are integers appropriate for the first day in each week.
547Will be truncated to the smaller of `calendar-left-margin' and
548`calendar-intermonth-spacing'. The last character is forced to be a space.
549For example, to display the ISO week numbers:
550
551 (setq calendar-week-start-day 1
552 calendar-intermonth-text
553 '(propertize
554 (format \"%2d\"
555 (car
556 (calendar-iso-from-absolute
557 (calendar-absolute-from-gregorian (list month day year)))))
558 'font-lock-face 'font-lock-function-name-face))
559
560See also `calendar-intermonth-header'."
561 :group 'calendar
562 :initialize 'custom-initialize-default
563 :risky t
564 :set (lambda (sym val)
565 (set sym val)
566 (calendar-redraw))
567 :type '(choice (const nil :tag "Nothing")
568 (string :tag "Fixed string")
569 (sexp :value
570 (propertize
571 (format "%2d"
572 (car
573 (calendar-iso-from-absolute
574 (calendar-absolute-from-gregorian
575 (list month day year)))))
576 'font-lock-face 'font-lock-function-name-face)))
577 :version "23.1")
0c74d40b Glenn Morris2008-06-21 19:28:09 +0000578
6ebbc2f6 Glenn Morris2015-06-15 20:46:01 -0400579(defcustom diary-file (locate-user-emacs-file "diary" "diary")
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000580 "Name of the file in which one's personal diary of dates is kept.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000581
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000582The file's entries are lines beginning with any of the forms
739d627a Glenn Morris2008-03-27 07:28:24 +0000583specified by the variable `diary-date-forms', which by default
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000584uses the forms of `diary-american-date-forms':
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000585
586 MONTH/DAY
587 MONTH/DAY/YEAR
588 MONTHNAME DAY
589 MONTHNAME DAY, YEAR
590 DAYNAME
591
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +0000592with the remainder of the line being the diary entry string for
593that date. MONTH and DAY are one or two digit numbers, YEAR is a
594number and may be written in full or abbreviated to the final two
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000595digits (if `diary-abbreviated-year-flag' is non-nil). MONTHNAME
27a28b50 Glenn Morris2008-03-14 02:46:37 +0000596and DAYNAME can be spelled in full (as specified by the variables
739d627a Glenn Morris2008-03-27 07:28:24 +0000597`calendar-month-name-array' and `calendar-day-name-array'), or
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000598abbreviated (as specified by `calendar-month-abbrev-array' and
739d627a
GM
Glenn Morris2008-03-27 07:28:24 +0000599`calendar-day-abbrev-array') with or without a period. Case is
600ignored. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which
601matches any day, month, or year, respectively. If the date does
602not contain a year, it is generic and applies to any year. A
603DAYNAME entry applies to the appropriate day of the week in every week.
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000604
8266a036 Glenn Morris2008-03-29 02:44:03 +0000605You can customize `diary-date-forms' to your preferred format.
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000606Three default styles are provided: `diary-american-date-forms',
607`diary-european-date-forms', and `diary-iso-date-forms'.
8266a036 Glenn Morris2008-03-29 02:44:03 +0000608You can choose between these by setting `calendar-date-style' in your
865fe16f Chong Yidong2012-09-17 13:41:04 +0800609init file, or by using `calendar-set-date-style' when in the calendar.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000610
739d627a
GM
Glenn Morris2008-03-27 07:28:24 +0000611A diary entry can be preceded by the character `diary-nonmarking-symbol'
612\(ordinarily `&') to make that entry nonmarking--that is, it will not be
613marked on dates in the calendar window but will appear in a diary window.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000614
615Multiline diary entries are made by indenting lines after the first with
616either a TAB or one or more spaces.
617
618Lines not in one the above formats are ignored. Here are some sample diary
619entries (in the default American style):
620
621 12/22/1988 Twentieth wedding anniversary!!
622 &1/1. Happy New Year!
623 10/22 Ruth's birthday.
624 21: Payday
625 Tuesday--weekly meeting with grad students at 10am
626 Supowit, Shen, Bitner, and Kapoor to attend.
627 1/13/89 Friday the thirteenth!!
628 &thu 4pm squash game with Lloyd.
629 mar 16 Dad's birthday
630 April 15, 1989 Income tax due.
631 &* 15 time cards due.
632
633If the first line of a diary entry consists only of the date or day name with
e555fdd8
RS
Richard M. Stallman1994-04-07 20:31:17 +0000634no trailing blanks or punctuation, then that line is not displayed in the
635diary window; only the continuation lines is shown. For example, the
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000636single diary entry
637
638 02/11/1989
639 Bill Blattner visits Princeton today
640 2pm Cognitive Studies Committee meeting
641 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
642 4:00pm Jamie Tappenden
643 7:30pm Dinner at George and Ed's for Alan Ryan
644 7:30-10:00pm dance at Stewart Country Day School
645
646will appear in the diary window without the date line at the beginning. This
647facility allows the diary window to look neater, but can cause confusion if
648used with more than one day's entries displayed.
649
650Diary entries can be based on Lisp sexps. For example, the diary entry
651
652 %%(diary-block 11 1 1990 11 10 1990) Vacation
653
811a8484 John Wiegley2004-05-08 12:42:07 +0000654causes the diary entry \"Vacation\" to appear from November 1 through
739d627a Glenn Morris2008-03-27 07:28:24 +0000655November 10, 1990. See the documentation for the function
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000656`diary-list-sexp-entries' for more details.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000657
6818b449 Glenn Morris2012-02-17 22:08:15 -0500658Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
811a8484 John Wiegley2004-05-08 12:42:07 +0000659calendar are also possible, but because these are somewhat slow, they
9ee4e581
GM
Glenn Morris2008-04-06 20:54:25 +0000660are ignored unless you set the `diary-nongregorian-listing-hook' and
661the `diary-nongregorian-marking-hook' appropriately. See the
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000662documentation of these hooks for details.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000663
664Diary files can contain directives to include the contents of other files; for
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000665details, see the documentation for the variable `diary-list-entries-hook'."
6ebbc2f6 Glenn Morris2015-06-15 20:46:01 -0400666 :version "25.1" ; ~/diary -> locate-user-emacs-file
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000667 :type 'file
668 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000669
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000670;; FIXME do these have to be single characters?
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000671(defcustom diary-nonmarking-symbol "&"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000672 "Symbol indicating that a diary entry is not to be marked in the calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000673 :type 'string
674 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000675
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +0800676(defcustom diary-chinese-entry-symbol "C"
677 "Symbol indicating a diary entry according to the Chinese calendar."
678 :type 'string
679 :group 'diary
cbdc06f3 Stefan Monnier2014-09-29 14:14:08 -0400680 :version "25.1")
bbdcf64f Leo Liu2014-05-04 08:16:58 +0800681
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000682(defcustom diary-hebrew-entry-symbol "H"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000683 "Symbol indicating a diary entry according to the Hebrew calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000684 :type 'string
685 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000686
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000687(defcustom diary-islamic-entry-symbol "I"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000688 "Symbol indicating a diary entry according to the Islamic calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000689 :type 'string
690 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000691
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000692(defcustom diary-bahai-entry-symbol "B"
6818b449 Glenn Morris2012-02-17 22:08:15 -0500693 "Symbol indicating a diary entry according to the Bahá'í calendar."
811a8484
JW
John Wiegley2004-05-08 12:42:07 +0000694 :type 'string
695 :group 'diary)
696
3f659704 Glenn Morris2014-10-05 19:02:04 -0700697(defcustom calendar-date-style 'american
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000698 "Your preferred style for writing dates.
699The options are:
700`american' - month/day/year
701`european' - day/month/year
702`iso' - year/month/day
703This affects how dates written in your diary are interpreted.
704It also affects date display, as well as those calendar and diary
705functions that take a date as an argument, e.g. `diary-date', by
706changing the order in which the arguments are interpreted.
707
708Setting this variable directly does not take effect (if the
709calendar package is already loaded). Rather, use either
710\\[customize] or the function `calendar-set-date-style'."
711 :version "23.1"
712 :type '(choice (const american :tag "Month/Day/Year")
713 (const european :tag "Day/Month/Year")
714 (const iso :tag "Year/Month/Day"))
715 :initialize 'custom-initialize-default
716 :set (lambda (symbol value)
717 (calendar-set-date-style value))
718 :group 'calendar)
719
720;; Next three are provided to aid in setting diary-date-forms.
b106af42 Glenn Morris2008-04-11 03:47:38 +0000721;; FIXME move to diary-lib?
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000722(defcustom diary-iso-date-forms
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000723 '((month "[-/]" day "[^-/0-9]")
724 (year "[-/]" month "[-/]" day "[^0-9]")
29f30ab7
GM
Glenn Morris2010-11-11 19:16:20 -0800725 ;; Cannot allow [-/] as separators here, since it would also match
726 ;; the first element (bug#7377).
727 (monthname " *" day "[^-0-9]")
728 (year " *" monthname " *" day "[^0-9]")
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000729 (dayname "\\W"))
730 "List of pseudo-patterns describing the ISO style of dates.
29f30ab7
GM
Glenn Morris2010-11-11 19:16:20 -0800731The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME DAY;
732YEAR MONTHNAME DAY; DAYNAME. Normally you should not customize this,
8266a036 Glenn Morris2008-03-29 02:44:03 +0000733but `diary-date-forms' (which see)."
29f30ab7 Glenn Morris2010-11-11 19:16:20 -0800734 :version "23.3" ; bug#7377
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000735 :type '(repeat (choice (cons :tag "Backup"
736 :value (backup . nil)
737 (const backup)
738 (repeat (list :inline t :format "%v"
739 (symbol :tag "Keyword")
740 (choice symbol regexp))))
741 (repeat (list :inline t :format "%v"
742 (symbol :tag "Keyword")
743 (choice symbol regexp)))))
744 :group 'diary)
745
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000746(defcustom diary-american-date-forms
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000747 '((month "/" day "[^/0-9]")
748 (month "/" day "/" year "[^0-9]")
749 (monthname " *" day "[^,0-9]")
750 (monthname " *" day ", *" year "[^0-9]")
751 (dayname "\\W"))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000752 "List of pseudo-patterns describing the American style of dates.
753The defaults are: MONTH/DAY; MONTH/DAY/YEAR; MONTHNAME DAY;
754MONTHNAME DAY, YEAR; DAYNAME. Normally you should not customize this,
755but `diary-date-forms' (which see)."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000756 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000757 :value (backup . nil)
758 (const backup)
759 (repeat (list :inline t :format "%v"
760 (symbol :tag "Keyword")
761 (choice symbol regexp))))
762 (repeat (list :inline t :format "%v"
763 (symbol :tag "Keyword")
764 (choice symbol regexp)))))
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000765 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000766
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000767(defcustom diary-european-date-forms
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000768 '((day "/" month "[^/0-9]")
769 (day "/" month "/" year "[^0-9]")
bb0541f8 Richard M. Stallman1999-08-02 00:32:50 +0000770 (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000771 (day " *" monthname " *" year "[^0-9]")
772 (dayname "\\W"))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000773 "List of pseudo-patterns describing the European style of dates.
774The defaults are: DAY/MONTH; DAY/MONTH/YEAR; DAY MONTHNAME;
775DAY MONTHNAME YEAR; DAYNAME. Normally you should not customize this, but
776`diary-date-forms' (which see)."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000777 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000778 :value (backup . nil)
779 (const backup)
780 (repeat (list :inline t :format "%v"
781 (symbol :tag "Keyword")
782 (choice symbol regexp))))
783 (repeat (list :inline t :format "%v"
784 (symbol :tag "Keyword")
785 (choice symbol regexp)))))
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000786 :group 'diary)
787
109eecc0
GM
Glenn Morris2007-04-07 21:53:39 +0000788(defvar diary-font-lock-keywords)
789
8266a036 Glenn Morris2008-03-29 02:44:03 +0000790(defcustom diary-date-forms (cond ((eq calendar-date-style 'iso)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000791 diary-iso-date-forms)
8266a036 Glenn Morris2008-03-29 02:44:03 +0000792 ((eq calendar-date-style 'european)
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000793 diary-european-date-forms)
794 (t diary-american-date-forms))
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000795 "List of pseudo-patterns describing the forms of date used in the diary.
8c64a298 Juanma Barranquero2002-04-03 14:47:16 +0000796The patterns on the list must be MUTUALLY EXCLUSIVE and should not match
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000797any portion of the diary entry itself, just the date component.
798
799A pseudo-pattern is a list of regular expressions and the keywords `month',
800`day', `year', `monthname', and `dayname'. The keyword `monthname' will
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +0000801match the name of the month (see `calendar-month-name-array'), capitalized
802or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
803followed by a period or not; it will also match `*'. Similarly, `dayname'
804will match the name of the day (see `calendar-day-name-array'), capitalized or
805not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
806followed by a period or not. The keywords `month', `day', and `year' will
807match those numerical values, preceded by arbitrarily many zeros; they will
808also match `*'.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000809
810The matching of the diary entries with the date forms is done with the
811standard syntax table from Fundamental mode, but with the `*' changed so
812that it is a word constituent.
813
814If, to be mutually exclusive, a pseudo-pattern must match a portion of the
815diary entry itself, the first element of the pattern MUST be `backup'. This
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +0000816directive causes the date recognizer to back up to the beginning of the
817current word of the diary entry, so in no case can the pattern match more than
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000818a portion of the first word of the diary entry.
819
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000820For examples of three common styles, see `diary-american-date-forms',
821`diary-european-date-forms', and `diary-iso-date-forms'."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000822 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000823 :value (backup . nil)
824 (const backup)
825 (repeat (list :inline t :format "%v"
826 (symbol :tag "Keyword")
827 (choice symbol regexp))))
828 (repeat (list :inline t :format "%v"
829 (symbol :tag "Keyword")
830 (choice symbol regexp)))))
6302f8ac
GM
Glenn Morris2009-03-02 07:00:43 +0000831 :set-after '(calendar-date-style diary-iso-date-forms
832 diary-european-date-forms
833 diary-american-date-forms)
109eecc0
GM
Glenn Morris2007-04-07 21:53:39 +0000834 :initialize 'custom-initialize-default
835 :set (lambda (symbol value)
836 (unless (equal value (eval symbol))
837 (custom-set-default symbol value)
838 (setq diary-font-lock-keywords (diary-font-lock-keywords))
839 ;; Need to redraw not just to get new font-locking, but also
840 ;; to pick up any newly recognized entries.
841 (and (diary-live-p)
842 (diary))))
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000843 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000844
8266a036 Glenn Morris2008-03-29 02:44:03 +0000845;; Next three are provided to aid in setting calendar-date-display-form.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000846(defcustom calendar-iso-date-display-form '((format "%s-%.2d-%.2d" year
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000847 (string-to-number month)
848 (string-to-number day)))
849 "Pseudo-pattern governing the way a date appears in the ISO style.
850Normally you should not customize this, but `calendar-date-display-form'
851\(which see)."
852 :type 'sexp
853 :version "23.1"
854 :group 'calendar)
855
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000856(defcustom calendar-european-date-display-form
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000857 '((if dayname (concat dayname ", ")) day " " monthname " " year)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000858 "Pseudo-pattern governing the way a date appears in the European style.
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000859Normally you should not customize this, but `calendar-date-display-form'
860\(which see)."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000861 :type 'sexp
862 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000863
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000864(defcustom calendar-american-date-display-form
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000865 '((if dayname (concat dayname ", ")) monthname " " day ", " year)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000866 "Pseudo-pattern governing the way a date appears in the American style.
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000867Normally you should not customize this, but `calendar-date-display-form'
868\(which see)."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000869 :type 'sexp
870 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000871
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000872(defcustom calendar-date-display-form
873 (cond ((eq calendar-date-style 'iso)
874 calendar-iso-date-display-form)
875 ((eq calendar-date-style 'european)
876 calendar-european-date-display-form)
877 (t calendar-american-date-display-form))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000878 "Pseudo-pattern governing the way a calendar date appears.
879Used by the function `calendar-date-string' (which see), a pseudo-pattern
880is a list of expressions that can involve the keywords `month', `day',
881and `year' (all numbers in string form), and `monthname' and `dayname'
882\(both alphabetic strings). For example, a typical American form would be
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000883
884 '(month \"/\" day \"/\" (substring year -2))
885
8266a036 Glenn Morris2008-03-29 02:44:03 +0000886whereas
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000887
888 '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
889
8266a036 Glenn Morris2008-03-29 02:44:03 +0000890would give the usual American style in fixed-length fields. The variables
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000891`calendar-iso-date-display-form', `calendar-european-date-display-form', and
892`calendar-american-date-display-form' provide some defaults for three common
8266a036 Glenn Morris2008-03-29 02:44:03 +0000893styles."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000894 :type 'sexp
6302f8ac
GM
Glenn Morris2009-03-02 07:00:43 +0000895 :set-after '(calendar-date-style calendar-iso-date-display-form
896 calendar-european-date-display-form
897 calendar-american-date-display-form)
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000898 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000899
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700900(defcustom calendar-american-month-header
901 '(propertize (format "%s %d" (calendar-month-name month) year)
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400902 'font-lock-face 'calendar-month-header)
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700903 "Default format for calendar month headings with the American date style.
904Normally you should not customize this, but `calender-month-header'."
905 :group 'calendar
906 :risky t
907 :type 'sexp
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400908 :version "24.4") ; font-lock-function-name-face -> calendar-month-header
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700909
910(defcustom calendar-european-month-header
911 '(propertize (format "%s %d" (calendar-month-name month) year)
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400912 'font-lock-face 'calendar-month-header)
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700913 "Default format for calendar month headings with the European date style.
914Normally you should not customize this, but `calender-month-header'."
915 :group 'calendar
916 :risky t
917 :type 'sexp
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400918 :version "24.4") ; font-lock-function-name-face -> calendar-month-header
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700919
920(defcustom calendar-iso-month-header
921 '(propertize (format "%d %s" year (calendar-month-name month))
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400922 'font-lock-face 'calendar-month-header)
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700923 "Default format for calendar month headings with the ISO date style.
924Normally you should not customize this, but `calender-month-header'."
925 :group 'calendar
926 :risky t
927 :type 'sexp
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400928 :version "24.4") ; font-lock-function-name-face -> calendar-month-header
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700929
930(defcustom calendar-month-header
931 (cond ((eq calendar-date-style 'iso)
932 calendar-iso-month-header)
933 ((eq calendar-date-style 'european)
934 calendar-european-month-header)
935 (t calendar-american-month-header))
936 "Expression to evaluate to return the calendar month headings.
937When this expression is evaluated, the variables MONTH and YEAR are
938integers appropriate to the relevant month. The result is padded
939to the width of `calendar-month-digit-width'.
940
941For examples of three common styles, see `calendar-american-month-header',
942`calendar-european-month-header', and `calendar-iso-month-header'.
943
944Changing this variable without using customize has no effect on
945pre-existing calendar windows."
946 :group 'calendar
947 :initialize 'custom-initialize-default
948 :risky t
949 :set (lambda (sym val)
950 (set sym val)
951 (calendar-redraw))
952 :set-after '(calendar-date-style calendar-american-month-header
953 calendar-european-month-header
954 calendar-iso-month-header)
955 :type 'sexp
956 :version "24.3")
957
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000958(defun calendar-set-date-style (style)
959 "Set the style of calendar and diary dates to STYLE (a symbol).
960The valid styles are described in the documentation of `calendar-date-style'."
961 (interactive (list (intern
962 (completing-read "Date style: "
963 '("american" "european" "iso") nil t
964 nil nil "american"))))
965 (or (memq style '(american european iso))
966 (setq style 'american))
967 (setq calendar-date-style style
968 calendar-date-display-form
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000969 (symbol-value (intern-soft
970 (format "calendar-%s-date-display-form" style)))
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700971 calendar-month-header
972 (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
8266a036 Glenn Morris2008-03-29 02:44:03 +0000973 diary-date-forms
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000974 (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
69f6644c Glenn Morris2012-09-19 00:27:29 -0700975 (calendar-redraw)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000976 (calendar-update-mode-line))
8266a036 Glenn Morris2008-03-29 02:44:03 +0000977
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000978(defcustom diary-show-holidays-flag t
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000979 "Non-nil means include holidays in the diary display.
e555fdd8 Richard M. Stallman1994-04-07 20:31:17 +0000980The holidays appear in the mode line of the diary buffer, or in the
354d0644 Jim Blandy1993-06-22 03:22:12 +0000981fancy diary buffer next to the date. This slows down the diary functions
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000982somewhat; setting it to nil makes the diary display faster."
983 :type 'boolean
984 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000985
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000986(defcustom calendar-debug-sexp nil
987 "Turn debugging on when evaluating a sexp in the diary or holiday list."
988 :type 'boolean
989 :group 'calendar)
2ec778d0 Richard M. Stallman1993-06-03 06:12:46 +0000990
c09dffbe Glenn Morris2008-04-04 04:36:54 +0000991(defcustom calendar-hebrew-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000992 "If nil, show only major holidays from the Hebrew calendar.
993This means only those Jewish holidays that appear on secular calendars.
994Otherwise, show all the holidays that would appear in a complete Hebrew
995calendar."
996 :type 'boolean
997 :group 'holidays)
998
c09dffbe Glenn Morris2008-04-04 04:36:54 +0000999(defcustom calendar-christian-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001000 "If nil, show only major holidays from the Christian calendar.
1001This means only those Christian holidays that appear on secular calendars.
1002Otherwise, show all the holidays that would appear in a complete Christian
1003calendar."
1004 :type 'boolean
1005 :group 'holidays)
1006
c09dffbe Glenn Morris2008-04-04 04:36:54 +00001007(defcustom calendar-islamic-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001008 "If nil, show only major holidays from the Islamic calendar.
1009This means only those Islamic holidays that appear on secular calendars.
1010Otherwise, show all the holidays that would appear in a complete Islamic
1011calendar."
1012 :type 'boolean
1013 :group 'holidays)
1014
c09dffbe Glenn Morris2008-04-04 04:36:54 +00001015(defcustom calendar-bahai-all-holidays-flag nil
6818b449 Glenn Morris2012-02-17 22:08:15 -05001016 "If nil, show only major holidays from the Bahá'í calendar.
f62611de Glenn Morris2008-03-08 03:47:03 +00001017These are the days on which work and school must be suspended.
6818b449 Glenn Morris2012-02-17 22:08:15 -05001018Otherwise, show all the holidays that would appear in a complete Bahá'í
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001019calendar."
1020 :type 'boolean
1021 :group 'holidays)
1022
7717093c
GM
Glenn Morris2008-04-23 02:59:47 +00001023(defcustom calendar-chinese-all-holidays-flag nil
1024 "If nil, show only the major holidays from the Chinese calendar."
1025 :version "23.1"
1026 :type 'boolean
1027 :group 'holidays)
1028
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001029;;; End of user options.
1030
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001031(calendar-recompute-layout-variables)
1032
1033(defconst calendar-first-date-row 3
1034 "First row in the calendar with actual dates.")
1035
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001036(defconst calendar-buffer "*Calendar*"
1037 "Name of the buffer used for the calendar.")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001038
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001039(defconst holiday-buffer "*Holidays*"
1040 "Name of the buffer used for the displaying the holidays.")
1041
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001042(defconst diary-fancy-buffer "*Fancy Diary Entries*"
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001043 "Name of the buffer used for the optional fancy display of the diary.")
1044
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001045(defconst calendar-other-calendars-buffer "*Other Calendars*"
726669d8
ER
Edward M. Reingold1998-05-27 20:18:40 +00001046 "Name of the buffer used for the display of date on other calendars.")
1047
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001048(defconst lunar-phases-buffer "*Phases of Moon*"
1049 "Name of the buffer used for the lunar phases.")
1050
f4498b9e Glenn Morris2008-09-27 19:58:53 +00001051(defconst solar-sunrises-buffer "*Sunrise/Sunset Times*"
6e73a6a2
GM
Glenn Morris2008-06-26 22:30:01 +00001052 "Name of buffer used for sunrise/sunset times.")
1053
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001054(defconst calendar-hebrew-yahrzeit-buffer "*Yahrzeits*"
bae5a5a3
GM
Glenn Morris2008-03-13 04:06:47 +00001055 "Name of the buffer used by `list-yahrzeit-dates'.")
1056
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001057(defmacro calendar-increment-month (mon yr n &optional nmonths)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001058 "Increment the variables MON and YR by N months.
1059Forward if N is positive or backward if N is negative.
f6c762dd Glenn Morris2008-03-31 07:11:00 +00001060A negative YR is interpreted as BC; -1 being 1 BC, and so on.
a8ee33ab
GM
Glenn Morris2008-03-31 16:00:05 +00001061Optional NMONTHS is the number of months per year (default 12)."
1062 ;; Can view this as a form of base-nmonths arithmetic, in which "a
1063 ;; year" = "ten", and we never bother to use hundreds.
1064 `(let ((nmonths (or ,nmonths 12))
1065 macro-y)
18db8896 Glenn Morris2003-10-01 20:48:17 +00001066 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
a8ee33ab
GM
Glenn Morris2008-03-31 16:00:05 +00001067 (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1068 ,mon (1+ (mod macro-y nmonths))
1069 ,yr (/ macro-y nmonths))
1070 ;; Alternative:
1071;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1072;;; ,yr (/ macro-y nmonths)
1073;;; ,mon (- macro-y (* ,yr nmonths)))
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001074 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1075 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001076
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001077(defvar displayed-month)
1078(defvar displayed-year)
1079
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001080(defun calendar-increment-month-cons (n &optional mon yr)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001081 "Return the Nth month after MON/YR.
1082The return value is a pair (MONTH . YEAR).
1083MON defaults to `displayed-month'. YR defaults to `displayed-year'."
1084 (unless mon (setq mon displayed-month))
b06ee3d2 Stefan Monnier2006-02-06 16:56:35 +00001085 (unless yr (setq yr displayed-year))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001086 (calendar-increment-month mon yr n)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001087 (cons mon yr))
1088
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001089(defmacro calendar-sum (index initial condition expression)
40802b08 Glenn Morris2008-03-15 03:00:17 +00001090 "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001091 (declare (debug (symbolp form form form)))
7e1e5cf1
SS
Sam Steingold1999-11-12 16:05:16 +00001092 `(let ((,index ,initial)
1093 (sum 0))
1094 (while ,condition
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001095 (setq sum (+ sum ,expression)
1096 ,index (1+ ,index)))
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +00001097 sum))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001098
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00001099(defmacro calendar-in-read-only-buffer (buffer &rest body)
628299e0 Sam Steingold2012-06-06 11:19:39 -04001100 "Switch to BUFFER and execute the forms in BODY.
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001101First creates or erases BUFFER as needed. Leaves BUFFER read-only,
1102with disabled undo. Leaves point at point-min, displays BUFFER."
1103 (declare (indent 1) (debug t))
1104 `(progn
1105 (set-buffer (get-buffer-create ,buffer))
89b5595a Glenn Morris2012-06-21 21:50:35 -04001106 (or (derived-mode-p 'special-mode) (special-mode))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001107 (setq buffer-read-only nil
1108 buffer-undo-list t)
1109 (erase-buffer)
1110 ,@body
1111 (goto-char (point-min))
1112 (set-buffer-modified-p nil)
1113 (setq buffer-read-only t)
1114 (display-buffer ,buffer)))
1115
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001116;; The following are in-line for speed; they can be called thousands of times
1117;; when looking up holidays or processing the diary. Here, for example, are
1118;; the numbers of calls to calendar/diary/holiday functions in preparing the
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001119;; fancy diary display, for a moderately complex diary file, with functions
1120;; used instead of macros. There were a total of 10000 such calls:
1121;;
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001122;; 1934 calendar-extract-month
1123;; 1852 calendar-extract-year
1124;; 1819 calendar-extract-day
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001125;; 845 calendar-leap-year-p
1126;; 837 calendar-day-number
1127;; 775 calendar-absolute-from-gregorian
1128;; 346 calendar-last-day-of-month
0a837994
GM
Glenn Morris2008-04-05 20:58:10 +00001129;; 286 calendar-hebrew-last-day-of-month
1130;; 188 calendar-hebrew-leap-year-p
1131;; 180 calendar-hebrew-elapsed-days
1132;; 163 calendar-hebrew-last-month-of-year
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001133;; 66 calendar-date-compare
0a837994 Glenn Morris2008-04-05 20:58:10 +00001134;; 65 calendar-hebrew-days-in-year
b78b866a Glenn Morris2008-04-04 07:32:39 +00001135;; 60 calendar-julian-to-absolute
0a837994 Glenn Morris2008-04-05 20:58:10 +00001136;; 50 calendar-hebrew-to-absolute
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001137;; 43 calendar-date-equal
1138;; 38 calendar-gregorian-from-absolute
1139;; .
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001140;;
1141;; The use of these seven macros eliminates the overhead of 92% of the function
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001142;; calls; it's faster this way.
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001143
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001144(defsubst calendar-extract-month (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001145 "Extract the month part of DATE which has the form (month day year)."
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001146 (car date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001147
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001148;; Note gives wrong answer for result of (calendar-read-date 'noday),
1149;; but that is only used by `calendar-other-month'.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001150(defsubst calendar-extract-day (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001151 "Extract the day part of DATE which has the form (month day year)."
40802b08 Glenn Morris2008-03-15 03:00:17 +00001152 (cadr date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001153
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001154(defsubst calendar-extract-year (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001155 "Extract the year part of DATE which has the form (month day year)."
40802b08 Glenn Morris2008-03-15 03:00:17 +00001156 (nth 2 date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001157
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001158(defsubst calendar-leap-year-p (year)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001159 "Return t if YEAR is a Gregorian leap year.
1160A negative year is interpreted as BC; -1 being 1 BC, and so on."
1161 ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
1162 (if (< year 0) (setq year (1- (abs year))))
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001163 (and (zerop (% year 4))
1164 (or (not (zerop (% year 100)))
1165 (zerop (% year 400)))))
1166
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001167;; The foregoing is a bit faster, but not as clear as the following:
1168;;
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001169;;(defsubst calendar-leap-year-p (year)
21db982b Glenn Morris2008-03-10 02:46:24 +00001170;; "Return t if YEAR is a Gregorian leap year."
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001171;; (or
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001172;; (and (zerop (% year 4))
1173;; (not (zerop (% year 100))))
1174;; (zerop (% year 400)))
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001175
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001176(defsubst calendar-last-day-of-month (month year)
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001177 "The last day in MONTH during YEAR."
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001178 (if (and (= month 2) (calendar-leap-year-p year))
1179 29
1180 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
1181
1182;; An explanation of the calculation can be found in PascAlgorithms by
1183;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
1184
1185(defsubst calendar-day-number (date)
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001186 "Return the day number within the year of the date DATE.
1187For example, (calendar-day-number '(1 1 1987)) returns the value 1,
1188while (calendar-day-number '(12 31 1980)) returns 366."
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001189 (let* ((month (calendar-extract-month date))
1190 (day (calendar-extract-day date))
1191 (year (calendar-extract-year date))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001192 (day-of-year (+ day (* 31 (1- month)))))
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001193 (when (> month 2)
1194 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
1195 (if (calendar-leap-year-p year)
1196 (setq day-of-year (1+ day-of-year))))
1197 day-of-year))
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001198
1199(defsubst calendar-absolute-from-gregorian (date)
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001200 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001201The Gregorian date Sunday, December 31, 1 BC is imaginary.
1202DATE is a list of the form (month day year). A negative year is
1203interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
1204return negative results."
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001205 (let ((year (calendar-extract-year date))
18db8896 Glenn Morris2003-10-01 20:48:17 +00001206 offset-years)
21db982b Glenn Morris2008-03-10 02:46:24 +00001207 (cond ((zerop year)
fb723401 Glenn Morris2015-06-10 17:04:54 -04001208 (user-error "There was no year zero"))
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001209 ((> year 0)
1210 (setq offset-years (1- year))
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001211 (+ (calendar-day-number date) ; days this year
1212 (* 365 offset-years) ; + days in prior years
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001213 (/ offset-years 4) ; + Julian leap years
1214 (- (/ offset-years 100)) ; - century years
1215 (/ offset-years 400))) ; + Gregorian leap years
1216 (t
1217 ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
1218 (setq offset-years (abs (1+ year)))
1219 (- (calendar-day-number date)
1220 (* 365 offset-years)
1221 (/ offset-years 4)
1222 (- (/ offset-years 100))
1223 (/ offset-years 400)
1224 (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001225
94b304d7 Richard M. Stallman1992-06-03 02:55:55 +00001226;;;###autoload
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001227(defun calendar (&optional arg)
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001228 "Display a three-month Gregorian calendar.
1229The three months appear side by side, with the current month in
1230the middle surrounded by the previous and next months. The
1231cursor is put on today's date. If optional prefix argument ARG
1232is non-nil, prompts for the central month and year.
1233
1234Once in the calendar window, future or past months can be moved
1235into view. Arbitrary months can be displayed, or the calendar
1236can be scrolled forward or backward. The cursor can be moved
1237forward or backward by one day, one week, one month, or one year.
1238All of these commands take prefix arguments which, when negative,
1239cause movement in the opposite direction. For convenience, the
1240digit keys and the minus sign are automatically prefixes. Use
1241\\[describe-mode] for details of the key bindings in the calendar
1242window.
1243
1244Displays the calendar in a separate window, or optionally in a
1245separate frame, depending on the value of `calendar-setup'.
1246
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001247If `calendar-view-diary-initially-flag' is non-nil, also displays the
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001248diary entries for the current date (or however many days
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001249`diary-number-of-entries' specifies). This variable can be
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001250overridden by `calendar-setup'. As well as being displayed,
1251diary entries can also be marked on the calendar (see
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001252`calendar-mark-diary-entries-flag').
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001253
1254Runs the following hooks:
1255
1256`calendar-load-hook' - after loading calendar.el
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001257`calendar-today-visible-hook', `calendar-today-invisible-hook' - after
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001258 generating a calendar, if today's date is visible or not, respectively
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001259`calendar-initial-window-hook' - after first creating a calendar
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001260
865fe16f Chong Yidong2012-09-17 13:41:04 +08001261This function is suitable for execution in an init file."
7086b78e Edward M. Reingold1995-09-21 02:40:35 +00001262 (interactive "P")
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001263 ;; Avoid loading cal-x unless it will be used.
1264 (if (and (memq calendar-setup '(one-frame two-frames calendar-only))
1265 (display-multi-frame-p))
1266 (calendar-frame-setup calendar-setup arg)
1267 (calendar-basic-setup arg)))
1268
1269(defun calendar-basic-setup (&optional arg nodisplay)
1270 "Create a three-month calendar.
1271If optional prefix argument ARG is non-nil, prompts for the month
1272and year, else uses the current date. If NODISPLAY is non-nil, don't
1273display the generated calendar."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001274 (interactive "P")
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001275 (let ((buff (current-buffer)))
1276 (set-buffer (get-buffer-create calendar-buffer))
1277 (calendar-mode)
1278 (let* ((pop-up-windows t)
1279 ;; Not really needed now, but means we use exactly the same
1280 ;; behavior as before in the non-wide case (see below).
1281 (split-height-threshold 1000)
58ae51ae Glenn Morris2009-10-10 20:50:39 +00001282 (split-width-threshold calendar-split-width-threshold)
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001283 (date (if arg (calendar-read-date t)
1284 (calendar-current-date)))
1285 (month (calendar-extract-month date))
1286 (year (calendar-extract-year date)))
1287 (calendar-increment-month month year (- calendar-offset))
1288 ;; Display the buffer before calling calendar-generate-window so that it
1289 ;; can get a chance to adjust the window sizes to the frame size.
1290 (unless nodisplay
1291 ;; We want a window configuration that looks something like
1292 ;; X X | Y
1293 ;; - -----
1294 ;; C Z | C
1295 ;; where C is the calendar, and the LHS is the traditional,
1296 ;; non-wide frame, and the RHS is the wide frame case.
1297 ;; We should end up in the same state regardless of whether the
1298 ;; windows were initially split or not.
1299 ;; Previously, we only thought about the non-wide case.
1300 ;; We could just set split-height-threshold to 1000, relying on
1301 ;; the fact that the window splitting treated a single window as
1302 ;; a special case and would always split it (vertically). The
1303 ;; same thing does not work in the wide-frame case, so now we do
1304 ;; the splitting by hand.
1305 ;; See discussion in bug#1806.
1306 ;; Actually, this still does not do quite the right thing in the
1307 ;; wide frame case if started from a configuration like the LHS.
1308 ;; Eg if you start with a non-wide frame, call calendar, then
1309 ;; make the frame wider. This one is problematic because you
1310 ;; might need to split a totally unrelated window. Oh well, it
1311 ;; seems unlikely, and perhaps respecting the original layout is
1312 ;; the right thing in that case.
1313 ;;
1314 ;; Is this a wide frame? If so, split it horizontally.
b360b106
MR
Martin Rudalics2014-08-21 10:40:29 +02001315
1316 ;; The following doesn't sound useful: If we split horizontally
1317 ;; here, the subsequent `pop-to-buffer' will likely split again
1318 ;; horizontally and we end up with three side-by-side windows.
1319 (when (window-splittable-p (selected-window) t)
1320 (split-window-right))
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001321 (pop-to-buffer calendar-buffer)
1322 ;; Has the window already been split vertically?
1323 (when (and (not (window-dedicated-p))
b360b106 Martin Rudalics2014-08-21 10:40:29 +02001324 (window-splittable-p (selected-window))
429a1506 Glenn Morris2009-10-07 02:57:46 +00001325 (window-full-height-p))
2d197ffb Chong Yidong2011-10-30 09:56:03 +08001326 (let ((win (split-window-below)))
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001327 ;; In the upper window, show whatever was visible before.
1328 ;; This looks better than using other-buffer.
1329 (switch-to-buffer buff)
1330 ;; Switch to the lower window with the calendar buffer.
1331 (select-window win))))
1332 (calendar-generate-window month year)
1333 (if (and calendar-view-diary-initially-flag
1334 (calendar-date-is-visible-p date))
6e82d877
GM
Glenn Morris2014-09-07 22:57:24 -07001335 ;; Do not clobber the calendar with the diary, if the diary
1336 ;; has previously been shown in the window that now shows the
1337 ;; calendar (bug#18381).
1338 (let ((display-buffer-overriding-action
1339 '(nil . ((inhibit-same-window . t)))))
1340 (diary-view-entries)))))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001341 (if calendar-view-holidays-initially-flag
9025db71 Glenn Morris2014-09-07 23:03:19 -07001342 (let* ((diary-buffer (diary-live-p))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001343 (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
1344 (split-height-threshold (if diary-window 2 1000)))
1345 ;; FIXME display buffer?
cb9b9874 Glenn Morris2007-09-14 04:30:30 +00001346 (calendar-list-holidays)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001347 (run-hooks 'calendar-initial-window-hook))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001348
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001349(defun calendar-generate-window (&optional mon yr)
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001350 "Generate the calendar window for the current date.
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001351Optional integers MON and YR are used instead of today's date."
712f4efe Stefan Monnier2007-07-29 20:49:13 +00001352 (let* ((inhibit-read-only t)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001353 (today (calendar-current-date))
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001354 (month (calendar-extract-month today))
1355 (day (calendar-extract-day today))
1356 (year (calendar-extract-year today))
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001357 (today-visible (or (not mon)
1358 (<= (abs (calendar-interval mon yr month year)) 1)))
290d5b58 Dmitry Antipov2013-08-05 18:26:57 +04001359 (in-calendar-window (eq (window-buffer)
0663481f Glenn Morris2005-02-27 20:25:48 +00001360 (get-buffer calendar-buffer))))
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001361 (calendar-generate (or mon month) (or yr year))
1362 (calendar-update-mode-line)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001363 (calendar-cursor-to-visible-date
1364 (if today-visible today (list displayed-month 1 displayed-year)))
1365 (set-buffer-modified-p nil)
0663481f Glenn Morris2005-02-27 20:25:48 +00001366 ;; Don't do any window-related stuff if we weren't called from a
21db982b Glenn Morris2008-03-10 02:46:24 +00001367 ;; window displaying the calendar.
0663481f Glenn Morris2005-02-27 20:25:48 +00001368 (when in-calendar-window
3d8daefe Martin Rudalics2011-10-30 09:29:56 +01001369 (if (window-combined-p)
39cffb44
MR
Martin Rudalics2011-06-12 09:46:56 +02001370 ;; Adjust the window to exactly fit the displayed calendar.
1371 (fit-window-to-buffer nil nil calendar-minimum-window-height)
1372 ;; For a full height window or a window that is horizontally
1373 ;; combined don't fit height to that of its buffer.
1374 (set-window-vscroll nil 0))
0663481f Glenn Morris2005-02-27 20:25:48 +00001375 (sit-for 0))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001376 (and calendar-mark-holidays-flag
6711a21f Stefan Monnier2014-05-28 23:45:29 -04001377 ;; (calendar-date-is-valid-p today) ; useful for BC dates
8ccd0d4d Glenn Morris2008-03-13 06:00:07 +00001378 (calendar-mark-holidays)
0663481f Glenn Morris2005-02-27 20:25:48 +00001379 (and in-calendar-window (sit-for 0)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001380 (unwind-protect
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001381 (if calendar-mark-diary-entries-flag (diary-mark-entries))
6711a21f
SM
Stefan Monnier2014-05-28 23:45:29 -04001382 (run-hooks (if today-visible
1383 'calendar-today-visible-hook
1384 'calendar-today-invisible-hook)))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001385
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001386(defun calendar-generate (month year)
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001387 "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001388 ;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
1389 ;; Note that while calendars for years BC could be displayed as it
1390 ;; stands, almost all other calendar functions (eg holidays) would
1391 ;; at best have unpredictable results for such dates.
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001392 (if (< (+ month (* 12 (1- year))) 2)
fb723401 Glenn Morris2015-06-10 17:04:54 -04001393 (user-error "Months before January, 1 AD cannot be displayed"))
4c635ea3
GM
Glenn Morris2004-02-23 00:11:12 +00001394 (setq displayed-month month
1395 displayed-year year)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001396 (erase-buffer)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001397 (calendar-increment-month month year -1)
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001398 (dotimes (i 3)
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001399 (calendar-generate-month month year
1400 (+ calendar-left-margin
1401 (* calendar-month-width i)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001402 (calendar-increment-month month year 1)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001403
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001404(defun calendar-move-to-column (indent)
1405 "Like `move-to-column', but indents if the line is too short."
1406 (if (< (move-to-column indent) indent)
1407 (indent-to indent)))
1408
1409(defun calendar-ensure-newline ()
1410 "Move to the next line, adding a newline if necessary."
1411 (or (zerop (forward-line 1))
1412 (insert "\n")))
1413
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001414(defun calendar-insert-at-column (indent string truncate)
1415 "Move to column INDENT, adding spaces as needed.
1416Inserts STRING so that it ends at INDENT. STRING is either a
1417literal string, or a sexp to evaluate to return such. Truncates
c7e73d51 Glenn Morris2012-03-15 21:10:46 -04001418STRING to length TRUNCATE, and ensures a trailing space."
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001419 (if (not (ignore-errors (stringp (setq string (eval string)))))
1420 (calendar-move-to-column indent)
c7e73d51
GM
Glenn Morris2012-03-15 21:10:46 -04001421 (if (> (string-width string) truncate)
1422 (setq string (truncate-string-to-width string truncate)))
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001423 (or (string-match " $" string)
c7e73d51
GM
Glenn Morris2012-03-15 21:10:46 -04001424 (setq string (concat (if (= (string-width string) truncate)
1425 (substring string 0 -1)
1426 string)
1427 ;; Avoid inserting text properties unless
1428 ;; we have to (ie, non-unit-width chars).
1429 ;; This is by no means essential.
1430 (if (= (string-width string) (length string))
1431 " "
1432 ;; Cribbed from buff-menu.el.
1433 (propertize
1434 " " 'display `(space :align-to ,indent))))))
1435 (calendar-move-to-column (- indent (string-width string)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001436 (insert string)))
1437
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001438(defun calendar-generate-month (month year indent)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001439 "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
f2172a68
EZ
Eli Zaretskii2002-01-28 19:23:14 +00001440The calendar is inserted at the top of the buffer in which point is currently
1441located, but indented INDENT spaces. The indentation is done from the first
1442character on the line and does not disturb the first INDENT characters on the
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001443line."
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001444 (let ((blank-days ; at start of month
1445 (mod
1446 (- (calendar-day-of-week (list month 1 year))
1447 calendar-week-start-day)
1448 7))
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00001449 (last (calendar-last-day-of-month month year))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001450 (trunc (min calendar-intermonth-spacing
1451 (1- calendar-left-margin)))
61debe4a
GM
Glenn Morris2014-03-17 09:04:32 -07001452 (day 1)
1453 j)
d8a200a7 Richard M. Stallman1993-10-20 05:49:24 +00001454 (goto-char (point-min))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001455 (calendar-move-to-column indent)
1456 (insert
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -07001457 (calendar-string-spread (list calendar-month-header)
1458 ?\s calendar-month-digit-width))
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001459 (calendar-ensure-newline)
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001460 (calendar-insert-at-column indent calendar-intermonth-header trunc)
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04001461 ;; Use the first N characters of each day to head the columns.
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001462 (dotimes (i 7)
61debe4a Glenn Morris2014-03-17 09:04:32 -07001463 (setq j (mod (+ calendar-week-start-day i) 7))
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001464 (insert
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04001465 (truncate-string-to-width
61debe4a Glenn Morris2014-03-17 09:04:32 -07001466 (propertize (calendar-day-name j 'header t)
397e316b Ingo Lohmar2015-08-02 17:20:53 +02001467 'font-lock-face (if (memq j calendar-weekend-days)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04001468 'calendar-weekend-header
1469 'calendar-weekday-header))
1470 calendar-day-header-width nil ?\s)
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001471 (make-string (- calendar-column-width calendar-day-header-width) ?\s)))
1472 (calendar-ensure-newline)
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001473 (calendar-insert-at-column indent calendar-intermonth-text trunc)
21db982b Glenn Morris2008-03-10 02:46:24 +00001474 ;; Add blank days before the first of the month.
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001475 (insert (make-string (* blank-days calendar-column-width) ?\s))
21db982b Glenn Morris2008-03-10 02:46:24 +00001476 ;; Put in the days of the month.
40802b08 Glenn Morris2008-03-15 03:00:17 +00001477 (dotimes (i last)
bb715837 Glenn Morris2008-06-17 05:56:48 +00001478 (setq day (1+ i))
6772c8e1 Glenn Morris2008-06-27 02:41:14 +00001479 ;; TODO should numbers be left-justified, centered...?
17f25e76
GM
Glenn Morris2013-08-04 23:49:37 -07001480 (insert (propertize
1481 (format (format "%%%dd" calendar-day-digit-width) day)
1482 'mouse-face 'highlight
1483 'help-echo (eval calendar-date-echo-text)
09e6d547
GM
Glenn Morris2013-08-04 23:54:30 -07001484 ;; 'date property prevents intermonth text confusing re-searches.
1485 ;; (Tried intangible, it did not really work.)
17f25e76
GM
Glenn Morris2013-08-04 23:49:37 -07001486 'date t)
1487 (make-string
1488 (- calendar-column-width calendar-day-digit-width) ?\s))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001489 (when (and (zerop (mod (+ day blank-days) 7))
1490 (/= day last))
1491 (calendar-ensure-newline)
1492 (setq day (1+ day)) ; first day of next week
1493 (calendar-insert-at-column indent calendar-intermonth-text trunc)))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001494
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001495(defun calendar-redraw ()
cea82f86 Glenn Morris2005-03-01 10:24:33 +00001496 "Redraw the calendar display, if `calendar-buffer' is live."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001497 (interactive)
57dd9e68
LL
Leo Liu2013-01-14 23:39:04 +08001498 (when (get-buffer calendar-buffer)
1499 (with-current-buffer calendar-buffer
1500 (let ((cursor-date (calendar-cursor-to-nearest-date)))
1501 (calendar-generate-window displayed-month displayed-year)
1502 (calendar-cursor-to-visible-date cursor-date))
1503 (when (window-live-p (get-buffer-window))
1504 (set-window-point (get-buffer-window) (point))))))
b924026d Glenn Morris2005-03-09 00:28:22 +00001505
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001506(defvar calendar-mode-map
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001507 (let ((map (make-keymap)))
1508 (suppress-keymap map)
1509 (dolist (c '(narrow-to-region mark-word mark-sexp mark-paragraph
1510 mark-defun mark-whole-buffer mark-page
1511 downcase-region upcase-region kill-region
1512 copy-region-as-kill capitalize-region write-region))
1513 (define-key map (vector 'remap c) 'calendar-not-implemented))
0581e7e7
SM
Stefan Monnier2007-07-27 06:28:39 +00001514 (define-key map "<" 'calendar-scroll-right)
1515 (define-key map "\C-x<" 'calendar-scroll-right)
1516 (define-key map [prior] 'calendar-scroll-right-three-months)
1517 (define-key map "\ev" 'calendar-scroll-right-three-months)
1518 (define-key map ">" 'calendar-scroll-left)
1519 (define-key map "\C-x>" 'calendar-scroll-left)
1520 (define-key map [next] 'calendar-scroll-left-three-months)
1521 (define-key map "\C-v" 'calendar-scroll-left-three-months)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001522 (define-key map "\C-b" 'calendar-backward-day)
1523 (define-key map "\C-p" 'calendar-backward-week)
1524 (define-key map "\e{" 'calendar-backward-month)
1525 (define-key map "\C-x[" 'calendar-backward-year)
1526 (define-key map "\C-f" 'calendar-forward-day)
1527 (define-key map "\C-n" 'calendar-forward-week)
1528 (define-key map [left] 'calendar-backward-day)
1529 (define-key map [up] 'calendar-backward-week)
1530 (define-key map [right] 'calendar-forward-day)
1531 (define-key map [down] 'calendar-forward-week)
1532 (define-key map "\e}" 'calendar-forward-month)
1533 (define-key map "\C-x]" 'calendar-forward-year)
1534 (define-key map "\C-a" 'calendar-beginning-of-week)
1535 (define-key map "\C-e" 'calendar-end-of-week)
1536 (define-key map "\ea" 'calendar-beginning-of-month)
1537 (define-key map "\ee" 'calendar-end-of-month)
1538 (define-key map "\e<" 'calendar-beginning-of-year)
1539 (define-key map "\e>" 'calendar-end-of-year)
1540 (define-key map "\C-@" 'calendar-set-mark)
1541 ;; Many people are used to typing C-SPC and getting C-@.
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001542 (define-key map [?\C-\s] 'calendar-set-mark)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001543 (define-key map "\C-x\C-x" 'calendar-exchange-point-and-mark)
1544 (define-key map "\e=" 'calendar-count-days-region)
1545 (define-key map "gd" 'calendar-goto-date)
1546 (define-key map "gD" 'calendar-goto-day-of-year)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001547 (define-key map "gj" 'calendar-julian-goto-date)
1548 (define-key map "ga" 'calendar-astro-goto-day-number)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001549 (define-key map "gh" 'calendar-hebrew-goto-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001550 (define-key map "gi" 'calendar-islamic-goto-date)
c8d2eff3 Glenn Morris2007-09-16 02:26:29 +00001551 (define-key map "gb" 'calendar-bahai-goto-date)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001552 (define-key map "gC" 'calendar-chinese-goto-date)
06bfc982
GM
Glenn Morris2008-04-05 19:16:40 +00001553 (define-key map "gk" 'calendar-coptic-goto-date)
1554 (define-key map "ge" 'calendar-ethiopic-goto-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001555 (define-key map "gp" 'calendar-persian-goto-date)
1556 (define-key map "gc" 'calendar-iso-goto-date)
1557 (define-key map "gw" 'calendar-iso-goto-week)
06bfc982 Glenn Morris2008-04-05 19:16:40 +00001558 (define-key map "gf" 'calendar-french-goto-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001559 (define-key map "gml" 'calendar-mayan-goto-long-count-date)
1560 (define-key map "gmpc" 'calendar-mayan-previous-round-date)
1561 (define-key map "gmnc" 'calendar-mayan-next-round-date)
1562 (define-key map "gmph" 'calendar-mayan-previous-haab-date)
1563 (define-key map "gmnh" 'calendar-mayan-next-haab-date)
1564 (define-key map "gmpt" 'calendar-mayan-previous-tzolkin-date)
1565 (define-key map "gmnt" 'calendar-mayan-next-tzolkin-date)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001566 (define-key map "Aa" 'appt-add)
1567 (define-key map "Ad" 'appt-delete)
1568 (define-key map "S" 'calendar-sunrise-sunset)
77bc20ee Glenn Morris2008-06-27 00:33:42 +00001569 (define-key map "M" 'calendar-lunar-phases)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001570 (define-key map " " 'scroll-other-window)
958614cf Glenn Morris2013-02-11 20:46:18 -08001571 (define-key map [?\S-\ ] 'scroll-other-window-down)
763f360c Glenn Morris2008-04-07 07:25:40 +00001572 (define-key map "\d" 'scroll-other-window-down)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001573 (define-key map "\C-c\C-l" 'calendar-redraw)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001574 (define-key map "." 'calendar-goto-today)
1575 (define-key map "o" 'calendar-other-month)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001576 (define-key map "q" 'calendar-exit)
cb9b9874 Glenn Morris2007-09-14 04:30:30 +00001577 (define-key map "a" 'calendar-list-holidays)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001578 (define-key map "h" 'calendar-cursor-holidays)
aea566be Glenn Morris2008-04-01 02:46:29 +00001579 (define-key map "x" 'calendar-mark-holidays)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001580 (define-key map "u" 'calendar-unmark)
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001581 (define-key map "m" 'diary-mark-entries)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001582 (define-key map "d" 'diary-view-entries)
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001583 (define-key map "D" 'diary-view-other-diary-entries)
7d129ac6 Glenn Morris2006-05-13 05:32:29 +00001584 (define-key map "s" 'diary-show-all-entries)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001585 (define-key map "pd" 'calendar-print-day-of-year)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001586 (define-key map "pC" 'calendar-chinese-print-date)
06bfc982
GM
Glenn Morris2008-04-05 19:16:40 +00001587 (define-key map "pk" 'calendar-coptic-print-date)
1588 (define-key map "pe" 'calendar-ethiopic-print-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001589 (define-key map "pp" 'calendar-persian-print-date)
1590 (define-key map "pc" 'calendar-iso-print-date)
1591 (define-key map "pj" 'calendar-julian-print-date)
1592 (define-key map "pa" 'calendar-astro-print-day-number)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001593 (define-key map "ph" 'calendar-hebrew-print-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001594 (define-key map "pi" 'calendar-islamic-print-date)
c8d2eff3 Glenn Morris2007-09-16 02:26:29 +00001595 (define-key map "pb" 'calendar-bahai-print-date)
06bfc982 Glenn Morris2008-04-05 19:16:40 +00001596 (define-key map "pf" 'calendar-french-print-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001597 (define-key map "pm" 'calendar-mayan-print-date)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001598 (define-key map "po" 'calendar-print-other-dates)
9ee4e581
GM
Glenn Morris2008-04-06 20:54:25 +00001599 (define-key map "id" 'diary-insert-entry)
1600 (define-key map "iw" 'diary-insert-weekly-entry)
1601 (define-key map "im" 'diary-insert-monthly-entry)
1602 (define-key map "iy" 'diary-insert-yearly-entry)
1603 (define-key map "ia" 'diary-insert-anniversary-entry)
1604 (define-key map "ib" 'diary-insert-block-entry)
1605 (define-key map "ic" 'diary-insert-cyclic-entry)
0a837994
GM
Glenn Morris2008-04-05 20:58:10 +00001606 (define-key map "ihd" 'diary-hebrew-insert-entry)
1607 (define-key map "ihm" 'diary-hebrew-insert-monthly-entry)
f971f8bc Glenn Morris2008-04-24 05:42:47 +00001608 (define-key map "ihy" 'diary-hebrew-insert-yearly-entry)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001609 (define-key map "iid" 'diary-islamic-insert-entry)
1610 (define-key map "iim" 'diary-islamic-insert-monthly-entry)
1611 (define-key map "iiy" 'diary-islamic-insert-yearly-entry)
c8d2eff3
GM
Glenn Morris2007-09-16 02:26:29 +00001612 (define-key map "iBd" 'diary-bahai-insert-entry)
1613 (define-key map "iBm" 'diary-bahai-insert-monthly-entry)
1614 (define-key map "iBy" 'diary-bahai-insert-yearly-entry)
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +08001615 (define-key map "iCd" 'diary-chinese-insert-entry)
1616 (define-key map "iCm" 'diary-chinese-insert-monthly-entry)
1617 (define-key map "iCy" 'diary-chinese-insert-yearly-entry)
1618 (define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001619 (define-key map "?" 'calendar-goto-info-node)
582172c6
GM
Glenn Morris2006-10-28 21:53:34 +00001620 (define-key map "Hm" 'cal-html-cursor-month)
1621 (define-key map "Hy" 'cal-html-cursor-year)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001622 (define-key map "tm" 'cal-tex-cursor-month)
1623 (define-key map "tM" 'cal-tex-cursor-month-landscape)
1624 (define-key map "td" 'cal-tex-cursor-day)
1625 (define-key map "tw1" 'cal-tex-cursor-week)
1626 (define-key map "tw2" 'cal-tex-cursor-week2)
f1f4dba0
GM
Glenn Morris2012-10-06 11:34:23 -07001627 (define-key map "tw3" 'cal-tex-cursor-week-iso) ; FIXME twi ?
1628 (define-key map "tw4" 'cal-tex-cursor-week-monday) ; twm ?
1629 (define-key map "twW" 'cal-tex-cursor-week2-summary)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001630 (define-key map "tfd" 'cal-tex-cursor-filofax-daily)
1631 (define-key map "tfw" 'cal-tex-cursor-filofax-2week)
1632 (define-key map "tfW" 'cal-tex-cursor-filofax-week)
1633 (define-key map "tfy" 'cal-tex-cursor-filofax-year)
1634 (define-key map "ty" 'cal-tex-cursor-year)
1635 (define-key map "tY" 'cal-tex-cursor-year-landscape)
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001636
1637 (define-key map [menu-bar edit] 'undefined)
1638 (define-key map [menu-bar search] 'undefined)
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001639
6e73a6a2 Glenn Morris2008-06-26 22:30:01 +00001640 (easy-menu-define nil map nil cal-menu-sunmoon-menu)
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001641 (easy-menu-define nil map nil cal-menu-diary-menu)
1642 (easy-menu-define nil map nil cal-menu-holidays-menu)
1643 (easy-menu-define nil map nil cal-menu-goto-menu)
1644 (easy-menu-define nil map nil cal-menu-scroll-menu)
0368765e Juanma Barranquero2008-03-06 15:01:24 +00001645
bb715837 Glenn Morris2008-06-17 05:56:48 +00001646 ;; These are referenced in the default calendar-date-echo-text.
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001647 (define-key map [down-mouse-3]
1648 (easy-menu-binding cal-menu-context-mouse-menu))
1649 (define-key map [down-mouse-2]
1650 (easy-menu-binding cal-menu-global-mouse-menu))
1651
daedbbc2 Glenn Morris2009-09-22 07:37:58 +00001652 ;; cf scroll-bar.el.
3f0f1700
GM
Glenn Morris2011-04-05 19:05:45 -07001653 (if (and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
1654 (define-key map [vertical-scroll-bar mouse-1]
1655 'calendar-scroll-toolkit-scroll)
1656 ;; Left-click moves us forward in time, right-click backwards.
1657 (define-key map [vertical-scroll-bar mouse-1] 'calendar-scroll-left)
1658 (define-key map [vertical-scroll-bar drag-mouse-1] 'calendar-scroll-left)
1659 ;; down-mouse-2 stays as scroll-bar-drag.
1660 (define-key map [vertical-scroll-bar mouse-3] 'calendar-scroll-right)
1661 (define-key map [vertical-scroll-bar drag-mouse-3]
1662 'calendar-scroll-right))
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001663 map)
1664 "Keymap for `calendar-mode'.")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001665
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001666;; Calendar mode is suitable only for specially formatted data.
1667(put 'calendar-mode 'mode-class 'special)
1668
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001669(defun calendar-mode-line-entry (command echo &optional key string)
1670 "Return a propertized string for `calendar-mode-line-format'.
1671COMMAND is a command to run, ECHO is the help-echo text, KEY
1672is COMMAND's keybinding, STRING describes the binding."
1673 (propertize (or key
1674 (substitute-command-keys
1675 (format "\\<calendar-mode-map>\\[%s] %s" command string)))
1676 'help-echo (format "mouse-1: %s" echo)
1677 'mouse-face 'mode-line-highlight
1678 'keymap (make-mode-line-mouse-map 'mouse-1 command)))
1679
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001680;; After calendar-mode-map.
1681(defcustom calendar-mode-line-format
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001682 (list
bb715837 Glenn Morris2008-06-17 05:56:48 +00001683 (calendar-mode-line-entry 'calendar-scroll-right "previous month" "<")
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001684 "Calendar"
d4ff5db9 Dave Love2000-09-17 17:06:00 +00001685 (concat
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001686 (calendar-mode-line-entry 'calendar-goto-info-node "read Info on Calendar"
1687 nil "info")
25ccbfee Chong Yidong2006-12-23 19:07:12 +00001688 " / "
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001689 (calendar-mode-line-entry 'calendar-other-month "choose another month"
1690 nil "other")
25ccbfee Chong Yidong2006-12-23 19:07:12 +00001691 " / "
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001692 (calendar-mode-line-entry 'calendar-goto-today "go to today's date"
1693 nil "today"))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001694 '(calendar-date-string (calendar-current-date) t)
bb715837 Glenn Morris2008-06-17 05:56:48 +00001695 (calendar-mode-line-entry 'calendar-scroll-left "next month" ">"))
2805ba19 Christopher Schmidt2014-09-13 19:44:32 +02001696 "If non-nil, the mode line of the calendar buffer.
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001697This is a list of items that evaluate to strings. The elements
1698are evaluated and concatenated, evenly separated by blanks.
1699During evaluation, the variable `date' is available as the date
1700nearest the cursor (or today's date if that fails). To update
2805ba19
CS
Christopher Schmidt2014-09-13 19:44:32 +02001701the mode-line as the cursor moves, add
1702`calendar-update-mode-line' to `calendar-move-hook'.
1703
1704If nil, do not modify the mode line at all.
1705
1706Here is an example that has the Hebrew date, the day number/days
1707remaining in the year, and the ISO week/year numbers:
a39f5a80 Richard M. Stallman2002-04-03 14:36:02 +00001708
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001709 (list
1710 \"\"
1711 '(calendar-hebrew-date-string date)
1712 '(let* ((year (calendar-extract-year date))
1713 (d (calendar-day-number date))
1714 (days-remaining
1715 (- (calendar-day-number (list 12 31 year)) d)))
1716 (format \"%d/%d\" d days-remaining))
1717 '(let* ((d (calendar-absolute-from-gregorian date))
1718 (iso-date (calendar-iso-from-absolute d)))
1719 (format \"ISO week %d of %d\"
1720 (calendar-extract-month iso-date)
1721 (calendar-extract-year iso-date)))
1722 \"\"))"
1723 :risky t
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001724 :type 'sexp
1725 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001726
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001727(defun calendar-goto-info-node ()
1728 "Go to the info node for the calendar."
1729 (interactive)
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001730 (info "(emacs)Calendar/Diary")
1731 (fit-window-to-buffer))
5d22135b Markus Rost2002-11-16 19:19:35 +00001732
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001733(defvar calendar-mark-ring nil
1734 "Used by `calendar-set-mark'.")
1735
bb715837 Glenn Morris2008-06-17 05:56:48 +00001736(define-derived-mode calendar-mode nil "Calendar"
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001737 "A major mode for the calendar window.
bb715837 Glenn Morris2008-06-17 05:56:48 +00001738For a complete description, see the info node `Calendar/Diary'.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001739
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001740\\<calendar-mode-map>\\{calendar-mode-map}"
bb715837 Glenn Morris2008-06-17 05:56:48 +00001741 (setq buffer-read-only t
aea566be Glenn Morris2008-04-01 02:46:29 +00001742 buffer-undo-list t
f62611de Glenn Morris2008-03-08 03:47:03 +00001743 indent-tabs-mode nil)
536aea70 Glenn Morris2012-01-05 20:03:40 -05001744 (set (make-local-variable 'scroll-margin) 0) ; bug#10379
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001745 (calendar-update-mode-line)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001746 (make-local-variable 'calendar-mark-ring)
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001747 (make-local-variable 'displayed-month) ; month in middle of window
1748 (make-local-variable 'displayed-year) ; year in middle of window
712f4efe
SM
Stefan Monnier2007-07-29 20:49:13 +00001749 ;; Most functions only work if displayed-month and displayed-year are set,
1750 ;; so let's make sure they're always set. Most likely, this will be reset
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001751 ;; soon in calendar-generate, but better safe than sorry.
712f4efe
SM
Stefan Monnier2007-07-29 20:49:13 +00001752 (unless (boundp 'displayed-month) (setq displayed-month 1))
1753 (unless (boundp 'displayed-year) (setq displayed-year 2001))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04001754 (if (bound-and-true-p calendar-font-lock-keywords)
1755 (set (make-local-variable 'font-lock-defaults)
1756 '(calendar-font-lock-keywords t))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001757
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001758(defun calendar-string-spread (strings char length)
cbecb9f9
ER
Edward M. Reingold1995-06-02 22:02:17 +00001759 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
1760The effect is like mapconcat but the separating pieces are as balanced as
1761possible. Each item of STRINGS is evaluated before concatenation so it can
1762actually be an expression that evaluates to a string. If LENGTH is too short,
1763the STRINGS are just concatenated and the result truncated."
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001764;; The algorithm is based on equation (3.25) on page 85 of Concrete
1765;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
21db982b Glenn Morris2008-03-10 02:46:24 +00001766;; Addison-Wesley, Reading, MA, 1989.
cbecb9f9
ER
Edward M. Reingold1995-06-02 22:02:17 +00001767 (let* ((strings (mapcar 'eval
1768 (if (< (length strings) 2)
1769 (append (list "") strings (list ""))
1770 strings)))
3809f91d
GM
Glenn Morris2012-03-13 13:56:31 -04001771 (n (- length (string-width (apply 'concat strings))))
1772 (m (* (1- (length strings)) (char-width char)))
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001773 (s (car strings))
1774 (strings (cdr strings))
1775 (i 0))
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001776 (dolist (string strings)
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001777 (setq s (concat s
1778 (make-string (max 0 (/ (+ n i) m)) char)
df3b40c1
GM
Glenn Morris2008-03-16 01:22:58 +00001779 string)
1780 i (1+ i)))
3809f91d Glenn Morris2012-03-13 13:56:31 -04001781 (truncate-string-to-width s length)))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001782
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001783(defun calendar-update-mode-line ()
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001784 "Update the calendar mode line with the current date and date style."
2805ba19
CS
Christopher Schmidt2014-09-13 19:44:32 +02001785 (if (and calendar-mode-line-format
1786 (bufferp (get-buffer calendar-buffer)))
34cb0115 Stefan Monnier2005-09-12 21:32:11 +00001787 (with-current-buffer calendar-buffer
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001788 (let ((start (- calendar-left-margin 2))
1789 (date (condition-case nil
1790 (calendar-cursor-to-nearest-date)
1791 (error (calendar-current-date)))))
1792 (setq mode-line-format
1793 (concat (make-string (max 0 (+ start
1794 (- (car (window-inside-edges))
1795 (car (window-edges))))) ?\s)
1796 (calendar-string-spread
1797 (mapcar 'eval calendar-mode-line-format)
1798 ?\s (- calendar-right-margin (1- start))))))
a39f5a80 Richard M. Stallman2002-04-03 14:36:02 +00001799 (force-mode-line-update))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001800
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001801(defun calendar-buffer-list ()
27a28b50 Glenn Morris2008-03-14 02:46:37 +00001802 "List of all calendar-related buffers (as buffers, not strings)."
bae5a5a3 Glenn Morris2008-03-13 04:06:47 +00001803 (let (buffs)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001804 (dolist (b (list calendar-hebrew-yahrzeit-buffer lunar-phases-buffer
6e73a6a2 Glenn Morris2008-06-26 22:30:01 +00001805 holiday-buffer diary-fancy-buffer solar-sunrises-buffer
bae5a5a3 Glenn Morris2008-03-13 04:06:47 +00001806 (get-file-buffer diary-file)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001807 calendar-buffer calendar-other-calendars-buffer))
27a28b50 Glenn Morris2008-03-14 02:46:37 +00001808 (and b (setq b (get-buffer b))
bae5a5a3
GM
Glenn Morris2008-03-13 04:06:47 +00001809 (push b buffs)))
1810 buffs))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001811
48c455c7 Sam Steingold2012-06-05 13:33:10 -04001812(defun calendar-exit (&optional kill)
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001813 "Get out of the calendar window and hide it and related buffers."
48c455c7
SS
Sam Steingold2012-06-05 13:33:10 -04001814 (interactive "P")
1815 (let ((diary-buffer (get-file-buffer diary-file))
1816 (calendar-buffers (calendar-buffer-list)))
1817 (when (or (not diary-buffer)
1818 (not (buffer-modified-p diary-buffer))
1819 (yes-or-no-p
1820 "Diary modified; do you really want to exit the calendar? "))
1821 (if (and calendar-setup (display-multi-frame-p))
1822 ;; FIXME: replace this cruft with the `quit-restore' window property
1823 (dolist (w (window-list-1 nil nil t))
1824 (if (and (memq (window-buffer w) calendar-buffers)
1825 (window-dedicated-p w))
5cf983b2
MR
Martin Rudalics2012-06-26 09:13:40 +02001826 (if (eq (window-deletable-p w) 'frame)
1827 (if calendar-remove-frame-by-deleting
1828 (delete-frame (window-frame w))
1829 (iconify-frame (window-frame w)))
1830 (quit-window kill w))))
48c455c7
SS
Sam Steingold2012-06-05 13:33:10 -04001831 (dolist (b calendar-buffers)
1832 (quit-windows-on b kill))))))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001833
3ce82f97
GM
Glenn Morris2009-07-08 02:46:23 +00001834(defun calendar-current-date (&optional offset)
1835 "Return the current date in a list (month day year).
7ef5b8b2
GM
Glenn Morris2009-07-08 02:48:11 +00001836Optional integer OFFSET is a number of days from the current date."
1837 (let* ((now (decode-time))
1838 (now (list (nth 4 now) (nth 3 now) (nth 5 now))))
1839 (if (zerop (or offset 0))
1840 now
1841 (calendar-gregorian-from-absolute
1842 (+ offset (calendar-absolute-from-gregorian now))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001843
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001844(defun calendar-column-to-segment ()
1845 "Convert current column to calendar month \"segment\".
1846The left-most month returns 0, the next right 1, and so on."
1847 (let ((col (max 0 (+ (current-column)
1848 (/ calendar-intermonth-spacing 2)
1849 (- calendar-left-margin)))))
1850 (/ col (+ (* 7 calendar-column-width) calendar-intermonth-spacing))))
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001851
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001852(defun calendar-cursor-to-date (&optional error event)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00001853 "Return a list (month day year) of current cursor position.
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001854If cursor is not on a specific date, signals an error if optional parameter
10979c74
SM
Stefan Monnier2008-06-17 15:42:19 +00001855ERROR is non-nil, otherwise just returns nil.
1856If EVENT is non-nil, it's an event indicating the buffer position to
1857use instead of point."
1858 (with-current-buffer
1859 (if event (window-buffer (posn-window (event-start event)))
1860 (current-buffer))
1861 (save-excursion
2b11fcd5
GM
Glenn Morris2008-06-26 07:08:01 +00001862 (and event (setq event (event-start event))
1863 (goto-char (posn-point event)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001864 (let* ((segment (calendar-column-to-segment))
1865 (month (% (+ displayed-month (1- segment)) 12)))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001866 ;; Call with point on either of the two digits in a 2-digit date,
1867 ;; or on or before the digit of a 1-digit date.
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001868 (if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001869 (get-text-property (point) 'date)))
71873e2b Stefan Monnier2012-05-04 19:16:47 -04001870 (if error (user-error "Not on a date!"))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001871 ;; Convert segment to real month and year.
1872 (if (zerop month) (setq month 12))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001873 ;; Go back to before the first date digit.
1874 (or (looking-at " ")
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001875 (re-search-backward "[^0-9]"))
c93b9aae Edward M. Reingold1994-02-23 02:38:23 +00001876 (list month
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001877 (string-to-number
1878 (buffer-substring (1+ (point))
1879 (+ 1 calendar-day-digit-width (point))))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001880 (cond
1881 ((and (= 12 month) (zerop segment)) (1- displayed-year))
1882 ((and (= 1 month) (= segment 2)) (1+ displayed-year))
1883 (t displayed-year))))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001884
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001885;; The following version of calendar-gregorian-from-absolute is preferred for
1886;; reasons of clarity, BUT it's much slower than the version that follows it.
1887
1888;;(defun calendar-gregorian-from-absolute (date)
1889;; "Compute the list (month day year) corresponding to the absolute DATE.
1890;;The absolute date is the number of days elapsed since the (imaginary)
1891;;Gregorian date Sunday, December 31, 1 BC."
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001892;; (let* ((approx (/ date 366)) ; approximation from below
1893;; (year ; search forward from the approximation
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001894;; (+ approx
1895;; (calendar-sum y approx
1896;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
1897;; 1)))
21db982b Glenn Morris2008-03-10 02:46:24 +00001898;; (month ; search forward from January
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001899;; (1+ (calendar-sum m 1
1900;; (> date
1901;; (calendar-absolute-from-gregorian
1902;; (list m (calendar-last-day-of-month m year) year)))
1903;; 1)))
21db982b Glenn Morris2008-03-10 02:46:24 +00001904;; (day ; calculate the day by subtraction
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001905;; (- date
1906;; (1- (calendar-absolute-from-gregorian (list month 1 year))))))
1907;; (list month day year)))
1908
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001909(defun calendar-gregorian-from-absolute (date)
1910 "Compute the list (month day year) corresponding to the absolute DATE.
1911The absolute date is the number of days elapsed since the (imaginary)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001912Gregorian date Sunday, December 31, 1 BC. This function does not
1913handle dates in years BC."
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001914 ;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
1915 ;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
1916 ;; Clamen, Software--Practice and Experience, Volume 23, Number 4
1917 ;; (April, 1993), pages 383-404 for an explanation.
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001918 (let* ((d0 (1- date))
1919 (n400 (/ d0 146097))
1920 (d1 (% d0 146097))
1921 (n100 (/ d1 36524))
1922 (d2 (% d1 36524))
1923 (n4 (/ d2 1461))
1924 (d3 (% d2 1461))
1925 (n1 (/ d3 365))
1926 (day (1+ (% d3 365)))
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001927 (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1))
1928 (month 1)
1929 mdays)
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001930 (if (or (= n100 4) (= n1 4))
1931 (list 12 31 year)
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001932 (setq year (1+ year))
1933 (while (< (setq mdays (calendar-last-day-of-month month year)) day)
1934 (setq day (- day mdays)
1935 month (1+ month)))
1936 (list month day year))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001937
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001938(defun calendar-other-month (month year &optional event)
1939 "Display a three-month calendar centered around MONTH and YEAR.
1940EVENT is an event like `last-nonmenu-event'."
1941 (interactive (let ((event (list last-nonmenu-event)))
1942 (append (calendar-read-date 'noday) event)))
1943 (save-selected-window
1944 (and event
1945 (setq event (event-start event))
1946 (select-window (posn-window event)))
1947 (unless (and (= month displayed-month)
1948 (= year displayed-year))
1949 (let ((old-date (calendar-cursor-to-date))
1950 (today (calendar-current-date)))
1951 (calendar-generate-window month year)
1952 (calendar-cursor-to-visible-date
1953 (cond
1954 ((calendar-date-is-visible-p old-date) old-date)
1955 ((calendar-date-is-visible-p today) today)
1956 (t (list month 1 year))))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001957
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001958(defun calendar-set-mark (arg &optional event)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001959 "Mark the date under the cursor, or jump to marked date.
1960With no prefix argument, push current date onto marked date ring.
21db982b Glenn Morris2008-03-10 02:46:24 +00001961With argument ARG, jump to mark, pop it, and put point at end of ring."
10979c74
SM
Stefan Monnier2008-06-17 15:42:19 +00001962 (interactive
1963 (list current-prefix-arg last-nonmenu-event))
1964 (let ((date (calendar-cursor-to-date t event)))
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001965 (if arg
1966 (if (null calendar-mark-ring)
1967 (error "No mark set in this buffer")
1968 (calendar-goto-date (car calendar-mark-ring))
1969 (setq calendar-mark-ring
1970 (cdr (nconc calendar-mark-ring (list date)))))
1971 (push date calendar-mark-ring)
1972 ;; Since the top of the mark ring is the marked date in the
1973 ;; calendar, the mark ring in the calendar is one longer than
1974 ;; in other buffers to get the same effect.
1975 (if (> (length calendar-mark-ring) (1+ mark-ring-max))
1976 (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
1977 (message "Mark set"))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001978
1979(defun calendar-exchange-point-and-mark ()
1980 "Exchange the current cursor position with the marked date."
1981 (interactive)
1982 (let ((mark (car calendar-mark-ring))
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001983 (date (calendar-cursor-to-date t)))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001984 (if (null mark)
1985 (error "No mark set in this buffer")
1986 (setq calendar-mark-ring (cons date (cdr calendar-mark-ring)))
1987 (calendar-goto-date mark))))
1988
1989(defun calendar-count-days-region ()
1990 "Count the number of days (inclusive) between point and the mark."
1991 (interactive)
1992 (let* ((days (- (calendar-absolute-from-gregorian
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001993 (calendar-cursor-to-date t))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001994 (calendar-absolute-from-gregorian
1995 (or (car calendar-mark-ring)
1996 (error "No mark set in this buffer")))))
1997 (days (1+ (if (> days 0) days (- days)))))
1998 (message "Region has %d day%s (inclusive)"
1999 days (if (> days 1) "s" ""))))
2000
2001(defun calendar-not-implemented ()
2002 "Not implemented."
2003 (interactive)
2004 (error "%s not available in the calendar"
2005 (global-key-binding (this-command-keys))))
2006
2007(defun calendar-read (prompt acceptable &optional initial-contents)
2008 "Return an object read from the minibuffer.
2009Prompt with the string PROMPT and use the function ACCEPTABLE to decide if
2010entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS
2011is a string to insert in the minibuffer before reading."
2012 (let ((value (read-minibuffer prompt initial-contents)))
2013 (while (not (funcall acceptable value))
2014 (setq value (read-minibuffer prompt initial-contents)))
2015 value))
2016
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002017
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002018(defun calendar-customized-p (symbol)
2019 "Return non-nil if SYMBOL has been customized."
2020 (and (default-boundp symbol)
2021 (let ((standard (get symbol 'standard-value)))
2022 (and standard
2023 (not (equal (eval (car standard)) (default-value symbol)))))))
2024
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04002025(defun calendar-abbrev-construct (full &optional maxlen)
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002026 "From sequence FULL, return a vector of abbreviations.
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002027Each abbreviation is no longer than MAXLEN (default `calendar-abbrev-length')
2028characters."
2029 (or maxlen (setq maxlen calendar-abbrev-length))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002030 (apply 'vector (mapcar
2031 (lambda (f)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002032 ;; TODO? truncate-string-to-width?
2033 (substring f 0 (min maxlen (length f))))
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002034 full)))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002035
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002036(defcustom calendar-day-name-array
b642d11e Edward M. Reingold1998-10-21 20:03:07 +00002037 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002038 "Array of capitalized strings giving, in order from Sunday, the day names.
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002039If you change this without using customize after the calendar has loaded,
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002040then you may also want to change `calendar-day-abbrev-array'
2041and `calendar-day-header-array'."
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002042 :group 'calendar
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002043 :initialize 'custom-initialize-default
2044 :set (lambda (symbol value)
2045 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002046 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2047 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002048 (set symbol value)
2049 (or dcustomized
2050 (setq calendar-day-abbrev-array
2051 (calendar-abbrev-construct calendar-day-name-array)))
2052 (and (not hcustomized)
2053 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002054 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2055 (or ccustomized
2056 (equal calendar-day-header-array
2057 (setq calendar-day-header-array
2058 (calendar-day-header-construct)))
2059 (calendar-redraw))))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00002060 :type '(vector (string :tag "Sunday")
2061 (string :tag "Monday")
2062 (string :tag "Tuesday")
2063 (string :tag "Wednesday")
2064 (string :tag "Thursday")
2065 (string :tag "Friday")
2066 (string :tag "Saturday")))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002067
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002068(defcustom calendar-abbrev-length 3
2069 "Default length of abbreviations to use for day and month names.
2070If you change this without using customize after the calendar has loaded,
2071then you may also want to change `calendar-day-abbrev-array' and
2072`calendar-month-abbrev-array'."
2073 :group 'calendar
2074 :initialize 'custom-initialize-default
2075 :set (lambda (symbol value)
2076 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
2077 (mcustomized (calendar-customized-p
2078 'calendar-month-abbrev-array))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002079 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2080 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002081 (set symbol value)
2082 (or dcustomized
2083 (setq calendar-day-abbrev-array
2084 (calendar-abbrev-construct calendar-day-name-array)))
2085 (or mcustomized
2086 (setq calendar-month-abbrev-array
2087 (calendar-abbrev-construct calendar-month-name-array)))
2088 (and (not hcustomized)
2089 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002090 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2091 (or ccustomized
2092 (equal calendar-day-header-array
2093 (setq calendar-day-header-array
2094 (calendar-day-header-construct)))
2095 (calendar-redraw))))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002096 :type 'integer)
2097
2098(defcustom calendar-day-abbrev-array
2099 (calendar-abbrev-construct calendar-day-name-array)
2100 "Array of capitalized strings giving the abbreviated day names.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002101The order should be the same as that of the full names specified
2102in `calendar-day-name-array'. These abbreviations may be used
2103instead of the full names in the diary file. Do not include a
2104trailing `.' in the strings specified in this variable, though
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002105you may use such in the diary file. By default, each string is
2106the first `calendar-abbrev-length' characters of the corresponding
2107full name."
2108 :group 'calendar
2109 :initialize 'custom-initialize-default
2110 :set-after '(calendar-abbrev-length calendar-day-name-array)
2111 :set (lambda (symbol value)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002112 (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2113 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002114 (set symbol value)
2115 (and (not hcustomized)
2116 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002117 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2118 (or ccustomized
2119 (equal calendar-day-header-array
2120 (setq calendar-day-header-array
2121 (calendar-day-header-construct)))
2122 (calendar-redraw))))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002123 :type '(vector (string :tag "Sun")
2124 (string :tag "Mon")
2125 (string :tag "Tue")
2126 (string :tag "Wed")
2127 (string :tag "Thu")
2128 (string :tag "Fri")
2129 (string :tag "Sat"))
2130 ;; Made defcustom, changed defaults from nil nil...
2131 :version "24.1")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002132
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002133(defcustom calendar-day-header-array (calendar-day-header-construct)
2134 "Array of strings to use for the headers of the calendar's day columns.
2135The order should be the same as in `calendar-day-name-array'.
2136In use, the calendar truncates elements to no more than
2137`calendar-day-header-width' columns wide.
2138Emacs constructs the default from either `calendar-day-name-array'
2139\(if `calendar-day-header-width' is more than `calendar-abbrev-length'),
2140or from `calendar-day-abbrev-array' (assuming that the abbreviated
2141name are more likely to be unique when truncated)."
2142 :group 'calendar
2143 :initialize 'custom-initialize-default
2144 :set-after '(calendar-day-header-width
2145 calendar-abbrev-length calendar-day-name-array
2146 calendar-day-abbrev-array)
2147 :set (lambda (symbol value)
2148 (or (equal calendar-day-header-array
2149 (set symbol value))
2150 (calendar-redraw)))
2151 :type '(vector (string :tag "Su")
2152 (string :tag "Mo")
2153 (string :tag "Tu")
2154 (string :tag "We")
2155 (string :tag "Th")
2156 (string :tag "Fr")
2157 (string :tag "Sa"))
2158 :version "24.4")
2159
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002160(defcustom calendar-month-name-array
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002161 ["January" "February" "March" "April" "May" "June"
b642d11e Edward M. Reingold1998-10-21 20:03:07 +00002162 "July" "August" "September" "October" "November" "December"]
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002163 "Array of capitalized strings giving, in order, the month names.
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002164If you change this without using customize after the calendar has loaded,
2165then you may also want to change `calendar-month-abbrev-array'."
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002166 :group 'calendar
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002167 :initialize 'custom-initialize-default
2168 :set (lambda (symbol value)
2169 (let ((mcustomized (calendar-customized-p
2170 'calendar-month-abbrev-array)))
2171 (set symbol value)
2172 (or mcustomized
2173 (setq calendar-month-abbrev-array
2174 (calendar-abbrev-construct calendar-month-name-array)))))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00002175 :type '(vector (string :tag "January")
2176 (string :tag "February")
2177 (string :tag "March")
2178 (string :tag "April")
2179 (string :tag "May")
2180 (string :tag "June")
2181 (string :tag "July")
2182 (string :tag "August")
2183 (string :tag "September")
2184 (string :tag "October")
2185 (string :tag "November")
2186 (string :tag "December")))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002187
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002188(defcustom calendar-month-abbrev-array
2189 (calendar-abbrev-construct calendar-month-name-array)
2190 "Array of capitalized strings giving the abbreviated month names.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002191The order should be the same as that of the full names specified
2192in `calendar-month-name-array'. These abbreviations are used in
2193the calendar menu entries, and can also be used in the diary
2194file. Do not include a trailing `.' in the strings specified in
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002195this variable, though you may use such in the diary file. By
9d35bb8d Paul Eggert2015-05-19 14:59:15 -07002196default, each string is the first `calendar-abbrev-length'
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002197characters of the corresponding full name."
2198 :group 'calendar
2199 :set-after '(calendar-abbrev-length calendar-month-name-array)
2200 :type '(vector (string :tag "Jan")
2201 (string :tag "Feb")
2202 (string :tag "Mar")
2203 (string :tag "Apr")
2204 (string :tag "May")
2205 (string :tag "Jun")
2206 (string :tag "Jul")
2207 (string :tag "Aug")
2208 (string :tag "Sep")
2209 (string :tag "Oct")
2210 (string :tag "Nov")
2211 (string :tag "Dec"))
2212 ;; Made defcustom, changed defaults from nil nil...
2213 :version "24.1")
2214
2215(defun calendar-make-alist (sequence &optional start-index filter
2216 &rest sequences)
2217 "Return an association list corresponding to SEQUENCE.
2218Associates each element of SEQUENCE with an incremented integer,
2219starting from START-INDEX (default 1). Applies the function FILTER,
2220if provided, to each key in the alist. Repeats the process, with
2221indices starting from START-INDEX each time, for any remaining
2222arguments SEQUENCES."
2223 (or start-index (setq start-index 1))
2224 (let (index alist)
2225 (mapc (lambda (seq)
2226 (setq index start-index)
2227 (mapc (lambda (elem)
2228 (setq alist (cons
2229 (cons (if filter (funcall filter elem) elem)
2230 index)
2231 alist)
2232 index (1+ index)))
2233 seq))
2234 (append (list sequence) sequences))
2235 (reverse alist)))
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002236
2237(defun calendar-read-date (&optional noday)
2238 "Prompt for Gregorian date. Return a list (month day year).
2239If optional NODAY is t, does not ask for day, but just returns
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002240\(month 1 year); if NODAY is any other non-nil value the value returned is
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002241\(month year)"
2242 (let* ((year (calendar-read
2243 "Year (>0): "
2244 (lambda (x) (> x 0))
d92bcf94 Glenn Morris2008-04-08 07:08:24 +00002245 (number-to-string (calendar-extract-year
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002246 (calendar-current-date)))))
2247 (month-array calendar-month-name-array)
2248 (completion-ignore-case t)
2249 (month (cdr (assoc-string
2250 (completing-read
2251 "Month name: "
2252 (mapcar 'list (append month-array nil))
2253 nil t)
2254 (calendar-make-alist month-array 1) t)))
2255 (last (calendar-last-day-of-month month year)))
2256 (if noday
2257 (if (eq noday t)
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002258 (list month 1 year)
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002259 (list month year))
2260 (list month
2261 (calendar-read (format "Day (1-%d): " last)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002262 (lambda (x) (and (< 0 x) (<= x last))))
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002263 year))))
2264
2265(defun calendar-interval (mon1 yr1 mon2 yr2)
2266 "The number of months difference between MON1, YR1 and MON2, YR2.
2267The result is positive if the second date is later than the first.
2268Negative years are interpreted as years BC; -1 being 1 BC, and so on."
2269 (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
2270 (if (< yr2 0) (setq yr2 (1+ yr2)))
2271 (+ (* 12 (- yr2 yr1))
2272 (- mon2 mon1)))
2273
8a806f04 Glenn Morris2013-08-06 20:06:43 -04002274(defvar calendar-font-lock-keywords nil
5d22135b
MR
Markus Rost2002-11-16 19:19:35 +00002275 "Default keywords to highlight in Calendar mode.")
2276
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002277(make-obsolete-variable 'calendar-font-lock-keywords
2278 "set font-lock keywords in `calendar-mode-hook', \
2279or customize calendar faces." "24.4")
2280
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002281(defun calendar-day-name (date &optional abbrev absolute)
e0dfc625 Richard M. Stallman2002-12-07 21:30:57 +00002282 "Return a string with the name of the day of the week of DATE.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002283DATE should be a list in the format (MONTH DAY YEAR), unless the
2284optional argument ABSOLUTE is non-nil, in which case DATE should
2285be an integer in the range 0 to 6 corresponding to the day of the
2286week. Day names are taken from the variable `calendar-day-name-array',
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002287unless the optional argument ABBREV is non-nil:
2288`header' means to use `calendar-day-header-array';
2289t to use `calendar-day-abbrev-array'."
2290 (aref (cond ((eq abbrev 'header) calendar-day-header-array)
2291 (abbrev calendar-day-abbrev-array)
2292 (t calendar-day-name-array))
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002293 (if absolute date (calendar-day-of-week date))))
2294
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002295(defun calendar-month-name (month &optional abbrev)
2296 "Return a string with the name of month number MONTH.
2297Months are numbered from one. Month names are taken from the
2298variable `calendar-month-name-array', unless the optional
2299argument ABBREV is non-nil, in which case
2300`calendar-month-abbrev-array' is used."
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002301 (aref (if abbrev calendar-month-abbrev-array calendar-month-name-array)
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002302 (1- month)))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002303
2304(defun calendar-day-of-week (date)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00002305 "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
2306DATE is a list of the form (month day year). A negative year is
2307interpreted as BC; -1 being 1 BC, and so on."
2308 (mod (calendar-absolute-from-gregorian date) 7))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002309
3260caf8
GM
Glenn Morris2010-07-10 16:34:57 -07002310(defun calendar-week-end-day ()
2311 "Return the index (0 for Sunday, etc.) of the last day of the week."
2312 (mod (+ calendar-week-start-day 6) 7))
2313
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002314(defun calendar-unmark ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002315 "Delete all diary/holiday marks/highlighting from the calendar."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002316 (interactive)
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002317 (setq calendar-mark-holidays-flag nil
2318 calendar-mark-diary-entries-flag nil)
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002319 (with-current-buffer calendar-buffer
2320 (mapc 'delete-overlay (overlays-in (point-min) (point-max)))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002321
2322(defun calendar-date-is-visible-p (date)
f6c762dd
GM
Glenn Morris2008-03-31 07:11:00 +00002323 "Return non-nil if DATE is valid and is visible in the calendar window."
2324 (and (calendar-date-is-valid-p date)
2325 (< (abs (calendar-interval
2326 displayed-month displayed-year
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002327 (calendar-extract-month date) (calendar-extract-year date)))
f6c762dd Glenn Morris2008-03-31 07:11:00 +00002328 2)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002329
7717093c Glenn Morris2008-04-23 02:59:47 +00002330;; FIXME can this be generalized for holiday-chinese?
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002331(defun calendar-nongregorian-visible-p (month day toabs fromabs switch)
2332 "Return non-nil if MONTH, DAY is visible in the calendar window.
2333MONTH and DAY are in some non-Gregorian calendar system. The
2334functions TOABS and FROMABS convert that system to and from
2335absolute, respectively. SWITCH is a function that takes a single
2336argument (a local month number). It applies when the local year
2337changes across the calendar window, and returns non-nil if the
2338specified month should be associated with the higher year.
2339Returns the corresponding Gregorian date."
2340 ;; We need to choose the local year associated with month and day
2341 ;; that might make them visible.
2342 (let* ((m1 displayed-month)
2343 (y1 displayed-year)
2344 (m2 displayed-month)
2345 (y2 displayed-year)
2346 ;; Absolute date of first/last dates in calendar window.
2347 (start-date (progn
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002348 (calendar-increment-month m1 y1 -1)
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002349 (calendar-absolute-from-gregorian (list m1 1 y1))))
2350 (end-date (progn
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002351 (calendar-increment-month m2 y2 1)
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002352 (calendar-absolute-from-gregorian
2353 (list m2 (calendar-last-day-of-month m2 y2) y2))))
2354 ;; Local date of first/last date in calendar window.
2355 (local-start (funcall fromabs start-date))
2356 (local-end (funcall fromabs end-date))
2357 ;; Local year of first/last dates.
2358 ;; Can only differ if displayed-month = 12, 1, 2.
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002359 (local-y1 (calendar-extract-year local-start))
2360 (local-y2 (calendar-extract-year local-end))
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002361 ;; Choose which year might be visible in the window.
2362 ;; Obviously it only matters when y1 and y2 differ, ie
2363 ;; when the _local_ new year is visible.
2364 (year (if (funcall switch month) local-y2 local-y1))
2365 (date (calendar-gregorian-from-absolute
2366 (funcall toabs (list month day year)))))
2367 (if (calendar-date-is-visible-p date)
2368 date)))
2369
0368765e Juanma Barranquero2008-03-06 15:01:24 +00002370(defun calendar-date-is-valid-p (date)
9f556e44 Werner LEMBERG2005-03-25 09:53:47 +00002371 "Return t if DATE is a valid date."
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002372 (let ((month (calendar-extract-month date))
2373 (day (calendar-extract-day date))
2374 (year (calendar-extract-year date)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002375 (and (<= 1 month) (<= month 12)
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002376 ;; (calendar-read-date t) used to return a date with day = nil.
21f8fcfd
GM
Glenn Morris2006-05-11 06:57:32 +00002377 ;; Should not be valid (?), since many funcs prob assume integer.
2378 ;; (calendar-read-date 'noday) returns (month year), which
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002379 ;; currently results in calendar-extract-year returning nil.
21f8fcfd Glenn Morris2006-05-11 06:57:32 +00002380 day year (<= 1 day) (<= day (calendar-last-day-of-month month year))
9f556e44 Werner LEMBERG2005-03-25 09:53:47 +00002381 ;; BC dates left as non-valid, to suppress errors from
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00002382 ;; complex holiday algorithms not suitable for years BC.
2383 ;; Note there are side effects on calendar navigation.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002384 (<= 1 year))))
2385
2386(defun calendar-date-equal (date1 date2)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002387 "Return t if the DATE1 and DATE2 are the same."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002388 (and
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002389 (= (calendar-extract-month date1) (calendar-extract-month date2))
2390 (= (calendar-extract-day date1) (calendar-extract-day date2))
2391 (= (calendar-extract-year date1) (calendar-extract-year date2))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002392
c899d5e3
GM
Glenn Morris2008-04-01 04:10:09 +00002393(defun calendar-make-temp-face (attrlist)
2394 "Return a temporary face based on the attributes in ATTRLIST.
2395ATTRLIST is a list with elements of the form :face face :foreground color."
8fe97050
GM
Glenn Morris2008-04-01 07:25:42 +00002396 (let ((attrs attrlist)
2397 faceinfo face temp-face)
2398 ;; Separate :face from the other attributes. Use the last :face
2399 ;; if there are more than one. FIXME is merging meaningful?
2400 (while attrs
2401 (if (eq (car attrs) :face)
2402 (setq face (intern-soft (cadr attrs))
2403 attrs (cddr attrs))
2404 (push (car attrs) faceinfo)
2405 (setq attrs (cdr attrs))))
2406 (or (facep face) (setq face 'default))
2407 (if (not faceinfo)
2408 ;; No attributes to apply, so just use an existing-face.
2409 face
2410 ;; FIXME should we be using numbered temp-faces, re-using where poss?
2411 (setq temp-face
2412 (make-symbol
2413 (concat ":caltemp"
2414 (mapconcat (lambda (sym)
2415 (cond
2416 ((symbolp sym) (symbol-name sym))
2417 ((numberp sym) (number-to-string sym))
2418 (t sym)))
2419 attrlist ""))))
2420 (make-face temp-face)
2421 (copy-face face temp-face)
2422 ;; Apply the font aspects.
2423 (apply 'set-face-attribute temp-face nil (nreverse faceinfo))
2424 temp-face)))
c899d5e3 Glenn Morris2008-04-01 04:10:09 +00002425
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002426(defun calendar-mark-visible-date (date &optional mark)
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002427 "Mark DATE in the calendar window with MARK.
d13c1378 Juanma Barranquero2003-02-11 23:23:10 +00002428MARK is a single-character string, a list of face attributes/values, or a face.
5d22135b Markus Rost2002-11-16 19:19:35 +00002429MARK defaults to `diary-entry-marker'."
0368765e Juanma Barranquero2008-03-06 15:01:24 +00002430 (if (calendar-date-is-valid-p date)
f09cfd28
SM
Stefan Monnier2005-09-19 17:41:22 +00002431 (with-current-buffer calendar-buffer
2432 (save-excursion
2433 (calendar-cursor-to-visible-date date)
2434 (setq mark
2435 (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
6ed17433
GM
Glenn Morris2009-02-08 01:52:01 +00002436 ;; The next two use to also check font-lock-mode.
2437 ;; See comments above diary-entry-marker for why
2438 ;; this was dropped.
2439;;; (and font-lock-mode
2440;;; (or
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00002441 (and (listp mark) (> (length mark) 0) mark) ; attrs
6ed17433
GM
Glenn Morris2009-02-08 01:52:01 +00002442 (and (facep mark) mark) ; )) face-name
2443 diary-entry-marker))
f09cfd28 Stefan Monnier2005-09-19 17:41:22 +00002444 (cond
21db982b Glenn Morris2008-03-10 02:46:24 +00002445 ;; Face or an attr-list that contained a face.
f09cfd28
SM
Stefan Monnier2005-09-19 17:41:22 +00002446 ((facep mark)
2447 (overlay-put
2448 (make-overlay (1- (point)) (1+ (point))) 'face mark))
aea566be Glenn Morris2008-04-01 02:46:29 +00002449 ;; Single-character mark, goes after the date.
f09cfd28 Stefan Monnier2005-09-19 17:41:22 +00002450 ((and (stringp mark) (= (length mark) 1))
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002451 (overlay-put
2452 (make-overlay (1+ (point)) (+ 2 (point))) 'display mark))
21db982b Glenn Morris2008-03-10 02:46:24 +00002453 (t ; attr list
c899d5e3
GM
Glenn Morris2008-04-01 04:10:09 +00002454 (overlay-put
2455 (make-overlay (1- (point)) (1+ (point))) 'face
2456 (calendar-make-temp-face mark))))))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002457
2458(defun calendar-star-date ()
2459 "Replace the date under the cursor in the calendar window with asterisks.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002460You might want to add this function to `calendar-today-visible-hook'."
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002461 (unless (catch 'found
2462 (dolist (ol (overlays-at (point)))
2463 (and (overlay-get ol 'calendar-star)
2464 (throw 'found t))))
2465 (let ((ol (make-overlay (1- (point)) (point))))
2466 (overlay-put ol 'display "*")
2467 (overlay-put ol 'calendar-star t)
2468 ;; Use copy-sequence to avoid merging of identical 'display props.
2469 ;; Use two overlays so as not to mess up
2470 ;; calendar-cursor-to-nearest-date (and calendar-forward-day).
2471 (overlay-put (setq ol (make-overlay (point) (1+ (point))))
2472 'display (copy-sequence "*"))
2473 (overlay-put ol 'calendar-star t))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002474
2475(defun calendar-mark-today ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002476 "Mark the date under the cursor in the calendar window.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002477The date is marked with `calendar-today-marker'. You might want to add
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002478this function to `calendar-today-visible-hook'."
2479 (calendar-mark-visible-date (calendar-cursor-to-date) calendar-today-marker))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002480
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +00002481;; FIXME why the car? Almost every usage calls list on the args.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002482(defun calendar-date-compare (date1 date2)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002483 "Return t if DATE1 is before DATE2, nil otherwise.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002484The actual dates are in the car of DATE1 and DATE2."
2485 (< (calendar-absolute-from-gregorian (car date1))
2486 (calendar-absolute-from-gregorian (car date2))))
2487
2488(defun calendar-date-string (date &optional abbreviate nodayname)
2489 "A string form of DATE, driven by the variable `calendar-date-display-form'.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002490An optional parameter ABBREVIATE, when non-nil, causes the month
2491and day names to be abbreviated as specified by
2492`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
2493respectively. An optional parameter NODAYNAME, when t, omits the
2494name of the day of the week."
40802b08 Glenn Morris2008-03-15 03:00:17 +00002495 (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002496 (month (calendar-extract-month date))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002497 (monthname (calendar-month-name month abbreviate))
d92bcf94
GM
Glenn Morris2008-04-08 07:08:24 +00002498 (day (number-to-string (calendar-extract-day date)))
2499 (month (number-to-string month))
2500 (year (number-to-string (calendar-extract-year date))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002501 (mapconcat 'eval calendar-date-display-form "")))
2502
2503(defun calendar-dayname-on-or-before (dayname date)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002504 "Return the absolute date of the DAYNAME on or before absolute DATE.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002505DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
2506
2507Note: Applying this function to d+6 gives us the DAYNAME on or after an
2508absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to
2509absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
2510date d, and applying it to d+7 gives the DAYNAME following absolute date d."
2511 (- date (% (- date dayname) 7)))
2512
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002513(defun calendar-nth-named-absday (n dayname month year &optional day)
e7057568
GM
Glenn Morris2008-04-29 03:34:17 +00002514 "Absolute date of the Nth DAYNAME after/before MONTH YEAR DAY.
2515A DAYNAME of 0 means Sunday, 1 means Monday, and so on.
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002516If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
e7057568
GM
Glenn Morris2008-04-29 03:34:17 +00002517If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
2518DAY defaults to 1 if N>0, and MONTH's last day otherwise."
04d5d338
PE
Paul Eggert1993-08-28 04:14:25 +00002519 (if (> n 0)
2520 (+ (* 7 (1- n))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002521 (calendar-dayname-on-or-before
2522 dayname
2523 (+ 6 (calendar-absolute-from-gregorian
2524 (list month (or day 1) year)))))
04d5d338
PE
Paul Eggert1993-08-28 04:14:25 +00002525 (+ (* 7 (1+ n))
2526 (calendar-dayname-on-or-before
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002527 dayname
2528 (calendar-absolute-from-gregorian
2529 (list month
2530 (or day (calendar-last-day-of-month month year))
2531 year))))))
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002532
354d0644 Jim Blandy1993-06-22 03:22:12 +00002533(defun calendar-nth-named-day (n dayname month year &optional day)
e7057568 Glenn Morris2008-04-29 03:34:17 +00002534 "Date of the Nth DAYNAME after/before MONTH YEAR DAY.
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00002535Like `calendar-nth-named-absday', but returns a Gregorian date."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002536 (calendar-gregorian-from-absolute
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002537 (calendar-nth-named-absday n dayname month year day)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002538
6a2aa94c
RS
Richard M. Stallman1994-01-30 00:25:00 +00002539(defun calendar-day-of-year-string (&optional date)
2540 "String of day number of year of Gregorian DATE.
2541Defaults to today's date if DATE is not given."
2542 (let* ((d (or date (calendar-current-date)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002543 (year (calendar-extract-year d))
6a2aa94c
RS
Richard M. Stallman1994-01-30 00:25:00 +00002544 (day (calendar-day-number d))
2545 (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
2546 (format "Day %d of %d; %d day%s remaining in the year"
2547 day year days-remaining (if (= days-remaining 1) "" "s"))))
2548
5968ae93
GM
Glenn Morris2008-03-20 04:41:47 +00002549(defun calendar-other-dates (date)
2550 "Return a list of strings giving Gregorian DATE in other calendars.
2551DATE is (month day year). Calendars that do not apply are omitted."
2552 (let (odate)
2553 (delq nil
2554 (list
2555 (calendar-day-of-year-string date)
2556 (format "ISO date: %s" (calendar-iso-date-string date))
2557 (format "Julian date: %s"
2558 (calendar-julian-date-string date))
2559 (format "Astronomical (Julian) day number (at noon UTC): %s.0"
2560 (calendar-astro-date-string date))
2561 (format "Fixed (RD) date: %s"
2562 (calendar-absolute-from-gregorian date))
2563 (format "Hebrew date (before sunset): %s"
2564 (calendar-hebrew-date-string date))
2565 (format "Persian date: %s"
2566 (calendar-persian-date-string date))
2567 (unless (string-equal
2568 (setq odate (calendar-islamic-date-string date))
2569 "")
2570 (format "Islamic date (before sunset): %s" odate))
2571 (unless (string-equal
2572 (setq odate (calendar-bahai-date-string date))
2573 "")
6818b449 Glenn Morris2012-02-17 22:08:15 -05002574 (format "Bahá'í date: %s" odate))
5968ae93
GM
Glenn Morris2008-03-20 04:41:47 +00002575 (format "Chinese date: %s"
2576 (calendar-chinese-date-string date))
2577 (unless (string-equal
2578 (setq odate (calendar-coptic-date-string date))
2579 "")
2580 (format "Coptic date: %s" odate))
2581 (unless (string-equal
2582 (setq odate (calendar-ethiopic-date-string date))
2583 "")
2584 (format "Ethiopic date: %s" odate))
2585 (unless (string-equal
2586 (setq odate (calendar-french-date-string date))
2587 "")
2588 (format "French Revolutionary date: %s" odate))
2589 (format "Mayan date: %s"
2590 (calendar-mayan-date-string date))))))
2591
e8a11b22 Glenn Morris2009-11-10 08:11:47 +00002592(declare-function x-popup-menu "menu.c" (position menu))
f2d9c15f Glenn Morris2008-08-11 01:23:07 +00002593
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002594(defun calendar-print-other-dates (&optional event)
2595 "Show dates on other calendars for date under the cursor.
2596If called by a mouse-event, pops up a menu with the result."
2597 (interactive (list last-nonmenu-event))
2598 (let* ((date (calendar-cursor-to-date t event))
2599 (title (format "%s (Gregorian)" (calendar-date-string date)))
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002600 (others (calendar-other-dates date))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002601 selection)
2602 (if (mouse-event-p event)
2603 (and (setq selection (cal-menu-x-popup-menu event title
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002604 (mapcar 'list others)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002605 (call-interactively selection))
2606 (calendar-in-read-only-buffer calendar-other-calendars-buffer
2607 (calendar-set-mode-line title)
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002608 (insert (mapconcat 'identity others "\n"))))))
726669d8 Edward M. Reingold1998-05-27 20:18:40 +00002609
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002610(defun calendar-print-day-of-year ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002611 "Show day number in year/days remaining in year for date under the cursor."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002612 (interactive)
274f1353 David Kastrup2007-12-08 01:02:29 +00002613 (message "%s" (calendar-day-of-year-string (calendar-cursor-to-date t))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002614
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00002615(defun calendar-set-mode-line (str)
2616 "Set mode line to STR, centered, surrounded by dashes."
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00002617 (let* ((edges (window-edges))
d519ea8a Glenn Morris2004-03-24 18:37:08 +00002618 ;; As per doc of window-width, total visible mode-line length.
40802b08 Glenn Morris2008-03-15 03:00:17 +00002619 (width (- (nth 2 edges) (car edges))))
fa262b58
GM
Glenn Morris2009-02-11 04:02:16 +00002620 ;; Hack for --daemon. See bug #2199.
2621 ;; If no frame exists yet, we have no idea what width to use.
2622 (and (= width 10)
2623 (not window-system)
24679323 Adam Spiers2012-03-05 21:18:29 -05002624 (setq width (string-to-number (or (getenv "COLUMNS") "80"))))
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00002625 (setq mode-line-format
2626 (if buffer-file-name
2627 `("-" mode-line-modified
2628 ,(calendar-string-spread (list str) ?- (- width 6))
2629 "---")
2630 (calendar-string-spread (list str) ?- width)))))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002631
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002632(run-hooks 'calendar-load-hook)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002633
2634(provide 'calendar)
2635
34cb0115
SM
Stefan Monnier2005-09-12 21:32:11 +00002636;; Local variables:
2637;; byte-compile-dynamic: t
6818b449 Glenn Morris2012-02-17 22:08:15 -05002638;; coding: utf-8
34cb0115 Stefan Monnier2005-09-12 21:32:11 +00002639;; End:
b578f267 Erik Naggum1996-01-14 07:34:30 +00002640
94b304d7 Richard M. Stallman1992-06-03 02:55:55 +00002641;;; calendar.el ends here