Fix mouse pointer on w32 when a menu is active
[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
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000193(defcustom calendar-view-diary-initially-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000194 "Non-nil means display current date's diary entries on entry to calendar.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000195The diary is displayed in another window when the calendar is first displayed,
196if the current date is visible. The number of days of diary entries displayed
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000197is governed by the variable `diary-number-of-entries'. This variable can
1293540e Glenn Morris2004-01-11 22:26:46 +0000198be overridden by the value of `calendar-setup'."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000199 :type 'boolean
200 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000201
6ed17433 Glenn Morris2009-02-08 01:52:01 +0000202;; FIXME :set
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000203(defcustom calendar-mark-diary-entries-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000204 "Non-nil means mark dates with diary entries, in the calendar window.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000205The marking symbol is specified by the variable `diary-entry-marker'."
206 :type 'boolean
207 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000208
f49f2a9e Glenn Morris2008-03-25 03:42:55 +0000209(defcustom calendar-remove-frame-by-deleting t
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000210 "Determine how the calendar mode removes a frame no longer needed.
7e1e5cf1
SS
Sam Steingold1999-11-12 16:05:16 +0000211If nil, make an icon of the frame. If non-nil, delete the frame."
212 :type 'boolean
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +0000213 :version "23.1" ; changed from nil to t
214 :group 'view
215 :group 'calendar)
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +0000216
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000217(defface calendar-today
218 '((t (:underline t)))
1f1e454e Glenn Morris2008-04-12 03:11:03 +0000219 "Face for indicating today's date in the calendar.
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000220See the variable `calendar-today-marker'."
1f1e454e Glenn Morris2008-04-12 03:11:03 +0000221 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000222
75eb05f6 Miles Bader2005-06-10 10:43:42 +0000223(defface diary
ea81d57e
DN
Dan Nicolaescu2005-04-08 14:26:13 +0000224 '((((min-colors 88) (class color) (background light))
225 :foreground "red1")
226 (((class color) (background light))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000227 :foreground "red")
ea81d57e
DN
Dan Nicolaescu2005-04-08 14:26:13 +0000228 (((min-colors 88) (class color) (background dark))
229 :foreground "yellow1")
9c887ada Miles Bader2000-11-03 03:30:49 +0000230 (((class color) (background dark))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000231 :foreground "yellow")
9c887ada Miles Bader2000-11-03 03:30:49 +0000232 (t
1fd714a4 Richard M. Stallman2001-12-31 20:44:44 +0000233 :weight bold))
1f1e454e
GM
Glenn Morris2008-04-12 03:11:03 +0000234 "Face for highlighting diary entries.
235Used to mark diary entries in the calendar (see `diary-entry-marker'),
236and to highlight the date header in the fancy diary."
237 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000238
75eb05f6 Miles Bader2005-06-10 10:43:42 +0000239(defface holiday
9c887ada Miles Bader2000-11-03 03:30:49 +0000240 '((((class color) (background light))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000241 :background "pink")
9c887ada Miles Bader2000-11-03 03:30:49 +0000242 (((class color) (background dark))
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000243 :background "chocolate4")
9c887ada Miles Bader2000-11-03 03:30:49 +0000244 (t
42121c23 ShengHuo ZHU2000-11-05 03:49:38 +0000245 :inverse-video t))
1f1e454e
GM
Glenn Morris2008-04-12 03:11:03 +0000246 "Face for indicating in the calendar dates that have holidays.
247See `calendar-holiday-marker'."
248 :group 'calendar-faces)
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +0000249
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400250(defface calendar-weekday-header '((t :inherit font-lock-constant-face))
251 "Face used for weekday column headers in the calendar.
252See also the face `calendar-weekend-header'."
253 :version "24.4"
254 :group 'calendar-faces)
255
256(defface calendar-weekend-header '((t :inherit font-lock-comment-face))
257 "Face used for weekend column headers in the calendar.
258See also the face `calendar-weekday-header'."
259 :version "24.4"
260 :group 'calendar-faces)
261
262(defface calendar-month-header '((t :inherit font-lock-function-name-face))
263 "Face used for month headers in the calendar."
264 :version "24.4"
265 :group 'calendar-faces)
266
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000267;; These briefly checked font-lock-mode, but that is broken, since it
268;; is a buffer-local variable, and which buffer happens to be current
269;; when this file is loaded shouldn't make a difference. One could
270;; perhaps check global-font-lock-mode, or font-lock-global-modes; but
271;; this feature doesn't use font-lock, so there's no real reason it
272;; should respect those either. See bug#2199.
273;; They also used to check display-color-p, but that is a problem if
274;; loaded from --daemon. Since BW displays are rare now, this was
275;; also taken out. The way to keep it would be to have nil mean do a
276;; runtime check whenever this variable is used.
277(defcustom diary-entry-marker 'diary
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000278 "How to mark dates that have diary entries.
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000279The value can be either a single-character string (e.g. \"+\") or a face."
280 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000281 :group 'diary
282 :version "23.1")
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +0000283
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000284(defcustom calendar-today-marker 'calendar-today
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000285 "How to mark today's date in the calendar.
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000286The value can be either a single-character string (e.g. \"=\") or a face.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000287Used by `calendar-mark-today'."
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000288 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000289 :group 'calendar
290 :version "23.1")
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +0000291
bdc3df30 Glenn Morris2009-02-09 07:52:54 +0000292(defcustom calendar-holiday-marker 'holiday
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000293 "How to mark notable dates in the calendar.
bdc3df30
GM
Glenn Morris2009-02-09 07:52:54 +0000294The value can be either a single-character string (e.g. \"*\") or a face."
295 :type '(choice (string :tag "Single character string") face)
833374ea
GM
Glenn Morris2009-02-09 17:26:21 +0000296 :group 'holidays
297 :version "23.1")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000298
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000299(defcustom calendar-view-holidays-initially-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000300 "Non-nil means display holidays for current three month period on entry.
354d0644 Jim Blandy1993-06-22 03:22:12 +0000301The holidays are displayed in another window when the calendar is first
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000302displayed."
303 :type 'boolean
304 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000305
6ed17433 Glenn Morris2009-02-08 01:52:01 +0000306;; FIXME :set
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000307(defcustom calendar-mark-holidays-flag nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000308 "Non-nil means mark dates of holidays in the calendar window.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000309The marking symbol is specified by the variable `calendar-holiday-marker'."
310 :type 'boolean
311 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000312
c8a9e437
GM
Glenn Morris2007-03-27 02:36:25 +0000313(defcustom calendar-mode-hook nil
314 "Hook run when entering `calendar-mode'."
315 :type 'hook
316 :group 'calendar-hooks)
317
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000318(defcustom calendar-load-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000319 "List of functions to be called after the calendar is first loaded.
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000320This is the place to add key bindings to `calendar-mode-map'."
321 :type 'hook
322 :group 'calendar-hooks)
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000323
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000324(defcustom calendar-initial-window-hook nil
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000325 "List of functions to be called when the calendar window is created.
acab8b97 Glenn Morris2008-03-18 03:35:58 +0000326Quitting the calendar and re-entering it will cause these functions
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000327to be called again."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000328 :type 'hook
329 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000330
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000331(defcustom calendar-today-visible-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000332 "List of functions called whenever the current date is visible.
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +0000333To mark today's date, add the function `calendar-mark-today'.
334To replace the date with asterisks, add the function `calendar-star-date'.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000335See also `calendar-today-invisible-hook'.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000336
acab8b97
GM
Glenn Morris2008-03-18 03:35:58 +0000337In general, be careful about changing characters in the calendar buffer,
338since it may cause the movement commands to fail."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000339 :type 'hook
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000340 :options '(calendar-mark-today calendar-star-date)
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000341 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000342
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000343(defcustom calendar-today-invisible-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000344 "List of functions called whenever the current date is not visible.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000345See also `calendar-today-visible-hook'."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000346 :type 'hook
347 :group 'calendar-hooks)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000348
5c9705e5 Richard M. Stallman1999-08-28 15:18:39 +0000349(defcustom calendar-move-hook nil
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000350 "List of functions called whenever the cursor moves in the calendar.
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +0000351For example,
5c9705e5 Richard M. Stallman1999-08-28 15:18:39 +0000352
34cb0115 Stefan Monnier2005-09-12 21:32:11 +0000353 (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
5c9705e5
RS
Richard M. Stallman1999-08-28 15:18:39 +0000354
355redisplays the diary for whatever date the cursor is moved to."
356 :type 'hook
bb715837 Glenn Morris2008-06-17 05:56:48 +0000357 :options '(calendar-update-mode-line)
5c9705e5
RS
Richard M. Stallman1999-08-28 15:18:39 +0000358 :group 'calendar-hooks)
359
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000360(defcustom calendar-date-echo-text
361 "mouse-2: general menu\nmouse-3: menu for this date"
362 "String displayed when the cursor is over a date in the calendar.
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000363Can be either a fixed string, or a lisp expression that returns one.
364When this expression is evaluated, DAY, MONTH, and YEAR are
bb715837 Glenn Morris2008-06-17 05:56:48 +0000365integers appropriate to the relevant date. For example, to
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000366display the ISO date:
367
368 (setq calendar-date-echo-text '(format \"ISO date: %s\"
369 (calendar-iso-date-string
370 (list month day year))))
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000371Changing this variable without using customize has no effect on
372pre-existing calendar windows."
373 :group 'calendar
374 :initialize 'custom-initialize-default
375 :risky t
376 :set (lambda (sym val)
377 (set sym val)
378 (calendar-redraw))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000379 :type '(choice (string :tag "Fixed string")
380 (sexp :value
381 (format "ISO date: %s"
382 (calendar-iso-date-string
383 (list month day year)))))
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +0000384 :version "23.1")
385
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000386
387(defvar calendar-month-digit-width nil
388 "Width of the region with numbers in each month in the calendar.")
389
390(defvar calendar-month-width nil
391 "Full width of each month in the calendar.")
392
393(defvar calendar-right-margin nil
394 "Right margin of the calendar.")
395
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000396(defvar calendar-month-edges nil
397 "Alist of month edge columns.
398Each element has the form (N LEFT FIRST LAST RIGHT), where
399LEFT is the leftmost column associated with month segment N,
400FIRST and LAST are the first and last columns with day digits in,
401and LAST is the rightmost column.")
402
403(defun calendar-month-edges (segment)
404 "Compute the month edge columns for month SEGMENT.
405Returns a list (LEFT FIRST LAST RIGHT), where LEFT is the
406leftmost column associated with a month, FIRST and LAST are the
407first and last columns with day digits in, and LAST is the
408rightmost column."
409 ;; The leftmost column with a digit in it in this month segment.
410 (let* ((first (+ calendar-left-margin
411 (* segment calendar-month-width)))
412 ;; The rightmost column with a digit in it in this month segment.
413 (last (+ first (1- calendar-month-digit-width)))
414 (left (if (eq segment 0)
415 0
416 (+ calendar-left-margin
417 (* segment calendar-month-width)
418 (- (/ calendar-intermonth-spacing 2)))))
419 ;; The rightmost edge of this month segment, dividing the
420 ;; space between months in two.
421 (right (+ calendar-left-margin
422 (* (1+ segment) calendar-month-width)
423 (- (/ calendar-intermonth-spacing 2)))))
424 (list left first last right)))
425
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000426(defun calendar-recompute-layout-variables ()
427 "Recompute some layout-related calendar \"constants\"."
428 (setq calendar-month-digit-width (+ (* 6 calendar-column-width)
429 calendar-day-digit-width)
430 calendar-month-width (+ (* 7 calendar-column-width)
431 calendar-intermonth-spacing)
432 calendar-right-margin (+ calendar-left-margin
433 (* 3 (* 7 calendar-column-width))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +0000434 (* 2 calendar-intermonth-spacing))
435 calendar-month-edges nil)
436 (dotimes (i 3)
437 (push (cons i (calendar-month-edges i)) calendar-month-edges))
438 (setq calendar-month-edges (reverse calendar-month-edges)))
0c74d40b Glenn Morris2008-06-21 19:28:09 +0000439
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000440(defun calendar-set-layout-variable (symbol value &optional minmax)
441 "Set SYMBOL's value to VALUE, an integer.
442A positive/negative MINMAX enforces a minimum/maximum value.
443Then redraw the calendar, if necessary."
444 (let ((oldvalue (symbol-value symbol)))
445 (custom-set-default symbol (if minmax
446 (if (< minmax 0)
447 (min value (- minmax))
448 (max value minmax))
449 value))
450 (unless (equal value oldvalue)
451 (calendar-recompute-layout-variables)
452 (calendar-redraw))))
453
454(defcustom calendar-left-margin 5
455 "Empty space to the left of the first month in the calendar."
456 :group 'calendar
457 :initialize 'custom-initialize-default
458 :set 'calendar-set-layout-variable
459 :type 'integer
460 :version "23.1")
461
462;; Or you can view it as columns of width 2, with 1 space, no space
463;; after the last column, and a 5 space gap between month.
464;; FIXME check things work if this is odd.
465(defcustom calendar-intermonth-spacing 4
466 "Space between months in the calendar. Minimum value is 1."
467 :group 'calendar
468 :initialize 'custom-initialize-default
469 :set (lambda (sym val)
470 (calendar-set-layout-variable sym val 1))
471 :type 'integer
472 :version "23.1")
473
b1c172fe Glenn Morris2008-06-26 03:41:20 +0000474;; FIXME calendar-month-column-width?
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000475(defcustom calendar-column-width 3
476 "Width of each day column in the calendar. Minimum value is 3."
477 :initialize 'custom-initialize-default
478 :set (lambda (sym val)
479 (calendar-set-layout-variable sym val 3))
480 :type 'integer
481 :version "23.1")
482
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400483(defun calendar-day-header-construct (&optional width)
484 "Return the default value for `calendar-day-header-array'.
485WIDTH defaults to `calendar-day-header-width'."
486 (or width (setq width calendar-day-header-width))
487 (calendar-abbrev-construct (if (<= width calendar-abbrev-length)
488 calendar-day-abbrev-array
489 calendar-day-name-array)
490 width))
491
492;; FIXME better to use a format spec?
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000493(defcustom calendar-day-header-width 2
494 "Width of the day column headers in the calendar.
495Must be at least one less than `calendar-column-width'."
496 :group 'calendar
497 :initialize 'custom-initialize-default
498 :set (lambda (sym val)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -0400499 (or (calendar-customized-p 'calendar-day-header-array)
500 (setq calendar-day-header-array
501 (calendar-day-header-construct val)))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +0000502 (calendar-set-layout-variable sym val (- 1 calendar-column-width)))
503 :type 'integer
504 :version "23.1")
505
506;; FIXME a format specifier instead?
507(defcustom calendar-day-digit-width 2
508 "Width of the day digits in the calendar. Minimum value is 2."
509 :group 'calendar
510 :initialize 'custom-initialize-default
511 :set (lambda (sym val)
512 (calendar-set-layout-variable sym val 2))
513 :type 'integer
514 :version "23.1")
515
5cbaccfe Glenn Morris2008-06-26 06:57:29 +0000516(defcustom calendar-intermonth-header nil
3ab44929 Glenn Morris2012-10-08 00:05:21 -0700517 "Header text to display in the space to the left of each calendar month.
5cbaccfe
GM
Glenn Morris2008-06-26 06:57:29 +0000518See `calendar-intermonth-text'."
519 :group 'calendar
520 :initialize 'custom-initialize-default
521 :risky t
522 :set (lambda (sym val)
523 (set sym val)
524 (calendar-redraw))
525 :type '(choice (const nil :tag "Nothing")
526 (string :tag "Fixed string")
527 (sexp :value
528 (propertize "WK" 'font-lock-face
529 'font-lock-function-name-face)))
530 :version "23.1")
531
532(defcustom calendar-intermonth-text nil
533 "Text to display in the space to the left of each calendar month.
534Can be nil, a fixed string, or a lisp expression that returns a string.
535When the expression is evaluated, the variables DAY, MONTH and YEAR
536are integers appropriate for the first day in each week.
537Will be truncated to the smaller of `calendar-left-margin' and
538`calendar-intermonth-spacing'. The last character is forced to be a space.
539For example, to display the ISO week numbers:
540
541 (setq calendar-week-start-day 1
542 calendar-intermonth-text
543 '(propertize
544 (format \"%2d\"
545 (car
546 (calendar-iso-from-absolute
547 (calendar-absolute-from-gregorian (list month day year)))))
548 'font-lock-face 'font-lock-function-name-face))
549
550See also `calendar-intermonth-header'."
551 :group 'calendar
552 :initialize 'custom-initialize-default
553 :risky t
554 :set (lambda (sym val)
555 (set sym val)
556 (calendar-redraw))
557 :type '(choice (const nil :tag "Nothing")
558 (string :tag "Fixed string")
559 (sexp :value
560 (propertize
561 (format "%2d"
562 (car
563 (calendar-iso-from-absolute
564 (calendar-absolute-from-gregorian
565 (list month day year)))))
566 'font-lock-face 'font-lock-function-name-face)))
567 :version "23.1")
0c74d40b Glenn Morris2008-06-21 19:28:09 +0000568
6ebbc2f6 Glenn Morris2015-06-15 20:46:01 -0400569(defcustom diary-file (locate-user-emacs-file "diary" "diary")
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000570 "Name of the file in which one's personal diary of dates is kept.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000571
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000572The file's entries are lines beginning with any of the forms
739d627a Glenn Morris2008-03-27 07:28:24 +0000573specified by the variable `diary-date-forms', which by default
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000574uses the forms of `diary-american-date-forms':
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000575
576 MONTH/DAY
577 MONTH/DAY/YEAR
578 MONTHNAME DAY
579 MONTHNAME DAY, YEAR
580 DAYNAME
581
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +0000582with the remainder of the line being the diary entry string for
583that date. MONTH and DAY are one or two digit numbers, YEAR is a
584number and may be written in full or abbreviated to the final two
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000585digits (if `diary-abbreviated-year-flag' is non-nil). MONTHNAME
27a28b50 Glenn Morris2008-03-14 02:46:37 +0000586and DAYNAME can be spelled in full (as specified by the variables
739d627a Glenn Morris2008-03-27 07:28:24 +0000587`calendar-month-name-array' and `calendar-day-name-array'), or
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000588abbreviated (as specified by `calendar-month-abbrev-array' and
739d627a
GM
Glenn Morris2008-03-27 07:28:24 +0000589`calendar-day-abbrev-array') with or without a period. Case is
590ignored. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which
591matches any day, month, or year, respectively. If the date does
592not contain a year, it is generic and applies to any year. A
593DAYNAME entry applies to the appropriate day of the week in every week.
2c8811d4 Glenn Morris2003-08-03 13:59:13 +0000594
8266a036 Glenn Morris2008-03-29 02:44:03 +0000595You can customize `diary-date-forms' to your preferred format.
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000596Three default styles are provided: `diary-american-date-forms',
597`diary-european-date-forms', and `diary-iso-date-forms'.
8266a036 Glenn Morris2008-03-29 02:44:03 +0000598You can choose between these by setting `calendar-date-style' in your
865fe16f Chong Yidong2012-09-17 13:41:04 +0800599init file, or by using `calendar-set-date-style' when in the calendar.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000600
739d627a
GM
Glenn Morris2008-03-27 07:28:24 +0000601A diary entry can be preceded by the character `diary-nonmarking-symbol'
602\(ordinarily `&') to make that entry nonmarking--that is, it will not be
603marked on dates in the calendar window but will appear in a diary window.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000604
605Multiline diary entries are made by indenting lines after the first with
606either a TAB or one or more spaces.
607
608Lines not in one the above formats are ignored. Here are some sample diary
609entries (in the default American style):
610
611 12/22/1988 Twentieth wedding anniversary!!
612 &1/1. Happy New Year!
613 10/22 Ruth's birthday.
614 21: Payday
615 Tuesday--weekly meeting with grad students at 10am
616 Supowit, Shen, Bitner, and Kapoor to attend.
617 1/13/89 Friday the thirteenth!!
618 &thu 4pm squash game with Lloyd.
619 mar 16 Dad's birthday
620 April 15, 1989 Income tax due.
621 &* 15 time cards due.
622
623If 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 +0000624no trailing blanks or punctuation, then that line is not displayed in the
625diary window; only the continuation lines is shown. For example, the
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000626single diary entry
627
628 02/11/1989
629 Bill Blattner visits Princeton today
630 2pm Cognitive Studies Committee meeting
631 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
632 4:00pm Jamie Tappenden
633 7:30pm Dinner at George and Ed's for Alan Ryan
634 7:30-10:00pm dance at Stewart Country Day School
635
636will appear in the diary window without the date line at the beginning. This
637facility allows the diary window to look neater, but can cause confusion if
638used with more than one day's entries displayed.
639
640Diary entries can be based on Lisp sexps. For example, the diary entry
641
642 %%(diary-block 11 1 1990 11 10 1990) Vacation
643
811a8484 John Wiegley2004-05-08 12:42:07 +0000644causes the diary entry \"Vacation\" to appear from November 1 through
739d627a Glenn Morris2008-03-27 07:28:24 +0000645November 10, 1990. See the documentation for the function
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000646`diary-list-sexp-entries' for more details.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000647
6818b449 Glenn Morris2012-02-17 22:08:15 -0500648Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
811a8484 John Wiegley2004-05-08 12:42:07 +0000649calendar are also possible, but because these are somewhat slow, they
9ee4e581
GM
Glenn Morris2008-04-06 20:54:25 +0000650are ignored unless you set the `diary-nongregorian-listing-hook' and
651the `diary-nongregorian-marking-hook' appropriately. See the
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000652documentation of these hooks for details.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000653
654Diary files can contain directives to include the contents of other files; for
9ee4e581 Glenn Morris2008-04-06 20:54:25 +0000655details, see the documentation for the variable `diary-list-entries-hook'."
6ebbc2f6 Glenn Morris2015-06-15 20:46:01 -0400656 :version "25.1" ; ~/diary -> locate-user-emacs-file
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000657 :type 'file
658 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000659
bf0cce5a Glenn Morris2008-03-17 02:30:06 +0000660;; FIXME do these have to be single characters?
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000661(defcustom diary-nonmarking-symbol "&"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000662 "Symbol indicating that a diary entry is not to be marked in the calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000663 :type 'string
664 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000665
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +0800666(defcustom diary-chinese-entry-symbol "C"
667 "Symbol indicating a diary entry according to the Chinese calendar."
668 :type 'string
669 :group 'diary
cbdc06f3 Stefan Monnier2014-09-29 14:14:08 -0400670 :version "25.1")
bbdcf64f Leo Liu2014-05-04 08:16:58 +0800671
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000672(defcustom diary-hebrew-entry-symbol "H"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000673 "Symbol indicating a diary entry according to the Hebrew calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000674 :type 'string
675 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000676
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000677(defcustom diary-islamic-entry-symbol "I"
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000678 "Symbol indicating a diary entry according to the Islamic calendar."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000679 :type 'string
680 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000681
bf41c46c Glenn Morris2008-04-05 20:20:08 +0000682(defcustom diary-bahai-entry-symbol "B"
6818b449 Glenn Morris2012-02-17 22:08:15 -0500683 "Symbol indicating a diary entry according to the Bahá'í calendar."
811a8484
JW
John Wiegley2004-05-08 12:42:07 +0000684 :type 'string
685 :group 'diary)
686
3f659704 Glenn Morris2014-10-05 19:02:04 -0700687(defcustom calendar-date-style 'american
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000688 "Your preferred style for writing dates.
689The options are:
690`american' - month/day/year
691`european' - day/month/year
692`iso' - year/month/day
693This affects how dates written in your diary are interpreted.
694It also affects date display, as well as those calendar and diary
695functions that take a date as an argument, e.g. `diary-date', by
696changing the order in which the arguments are interpreted.
697
698Setting this variable directly does not take effect (if the
699calendar package is already loaded). Rather, use either
700\\[customize] or the function `calendar-set-date-style'."
701 :version "23.1"
702 :type '(choice (const american :tag "Month/Day/Year")
703 (const european :tag "Day/Month/Year")
704 (const iso :tag "Year/Month/Day"))
705 :initialize 'custom-initialize-default
706 :set (lambda (symbol value)
707 (calendar-set-date-style value))
708 :group 'calendar)
709
710;; Next three are provided to aid in setting diary-date-forms.
b106af42 Glenn Morris2008-04-11 03:47:38 +0000711;; FIXME move to diary-lib?
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000712(defcustom diary-iso-date-forms
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000713 '((month "[-/]" day "[^-/0-9]")
714 (year "[-/]" month "[-/]" day "[^0-9]")
29f30ab7
GM
Glenn Morris2010-11-11 19:16:20 -0800715 ;; Cannot allow [-/] as separators here, since it would also match
716 ;; the first element (bug#7377).
717 (monthname " *" day "[^-0-9]")
718 (year " *" monthname " *" day "[^0-9]")
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000719 (dayname "\\W"))
720 "List of pseudo-patterns describing the ISO style of dates.
29f30ab7
GM
Glenn Morris2010-11-11 19:16:20 -0800721The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME DAY;
722YEAR MONTHNAME DAY; DAYNAME. Normally you should not customize this,
8266a036 Glenn Morris2008-03-29 02:44:03 +0000723but `diary-date-forms' (which see)."
29f30ab7 Glenn Morris2010-11-11 19:16:20 -0800724 :version "23.3" ; bug#7377
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000725 :type '(repeat (choice (cons :tag "Backup"
726 :value (backup . nil)
727 (const backup)
728 (repeat (list :inline t :format "%v"
729 (symbol :tag "Keyword")
730 (choice symbol regexp))))
731 (repeat (list :inline t :format "%v"
732 (symbol :tag "Keyword")
733 (choice symbol regexp)))))
734 :group 'diary)
735
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000736(defcustom diary-american-date-forms
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000737 '((month "/" day "[^/0-9]")
738 (month "/" day "/" year "[^0-9]")
739 (monthname " *" day "[^,0-9]")
740 (monthname " *" day ", *" year "[^0-9]")
741 (dayname "\\W"))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000742 "List of pseudo-patterns describing the American style of dates.
743The defaults are: MONTH/DAY; MONTH/DAY/YEAR; MONTHNAME DAY;
744MONTHNAME DAY, YEAR; DAYNAME. Normally you should not customize this,
745but `diary-date-forms' (which see)."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000746 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000747 :value (backup . nil)
748 (const backup)
749 (repeat (list :inline t :format "%v"
750 (symbol :tag "Keyword")
751 (choice symbol regexp))))
752 (repeat (list :inline t :format "%v"
753 (symbol :tag "Keyword")
754 (choice symbol regexp)))))
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000755 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000756
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000757(defcustom diary-european-date-forms
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000758 '((day "/" month "[^/0-9]")
759 (day "/" month "/" year "[^0-9]")
bb0541f8 Richard M. Stallman1999-08-02 00:32:50 +0000760 (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000761 (day " *" monthname " *" year "[^0-9]")
762 (dayname "\\W"))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000763 "List of pseudo-patterns describing the European style of dates.
764The defaults are: DAY/MONTH; DAY/MONTH/YEAR; DAY MONTHNAME;
765DAY MONTHNAME YEAR; DAYNAME. Normally you should not customize this, but
766`diary-date-forms' (which see)."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000767 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000768 :value (backup . nil)
769 (const backup)
770 (repeat (list :inline t :format "%v"
771 (symbol :tag "Keyword")
772 (choice symbol regexp))))
773 (repeat (list :inline t :format "%v"
774 (symbol :tag "Keyword")
775 (choice symbol regexp)))))
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000776 :group 'diary)
777
109eecc0
GM
Glenn Morris2007-04-07 21:53:39 +0000778(defvar diary-font-lock-keywords)
779
8266a036 Glenn Morris2008-03-29 02:44:03 +0000780(defcustom diary-date-forms (cond ((eq calendar-date-style 'iso)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000781 diary-iso-date-forms)
8266a036 Glenn Morris2008-03-29 02:44:03 +0000782 ((eq calendar-date-style 'european)
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000783 diary-european-date-forms)
784 (t diary-american-date-forms))
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000785 "List of pseudo-patterns describing the forms of date used in the diary.
8c64a298 Juanma Barranquero2002-04-03 14:47:16 +0000786The patterns on the list must be MUTUALLY EXCLUSIVE and should not match
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000787any portion of the diary entry itself, just the date component.
788
789A pseudo-pattern is a list of regular expressions and the keywords `month',
790`day', `year', `monthname', and `dayname'. The keyword `monthname' will
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +0000791match the name of the month (see `calendar-month-name-array'), capitalized
792or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
793followed by a period or not; it will also match `*'. Similarly, `dayname'
794will match the name of the day (see `calendar-day-name-array'), capitalized or
795not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
796followed by a period or not. The keywords `month', `day', and `year' will
797match those numerical values, preceded by arbitrarily many zeros; they will
798also match `*'.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000799
800The matching of the diary entries with the date forms is done with the
801standard syntax table from Fundamental mode, but with the `*' changed so
802that it is a word constituent.
803
804If, to be mutually exclusive, a pseudo-pattern must match a portion of the
805diary entry itself, the first element of the pattern MUST be `backup'. This
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +0000806directive causes the date recognizer to back up to the beginning of the
807current word of the diary entry, so in no case can the pattern match more than
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000808a portion of the first word of the diary entry.
809
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000810For examples of three common styles, see `diary-american-date-forms',
811`diary-european-date-forms', and `diary-iso-date-forms'."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000812 :type '(repeat (choice (cons :tag "Backup"
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000813 :value (backup . nil)
814 (const backup)
815 (repeat (list :inline t :format "%v"
816 (symbol :tag "Keyword")
817 (choice symbol regexp))))
818 (repeat (list :inline t :format "%v"
819 (symbol :tag "Keyword")
820 (choice symbol regexp)))))
6302f8ac
GM
Glenn Morris2009-03-02 07:00:43 +0000821 :set-after '(calendar-date-style diary-iso-date-forms
822 diary-european-date-forms
823 diary-american-date-forms)
109eecc0
GM
Glenn Morris2007-04-07 21:53:39 +0000824 :initialize 'custom-initialize-default
825 :set (lambda (symbol value)
826 (unless (equal value (eval symbol))
827 (custom-set-default symbol value)
828 (setq diary-font-lock-keywords (diary-font-lock-keywords))
829 ;; Need to redraw not just to get new font-locking, but also
830 ;; to pick up any newly recognized entries.
831 (and (diary-live-p)
832 (diary))))
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000833 :group 'diary)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000834
8266a036 Glenn Morris2008-03-29 02:44:03 +0000835;; Next three are provided to aid in setting calendar-date-display-form.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000836(defcustom calendar-iso-date-display-form '((format "%s-%.2d-%.2d" year
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000837 (string-to-number month)
838 (string-to-number day)))
839 "Pseudo-pattern governing the way a date appears in the ISO style.
840Normally you should not customize this, but `calendar-date-display-form'
841\(which see)."
842 :type 'sexp
843 :version "23.1"
844 :group 'calendar)
845
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000846(defcustom calendar-european-date-display-form
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000847 '((if dayname (concat dayname ", ")) day " " monthname " " year)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000848 "Pseudo-pattern governing the way a date appears in the European style.
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000849Normally you should not customize this, but `calendar-date-display-form'
850\(which see)."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000851 :type 'sexp
852 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000853
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000854(defcustom calendar-american-date-display-form
7e1dae73 Jim Blandy1992-08-12 12:50:10 +0000855 '((if dayname (concat dayname ", ")) monthname " " day ", " year)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000856 "Pseudo-pattern governing the way a date appears in the American style.
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000857Normally you should not customize this, but `calendar-date-display-form'
858\(which see)."
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000859 :type 'sexp
860 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000861
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000862(defcustom calendar-date-display-form
863 (cond ((eq calendar-date-style 'iso)
864 calendar-iso-date-display-form)
865 ((eq calendar-date-style 'european)
866 calendar-european-date-display-form)
867 (t calendar-american-date-display-form))
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000868 "Pseudo-pattern governing the way a calendar date appears.
869Used by the function `calendar-date-string' (which see), a pseudo-pattern
870is a list of expressions that can involve the keywords `month', `day',
871and `year' (all numbers in string form), and `monthname' and `dayname'
872\(both alphabetic strings). For example, a typical American form would be
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000873
874 '(month \"/\" day \"/\" (substring year -2))
875
8266a036 Glenn Morris2008-03-29 02:44:03 +0000876whereas
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +0000877
878 '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
879
8266a036 Glenn Morris2008-03-29 02:44:03 +0000880would give the usual American style in fixed-length fields. The variables
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000881`calendar-iso-date-display-form', `calendar-european-date-display-form', and
882`calendar-american-date-display-form' provide some defaults for three common
8266a036 Glenn Morris2008-03-29 02:44:03 +0000883styles."
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000884 :type 'sexp
6302f8ac
GM
Glenn Morris2009-03-02 07:00:43 +0000885 :set-after '(calendar-date-style calendar-iso-date-display-form
886 calendar-european-date-display-form
887 calendar-american-date-display-form)
b032077a Richard M. Stallman1997-05-03 04:56:48 +0000888 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000889
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700890(defcustom calendar-american-month-header
891 '(propertize (format "%s %d" (calendar-month-name month) year)
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400892 'font-lock-face 'calendar-month-header)
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700893 "Default format for calendar month headings with the American date style.
894Normally you should not customize this, but `calender-month-header'."
895 :group 'calendar
896 :risky t
897 :type 'sexp
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -0400898 :version "24.4") ; font-lock-function-name-face -> calendar-month-header
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700899
900(defcustom calendar-european-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 European 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-iso-month-header
911 '(propertize (format "%d %s" year (calendar-month-name month))
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 ISO 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-month-header
921 (cond ((eq calendar-date-style 'iso)
922 calendar-iso-month-header)
923 ((eq calendar-date-style 'european)
924 calendar-european-month-header)
925 (t calendar-american-month-header))
926 "Expression to evaluate to return the calendar month headings.
927When this expression is evaluated, the variables MONTH and YEAR are
928integers appropriate to the relevant month. The result is padded
929to the width of `calendar-month-digit-width'.
930
931For examples of three common styles, see `calendar-american-month-header',
932`calendar-european-month-header', and `calendar-iso-month-header'.
933
934Changing this variable without using customize has no effect on
935pre-existing calendar windows."
936 :group 'calendar
937 :initialize 'custom-initialize-default
938 :risky t
939 :set (lambda (sym val)
940 (set sym val)
941 (calendar-redraw))
942 :set-after '(calendar-date-style calendar-american-month-header
943 calendar-european-month-header
944 calendar-iso-month-header)
945 :type 'sexp
946 :version "24.3")
947
8266a036
GM
Glenn Morris2008-03-29 02:44:03 +0000948(defun calendar-set-date-style (style)
949 "Set the style of calendar and diary dates to STYLE (a symbol).
950The valid styles are described in the documentation of `calendar-date-style'."
951 (interactive (list (intern
952 (completing-read "Date style: "
953 '("american" "european" "iso") nil t
954 nil nil "american"))))
955 (or (memq style '(american european iso))
956 (setq style 'american))
957 (setq calendar-date-style style
958 calendar-date-display-form
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +0000959 (symbol-value (intern-soft
960 (format "calendar-%s-date-display-form" style)))
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -0700961 calendar-month-header
962 (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
8266a036 Glenn Morris2008-03-29 02:44:03 +0000963 diary-date-forms
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000964 (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
69f6644c Glenn Morris2012-09-19 00:27:29 -0700965 (calendar-redraw)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000966 (calendar-update-mode-line))
8266a036 Glenn Morris2008-03-29 02:44:03 +0000967
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +0000968(defcustom diary-show-holidays-flag t
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +0000969 "Non-nil means include holidays in the diary display.
e555fdd8 Richard M. Stallman1994-04-07 20:31:17 +0000970The holidays appear in the mode line of the diary buffer, or in the
354d0644 Jim Blandy1993-06-22 03:22:12 +0000971fancy diary buffer next to the date. This slows down the diary functions
b032077a
RS
Richard M. Stallman1997-05-03 04:56:48 +0000972somewhat; setting it to nil makes the diary display faster."
973 :type 'boolean
974 :group 'holidays)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +0000975
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000976(defcustom calendar-debug-sexp nil
977 "Turn debugging on when evaluating a sexp in the diary or holiday list."
978 :type 'boolean
979 :group 'calendar)
2ec778d0 Richard M. Stallman1993-06-03 06:12:46 +0000980
c09dffbe Glenn Morris2008-04-04 04:36:54 +0000981(defcustom calendar-hebrew-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000982 "If nil, show only major holidays from the Hebrew calendar.
983This means only those Jewish holidays that appear on secular calendars.
984Otherwise, show all the holidays that would appear in a complete Hebrew
985calendar."
986 :type 'boolean
987 :group 'holidays)
988
c09dffbe Glenn Morris2008-04-04 04:36:54 +0000989(defcustom calendar-christian-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000990 "If nil, show only major holidays from the Christian calendar.
991This means only those Christian holidays that appear on secular calendars.
992Otherwise, show all the holidays that would appear in a complete Christian
993calendar."
994 :type 'boolean
995 :group 'holidays)
996
c09dffbe Glenn Morris2008-04-04 04:36:54 +0000997(defcustom calendar-islamic-all-holidays-flag nil
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +0000998 "If nil, show only major holidays from the Islamic calendar.
999This means only those Islamic holidays that appear on secular calendars.
1000Otherwise, show all the holidays that would appear in a complete Islamic
1001calendar."
1002 :type 'boolean
1003 :group 'holidays)
1004
c09dffbe Glenn Morris2008-04-04 04:36:54 +00001005(defcustom calendar-bahai-all-holidays-flag nil
6818b449 Glenn Morris2012-02-17 22:08:15 -05001006 "If nil, show only major holidays from the Bahá'í calendar.
f62611de Glenn Morris2008-03-08 03:47:03 +00001007These are the days on which work and school must be suspended.
6818b449 Glenn Morris2012-02-17 22:08:15 -05001008Otherwise, show all the holidays that would appear in a complete Bahá'í
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001009calendar."
1010 :type 'boolean
1011 :group 'holidays)
1012
7717093c
GM
Glenn Morris2008-04-23 02:59:47 +00001013(defcustom calendar-chinese-all-holidays-flag nil
1014 "If nil, show only the major holidays from the Chinese calendar."
1015 :version "23.1"
1016 :type 'boolean
1017 :group 'holidays)
1018
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001019;;; End of user options.
1020
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001021(calendar-recompute-layout-variables)
1022
1023(defconst calendar-first-date-row 3
1024 "First row in the calendar with actual dates.")
1025
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001026(defconst calendar-buffer "*Calendar*"
1027 "Name of the buffer used for the calendar.")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001028
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001029(defconst holiday-buffer "*Holidays*"
1030 "Name of the buffer used for the displaying the holidays.")
1031
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001032(defconst diary-fancy-buffer "*Fancy Diary Entries*"
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001033 "Name of the buffer used for the optional fancy display of the diary.")
1034
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001035(defconst calendar-other-calendars-buffer "*Other Calendars*"
726669d8
ER
Edward M. Reingold1998-05-27 20:18:40 +00001036 "Name of the buffer used for the display of date on other calendars.")
1037
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001038(defconst lunar-phases-buffer "*Phases of Moon*"
1039 "Name of the buffer used for the lunar phases.")
1040
f4498b9e Glenn Morris2008-09-27 19:58:53 +00001041(defconst solar-sunrises-buffer "*Sunrise/Sunset Times*"
6e73a6a2
GM
Glenn Morris2008-06-26 22:30:01 +00001042 "Name of buffer used for sunrise/sunset times.")
1043
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001044(defconst calendar-hebrew-yahrzeit-buffer "*Yahrzeits*"
bae5a5a3
GM
Glenn Morris2008-03-13 04:06:47 +00001045 "Name of the buffer used by `list-yahrzeit-dates'.")
1046
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001047(defmacro calendar-increment-month (mon yr n &optional nmonths)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001048 "Increment the variables MON and YR by N months.
1049Forward if N is positive or backward if N is negative.
f6c762dd Glenn Morris2008-03-31 07:11:00 +00001050A negative YR is interpreted as BC; -1 being 1 BC, and so on.
a8ee33ab
GM
Glenn Morris2008-03-31 16:00:05 +00001051Optional NMONTHS is the number of months per year (default 12)."
1052 ;; Can view this as a form of base-nmonths arithmetic, in which "a
1053 ;; year" = "ten", and we never bother to use hundreds.
1054 `(let ((nmonths (or ,nmonths 12))
1055 macro-y)
18db8896 Glenn Morris2003-10-01 20:48:17 +00001056 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
a8ee33ab
GM
Glenn Morris2008-03-31 16:00:05 +00001057 (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1058 ,mon (1+ (mod macro-y nmonths))
1059 ,yr (/ macro-y nmonths))
1060 ;; Alternative:
1061;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1062;;; ,yr (/ macro-y nmonths)
1063;;; ,mon (- macro-y (* ,yr nmonths)))
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001064 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1065 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001066
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001067(defvar displayed-month)
1068(defvar displayed-year)
1069
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001070(defun calendar-increment-month-cons (n &optional mon yr)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001071 "Return the Nth month after MON/YR.
1072The return value is a pair (MONTH . YEAR).
1073MON defaults to `displayed-month'. YR defaults to `displayed-year'."
1074 (unless mon (setq mon displayed-month))
b06ee3d2 Stefan Monnier2006-02-06 16:56:35 +00001075 (unless yr (setq yr displayed-year))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001076 (calendar-increment-month mon yr n)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001077 (cons mon yr))
1078
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001079(defmacro calendar-sum (index initial condition expression)
40802b08 Glenn Morris2008-03-15 03:00:17 +00001080 "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001081 (declare (debug (symbolp form form form)))
7e1e5cf1
SS
Sam Steingold1999-11-12 16:05:16 +00001082 `(let ((,index ,initial)
1083 (sum 0))
1084 (while ,condition
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001085 (setq sum (+ sum ,expression)
1086 ,index (1+ ,index)))
7e1e5cf1 Sam Steingold1999-11-12 16:05:16 +00001087 sum))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001088
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00001089(defmacro calendar-in-read-only-buffer (buffer &rest body)
628299e0 Sam Steingold2012-06-06 11:19:39 -04001090 "Switch to BUFFER and execute the forms in BODY.
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001091First creates or erases BUFFER as needed. Leaves BUFFER read-only,
1092with disabled undo. Leaves point at point-min, displays BUFFER."
1093 (declare (indent 1) (debug t))
1094 `(progn
1095 (set-buffer (get-buffer-create ,buffer))
89b5595a Glenn Morris2012-06-21 21:50:35 -04001096 (or (derived-mode-p 'special-mode) (special-mode))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001097 (setq buffer-read-only nil
1098 buffer-undo-list t)
1099 (erase-buffer)
1100 ,@body
1101 (goto-char (point-min))
1102 (set-buffer-modified-p nil)
1103 (setq buffer-read-only t)
1104 (display-buffer ,buffer)))
1105
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001106;; The following are in-line for speed; they can be called thousands of times
1107;; when looking up holidays or processing the diary. Here, for example, are
1108;; the numbers of calls to calendar/diary/holiday functions in preparing the
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001109;; fancy diary display, for a moderately complex diary file, with functions
1110;; used instead of macros. There were a total of 10000 such calls:
1111;;
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001112;; 1934 calendar-extract-month
1113;; 1852 calendar-extract-year
1114;; 1819 calendar-extract-day
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001115;; 845 calendar-leap-year-p
1116;; 837 calendar-day-number
1117;; 775 calendar-absolute-from-gregorian
1118;; 346 calendar-last-day-of-month
0a837994
GM
Glenn Morris2008-04-05 20:58:10 +00001119;; 286 calendar-hebrew-last-day-of-month
1120;; 188 calendar-hebrew-leap-year-p
1121;; 180 calendar-hebrew-elapsed-days
1122;; 163 calendar-hebrew-last-month-of-year
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001123;; 66 calendar-date-compare
0a837994 Glenn Morris2008-04-05 20:58:10 +00001124;; 65 calendar-hebrew-days-in-year
b78b866a Glenn Morris2008-04-04 07:32:39 +00001125;; 60 calendar-julian-to-absolute
0a837994 Glenn Morris2008-04-05 20:58:10 +00001126;; 50 calendar-hebrew-to-absolute
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001127;; 43 calendar-date-equal
1128;; 38 calendar-gregorian-from-absolute
1129;; .
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001130;;
1131;; The use of these seven macros eliminates the overhead of 92% of the function
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001132;; calls; it's faster this way.
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001133
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001134(defsubst calendar-extract-month (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001135 "Extract the month part of DATE which has the form (month day year)."
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001136 (car date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001137
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001138;; Note gives wrong answer for result of (calendar-read-date 'noday),
1139;; but that is only used by `calendar-other-month'.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001140(defsubst calendar-extract-day (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001141 "Extract the day part of DATE which has the form (month day year)."
40802b08 Glenn Morris2008-03-15 03:00:17 +00001142 (cadr date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001143
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001144(defsubst calendar-extract-year (date)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001145 "Extract the year part of DATE which has the form (month day year)."
40802b08 Glenn Morris2008-03-15 03:00:17 +00001146 (nth 2 date))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001147
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001148(defsubst calendar-leap-year-p (year)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001149 "Return t if YEAR is a Gregorian leap year.
1150A negative year is interpreted as BC; -1 being 1 BC, and so on."
1151 ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
1152 (if (< year 0) (setq year (1- (abs year))))
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001153 (and (zerop (% year 4))
1154 (or (not (zerop (% year 100)))
1155 (zerop (% year 400)))))
1156
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001157;; The foregoing is a bit faster, but not as clear as the following:
1158;;
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001159;;(defsubst calendar-leap-year-p (year)
21db982b Glenn Morris2008-03-10 02:46:24 +00001160;; "Return t if YEAR is a Gregorian leap year."
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001161;; (or
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001162;; (and (zerop (% year 4))
1163;; (not (zerop (% year 100))))
1164;; (zerop (% year 400)))
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001165
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001166(defsubst calendar-last-day-of-month (month year)
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001167 "The last day in MONTH during YEAR."
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001168 (if (and (= month 2) (calendar-leap-year-p year))
1169 29
1170 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
1171
1172;; An explanation of the calculation can be found in PascAlgorithms by
1173;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
1174
1175(defsubst calendar-day-number (date)
e5d77022
JB
Jim Blandy1992-06-30 13:54:21 +00001176 "Return the day number within the year of the date DATE.
1177For example, (calendar-day-number '(1 1 1987)) returns the value 1,
1178while (calendar-day-number '(12 31 1980)) returns 366."
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001179 (let* ((month (calendar-extract-month date))
1180 (day (calendar-extract-day date))
1181 (year (calendar-extract-year date))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001182 (day-of-year (+ day (* 31 (1- month)))))
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001183 (when (> month 2)
1184 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
1185 (if (calendar-leap-year-p year)
1186 (setq day-of-year (1+ day-of-year))))
1187 day-of-year))
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001188
1189(defsubst calendar-absolute-from-gregorian (date)
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001190 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001191The Gregorian date Sunday, December 31, 1 BC is imaginary.
1192DATE is a list of the form (month day year). A negative year is
1193interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
1194return negative results."
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001195 (let ((year (calendar-extract-year date))
18db8896 Glenn Morris2003-10-01 20:48:17 +00001196 offset-years)
21db982b Glenn Morris2008-03-10 02:46:24 +00001197 (cond ((zerop year)
fb723401 Glenn Morris2015-06-10 17:04:54 -04001198 (user-error "There was no year zero"))
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001199 ((> year 0)
1200 (setq offset-years (1- year))
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001201 (+ (calendar-day-number date) ; days this year
1202 (* 365 offset-years) ; + days in prior years
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001203 (/ offset-years 4) ; + Julian leap years
1204 (- (/ offset-years 100)) ; - century years
1205 (/ offset-years 400))) ; + Gregorian leap years
1206 (t
1207 ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
1208 (setq offset-years (abs (1+ year)))
1209 (- (calendar-day-number date)
1210 (* 365 offset-years)
1211 (/ offset-years 4)
1212 (- (/ offset-years 100))
1213 (/ offset-years 400)
1214 (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
e5d77022 Jim Blandy1992-06-30 13:54:21 +00001215
94b304d7 Richard M. Stallman1992-06-03 02:55:55 +00001216;;;###autoload
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001217(defun calendar (&optional arg)
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001218 "Display a three-month Gregorian calendar.
1219The three months appear side by side, with the current month in
1220the middle surrounded by the previous and next months. The
1221cursor is put on today's date. If optional prefix argument ARG
1222is non-nil, prompts for the central month and year.
1223
1224Once in the calendar window, future or past months can be moved
1225into view. Arbitrary months can be displayed, or the calendar
1226can be scrolled forward or backward. The cursor can be moved
1227forward or backward by one day, one week, one month, or one year.
1228All of these commands take prefix arguments which, when negative,
1229cause movement in the opposite direction. For convenience, the
1230digit keys and the minus sign are automatically prefixes. Use
1231\\[describe-mode] for details of the key bindings in the calendar
1232window.
1233
1234Displays the calendar in a separate window, or optionally in a
1235separate frame, depending on the value of `calendar-setup'.
1236
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001237If `calendar-view-diary-initially-flag' is non-nil, also displays the
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001238diary entries for the current date (or however many days
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001239`diary-number-of-entries' specifies). This variable can be
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001240overridden by `calendar-setup'. As well as being displayed,
1241diary entries can also be marked on the calendar (see
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001242`calendar-mark-diary-entries-flag').
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001243
1244Runs the following hooks:
1245
1246`calendar-load-hook' - after loading calendar.el
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001247`calendar-today-visible-hook', `calendar-today-invisible-hook' - after
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001248 generating a calendar, if today's date is visible or not, respectively
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001249`calendar-initial-window-hook' - after first creating a calendar
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001250
865fe16f Chong Yidong2012-09-17 13:41:04 +08001251This function is suitable for execution in an init file."
7086b78e Edward M. Reingold1995-09-21 02:40:35 +00001252 (interactive "P")
f49f2a9e
GM
Glenn Morris2008-03-25 03:42:55 +00001253 ;; Avoid loading cal-x unless it will be used.
1254 (if (and (memq calendar-setup '(one-frame two-frames calendar-only))
1255 (display-multi-frame-p))
1256 (calendar-frame-setup calendar-setup arg)
1257 (calendar-basic-setup arg)))
1258
1259(defun calendar-basic-setup (&optional arg nodisplay)
1260 "Create a three-month calendar.
1261If optional prefix argument ARG is non-nil, prompts for the month
1262and year, else uses the current date. If NODISPLAY is non-nil, don't
1263display the generated calendar."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001264 (interactive "P")
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001265 (let ((buff (current-buffer)))
1266 (set-buffer (get-buffer-create calendar-buffer))
1267 (calendar-mode)
1268 (let* ((pop-up-windows t)
1269 ;; Not really needed now, but means we use exactly the same
1270 ;; behavior as before in the non-wide case (see below).
1271 (split-height-threshold 1000)
58ae51ae Glenn Morris2009-10-10 20:50:39 +00001272 (split-width-threshold calendar-split-width-threshold)
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001273 (date (if arg (calendar-read-date t)
1274 (calendar-current-date)))
1275 (month (calendar-extract-month date))
1276 (year (calendar-extract-year date)))
1277 (calendar-increment-month month year (- calendar-offset))
1278 ;; Display the buffer before calling calendar-generate-window so that it
1279 ;; can get a chance to adjust the window sizes to the frame size.
1280 (unless nodisplay
1281 ;; We want a window configuration that looks something like
1282 ;; X X | Y
1283 ;; - -----
1284 ;; C Z | C
1285 ;; where C is the calendar, and the LHS is the traditional,
1286 ;; non-wide frame, and the RHS is the wide frame case.
1287 ;; We should end up in the same state regardless of whether the
1288 ;; windows were initially split or not.
1289 ;; Previously, we only thought about the non-wide case.
1290 ;; We could just set split-height-threshold to 1000, relying on
1291 ;; the fact that the window splitting treated a single window as
1292 ;; a special case and would always split it (vertically). The
1293 ;; same thing does not work in the wide-frame case, so now we do
1294 ;; the splitting by hand.
1295 ;; See discussion in bug#1806.
1296 ;; Actually, this still does not do quite the right thing in the
1297 ;; wide frame case if started from a configuration like the LHS.
1298 ;; Eg if you start with a non-wide frame, call calendar, then
1299 ;; make the frame wider. This one is problematic because you
1300 ;; might need to split a totally unrelated window. Oh well, it
1301 ;; seems unlikely, and perhaps respecting the original layout is
1302 ;; the right thing in that case.
1303 ;;
1304 ;; Is this a wide frame? If so, split it horizontally.
b360b106
MR
Martin Rudalics2014-08-21 10:40:29 +02001305
1306 ;; The following doesn't sound useful: If we split horizontally
1307 ;; here, the subsequent `pop-to-buffer' will likely split again
1308 ;; horizontally and we end up with three side-by-side windows.
1309 (when (window-splittable-p (selected-window) t)
1310 (split-window-right))
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001311 (pop-to-buffer calendar-buffer)
1312 ;; Has the window already been split vertically?
1313 (when (and (not (window-dedicated-p))
b360b106 Martin Rudalics2014-08-21 10:40:29 +02001314 (window-splittable-p (selected-window))
429a1506 Glenn Morris2009-10-07 02:57:46 +00001315 (window-full-height-p))
2d197ffb Chong Yidong2011-10-30 09:56:03 +08001316 (let ((win (split-window-below)))
429a1506
GM
Glenn Morris2009-10-07 02:57:46 +00001317 ;; In the upper window, show whatever was visible before.
1318 ;; This looks better than using other-buffer.
1319 (switch-to-buffer buff)
1320 ;; Switch to the lower window with the calendar buffer.
1321 (select-window win))))
1322 (calendar-generate-window month year)
1323 (if (and calendar-view-diary-initially-flag
1324 (calendar-date-is-visible-p date))
6e82d877
GM
Glenn Morris2014-09-07 22:57:24 -07001325 ;; Do not clobber the calendar with the diary, if the diary
1326 ;; has previously been shown in the window that now shows the
1327 ;; calendar (bug#18381).
1328 (let ((display-buffer-overriding-action
1329 '(nil . ((inhibit-same-window . t)))))
1330 (diary-view-entries)))))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001331 (if calendar-view-holidays-initially-flag
9025db71 Glenn Morris2014-09-07 23:03:19 -07001332 (let* ((diary-buffer (diary-live-p))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00001333 (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
1334 (split-height-threshold (if diary-window 2 1000)))
1335 ;; FIXME display buffer?
cb9b9874 Glenn Morris2007-09-14 04:30:30 +00001336 (calendar-list-holidays)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001337 (run-hooks 'calendar-initial-window-hook))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001338
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001339(defun calendar-generate-window (&optional mon yr)
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001340 "Generate the calendar window for the current date.
f49f2a9e Glenn Morris2008-03-25 03:42:55 +00001341Optional integers MON and YR are used instead of today's date."
712f4efe Stefan Monnier2007-07-29 20:49:13 +00001342 (let* ((inhibit-read-only t)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001343 (today (calendar-current-date))
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001344 (month (calendar-extract-month today))
1345 (day (calendar-extract-day today))
1346 (year (calendar-extract-year today))
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001347 (today-visible (or (not mon)
1348 (<= (abs (calendar-interval mon yr month year)) 1)))
290d5b58 Dmitry Antipov2013-08-05 18:26:57 +04001349 (in-calendar-window (eq (window-buffer)
0663481f Glenn Morris2005-02-27 20:25:48 +00001350 (get-buffer calendar-buffer))))
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00001351 (calendar-generate (or mon month) (or yr year))
1352 (calendar-update-mode-line)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001353 (calendar-cursor-to-visible-date
1354 (if today-visible today (list displayed-month 1 displayed-year)))
1355 (set-buffer-modified-p nil)
0663481f Glenn Morris2005-02-27 20:25:48 +00001356 ;; Don't do any window-related stuff if we weren't called from a
21db982b Glenn Morris2008-03-10 02:46:24 +00001357 ;; window displaying the calendar.
0663481f Glenn Morris2005-02-27 20:25:48 +00001358 (when in-calendar-window
3d8daefe Martin Rudalics2011-10-30 09:29:56 +01001359 (if (window-combined-p)
39cffb44
MR
Martin Rudalics2011-06-12 09:46:56 +02001360 ;; Adjust the window to exactly fit the displayed calendar.
1361 (fit-window-to-buffer nil nil calendar-minimum-window-height)
1362 ;; For a full height window or a window that is horizontally
1363 ;; combined don't fit height to that of its buffer.
1364 (set-window-vscroll nil 0))
0663481f Glenn Morris2005-02-27 20:25:48 +00001365 (sit-for 0))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001366 (and calendar-mark-holidays-flag
6711a21f Stefan Monnier2014-05-28 23:45:29 -04001367 ;; (calendar-date-is-valid-p today) ; useful for BC dates
8ccd0d4d Glenn Morris2008-03-13 06:00:07 +00001368 (calendar-mark-holidays)
0663481f Glenn Morris2005-02-27 20:25:48 +00001369 (and in-calendar-window (sit-for 0)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001370 (unwind-protect
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001371 (if calendar-mark-diary-entries-flag (diary-mark-entries))
6711a21f
SM
Stefan Monnier2014-05-28 23:45:29 -04001372 (run-hooks (if today-visible
1373 'calendar-today-visible-hook
1374 'calendar-today-invisible-hook)))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001375
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001376(defun calendar-generate (month year)
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001377 "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001378 ;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
1379 ;; Note that while calendars for years BC could be displayed as it
1380 ;; stands, almost all other calendar functions (eg holidays) would
1381 ;; at best have unpredictable results for such dates.
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001382 (if (< (+ month (* 12 (1- year))) 2)
fb723401 Glenn Morris2015-06-10 17:04:54 -04001383 (user-error "Months before January, 1 AD cannot be displayed"))
4c635ea3
GM
Glenn Morris2004-02-23 00:11:12 +00001384 (setq displayed-month month
1385 displayed-year year)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001386 (erase-buffer)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001387 (calendar-increment-month month year -1)
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001388 (dotimes (i 3)
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001389 (calendar-generate-month month year
1390 (+ calendar-left-margin
1391 (* calendar-month-width i)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001392 (calendar-increment-month month year 1)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001393
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001394(defun calendar-move-to-column (indent)
1395 "Like `move-to-column', but indents if the line is too short."
1396 (if (< (move-to-column indent) indent)
1397 (indent-to indent)))
1398
1399(defun calendar-ensure-newline ()
1400 "Move to the next line, adding a newline if necessary."
1401 (or (zerop (forward-line 1))
1402 (insert "\n")))
1403
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001404(defun calendar-insert-at-column (indent string truncate)
1405 "Move to column INDENT, adding spaces as needed.
1406Inserts STRING so that it ends at INDENT. STRING is either a
1407literal string, or a sexp to evaluate to return such. Truncates
c7e73d51 Glenn Morris2012-03-15 21:10:46 -04001408STRING to length TRUNCATE, and ensures a trailing space."
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001409 (if (not (ignore-errors (stringp (setq string (eval string)))))
1410 (calendar-move-to-column indent)
c7e73d51
GM
Glenn Morris2012-03-15 21:10:46 -04001411 (if (> (string-width string) truncate)
1412 (setq string (truncate-string-to-width string truncate)))
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001413 (or (string-match " $" string)
c7e73d51
GM
Glenn Morris2012-03-15 21:10:46 -04001414 (setq string (concat (if (= (string-width string) truncate)
1415 (substring string 0 -1)
1416 string)
1417 ;; Avoid inserting text properties unless
1418 ;; we have to (ie, non-unit-width chars).
1419 ;; This is by no means essential.
1420 (if (= (string-width string) (length string))
1421 " "
1422 ;; Cribbed from buff-menu.el.
1423 (propertize
1424 " " 'display `(space :align-to ,indent))))))
1425 (calendar-move-to-column (- indent (string-width string)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001426 (insert string)))
1427
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001428(defun calendar-generate-month (month year indent)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001429 "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
f2172a68
EZ
Eli Zaretskii2002-01-28 19:23:14 +00001430The calendar is inserted at the top of the buffer in which point is currently
1431located, but indented INDENT spaces. The indentation is done from the first
1432character on the line and does not disturb the first INDENT characters on the
4c635ea3 Glenn Morris2004-02-23 00:11:12 +00001433line."
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001434 (let ((blank-days ; at start of month
1435 (mod
1436 (- (calendar-day-of-week (list month 1 year))
1437 calendar-week-start-day)
1438 7))
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00001439 (last (calendar-last-day-of-month month year))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001440 (trunc (min calendar-intermonth-spacing
1441 (1- calendar-left-margin)))
61debe4a
GM
Glenn Morris2014-03-17 09:04:32 -07001442 (day 1)
1443 j)
d8a200a7 Richard M. Stallman1993-10-20 05:49:24 +00001444 (goto-char (point-min))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001445 (calendar-move-to-column indent)
1446 (insert
69f6644c
GM
Glenn Morris2012-09-19 00:27:29 -07001447 (calendar-string-spread (list calendar-month-header)
1448 ?\s calendar-month-digit-width))
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001449 (calendar-ensure-newline)
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001450 (calendar-insert-at-column indent calendar-intermonth-header trunc)
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04001451 ;; Use the first N characters of each day to head the columns.
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001452 (dotimes (i 7)
61debe4a Glenn Morris2014-03-17 09:04:32 -07001453 (setq j (mod (+ calendar-week-start-day i) 7))
6ce285a6 Glenn Morris2007-07-24 06:12:32 +00001454 (insert
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04001455 (truncate-string-to-width
61debe4a
GM
Glenn Morris2014-03-17 09:04:32 -07001456 (propertize (calendar-day-name j 'header t)
1457 'font-lock-face (if (memq j '(0 6))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04001458 'calendar-weekend-header
1459 'calendar-weekday-header))
1460 calendar-day-header-width nil ?\s)
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001461 (make-string (- calendar-column-width calendar-day-header-width) ?\s)))
1462 (calendar-ensure-newline)
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001463 (calendar-insert-at-column indent calendar-intermonth-text trunc)
21db982b Glenn Morris2008-03-10 02:46:24 +00001464 ;; Add blank days before the first of the month.
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001465 (insert (make-string (* blank-days calendar-column-width) ?\s))
21db982b Glenn Morris2008-03-10 02:46:24 +00001466 ;; Put in the days of the month.
40802b08 Glenn Morris2008-03-15 03:00:17 +00001467 (dotimes (i last)
bb715837 Glenn Morris2008-06-17 05:56:48 +00001468 (setq day (1+ i))
6772c8e1 Glenn Morris2008-06-27 02:41:14 +00001469 ;; TODO should numbers be left-justified, centered...?
17f25e76
GM
Glenn Morris2013-08-04 23:49:37 -07001470 (insert (propertize
1471 (format (format "%%%dd" calendar-day-digit-width) day)
1472 'mouse-face 'highlight
1473 'help-echo (eval calendar-date-echo-text)
09e6d547
GM
Glenn Morris2013-08-04 23:54:30 -07001474 ;; 'date property prevents intermonth text confusing re-searches.
1475 ;; (Tried intangible, it did not really work.)
17f25e76
GM
Glenn Morris2013-08-04 23:49:37 -07001476 'date t)
1477 (make-string
1478 (- calendar-column-width calendar-day-digit-width) ?\s))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001479 (when (and (zerop (mod (+ day blank-days) 7))
1480 (/= day last))
1481 (calendar-ensure-newline)
1482 (setq day (1+ day)) ; first day of next week
1483 (calendar-insert-at-column indent calendar-intermonth-text trunc)))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001484
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001485(defun calendar-redraw ()
cea82f86 Glenn Morris2005-03-01 10:24:33 +00001486 "Redraw the calendar display, if `calendar-buffer' is live."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001487 (interactive)
57dd9e68
LL
Leo Liu2013-01-14 23:39:04 +08001488 (when (get-buffer calendar-buffer)
1489 (with-current-buffer calendar-buffer
1490 (let ((cursor-date (calendar-cursor-to-nearest-date)))
1491 (calendar-generate-window displayed-month displayed-year)
1492 (calendar-cursor-to-visible-date cursor-date))
1493 (when (window-live-p (get-buffer-window))
1494 (set-window-point (get-buffer-window) (point))))))
b924026d Glenn Morris2005-03-09 00:28:22 +00001495
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001496(defvar calendar-mode-map
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001497 (let ((map (make-keymap)))
1498 (suppress-keymap map)
1499 (dolist (c '(narrow-to-region mark-word mark-sexp mark-paragraph
1500 mark-defun mark-whole-buffer mark-page
1501 downcase-region upcase-region kill-region
1502 copy-region-as-kill capitalize-region write-region))
1503 (define-key map (vector 'remap c) 'calendar-not-implemented))
0581e7e7
SM
Stefan Monnier2007-07-27 06:28:39 +00001504 (define-key map "<" 'calendar-scroll-right)
1505 (define-key map "\C-x<" 'calendar-scroll-right)
1506 (define-key map [prior] 'calendar-scroll-right-three-months)
1507 (define-key map "\ev" 'calendar-scroll-right-three-months)
1508 (define-key map ">" 'calendar-scroll-left)
1509 (define-key map "\C-x>" 'calendar-scroll-left)
1510 (define-key map [next] 'calendar-scroll-left-three-months)
1511 (define-key map "\C-v" 'calendar-scroll-left-three-months)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001512 (define-key map "\C-b" 'calendar-backward-day)
1513 (define-key map "\C-p" 'calendar-backward-week)
1514 (define-key map "\e{" 'calendar-backward-month)
1515 (define-key map "\C-x[" 'calendar-backward-year)
1516 (define-key map "\C-f" 'calendar-forward-day)
1517 (define-key map "\C-n" 'calendar-forward-week)
1518 (define-key map [left] 'calendar-backward-day)
1519 (define-key map [up] 'calendar-backward-week)
1520 (define-key map [right] 'calendar-forward-day)
1521 (define-key map [down] 'calendar-forward-week)
1522 (define-key map "\e}" 'calendar-forward-month)
1523 (define-key map "\C-x]" 'calendar-forward-year)
1524 (define-key map "\C-a" 'calendar-beginning-of-week)
1525 (define-key map "\C-e" 'calendar-end-of-week)
1526 (define-key map "\ea" 'calendar-beginning-of-month)
1527 (define-key map "\ee" 'calendar-end-of-month)
1528 (define-key map "\e<" 'calendar-beginning-of-year)
1529 (define-key map "\e>" 'calendar-end-of-year)
1530 (define-key map "\C-@" 'calendar-set-mark)
1531 ;; Many people are used to typing C-SPC and getting C-@.
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001532 (define-key map [?\C-\s] 'calendar-set-mark)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001533 (define-key map "\C-x\C-x" 'calendar-exchange-point-and-mark)
1534 (define-key map "\e=" 'calendar-count-days-region)
1535 (define-key map "gd" 'calendar-goto-date)
1536 (define-key map "gD" 'calendar-goto-day-of-year)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001537 (define-key map "gj" 'calendar-julian-goto-date)
1538 (define-key map "ga" 'calendar-astro-goto-day-number)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001539 (define-key map "gh" 'calendar-hebrew-goto-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001540 (define-key map "gi" 'calendar-islamic-goto-date)
c8d2eff3 Glenn Morris2007-09-16 02:26:29 +00001541 (define-key map "gb" 'calendar-bahai-goto-date)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001542 (define-key map "gC" 'calendar-chinese-goto-date)
06bfc982
GM
Glenn Morris2008-04-05 19:16:40 +00001543 (define-key map "gk" 'calendar-coptic-goto-date)
1544 (define-key map "ge" 'calendar-ethiopic-goto-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001545 (define-key map "gp" 'calendar-persian-goto-date)
1546 (define-key map "gc" 'calendar-iso-goto-date)
1547 (define-key map "gw" 'calendar-iso-goto-week)
06bfc982 Glenn Morris2008-04-05 19:16:40 +00001548 (define-key map "gf" 'calendar-french-goto-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001549 (define-key map "gml" 'calendar-mayan-goto-long-count-date)
1550 (define-key map "gmpc" 'calendar-mayan-previous-round-date)
1551 (define-key map "gmnc" 'calendar-mayan-next-round-date)
1552 (define-key map "gmph" 'calendar-mayan-previous-haab-date)
1553 (define-key map "gmnh" 'calendar-mayan-next-haab-date)
1554 (define-key map "gmpt" 'calendar-mayan-previous-tzolkin-date)
1555 (define-key map "gmnt" 'calendar-mayan-next-tzolkin-date)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001556 (define-key map "Aa" 'appt-add)
1557 (define-key map "Ad" 'appt-delete)
1558 (define-key map "S" 'calendar-sunrise-sunset)
77bc20ee Glenn Morris2008-06-27 00:33:42 +00001559 (define-key map "M" 'calendar-lunar-phases)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001560 (define-key map " " 'scroll-other-window)
958614cf Glenn Morris2013-02-11 20:46:18 -08001561 (define-key map [?\S-\ ] 'scroll-other-window-down)
763f360c Glenn Morris2008-04-07 07:25:40 +00001562 (define-key map "\d" 'scroll-other-window-down)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001563 (define-key map "\C-c\C-l" 'calendar-redraw)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001564 (define-key map "." 'calendar-goto-today)
1565 (define-key map "o" 'calendar-other-month)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001566 (define-key map "q" 'calendar-exit)
cb9b9874 Glenn Morris2007-09-14 04:30:30 +00001567 (define-key map "a" 'calendar-list-holidays)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001568 (define-key map "h" 'calendar-cursor-holidays)
aea566be Glenn Morris2008-04-01 02:46:29 +00001569 (define-key map "x" 'calendar-mark-holidays)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001570 (define-key map "u" 'calendar-unmark)
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001571 (define-key map "m" 'diary-mark-entries)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001572 (define-key map "d" 'diary-view-entries)
9ee4e581 Glenn Morris2008-04-06 20:54:25 +00001573 (define-key map "D" 'diary-view-other-diary-entries)
7d129ac6 Glenn Morris2006-05-13 05:32:29 +00001574 (define-key map "s" 'diary-show-all-entries)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001575 (define-key map "pd" 'calendar-print-day-of-year)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001576 (define-key map "pC" 'calendar-chinese-print-date)
06bfc982
GM
Glenn Morris2008-04-05 19:16:40 +00001577 (define-key map "pk" 'calendar-coptic-print-date)
1578 (define-key map "pe" 'calendar-ethiopic-print-date)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001579 (define-key map "pp" 'calendar-persian-print-date)
1580 (define-key map "pc" 'calendar-iso-print-date)
1581 (define-key map "pj" 'calendar-julian-print-date)
1582 (define-key map "pa" 'calendar-astro-print-day-number)
0a837994 Glenn Morris2008-04-05 20:58:10 +00001583 (define-key map "ph" 'calendar-hebrew-print-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001584 (define-key map "pi" 'calendar-islamic-print-date)
c8d2eff3 Glenn Morris2007-09-16 02:26:29 +00001585 (define-key map "pb" 'calendar-bahai-print-date)
06bfc982 Glenn Morris2008-04-05 19:16:40 +00001586 (define-key map "pf" 'calendar-french-print-date)
b78b866a Glenn Morris2008-04-04 07:32:39 +00001587 (define-key map "pm" 'calendar-mayan-print-date)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001588 (define-key map "po" 'calendar-print-other-dates)
9ee4e581
GM
Glenn Morris2008-04-06 20:54:25 +00001589 (define-key map "id" 'diary-insert-entry)
1590 (define-key map "iw" 'diary-insert-weekly-entry)
1591 (define-key map "im" 'diary-insert-monthly-entry)
1592 (define-key map "iy" 'diary-insert-yearly-entry)
1593 (define-key map "ia" 'diary-insert-anniversary-entry)
1594 (define-key map "ib" 'diary-insert-block-entry)
1595 (define-key map "ic" 'diary-insert-cyclic-entry)
0a837994
GM
Glenn Morris2008-04-05 20:58:10 +00001596 (define-key map "ihd" 'diary-hebrew-insert-entry)
1597 (define-key map "ihm" 'diary-hebrew-insert-monthly-entry)
f971f8bc Glenn Morris2008-04-24 05:42:47 +00001598 (define-key map "ihy" 'diary-hebrew-insert-yearly-entry)
b78b866a
GM
Glenn Morris2008-04-04 07:32:39 +00001599 (define-key map "iid" 'diary-islamic-insert-entry)
1600 (define-key map "iim" 'diary-islamic-insert-monthly-entry)
1601 (define-key map "iiy" 'diary-islamic-insert-yearly-entry)
c8d2eff3
GM
Glenn Morris2007-09-16 02:26:29 +00001602 (define-key map "iBd" 'diary-bahai-insert-entry)
1603 (define-key map "iBm" 'diary-bahai-insert-monthly-entry)
1604 (define-key map "iBy" 'diary-bahai-insert-yearly-entry)
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +08001605 (define-key map "iCd" 'diary-chinese-insert-entry)
1606 (define-key map "iCm" 'diary-chinese-insert-monthly-entry)
1607 (define-key map "iCy" 'diary-chinese-insert-yearly-entry)
1608 (define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001609 (define-key map "?" 'calendar-goto-info-node)
582172c6
GM
Glenn Morris2006-10-28 21:53:34 +00001610 (define-key map "Hm" 'cal-html-cursor-month)
1611 (define-key map "Hy" 'cal-html-cursor-year)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001612 (define-key map "tm" 'cal-tex-cursor-month)
1613 (define-key map "tM" 'cal-tex-cursor-month-landscape)
1614 (define-key map "td" 'cal-tex-cursor-day)
1615 (define-key map "tw1" 'cal-tex-cursor-week)
1616 (define-key map "tw2" 'cal-tex-cursor-week2)
f1f4dba0
GM
Glenn Morris2012-10-06 11:34:23 -07001617 (define-key map "tw3" 'cal-tex-cursor-week-iso) ; FIXME twi ?
1618 (define-key map "tw4" 'cal-tex-cursor-week-monday) ; twm ?
1619 (define-key map "twW" 'cal-tex-cursor-week2-summary)
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00001620 (define-key map "tfd" 'cal-tex-cursor-filofax-daily)
1621 (define-key map "tfw" 'cal-tex-cursor-filofax-2week)
1622 (define-key map "tfW" 'cal-tex-cursor-filofax-week)
1623 (define-key map "tfy" 'cal-tex-cursor-filofax-year)
1624 (define-key map "ty" 'cal-tex-cursor-year)
1625 (define-key map "tY" 'cal-tex-cursor-year-landscape)
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001626
1627 (define-key map [menu-bar edit] 'undefined)
1628 (define-key map [menu-bar search] 'undefined)
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001629
6e73a6a2 Glenn Morris2008-06-26 22:30:01 +00001630 (easy-menu-define nil map nil cal-menu-sunmoon-menu)
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001631 (easy-menu-define nil map nil cal-menu-diary-menu)
1632 (easy-menu-define nil map nil cal-menu-holidays-menu)
1633 (easy-menu-define nil map nil cal-menu-goto-menu)
1634 (easy-menu-define nil map nil cal-menu-scroll-menu)
0368765e Juanma Barranquero2008-03-06 15:01:24 +00001635
bb715837 Glenn Morris2008-06-17 05:56:48 +00001636 ;; These are referenced in the default calendar-date-echo-text.
458cf788
SM
Stefan Monnier2007-07-25 21:59:26 +00001637 (define-key map [down-mouse-3]
1638 (easy-menu-binding cal-menu-context-mouse-menu))
1639 (define-key map [down-mouse-2]
1640 (easy-menu-binding cal-menu-global-mouse-menu))
1641
daedbbc2 Glenn Morris2009-09-22 07:37:58 +00001642 ;; cf scroll-bar.el.
3f0f1700
GM
Glenn Morris2011-04-05 19:05:45 -07001643 (if (and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
1644 (define-key map [vertical-scroll-bar mouse-1]
1645 'calendar-scroll-toolkit-scroll)
1646 ;; Left-click moves us forward in time, right-click backwards.
1647 (define-key map [vertical-scroll-bar mouse-1] 'calendar-scroll-left)
1648 (define-key map [vertical-scroll-bar drag-mouse-1] 'calendar-scroll-left)
1649 ;; down-mouse-2 stays as scroll-bar-drag.
1650 (define-key map [vertical-scroll-bar mouse-3] 'calendar-scroll-right)
1651 (define-key map [vertical-scroll-bar drag-mouse-3]
1652 'calendar-scroll-right))
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001653 map)
1654 "Keymap for `calendar-mode'.")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001655
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001656;; Calendar mode is suitable only for specially formatted data.
1657(put 'calendar-mode 'mode-class 'special)
1658
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001659(defun calendar-mode-line-entry (command echo &optional key string)
1660 "Return a propertized string for `calendar-mode-line-format'.
1661COMMAND is a command to run, ECHO is the help-echo text, KEY
1662is COMMAND's keybinding, STRING describes the binding."
1663 (propertize (or key
1664 (substitute-command-keys
1665 (format "\\<calendar-mode-map>\\[%s] %s" command string)))
1666 'help-echo (format "mouse-1: %s" echo)
1667 'mouse-face 'mode-line-highlight
1668 'keymap (make-mode-line-mouse-map 'mouse-1 command)))
1669
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001670;; After calendar-mode-map.
1671(defcustom calendar-mode-line-format
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001672 (list
bb715837 Glenn Morris2008-06-17 05:56:48 +00001673 (calendar-mode-line-entry 'calendar-scroll-right "previous month" "<")
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001674 "Calendar"
d4ff5db9 Dave Love2000-09-17 17:06:00 +00001675 (concat
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001676 (calendar-mode-line-entry 'calendar-goto-info-node "read Info on Calendar"
1677 nil "info")
25ccbfee Chong Yidong2006-12-23 19:07:12 +00001678 " / "
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001679 (calendar-mode-line-entry 'calendar-other-month "choose another month"
1680 nil "other")
25ccbfee Chong Yidong2006-12-23 19:07:12 +00001681 " / "
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001682 (calendar-mode-line-entry 'calendar-goto-today "go to today's date"
1683 nil "today"))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001684 '(calendar-date-string (calendar-current-date) t)
bb715837 Glenn Morris2008-06-17 05:56:48 +00001685 (calendar-mode-line-entry 'calendar-scroll-left "next month" ">"))
2805ba19 Christopher Schmidt2014-09-13 19:44:32 +02001686 "If non-nil, the mode line of the calendar buffer.
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001687This is a list of items that evaluate to strings. The elements
1688are evaluated and concatenated, evenly separated by blanks.
1689During evaluation, the variable `date' is available as the date
1690nearest the cursor (or today's date if that fails). To update
2805ba19
CS
Christopher Schmidt2014-09-13 19:44:32 +02001691the mode-line as the cursor moves, add
1692`calendar-update-mode-line' to `calendar-move-hook'.
1693
1694If nil, do not modify the mode line at all.
1695
1696Here is an example that has the Hebrew date, the day number/days
1697remaining in the year, and the ISO week/year numbers:
a39f5a80 Richard M. Stallman2002-04-03 14:36:02 +00001698
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001699 (list
1700 \"\"
1701 '(calendar-hebrew-date-string date)
1702 '(let* ((year (calendar-extract-year date))
1703 (d (calendar-day-number date))
1704 (days-remaining
1705 (- (calendar-day-number (list 12 31 year)) d)))
1706 (format \"%d/%d\" d days-remaining))
1707 '(let* ((d (calendar-absolute-from-gregorian date))
1708 (iso-date (calendar-iso-from-absolute d)))
1709 (format \"ISO week %d of %d\"
1710 (calendar-extract-month iso-date)
1711 (calendar-extract-year iso-date)))
1712 \"\"))"
1713 :risky t
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001714 :type 'sexp
1715 :group 'calendar)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001716
cba0c253
ER
Edward M. Reingold1994-10-26 15:26:22 +00001717(defun calendar-goto-info-node ()
1718 "Go to the info node for the calendar."
1719 (interactive)
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001720 (info "(emacs)Calendar/Diary")
1721 (fit-window-to-buffer))
5d22135b Markus Rost2002-11-16 19:19:35 +00001722
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00001723(defvar calendar-mark-ring nil
1724 "Used by `calendar-set-mark'.")
1725
bb715837 Glenn Morris2008-06-17 05:56:48 +00001726(define-derived-mode calendar-mode nil "Calendar"
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001727 "A major mode for the calendar window.
bb715837 Glenn Morris2008-06-17 05:56:48 +00001728For a complete description, see the info node `Calendar/Diary'.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001729
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001730\\<calendar-mode-map>\\{calendar-mode-map}"
bb715837 Glenn Morris2008-06-17 05:56:48 +00001731 (setq buffer-read-only t
aea566be Glenn Morris2008-04-01 02:46:29 +00001732 buffer-undo-list t
f62611de Glenn Morris2008-03-08 03:47:03 +00001733 indent-tabs-mode nil)
536aea70 Glenn Morris2012-01-05 20:03:40 -05001734 (set (make-local-variable 'scroll-margin) 0) ; bug#10379
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001735 (calendar-update-mode-line)
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001736 (make-local-variable 'calendar-mark-ring)
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001737 (make-local-variable 'displayed-month) ; month in middle of window
1738 (make-local-variable 'displayed-year) ; year in middle of window
712f4efe
SM
Stefan Monnier2007-07-29 20:49:13 +00001739 ;; Most functions only work if displayed-month and displayed-year are set,
1740 ;; so let's make sure they're always set. Most likely, this will be reset
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001741 ;; soon in calendar-generate, but better safe than sorry.
712f4efe
SM
Stefan Monnier2007-07-29 20:49:13 +00001742 (unless (boundp 'displayed-month) (setq displayed-month 1))
1743 (unless (boundp 'displayed-year) (setq displayed-year 2001))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04001744 (if (bound-and-true-p calendar-font-lock-keywords)
1745 (set (make-local-variable 'font-lock-defaults)
1746 '(calendar-font-lock-keywords t))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001747
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001748(defun calendar-string-spread (strings char length)
cbecb9f9
ER
Edward M. Reingold1995-06-02 22:02:17 +00001749 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
1750The effect is like mapconcat but the separating pieces are as balanced as
1751possible. Each item of STRINGS is evaluated before concatenation so it can
1752actually be an expression that evaluates to a string. If LENGTH is too short,
1753the STRINGS are just concatenated and the result truncated."
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001754;; The algorithm is based on equation (3.25) on page 85 of Concrete
1755;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
21db982b Glenn Morris2008-03-10 02:46:24 +00001756;; Addison-Wesley, Reading, MA, 1989.
cbecb9f9
ER
Edward M. Reingold1995-06-02 22:02:17 +00001757 (let* ((strings (mapcar 'eval
1758 (if (< (length strings) 2)
1759 (append (list "") strings (list ""))
1760 strings)))
3809f91d
GM
Glenn Morris2012-03-13 13:56:31 -04001761 (n (- length (string-width (apply 'concat strings))))
1762 (m (* (1- (length strings)) (char-width char)))
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001763 (s (car strings))
1764 (strings (cdr strings))
1765 (i 0))
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00001766 (dolist (string strings)
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00001767 (setq s (concat s
1768 (make-string (max 0 (/ (+ n i) m)) char)
df3b40c1
GM
Glenn Morris2008-03-16 01:22:58 +00001769 string)
1770 i (1+ i)))
3809f91d Glenn Morris2012-03-13 13:56:31 -04001771 (truncate-string-to-width s length)))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00001772
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001773(defun calendar-update-mode-line ()
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001774 "Update the calendar mode line with the current date and date style."
2805ba19
CS
Christopher Schmidt2014-09-13 19:44:32 +02001775 (if (and calendar-mode-line-format
1776 (bufferp (get-buffer calendar-buffer)))
34cb0115 Stefan Monnier2005-09-12 21:32:11 +00001777 (with-current-buffer calendar-buffer
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001778 (let ((start (- calendar-left-margin 2))
1779 (date (condition-case nil
1780 (calendar-cursor-to-nearest-date)
1781 (error (calendar-current-date)))))
1782 (setq mode-line-format
1783 (concat (make-string (max 0 (+ start
1784 (- (car (window-inside-edges))
1785 (car (window-edges))))) ?\s)
1786 (calendar-string-spread
1787 (mapcar 'eval calendar-mode-line-format)
1788 ?\s (- calendar-right-margin (1- start))))))
a39f5a80 Richard M. Stallman2002-04-03 14:36:02 +00001789 (force-mode-line-update))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001790
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001791(defun calendar-buffer-list ()
27a28b50 Glenn Morris2008-03-14 02:46:37 +00001792 "List of all calendar-related buffers (as buffers, not strings)."
bae5a5a3 Glenn Morris2008-03-13 04:06:47 +00001793 (let (buffs)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001794 (dolist (b (list calendar-hebrew-yahrzeit-buffer lunar-phases-buffer
6e73a6a2 Glenn Morris2008-06-26 22:30:01 +00001795 holiday-buffer diary-fancy-buffer solar-sunrises-buffer
bae5a5a3 Glenn Morris2008-03-13 04:06:47 +00001796 (get-file-buffer diary-file)
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00001797 calendar-buffer calendar-other-calendars-buffer))
27a28b50 Glenn Morris2008-03-14 02:46:37 +00001798 (and b (setq b (get-buffer b))
bae5a5a3
GM
Glenn Morris2008-03-13 04:06:47 +00001799 (push b buffs)))
1800 buffs))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001801
48c455c7 Sam Steingold2012-06-05 13:33:10 -04001802(defun calendar-exit (&optional kill)
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001803 "Get out of the calendar window and hide it and related buffers."
48c455c7
SS
Sam Steingold2012-06-05 13:33:10 -04001804 (interactive "P")
1805 (let ((diary-buffer (get-file-buffer diary-file))
1806 (calendar-buffers (calendar-buffer-list)))
1807 (when (or (not diary-buffer)
1808 (not (buffer-modified-p diary-buffer))
1809 (yes-or-no-p
1810 "Diary modified; do you really want to exit the calendar? "))
1811 (if (and calendar-setup (display-multi-frame-p))
1812 ;; FIXME: replace this cruft with the `quit-restore' window property
1813 (dolist (w (window-list-1 nil nil t))
1814 (if (and (memq (window-buffer w) calendar-buffers)
1815 (window-dedicated-p w))
5cf983b2
MR
Martin Rudalics2012-06-26 09:13:40 +02001816 (if (eq (window-deletable-p w) 'frame)
1817 (if calendar-remove-frame-by-deleting
1818 (delete-frame (window-frame w))
1819 (iconify-frame (window-frame w)))
1820 (quit-window kill w))))
48c455c7
SS
Sam Steingold2012-06-05 13:33:10 -04001821 (dolist (b calendar-buffers)
1822 (quit-windows-on b kill))))))
cba0c253 Edward M. Reingold1994-10-26 15:26:22 +00001823
3ce82f97
GM
Glenn Morris2009-07-08 02:46:23 +00001824(defun calendar-current-date (&optional offset)
1825 "Return the current date in a list (month day year).
7ef5b8b2
GM
Glenn Morris2009-07-08 02:48:11 +00001826Optional integer OFFSET is a number of days from the current date."
1827 (let* ((now (decode-time))
1828 (now (list (nth 4 now) (nth 3 now) (nth 5 now))))
1829 (if (zerop (or offset 0))
1830 now
1831 (calendar-gregorian-from-absolute
1832 (+ offset (calendar-absolute-from-gregorian now))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001833
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001834(defun calendar-column-to-segment ()
1835 "Convert current column to calendar month \"segment\".
1836The left-most month returns 0, the next right 1, and so on."
1837 (let ((col (max 0 (+ (current-column)
1838 (/ calendar-intermonth-spacing 2)
1839 (- calendar-left-margin)))))
1840 (/ col (+ (* 7 calendar-column-width) calendar-intermonth-spacing))))
0c74d40b Glenn Morris2008-06-21 19:28:09 +00001841
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001842(defun calendar-cursor-to-date (&optional error event)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00001843 "Return a list (month day year) of current cursor position.
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001844If cursor is not on a specific date, signals an error if optional parameter
10979c74
SM
Stefan Monnier2008-06-17 15:42:19 +00001845ERROR is non-nil, otherwise just returns nil.
1846If EVENT is non-nil, it's an event indicating the buffer position to
1847use instead of point."
1848 (with-current-buffer
1849 (if event (window-buffer (posn-window (event-start event)))
1850 (current-buffer))
1851 (save-excursion
2b11fcd5
GM
Glenn Morris2008-06-26 07:08:01 +00001852 (and event (setq event (event-start event))
1853 (goto-char (posn-point event)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001854 (let* ((segment (calendar-column-to-segment))
1855 (month (% (+ displayed-month (1- segment)) 12)))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001856 ;; Call with point on either of the two digits in a 2-digit date,
1857 ;; or on or before the digit of a 1-digit date.
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001858 (if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
b1c172fe Glenn Morris2008-06-26 03:41:20 +00001859 (get-text-property (point) 'date)))
71873e2b Stefan Monnier2012-05-04 19:16:47 -04001860 (if error (user-error "Not on a date!"))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001861 ;; Convert segment to real month and year.
1862 (if (zerop month) (setq month 12))
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001863 ;; Go back to before the first date digit.
1864 (or (looking-at " ")
458cf788 Stefan Monnier2007-07-25 21:59:26 +00001865 (re-search-backward "[^0-9]"))
c93b9aae Edward M. Reingold1994-02-23 02:38:23 +00001866 (list month
0c74d40b
GM
Glenn Morris2008-06-21 19:28:09 +00001867 (string-to-number
1868 (buffer-substring (1+ (point))
1869 (+ 1 calendar-day-digit-width (point))))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00001870 (cond
1871 ((and (= 12 month) (zerop segment)) (1- displayed-year))
1872 ((and (= 1 month) (= segment 2)) (1+ displayed-year))
1873 (t displayed-year))))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001874
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001875;; The following version of calendar-gregorian-from-absolute is preferred for
1876;; reasons of clarity, BUT it's much slower than the version that follows it.
1877
1878;;(defun calendar-gregorian-from-absolute (date)
1879;; "Compute the list (month day year) corresponding to the absolute DATE.
1880;;The absolute date is the number of days elapsed since the (imaginary)
1881;;Gregorian date Sunday, December 31, 1 BC."
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001882;; (let* ((approx (/ date 366)) ; approximation from below
1883;; (year ; search forward from the approximation
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001884;; (+ approx
1885;; (calendar-sum y approx
1886;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
1887;; 1)))
21db982b Glenn Morris2008-03-10 02:46:24 +00001888;; (month ; search forward from January
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001889;; (1+ (calendar-sum m 1
1890;; (> date
1891;; (calendar-absolute-from-gregorian
1892;; (list m (calendar-last-day-of-month m year) year)))
1893;; 1)))
21db982b Glenn Morris2008-03-10 02:46:24 +00001894;; (day ; calculate the day by subtraction
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001895;; (- date
1896;; (1- (calendar-absolute-from-gregorian (list month 1 year))))))
1897;; (list month day year)))
1898
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001899(defun calendar-gregorian-from-absolute (date)
1900 "Compute the list (month day year) corresponding to the absolute DATE.
1901The absolute date is the number of days elapsed since the (imaginary)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00001902Gregorian date Sunday, December 31, 1 BC. This function does not
1903handle dates in years BC."
21db982b
GM
Glenn Morris2008-03-10 02:46:24 +00001904 ;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
1905 ;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
1906 ;; Clamen, Software--Practice and Experience, Volume 23, Number 4
1907 ;; (April, 1993), pages 383-404 for an explanation.
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001908 (let* ((d0 (1- date))
1909 (n400 (/ d0 146097))
1910 (d1 (% d0 146097))
1911 (n100 (/ d1 36524))
1912 (d2 (% d1 36524))
1913 (n4 (/ d2 1461))
1914 (d3 (% d2 1461))
1915 (n1 (/ d3 365))
1916 (day (1+ (% d3 365)))
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001917 (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1))
1918 (month 1)
1919 mdays)
354d0644
JB
Jim Blandy1993-06-22 03:22:12 +00001920 (if (or (= n100 4) (= n1 4))
1921 (list 12 31 year)
2475d1a3
GM
Glenn Morris2008-04-02 03:35:38 +00001922 (setq year (1+ year))
1923 (while (< (setq mdays (calendar-last-day-of-month month year)) day)
1924 (setq day (- day mdays)
1925 month (1+ month)))
1926 (list month day year))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001927
bb715837
GM
Glenn Morris2008-06-17 05:56:48 +00001928(defun calendar-other-month (month year &optional event)
1929 "Display a three-month calendar centered around MONTH and YEAR.
1930EVENT is an event like `last-nonmenu-event'."
1931 (interactive (let ((event (list last-nonmenu-event)))
1932 (append (calendar-read-date 'noday) event)))
1933 (save-selected-window
1934 (and event
1935 (setq event (event-start event))
1936 (select-window (posn-window event)))
1937 (unless (and (= month displayed-month)
1938 (= year displayed-year))
1939 (let ((old-date (calendar-cursor-to-date))
1940 (today (calendar-current-date)))
1941 (calendar-generate-window month year)
1942 (calendar-cursor-to-visible-date
1943 (cond
1944 ((calendar-date-is-visible-p old-date) old-date)
1945 ((calendar-date-is-visible-p today) today)
1946 (t (list month 1 year))))))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00001947
10979c74 Stefan Monnier2008-06-17 15:42:19 +00001948(defun calendar-set-mark (arg &optional event)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001949 "Mark the date under the cursor, or jump to marked date.
1950With no prefix argument, push current date onto marked date ring.
21db982b Glenn Morris2008-03-10 02:46:24 +00001951With argument ARG, jump to mark, pop it, and put point at end of ring."
10979c74
SM
Stefan Monnier2008-06-17 15:42:19 +00001952 (interactive
1953 (list current-prefix-arg last-nonmenu-event))
1954 (let ((date (calendar-cursor-to-date t event)))
40802b08
GM
Glenn Morris2008-03-15 03:00:17 +00001955 (if arg
1956 (if (null calendar-mark-ring)
1957 (error "No mark set in this buffer")
1958 (calendar-goto-date (car calendar-mark-ring))
1959 (setq calendar-mark-ring
1960 (cdr (nconc calendar-mark-ring (list date)))))
1961 (push date calendar-mark-ring)
1962 ;; Since the top of the mark ring is the marked date in the
1963 ;; calendar, the mark ring in the calendar is one longer than
1964 ;; in other buffers to get the same effect.
1965 (if (> (length calendar-mark-ring) (1+ mark-ring-max))
1966 (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
1967 (message "Mark set"))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001968
1969(defun calendar-exchange-point-and-mark ()
1970 "Exchange the current cursor position with the marked date."
1971 (interactive)
1972 (let ((mark (car calendar-mark-ring))
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001973 (date (calendar-cursor-to-date t)))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001974 (if (null mark)
1975 (error "No mark set in this buffer")
1976 (setq calendar-mark-ring (cons date (cdr calendar-mark-ring)))
1977 (calendar-goto-date mark))))
1978
1979(defun calendar-count-days-region ()
1980 "Count the number of days (inclusive) between point and the mark."
1981 (interactive)
1982 (let* ((days (- (calendar-absolute-from-gregorian
ffd82264 Richard M. Stallman1994-02-07 20:42:44 +00001983 (calendar-cursor-to-date t))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00001984 (calendar-absolute-from-gregorian
1985 (or (car calendar-mark-ring)
1986 (error "No mark set in this buffer")))))
1987 (days (1+ (if (> days 0) days (- days)))))
1988 (message "Region has %d day%s (inclusive)"
1989 days (if (> days 1) "s" ""))))
1990
1991(defun calendar-not-implemented ()
1992 "Not implemented."
1993 (interactive)
1994 (error "%s not available in the calendar"
1995 (global-key-binding (this-command-keys))))
1996
1997(defun calendar-read (prompt acceptable &optional initial-contents)
1998 "Return an object read from the minibuffer.
1999Prompt with the string PROMPT and use the function ACCEPTABLE to decide if
2000entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS
2001is a string to insert in the minibuffer before reading."
2002 (let ((value (read-minibuffer prompt initial-contents)))
2003 (while (not (funcall acceptable value))
2004 (setq value (read-minibuffer prompt initial-contents)))
2005 value))
2006
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002007
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002008(defun calendar-customized-p (symbol)
2009 "Return non-nil if SYMBOL has been customized."
2010 (and (default-boundp symbol)
2011 (let ((standard (get symbol 'standard-value)))
2012 (and standard
2013 (not (equal (eval (car standard)) (default-value symbol)))))))
2014
3b5c03d3 Glenn Morris2013-08-06 19:53:49 -04002015(defun calendar-abbrev-construct (full &optional maxlen)
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002016 "From sequence FULL, return a vector of abbreviations.
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002017Each abbreviation is no longer than MAXLEN (default `calendar-abbrev-length')
2018characters."
2019 (or maxlen (setq maxlen calendar-abbrev-length))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002020 (apply 'vector (mapcar
2021 (lambda (f)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002022 ;; TODO? truncate-string-to-width?
2023 (substring f 0 (min maxlen (length f))))
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002024 full)))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002025
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002026(defcustom calendar-day-name-array
b642d11e Edward M. Reingold1998-10-21 20:03:07 +00002027 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002028 "Array of capitalized strings giving, in order from Sunday, the day names.
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002029If you change this without using customize after the calendar has loaded,
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002030then you may also want to change `calendar-day-abbrev-array'
2031and `calendar-day-header-array'."
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002032 :group 'calendar
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002033 :initialize 'custom-initialize-default
2034 :set (lambda (symbol value)
2035 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002036 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2037 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002038 (set symbol value)
2039 (or dcustomized
2040 (setq calendar-day-abbrev-array
2041 (calendar-abbrev-construct calendar-day-name-array)))
2042 (and (not hcustomized)
2043 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002044 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2045 (or ccustomized
2046 (equal calendar-day-header-array
2047 (setq calendar-day-header-array
2048 (calendar-day-header-construct)))
2049 (calendar-redraw))))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00002050 :type '(vector (string :tag "Sunday")
2051 (string :tag "Monday")
2052 (string :tag "Tuesday")
2053 (string :tag "Wednesday")
2054 (string :tag "Thursday")
2055 (string :tag "Friday")
2056 (string :tag "Saturday")))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002057
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002058(defcustom calendar-abbrev-length 3
2059 "Default length of abbreviations to use for day and month names.
2060If you change this without using customize after the calendar has loaded,
2061then you may also want to change `calendar-day-abbrev-array' and
2062`calendar-month-abbrev-array'."
2063 :group 'calendar
2064 :initialize 'custom-initialize-default
2065 :set (lambda (symbol value)
2066 (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
2067 (mcustomized (calendar-customized-p
2068 'calendar-month-abbrev-array))
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002069 (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2070 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002071 (set symbol value)
2072 (or dcustomized
2073 (setq calendar-day-abbrev-array
2074 (calendar-abbrev-construct calendar-day-name-array)))
2075 (or mcustomized
2076 (setq calendar-month-abbrev-array
2077 (calendar-abbrev-construct calendar-month-name-array)))
2078 (and (not hcustomized)
2079 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002080 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2081 (or ccustomized
2082 (equal calendar-day-header-array
2083 (setq calendar-day-header-array
2084 (calendar-day-header-construct)))
2085 (calendar-redraw))))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002086 :type 'integer)
2087
2088(defcustom calendar-day-abbrev-array
2089 (calendar-abbrev-construct calendar-day-name-array)
2090 "Array of capitalized strings giving the abbreviated day names.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002091The order should be the same as that of the full names specified
2092in `calendar-day-name-array'. These abbreviations may be used
2093instead of the full names in the diary file. Do not include a
2094trailing `.' in the strings specified in this variable, though
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002095you may use such in the diary file. By default, each string is
2096the first `calendar-abbrev-length' characters of the corresponding
2097full name."
2098 :group 'calendar
2099 :initialize 'custom-initialize-default
2100 :set-after '(calendar-abbrev-length calendar-day-name-array)
2101 :set (lambda (symbol value)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002102 (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array))
2103 (ccustomized (calendar-customized-p 'calendar-day-header-array)))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002104 (set symbol value)
2105 (and (not hcustomized)
2106 (boundp 'cal-html-day-abbrev-array)
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002107 (setq cal-html-day-abbrev-array calendar-day-abbrev-array))
2108 (or ccustomized
2109 (equal calendar-day-header-array
2110 (setq calendar-day-header-array
2111 (calendar-day-header-construct)))
2112 (calendar-redraw))))
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002113 :type '(vector (string :tag "Sun")
2114 (string :tag "Mon")
2115 (string :tag "Tue")
2116 (string :tag "Wed")
2117 (string :tag "Thu")
2118 (string :tag "Fri")
2119 (string :tag "Sat"))
2120 ;; Made defcustom, changed defaults from nil nil...
2121 :version "24.1")
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002122
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002123(defcustom calendar-day-header-array (calendar-day-header-construct)
2124 "Array of strings to use for the headers of the calendar's day columns.
2125The order should be the same as in `calendar-day-name-array'.
2126In use, the calendar truncates elements to no more than
2127`calendar-day-header-width' columns wide.
2128Emacs constructs the default from either `calendar-day-name-array'
2129\(if `calendar-day-header-width' is more than `calendar-abbrev-length'),
2130or from `calendar-day-abbrev-array' (assuming that the abbreviated
2131name are more likely to be unique when truncated)."
2132 :group 'calendar
2133 :initialize 'custom-initialize-default
2134 :set-after '(calendar-day-header-width
2135 calendar-abbrev-length calendar-day-name-array
2136 calendar-day-abbrev-array)
2137 :set (lambda (symbol value)
2138 (or (equal calendar-day-header-array
2139 (set symbol value))
2140 (calendar-redraw)))
2141 :type '(vector (string :tag "Su")
2142 (string :tag "Mo")
2143 (string :tag "Tu")
2144 (string :tag "We")
2145 (string :tag "Th")
2146 (string :tag "Fr")
2147 (string :tag "Sa"))
2148 :version "24.4")
2149
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002150(defcustom calendar-month-name-array
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002151 ["January" "February" "March" "April" "May" "June"
b642d11e Edward M. Reingold1998-10-21 20:03:07 +00002152 "July" "August" "September" "October" "November" "December"]
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002153 "Array of capitalized strings giving, in order, the month names.
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002154If you change this without using customize after the calendar has loaded,
2155then you may also want to change `calendar-month-abbrev-array'."
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002156 :group 'calendar
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002157 :initialize 'custom-initialize-default
2158 :set (lambda (symbol value)
2159 (let ((mcustomized (calendar-customized-p
2160 'calendar-month-abbrev-array)))
2161 (set symbol value)
2162 (or mcustomized
2163 (setq calendar-month-abbrev-array
2164 (calendar-abbrev-construct calendar-month-name-array)))))
bf0cce5a
GM
Glenn Morris2008-03-17 02:30:06 +00002165 :type '(vector (string :tag "January")
2166 (string :tag "February")
2167 (string :tag "March")
2168 (string :tag "April")
2169 (string :tag "May")
2170 (string :tag "June")
2171 (string :tag "July")
2172 (string :tag "August")
2173 (string :tag "September")
2174 (string :tag "October")
2175 (string :tag "November")
2176 (string :tag "December")))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002177
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002178(defcustom calendar-month-abbrev-array
2179 (calendar-abbrev-construct calendar-month-name-array)
2180 "Array of capitalized strings giving the abbreviated month names.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002181The order should be the same as that of the full names specified
2182in `calendar-month-name-array'. These abbreviations are used in
2183the calendar menu entries, and can also be used in the diary
2184file. Do not include a trailing `.' in the strings specified in
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002185this variable, though you may use such in the diary file. By
9d35bb8d Paul Eggert2015-05-19 14:59:15 -07002186default, each string is the first `calendar-abbrev-length'
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002187characters of the corresponding full name."
2188 :group 'calendar
2189 :set-after '(calendar-abbrev-length calendar-month-name-array)
2190 :type '(vector (string :tag "Jan")
2191 (string :tag "Feb")
2192 (string :tag "Mar")
2193 (string :tag "Apr")
2194 (string :tag "May")
2195 (string :tag "Jun")
2196 (string :tag "Jul")
2197 (string :tag "Aug")
2198 (string :tag "Sep")
2199 (string :tag "Oct")
2200 (string :tag "Nov")
2201 (string :tag "Dec"))
2202 ;; Made defcustom, changed defaults from nil nil...
2203 :version "24.1")
2204
2205(defun calendar-make-alist (sequence &optional start-index filter
2206 &rest sequences)
2207 "Return an association list corresponding to SEQUENCE.
2208Associates each element of SEQUENCE with an incremented integer,
2209starting from START-INDEX (default 1). Applies the function FILTER,
2210if provided, to each key in the alist. Repeats the process, with
2211indices starting from START-INDEX each time, for any remaining
2212arguments SEQUENCES."
2213 (or start-index (setq start-index 1))
2214 (let (index alist)
2215 (mapc (lambda (seq)
2216 (setq index start-index)
2217 (mapc (lambda (elem)
2218 (setq alist (cons
2219 (cons (if filter (funcall filter elem) elem)
2220 index)
2221 alist)
2222 index (1+ index)))
2223 seq))
2224 (append (list sequence) sequences))
2225 (reverse alist)))
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002226
2227(defun calendar-read-date (&optional noday)
2228 "Prompt for Gregorian date. Return a list (month day year).
2229If optional NODAY is t, does not ask for day, but just returns
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002230\(month 1 year); if NODAY is any other non-nil value the value returned is
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002231\(month year)"
2232 (let* ((year (calendar-read
2233 "Year (>0): "
2234 (lambda (x) (> x 0))
d92bcf94 Glenn Morris2008-04-08 07:08:24 +00002235 (number-to-string (calendar-extract-year
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002236 (calendar-current-date)))))
2237 (month-array calendar-month-name-array)
2238 (completion-ignore-case t)
2239 (month (cdr (assoc-string
2240 (completing-read
2241 "Month name: "
2242 (mapcar 'list (append month-array nil))
2243 nil t)
2244 (calendar-make-alist month-array 1) t)))
2245 (last (calendar-last-day-of-month month year)))
2246 (if noday
2247 (if (eq noday t)
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002248 (list month 1 year)
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002249 (list month year))
2250 (list month
2251 (calendar-read (format "Day (1-%d): " last)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002252 (lambda (x) (and (< 0 x) (<= x last))))
f62611de
GM
Glenn Morris2008-03-08 03:47:03 +00002253 year))))
2254
2255(defun calendar-interval (mon1 yr1 mon2 yr2)
2256 "The number of months difference between MON1, YR1 and MON2, YR2.
2257The result is positive if the second date is later than the first.
2258Negative years are interpreted as years BC; -1 being 1 BC, and so on."
2259 (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
2260 (if (< yr2 0) (setq yr2 (1+ yr2)))
2261 (+ (* 12 (- yr2 yr1))
2262 (- mon2 mon1)))
2263
8a806f04 Glenn Morris2013-08-06 20:06:43 -04002264(defvar calendar-font-lock-keywords nil
5d22135b
MR
Markus Rost2002-11-16 19:19:35 +00002265 "Default keywords to highlight in Calendar mode.")
2266
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002267(make-obsolete-variable 'calendar-font-lock-keywords
2268 "set font-lock keywords in `calendar-mode-hook', \
2269or customize calendar faces." "24.4")
2270
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002271(defun calendar-day-name (date &optional abbrev absolute)
e0dfc625 Richard M. Stallman2002-12-07 21:30:57 +00002272 "Return a string with the name of the day of the week of DATE.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002273DATE should be a list in the format (MONTH DAY YEAR), unless the
2274optional argument ABSOLUTE is non-nil, in which case DATE should
2275be an integer in the range 0 to 6 corresponding to the day of the
2276week. Day names are taken from the variable `calendar-day-name-array',
3b5c03d3
GM
Glenn Morris2013-08-06 19:53:49 -04002277unless the optional argument ABBREV is non-nil:
2278`header' means to use `calendar-day-header-array';
2279t to use `calendar-day-abbrev-array'."
2280 (aref (cond ((eq abbrev 'header) calendar-day-header-array)
2281 (abbrev calendar-day-abbrev-array)
2282 (t calendar-day-name-array))
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002283 (if absolute date (calendar-day-of-week date))))
2284
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002285(defun calendar-month-name (month &optional abbrev)
2286 "Return a string with the name of month number MONTH.
2287Months are numbered from one. Month names are taken from the
2288variable `calendar-month-name-array', unless the optional
2289argument ABBREV is non-nil, in which case
2290`calendar-month-abbrev-array' is used."
e565dd37 Glenn Morris2011-05-17 20:20:13 -07002291 (aref (if abbrev calendar-month-abbrev-array calendar-month-name-array)
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002292 (1- month)))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002293
2294(defun calendar-day-of-week (date)
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00002295 "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
2296DATE is a list of the form (month day year). A negative year is
2297interpreted as BC; -1 being 1 BC, and so on."
2298 (mod (calendar-absolute-from-gregorian date) 7))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002299
3260caf8
GM
Glenn Morris2010-07-10 16:34:57 -07002300(defun calendar-week-end-day ()
2301 "Return the index (0 for Sunday, etc.) of the last day of the week."
2302 (mod (+ calendar-week-start-day 6) 7))
2303
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002304(defun calendar-unmark ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002305 "Delete all diary/holiday marks/highlighting from the calendar."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002306 (interactive)
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002307 (setq calendar-mark-holidays-flag nil
2308 calendar-mark-diary-entries-flag nil)
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002309 (with-current-buffer calendar-buffer
2310 (mapc 'delete-overlay (overlays-in (point-min) (point-max)))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002311
2312(defun calendar-date-is-visible-p (date)
f6c762dd
GM
Glenn Morris2008-03-31 07:11:00 +00002313 "Return non-nil if DATE is valid and is visible in the calendar window."
2314 (and (calendar-date-is-valid-p date)
2315 (< (abs (calendar-interval
2316 displayed-month displayed-year
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002317 (calendar-extract-month date) (calendar-extract-year date)))
f6c762dd Glenn Morris2008-03-31 07:11:00 +00002318 2)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002319
7717093c Glenn Morris2008-04-23 02:59:47 +00002320;; FIXME can this be generalized for holiday-chinese?
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002321(defun calendar-nongregorian-visible-p (month day toabs fromabs switch)
2322 "Return non-nil if MONTH, DAY is visible in the calendar window.
2323MONTH and DAY are in some non-Gregorian calendar system. The
2324functions TOABS and FROMABS convert that system to and from
2325absolute, respectively. SWITCH is a function that takes a single
2326argument (a local month number). It applies when the local year
2327changes across the calendar window, and returns non-nil if the
2328specified month should be associated with the higher year.
2329Returns the corresponding Gregorian date."
2330 ;; We need to choose the local year associated with month and day
2331 ;; that might make them visible.
2332 (let* ((m1 displayed-month)
2333 (y1 displayed-year)
2334 (m2 displayed-month)
2335 (y2 displayed-year)
2336 ;; Absolute date of first/last dates in calendar window.
2337 (start-date (progn
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002338 (calendar-increment-month m1 y1 -1)
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002339 (calendar-absolute-from-gregorian (list m1 1 y1))))
2340 (end-date (progn
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002341 (calendar-increment-month m2 y2 1)
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002342 (calendar-absolute-from-gregorian
2343 (list m2 (calendar-last-day-of-month m2 y2) y2))))
2344 ;; Local date of first/last date in calendar window.
2345 (local-start (funcall fromabs start-date))
2346 (local-end (funcall fromabs end-date))
2347 ;; Local year of first/last dates.
2348 ;; Can only differ if displayed-month = 12, 1, 2.
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002349 (local-y1 (calendar-extract-year local-start))
2350 (local-y2 (calendar-extract-year local-end))
b3103ae9
GM
Glenn Morris2008-04-01 02:55:03 +00002351 ;; Choose which year might be visible in the window.
2352 ;; Obviously it only matters when y1 and y2 differ, ie
2353 ;; when the _local_ new year is visible.
2354 (year (if (funcall switch month) local-y2 local-y1))
2355 (date (calendar-gregorian-from-absolute
2356 (funcall toabs (list month day year)))))
2357 (if (calendar-date-is-visible-p date)
2358 date)))
2359
0368765e Juanma Barranquero2008-03-06 15:01:24 +00002360(defun calendar-date-is-valid-p (date)
9f556e44 Werner LEMBERG2005-03-25 09:53:47 +00002361 "Return t if DATE is a valid date."
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002362 (let ((month (calendar-extract-month date))
2363 (day (calendar-extract-day date))
2364 (year (calendar-extract-year date)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002365 (and (<= 1 month) (<= month 12)
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002366 ;; (calendar-read-date t) used to return a date with day = nil.
21f8fcfd
GM
Glenn Morris2006-05-11 06:57:32 +00002367 ;; Should not be valid (?), since many funcs prob assume integer.
2368 ;; (calendar-read-date 'noday) returns (month year), which
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002369 ;; currently results in calendar-extract-year returning nil.
21f8fcfd Glenn Morris2006-05-11 06:57:32 +00002370 day year (<= 1 day) (<= day (calendar-last-day-of-month month year))
9f556e44 Werner LEMBERG2005-03-25 09:53:47 +00002371 ;; BC dates left as non-valid, to suppress errors from
18db8896
GM
Glenn Morris2003-10-01 20:48:17 +00002372 ;; complex holiday algorithms not suitable for years BC.
2373 ;; Note there are side effects on calendar navigation.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002374 (<= 1 year))))
2375
2376(defun calendar-date-equal (date1 date2)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002377 "Return t if the DATE1 and DATE2 are the same."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002378 (and
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002379 (= (calendar-extract-month date1) (calendar-extract-month date2))
2380 (= (calendar-extract-day date1) (calendar-extract-day date2))
2381 (= (calendar-extract-year date1) (calendar-extract-year date2))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002382
c899d5e3
GM
Glenn Morris2008-04-01 04:10:09 +00002383(defun calendar-make-temp-face (attrlist)
2384 "Return a temporary face based on the attributes in ATTRLIST.
2385ATTRLIST is a list with elements of the form :face face :foreground color."
8fe97050
GM
Glenn Morris2008-04-01 07:25:42 +00002386 (let ((attrs attrlist)
2387 faceinfo face temp-face)
2388 ;; Separate :face from the other attributes. Use the last :face
2389 ;; if there are more than one. FIXME is merging meaningful?
2390 (while attrs
2391 (if (eq (car attrs) :face)
2392 (setq face (intern-soft (cadr attrs))
2393 attrs (cddr attrs))
2394 (push (car attrs) faceinfo)
2395 (setq attrs (cdr attrs))))
2396 (or (facep face) (setq face 'default))
2397 (if (not faceinfo)
2398 ;; No attributes to apply, so just use an existing-face.
2399 face
2400 ;; FIXME should we be using numbered temp-faces, re-using where poss?
2401 (setq temp-face
2402 (make-symbol
2403 (concat ":caltemp"
2404 (mapconcat (lambda (sym)
2405 (cond
2406 ((symbolp sym) (symbol-name sym))
2407 ((numberp sym) (number-to-string sym))
2408 (t sym)))
2409 attrlist ""))))
2410 (make-face temp-face)
2411 (copy-face face temp-face)
2412 ;; Apply the font aspects.
2413 (apply 'set-face-attribute temp-face nil (nreverse faceinfo))
2414 temp-face)))
c899d5e3 Glenn Morris2008-04-01 04:10:09 +00002415
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002416(defun calendar-mark-visible-date (date &optional mark)
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002417 "Mark DATE in the calendar window with MARK.
d13c1378 Juanma Barranquero2003-02-11 23:23:10 +00002418MARK is a single-character string, a list of face attributes/values, or a face.
5d22135b Markus Rost2002-11-16 19:19:35 +00002419MARK defaults to `diary-entry-marker'."
0368765e Juanma Barranquero2008-03-06 15:01:24 +00002420 (if (calendar-date-is-valid-p date)
f09cfd28
SM
Stefan Monnier2005-09-19 17:41:22 +00002421 (with-current-buffer calendar-buffer
2422 (save-excursion
2423 (calendar-cursor-to-visible-date date)
2424 (setq mark
2425 (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
6ed17433
GM
Glenn Morris2009-02-08 01:52:01 +00002426 ;; The next two use to also check font-lock-mode.
2427 ;; See comments above diary-entry-marker for why
2428 ;; this was dropped.
2429;;; (and font-lock-mode
2430;;; (or
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00002431 (and (listp mark) (> (length mark) 0) mark) ; attrs
6ed17433
GM
Glenn Morris2009-02-08 01:52:01 +00002432 (and (facep mark) mark) ; )) face-name
2433 diary-entry-marker))
f09cfd28 Stefan Monnier2005-09-19 17:41:22 +00002434 (cond
21db982b Glenn Morris2008-03-10 02:46:24 +00002435 ;; Face or an attr-list that contained a face.
f09cfd28
SM
Stefan Monnier2005-09-19 17:41:22 +00002436 ((facep mark)
2437 (overlay-put
2438 (make-overlay (1- (point)) (1+ (point))) 'face mark))
aea566be Glenn Morris2008-04-01 02:46:29 +00002439 ;; Single-character mark, goes after the date.
f09cfd28 Stefan Monnier2005-09-19 17:41:22 +00002440 ((and (stringp mark) (= (length mark) 1))
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002441 (overlay-put
2442 (make-overlay (1+ (point)) (+ 2 (point))) 'display mark))
21db982b Glenn Morris2008-03-10 02:46:24 +00002443 (t ; attr list
c899d5e3
GM
Glenn Morris2008-04-01 04:10:09 +00002444 (overlay-put
2445 (make-overlay (1- (point)) (1+ (point))) 'face
2446 (calendar-make-temp-face mark))))))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002447
2448(defun calendar-star-date ()
2449 "Replace the date under the cursor in the calendar window with asterisks.
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002450You might want to add this function to `calendar-today-visible-hook'."
aea566be
GM
Glenn Morris2008-04-01 02:46:29 +00002451 (unless (catch 'found
2452 (dolist (ol (overlays-at (point)))
2453 (and (overlay-get ol 'calendar-star)
2454 (throw 'found t))))
2455 (let ((ol (make-overlay (1- (point)) (point))))
2456 (overlay-put ol 'display "*")
2457 (overlay-put ol 'calendar-star t)
2458 ;; Use copy-sequence to avoid merging of identical 'display props.
2459 ;; Use two overlays so as not to mess up
2460 ;; calendar-cursor-to-nearest-date (and calendar-forward-day).
2461 (overlay-put (setq ol (make-overlay (point) (1+ (point))))
2462 'display (copy-sequence "*"))
2463 (overlay-put ol 'calendar-star t))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002464
2465(defun calendar-mark-today ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002466 "Mark the date under the cursor in the calendar window.
bf0cce5a Glenn Morris2008-03-17 02:30:06 +00002467The date is marked with `calendar-today-marker'. You might want to add
1b73d7f3
GM
Glenn Morris2008-04-07 01:58:55 +00002468this function to `calendar-today-visible-hook'."
2469 (calendar-mark-visible-date (calendar-cursor-to-date) calendar-today-marker))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002470
d8bc5d08 Glenn Morris2009-08-31 01:33:43 +00002471;; FIXME why the car? Almost every usage calls list on the args.
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002472(defun calendar-date-compare (date1 date2)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002473 "Return t if DATE1 is before DATE2, nil otherwise.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002474The actual dates are in the car of DATE1 and DATE2."
2475 (< (calendar-absolute-from-gregorian (car date1))
2476 (calendar-absolute-from-gregorian (car date2))))
2477
2478(defun calendar-date-string (date &optional abbreviate nodayname)
2479 "A string form of DATE, driven by the variable `calendar-date-display-form'.
2c8811d4
GM
Glenn Morris2003-08-03 13:59:13 +00002480An optional parameter ABBREVIATE, when non-nil, causes the month
2481and day names to be abbreviated as specified by
2482`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
2483respectively. An optional parameter NODAYNAME, when t, omits the
2484name of the day of the week."
40802b08 Glenn Morris2008-03-15 03:00:17 +00002485 (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002486 (month (calendar-extract-month date))
2c8811d4 Glenn Morris2003-08-03 13:59:13 +00002487 (monthname (calendar-month-name month abbreviate))
d92bcf94
GM
Glenn Morris2008-04-08 07:08:24 +00002488 (day (number-to-string (calendar-extract-day date)))
2489 (month (number-to-string month))
2490 (year (number-to-string (calendar-extract-year date))))
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002491 (mapconcat 'eval calendar-date-display-form "")))
2492
2493(defun calendar-dayname-on-or-before (dayname date)
3cbb4860 Stefan Monnier2000-09-19 15:50:54 +00002494 "Return the absolute date of the DAYNAME on or before absolute DATE.
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002495DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
2496
2497Note: Applying this function to d+6 gives us the DAYNAME on or after an
2498absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to
2499absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
2500date d, and applying it to d+7 gives the DAYNAME following absolute date d."
2501 (- date (% (- date dayname) 7)))
2502
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002503(defun calendar-nth-named-absday (n dayname month year &optional day)
e7057568
GM
Glenn Morris2008-04-29 03:34:17 +00002504 "Absolute date of the Nth DAYNAME after/before MONTH YEAR DAY.
2505A DAYNAME of 0 means Sunday, 1 means Monday, and so on.
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002506If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
e7057568
GM
Glenn Morris2008-04-29 03:34:17 +00002507If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
2508DAY defaults to 1 if N>0, and MONTH's last day otherwise."
04d5d338
PE
Paul Eggert1993-08-28 04:14:25 +00002509 (if (> n 0)
2510 (+ (* 7 (1- n))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002511 (calendar-dayname-on-or-before
2512 dayname
2513 (+ 6 (calendar-absolute-from-gregorian
2514 (list month (or day 1) year)))))
04d5d338
PE
Paul Eggert1993-08-28 04:14:25 +00002515 (+ (* 7 (1+ n))
2516 (calendar-dayname-on-or-before
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002517 dayname
2518 (calendar-absolute-from-gregorian
2519 (list month
2520 (or day (calendar-last-day-of-month month year))
2521 year))))))
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002522
354d0644 Jim Blandy1993-06-22 03:22:12 +00002523(defun calendar-nth-named-day (n dayname month year &optional day)
e7057568 Glenn Morris2008-04-29 03:34:17 +00002524 "Date of the Nth DAYNAME after/before MONTH YEAR DAY.
2475d1a3 Glenn Morris2008-04-02 03:35:38 +00002525Like `calendar-nth-named-absday', but returns a Gregorian date."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002526 (calendar-gregorian-from-absolute
04d5d338 Paul Eggert1993-08-28 04:14:25 +00002527 (calendar-nth-named-absday n dayname month year day)))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002528
6a2aa94c
RS
Richard M. Stallman1994-01-30 00:25:00 +00002529(defun calendar-day-of-year-string (&optional date)
2530 "String of day number of year of Gregorian DATE.
2531Defaults to today's date if DATE is not given."
2532 (let* ((d (or date (calendar-current-date)))
1b73d7f3 Glenn Morris2008-04-07 01:58:55 +00002533 (year (calendar-extract-year d))
6a2aa94c
RS
Richard M. Stallman1994-01-30 00:25:00 +00002534 (day (calendar-day-number d))
2535 (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
2536 (format "Day %d of %d; %d day%s remaining in the year"
2537 day year days-remaining (if (= days-remaining 1) "" "s"))))
2538
5968ae93
GM
Glenn Morris2008-03-20 04:41:47 +00002539(defun calendar-other-dates (date)
2540 "Return a list of strings giving Gregorian DATE in other calendars.
2541DATE is (month day year). Calendars that do not apply are omitted."
2542 (let (odate)
2543 (delq nil
2544 (list
2545 (calendar-day-of-year-string date)
2546 (format "ISO date: %s" (calendar-iso-date-string date))
2547 (format "Julian date: %s"
2548 (calendar-julian-date-string date))
2549 (format "Astronomical (Julian) day number (at noon UTC): %s.0"
2550 (calendar-astro-date-string date))
2551 (format "Fixed (RD) date: %s"
2552 (calendar-absolute-from-gregorian date))
2553 (format "Hebrew date (before sunset): %s"
2554 (calendar-hebrew-date-string date))
2555 (format "Persian date: %s"
2556 (calendar-persian-date-string date))
2557 (unless (string-equal
2558 (setq odate (calendar-islamic-date-string date))
2559 "")
2560 (format "Islamic date (before sunset): %s" odate))
2561 (unless (string-equal
2562 (setq odate (calendar-bahai-date-string date))
2563 "")
6818b449 Glenn Morris2012-02-17 22:08:15 -05002564 (format "Bahá'í date: %s" odate))
5968ae93
GM
Glenn Morris2008-03-20 04:41:47 +00002565 (format "Chinese date: %s"
2566 (calendar-chinese-date-string date))
2567 (unless (string-equal
2568 (setq odate (calendar-coptic-date-string date))
2569 "")
2570 (format "Coptic date: %s" odate))
2571 (unless (string-equal
2572 (setq odate (calendar-ethiopic-date-string date))
2573 "")
2574 (format "Ethiopic date: %s" odate))
2575 (unless (string-equal
2576 (setq odate (calendar-french-date-string date))
2577 "")
2578 (format "French Revolutionary date: %s" odate))
2579 (format "Mayan date: %s"
2580 (calendar-mayan-date-string date))))))
2581
e8a11b22 Glenn Morris2009-11-10 08:11:47 +00002582(declare-function x-popup-menu "menu.c" (position menu))
f2d9c15f Glenn Morris2008-08-11 01:23:07 +00002583
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002584(defun calendar-print-other-dates (&optional event)
2585 "Show dates on other calendars for date under the cursor.
2586If called by a mouse-event, pops up a menu with the result."
2587 (interactive (list last-nonmenu-event))
2588 (let* ((date (calendar-cursor-to-date t event))
2589 (title (format "%s (Gregorian)" (calendar-date-string date)))
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002590 (others (calendar-other-dates date))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002591 selection)
2592 (if (mouse-event-p event)
2593 (and (setq selection (cal-menu-x-popup-menu event title
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002594 (mapcar 'list others)))
b1c172fe
GM
Glenn Morris2008-06-26 03:41:20 +00002595 (call-interactively selection))
2596 (calendar-in-read-only-buffer calendar-other-calendars-buffer
2597 (calendar-set-mode-line title)
5cbaccfe Glenn Morris2008-06-26 06:57:29 +00002598 (insert (mapconcat 'identity others "\n"))))))
726669d8 Edward M. Reingold1998-05-27 20:18:40 +00002599
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002600(defun calendar-print-day-of-year ()
6a2aa94c Richard M. Stallman1994-01-30 00:25:00 +00002601 "Show day number in year/days remaining in year for date under the cursor."
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002602 (interactive)
274f1353 David Kastrup2007-12-08 01:02:29 +00002603 (message "%s" (calendar-day-of-year-string (calendar-cursor-to-date t))))
ecaa0527 Richard M. Stallman1992-05-04 16:48:30 +00002604
7e1dae73
JB
Jim Blandy1992-08-12 12:50:10 +00002605(defun calendar-set-mode-line (str)
2606 "Set mode line to STR, centered, surrounded by dashes."
5d1c8151 Stefan Monnier2006-01-24 17:07:29 +00002607 (let* ((edges (window-edges))
d519ea8a Glenn Morris2004-03-24 18:37:08 +00002608 ;; As per doc of window-width, total visible mode-line length.
40802b08 Glenn Morris2008-03-15 03:00:17 +00002609 (width (- (nth 2 edges) (car edges))))
fa262b58
GM
Glenn Morris2009-02-11 04:02:16 +00002610 ;; Hack for --daemon. See bug #2199.
2611 ;; If no frame exists yet, we have no idea what width to use.
2612 (and (= width 10)
2613 (not window-system)
24679323 Adam Spiers2012-03-05 21:18:29 -05002614 (setq width (string-to-number (or (getenv "COLUMNS") "80"))))
5d1c8151
SM
Stefan Monnier2006-01-24 17:07:29 +00002615 (setq mode-line-format
2616 (if buffer-file-name
2617 `("-" mode-line-modified
2618 ,(calendar-string-spread (list str) ?- (- width 6))
2619 "---")
2620 (calendar-string-spread (list str) ?- width)))))
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002621
7e1dae73 Jim Blandy1992-08-12 12:50:10 +00002622(run-hooks 'calendar-load-hook)
ecaa0527
RS
Richard M. Stallman1992-05-04 16:48:30 +00002623
2624(provide 'calendar)
2625
34cb0115
SM
Stefan Monnier2005-09-12 21:32:11 +00002626;; Local variables:
2627;; byte-compile-dynamic: t
6818b449 Glenn Morris2012-02-17 22:08:15 -05002628;; coding: utf-8
34cb0115 Stefan Monnier2005-09-12 21:32:11 +00002629;; End:
b578f267 Erik Naggum1996-01-14 07:34:30 +00002630
94b304d7 Richard M. Stallman1992-06-03 02:55:55 +00002631;;; calendar.el ends here