Commit | Line | Data |
---|---|---|
b578f267 | 1 | ;;; calendar.el --- Calendar functions. |
fd7fa35a | 2 | |
b578f267 EN |
3 | ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995 Free |
4 | ;; Software Foundation, Inc. | |
3a801d0c | 5 | |
fd7fa35a | 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
e9571d2a | 7 | ;; Keywords: calendar |
3076647c | 8 | ;; Human-Keywords: calendar, Gregorian calendar, diary, holidays |
fd7fa35a | 9 | |
ecaa0527 RS |
10 | ;; This file is part of GNU Emacs. |
11 | ||
e555fdd8 RS |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
ecaa0527 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
e555fdd8 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
ecaa0527 | 26 | |
fd7fa35a ER |
27 | ;;; Commentary: |
28 | ||
7086b78e ER |
29 | ;; This collection of functions implements a calendar window. It generates a |
30 | ;; calendar for the current month, together with the previous and coming | |
31 | ;; months, or for any other three-month period. The calendar can be scrolled | |
32 | ;; forward and backward in the window to show months in the past or future; | |
33 | ;; the cursor can move forward and backward by days, weeks, or months, making | |
34 | ;; it possible, for instance, to jump to the date a specified number of days, | |
35 | ;; weeks, or months from the date under the cursor. The user can display a | |
36 | ;; list of holidays and other notable days for the period shown; the notable | |
37 | ;; days can be marked on the calendar, if desired. The user can also specify | |
38 | ;; that dates having corresponding diary entries (in a file that the user | |
39 | ;; specifies) be marked; the diary entries for any date can be viewed in a | |
40 | ;; separate window. The diary and the notable days can be viewed | |
41 | ;; independently of the calendar. Dates can be translated from the (usual) | |
42 | ;; Gregorian calendar to the day of the year/days remaining in year, to the | |
43 | ;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew | |
44 | ;; calendar, to the Islamic calendar, to the French Revolutionary calendar, to | |
45 | ;; the Mayan calendar, to the Chinese calendar, to the Coptic calendar, to the | |
46 | ;; Ethiopic calendar, and to the astronomical (Julian) day number. When | |
47 | ;; floating point is available, times of sunrise/sunset can be displayed, as | |
48 | ;; can the phases of the moon. Appointment notification for diary entries is | |
3076647c | 49 | ;; available. Calendar printing via LaTeX is available. |
7e1dae73 JB |
50 | |
51 | ;; The following files are part of the calendar/diary code: | |
52 | ||
3076647c ER |
53 | ;; appt.el Appointment notification |
54 | ;; cal-chinese.el Chinese calendar | |
55 | ;; cal-coptic.el Coptic/Ethiopic calendars | |
56 | ;; cal-dst.el Daylight savings time rules | |
57 | ;; cal-hebrew.el Hebrew calendar | |
58 | ;; cal-islamic.el Islamic calendar | |
59 | ;; cal-iso.el ISO calendar | |
60 | ;; cal-julian.el Julian/astronomical calendars | |
61 | ;; cal-mayan.el Mayan calendars | |
6a2aa94c | 62 | ;; cal-menu.el Menu support |
7086b78e | 63 | ;; cal-move.el Movement in the calendar |
3076647c | 64 | ;; cal-tex.el Calendars in LaTeX |
bcbb4a0a | 65 | ;; cal-x.el X-windows dedicated frame functions |
7086b78e | 66 | ;; diary.el Diary functions |
7e1dae73 | 67 | ;; holidays.el Holiday functions |
7e1dae73 | 68 | ;; lunar.el Phases of the moon |
3076647c | 69 | ;; solar.el Sunrise/sunset, equinoxes/solstices |
ecaa0527 RS |
70 | |
71 | ;; Comments, corrections, and improvements should be sent to | |
72 | ;; Edward M. Reingold Department of Computer Science | |
73 | ;; (217) 333-6733 University of Illinois at Urbana-Champaign | |
74 | ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | |
75 | ;; Urbana, Illinois 61801 | |
76 | ||
ecaa0527 | 77 | ;; Technical details of all the calendrical calculations can be found in |
7e1dae73 | 78 | |
ecaa0527 RS |
79 | ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, |
80 | ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), | |
7e1dae73 JB |
81 | ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical |
82 | ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, | |
e4c61e50 JB |
83 | ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), |
84 | ;; pages 383-404. | |
7e1dae73 JB |
85 | |
86 | ;; Hard copies of these two papers can be obtained by sending email to | |
87 | ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and | |
88 | ;; the message BODY containing your mailing address (snail). | |
ecaa0527 | 89 | |
fd7fa35a | 90 | ;;; Code: |
ecaa0527 | 91 | |
e555fdd8 RS |
92 | (defun calendar-version () |
93 | (interactive) | |
3076647c | 94 | (message "Version 6, October 12, 1995")) |
e555fdd8 | 95 | |
d8a200a7 RS |
96 | ;;;###autoload |
97 | (defvar calendar-week-start-day 0 | |
98 | "*The day of the week on which a week in the calendar begins. | |
99 | 0 means Sunday (default), 1 means Monday, and so on.") | |
100 | ||
cba0c253 ER |
101 | ;;;###autoload |
102 | (defvar calendar-offset 0 | |
103 | "*The offset of the principal month from the center of the calendar window. | |
104 | 0 means the principal month is in the center (default), -1 means on the left, | |
105 | +1 means on the right. Larger (or smaller) values push the principal month off | |
106 | the screen.") | |
107 | ||
7e1dae73 | 108 | ;;;###autoload |
ecaa0527 | 109 | (defvar view-diary-entries-initially nil |
e555fdd8 | 110 | "*Non-nil means display current date's diary entries on entry. |
ecaa0527 RS |
111 | The diary is displayed in another window when the calendar is first displayed, |
112 | if the current date is visible. The number of days of diary entries displayed | |
113 | is governed by the variable `number-of-diary-entries'.") | |
114 | ||
7e1dae73 | 115 | ;;;###autoload |
ecaa0527 RS |
116 | (defvar number-of-diary-entries 1 |
117 | "*Specifies how many days of diary entries are to be displayed initially. | |
118 | This variable affects the diary display when the command M-x diary is used, | |
119 | or if the value of the variable `view-diary-entries-initially' is t. For | |
120 | example, if the default value 1 is used, then only the current day's diary | |
121 | entries will be displayed. If the value 2 is used, then both the current | |
e555fdd8 RS |
122 | day's and the next day's entries will be displayed. |
123 | ||
124 | The value can also be a vector such as [0 2 2 2 2 4 1]; this value | |
125 | says to display no diary entries on Sunday, the display the entries | |
126 | for the current date and the day after on Monday through Thursday, | |
127 | display Friday through Monday's entries on Friday, and display only | |
128 | Saturday's entries on Saturday. | |
129 | ||
130 | This variable does not affect the diary display with the `d' command | |
131 | from the calendar; in that case, the prefix argument controls the | |
ecaa0527 RS |
132 | number of days of diary entries displayed.") |
133 | ||
7e1dae73 | 134 | ;;;###autoload |
ecaa0527 | 135 | (defvar mark-diary-entries-in-calendar nil |
e555fdd8 | 136 | "*Non-nil means mark dates with diary entries, in the calendar window. |
ecaa0527 RS |
137 | The marking symbol is specified by the variable `diary-entry-marker'.") |
138 | ||
6a2aa94c RS |
139 | (defvar diary-entry-marker |
140 | (if (not window-system) | |
141 | "+" | |
142 | (require 'faces) | |
1e252576 | 143 | (add-to-list 'facemenu-unlisted-faces 'diary-face) |
6a2aa94c | 144 | (make-face 'diary-face) |
06f7e2c5 ER |
145 | (cond ((face-differs-from-default-p 'diary-face)) |
146 | ((x-display-color-p) (set-face-foreground 'diary-face "red")) | |
147 | (t (copy-face 'bold 'diary-face))) | |
6a2aa94c RS |
148 | 'diary-face) |
149 | "*Used to mark dates that have diary entries. | |
150 | Can be either a single-character string or a face.") | |
151 | ||
152 | (defvar calendar-today-marker | |
153 | (if (not window-system) | |
154 | "=" | |
155 | (require 'faces) | |
1e252576 | 156 | (add-to-list 'facemenu-unlisted-faces 'calendar-today-face) |
6a2aa94c | 157 | (make-face 'calendar-today-face) |
06f7e2c5 ER |
158 | (if (not (face-differs-from-default-p 'calendar-today-face)) |
159 | (set-face-underline-p 'calendar-today-face t)) | |
6a2aa94c RS |
160 | 'calendar-today-face) |
161 | "*Used to mark today's date. | |
162 | Can be either a single-character string or a face.") | |
163 | ||
164 | (defvar calendar-holiday-marker | |
165 | (if (not window-system) | |
166 | "*" | |
167 | (require 'faces) | |
1e252576 | 168 | (add-to-list 'facemenu-unlisted-faces 'holiday-face) |
6a2aa94c | 169 | (make-face 'holiday-face) |
06f7e2c5 ER |
170 | (cond ((face-differs-from-default-p 'holiday-face)) |
171 | ((x-display-color-p) (set-face-background 'holiday-face "pink")) | |
172 | (t (set-face-background 'holiday-face "black") | |
173 | (set-face-foreground 'holiday-face "white"))) | |
6a2aa94c RS |
174 | 'holiday-face) |
175 | "*Used to mark notable dates in the calendar. | |
176 | Can be either a single-character string or a face.") | |
ecaa0527 | 177 | |
7e1dae73 | 178 | ;;;###autoload |
ecaa0527 | 179 | (defvar view-calendar-holidays-initially nil |
e555fdd8 | 180 | "*Non-nil means display holidays for current three month period on entry. |
354d0644 JB |
181 | The holidays are displayed in another window when the calendar is first |
182 | displayed.") | |
ecaa0527 | 183 | |
e5d77022 | 184 | ;;;###autoload |
ecaa0527 | 185 | (defvar mark-holidays-in-calendar nil |
e555fdd8 | 186 | "*Non-nil means mark dates of holidays in the calendar window. |
ecaa0527 RS |
187 | The marking symbol is specified by the variable `calendar-holiday-marker'.") |
188 | ||
e5d77022 | 189 | ;;;###autoload |
ecaa0527 | 190 | (defvar all-hebrew-calendar-holidays nil |
354d0644 | 191 | "*If nil, show only major holidays from the Hebrew calendar. |
e555fdd8 | 192 | This means only those Jewish holidays that appear on secular calendars. |
354d0644 | 193 | |
e555fdd8 | 194 | If t, show all the holidays that would appear in a complete Hebrew calendar.") |
ecaa0527 | 195 | |
e5d77022 | 196 | ;;;###autoload |
ecaa0527 | 197 | (defvar all-christian-calendar-holidays nil |
354d0644 | 198 | "*If nil, show only major holidays from the Christian calendar. |
e555fdd8 | 199 | This means only those Christian holidays that appear on secular calendars. |
354d0644 | 200 | |
e555fdd8 RS |
201 | If t, show all the holidays that would appear in a complete Christian |
202 | calendar.") | |
ecaa0527 | 203 | |
e5d77022 | 204 | ;;;###autoload |
ecaa0527 | 205 | (defvar all-islamic-calendar-holidays nil |
354d0644 | 206 | "*If nil, show only major holidays from the Islamic calendar. |
e555fdd8 | 207 | This means only those Islamic holidays that appear on secular calendars. |
354d0644 | 208 | |
e555fdd8 RS |
209 | If t, show all the holidays that would appear in a complete Islamic |
210 | calendar.") | |
ecaa0527 | 211 | |
7e1dae73 JB |
212 | ;;;###autoload |
213 | (defvar calendar-load-hook nil | |
214 | "*List of functions to be called after the calendar is first loaded. | |
e555fdd8 | 215 | This is the place to add key bindings to `calendar-mode-map'.") |
7e1dae73 JB |
216 | |
217 | ;;;###autoload | |
ecaa0527 RS |
218 | (defvar initial-calendar-window-hook nil |
219 | "*List of functions to be called when the calendar window is first opened. | |
220 | The functions invoked are called after the calendar window is opened, but | |
221 | once opened is never called again. Leaving the calendar with the `q' command | |
222 | and reentering it will cause these functions to be called again.") | |
223 | ||
7e1dae73 | 224 | ;;;###autoload |
ecaa0527 RS |
225 | (defvar today-visible-calendar-hook nil |
226 | "*List of functions called whenever the current date is visible. | |
227 | This can be used, for example, to replace today's date with asterisks; a | |
228 | function `calendar-star-date' is included for this purpose: | |
229 | (setq today-visible-calendar-hook 'calendar-star-date) | |
6b1abbd1 | 230 | It can also be used to mark the current date with `calendar-today-marker'; |
6a2aa94c | 231 | a function is also provided for this: |
ecaa0527 RS |
232 | (setq today-visible-calendar-hook 'calendar-mark-today) |
233 | ||
234 | The corresponding variable `today-invisible-calendar-hook' is the list of | |
235 | functions called when the calendar function was called when the current | |
236 | date is not visible in the window. | |
237 | ||
238 | Other than the use of the provided functions, the changing of any | |
239 | characters in the calendar buffer by the hooks may cause the failure of the | |
240 | functions that move by days and weeks.") | |
241 | ||
7e1dae73 | 242 | ;;;###autoload |
ecaa0527 RS |
243 | (defvar today-invisible-calendar-hook nil |
244 | "*List of functions called whenever the current date is not visible. | |
245 | ||
246 | The corresponding variable `today-visible-calendar-hook' is the list of | |
247 | functions called when the calendar function was called when the current | |
248 | date is visible in the window. | |
249 | ||
250 | Other than the use of the provided functions, the changing of any | |
251 | characters in the calendar buffer by the hooks may cause the failure of the | |
252 | functions that move by days and weeks.") | |
253 | ||
7e1dae73 | 254 | ;;;###autoload |
ecaa0527 RS |
255 | (defvar diary-file "~/diary" |
256 | "*Name of the file in which one's personal diary of dates is kept. | |
257 | ||
258 | The file's entries are lines in any of the forms | |
259 | ||
260 | MONTH/DAY | |
261 | MONTH/DAY/YEAR | |
262 | MONTHNAME DAY | |
263 | MONTHNAME DAY, YEAR | |
264 | DAYNAME | |
265 | ||
266 | at the beginning of the line; the remainder of the line is the diary entry | |
267 | string for that date. MONTH and DAY are one or two digit numbers, YEAR is | |
268 | a number and may be written in full or abbreviated to the final two digits. | |
269 | If the date does not contain a year, it is generic and applies to any year. | |
270 | DAYNAME entries apply to any date on which is on that day of the week. | |
271 | MONTHNAME and DAYNAME can be spelled in full, abbreviated to three | |
272 | characters (with or without a period), capitalized or not. Any of DAY, | |
273 | MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, | |
274 | respectively. | |
275 | ||
276 | The European style (in which the day precedes the month) can be used | |
277 | instead, if you execute `european-calendar' when in the calendar, or set | |
278 | `european-calendar-style' to t in your .emacs file. The European forms are | |
279 | ||
280 | DAY/MONTH | |
281 | DAY/MONTH/YEAR | |
282 | DAY MONTHNAME | |
283 | DAY MONTHNAME YEAR | |
284 | DAYNAME | |
285 | ||
286 | To revert to the default American style from the European style, execute | |
287 | `american-calendar' in the calendar. | |
288 | ||
6b1abbd1 RS |
289 | A diary entry can be preceded by the character |
290 | `diary-nonmarking-symbol' (ordinarily `&') to make that entry | |
291 | nonmarking--that is, it will not be marked on dates in the calendar | |
292 | window but will appear in a diary window. | |
ecaa0527 RS |
293 | |
294 | Multiline diary entries are made by indenting lines after the first with | |
295 | either a TAB or one or more spaces. | |
296 | ||
297 | Lines not in one the above formats are ignored. Here are some sample diary | |
298 | entries (in the default American style): | |
299 | ||
300 | 12/22/1988 Twentieth wedding anniversary!! | |
301 | &1/1. Happy New Year! | |
302 | 10/22 Ruth's birthday. | |
303 | 21: Payday | |
304 | Tuesday--weekly meeting with grad students at 10am | |
305 | Supowit, Shen, Bitner, and Kapoor to attend. | |
306 | 1/13/89 Friday the thirteenth!! | |
307 | &thu 4pm squash game with Lloyd. | |
308 | mar 16 Dad's birthday | |
309 | April 15, 1989 Income tax due. | |
310 | &* 15 time cards due. | |
311 | ||
312 | If the first line of a diary entry consists only of the date or day name with | |
e555fdd8 RS |
313 | no trailing blanks or punctuation, then that line is not displayed in the |
314 | diary window; only the continuation lines is shown. For example, the | |
ecaa0527 RS |
315 | single diary entry |
316 | ||
317 | 02/11/1989 | |
318 | Bill Blattner visits Princeton today | |
319 | 2pm Cognitive Studies Committee meeting | |
320 | 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative' | |
321 | 4:00pm Jamie Tappenden | |
322 | 7:30pm Dinner at George and Ed's for Alan Ryan | |
323 | 7:30-10:00pm dance at Stewart Country Day School | |
324 | ||
325 | will appear in the diary window without the date line at the beginning. This | |
326 | facility allows the diary window to look neater, but can cause confusion if | |
327 | used with more than one day's entries displayed. | |
328 | ||
329 | Diary entries can be based on Lisp sexps. For example, the diary entry | |
330 | ||
331 | %%(diary-block 11 1 1990 11 10 1990) Vacation | |
332 | ||
333 | causes the diary entry \"Vacation\" to appear from November 1 through November | |
334 | 10, 1990. Other functions available are `diary-float', `diary-anniversary', | |
7e1dae73 JB |
335 | `diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', |
336 | `diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', | |
7086b78e | 337 | `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', |
7e1dae73 JB |
338 | `diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon', |
339 | `diary-parasha', `diary-omer', `diary-rosh-hodesh', and | |
340 | `diary-sabbath-candles'. See the documentation for the function | |
341 | `list-sexp-diary-entries' for more details. | |
ecaa0527 RS |
342 | |
343 | Diary entries based on the Hebrew and/or the Islamic calendar are also | |
344 | possible, but because these are somewhat slow, they are ignored | |
345 | unless you set the `nongregorian-diary-listing-hook' and the | |
346 | `nongregorian-diary-marking-hook' appropriately. See the documentation | |
347 | for these functions for details. | |
348 | ||
349 | Diary files can contain directives to include the contents of other files; for | |
350 | details, see the documentation for the variable `list-diary-entries-hook'.") | |
351 | ||
7e1dae73 | 352 | ;;;###autoload |
ecaa0527 | 353 | (defvar diary-nonmarking-symbol "&" |
354d0644 | 354 | "*Symbol indicating that a diary entry is not to be marked in the calendar.") |
ecaa0527 | 355 | |
7e1dae73 | 356 | ;;;###autoload |
ecaa0527 | 357 | (defvar hebrew-diary-entry-symbol "H" |
354d0644 | 358 | "*Symbol indicating a diary entry according to the Hebrew calendar.") |
ecaa0527 | 359 | |
7e1dae73 | 360 | ;;;###autoload |
ecaa0527 | 361 | (defvar islamic-diary-entry-symbol "I" |
354d0644 | 362 | "*Symbol indicating a diary entry according to the Islamic calendar.") |
ecaa0527 | 363 | |
7e1dae73 | 364 | ;;;###autoload |
ecaa0527 | 365 | (defvar diary-include-string "#include" |
354d0644 JB |
366 | "*The string indicating inclusion of another file of diary entries. |
367 | See the documentation for the function `include-other-diary-files'.") | |
ecaa0527 | 368 | |
7e1dae73 | 369 | ;;;###autoload |
ecaa0527 RS |
370 | (defvar sexp-diary-entry-symbol "%%" |
371 | "*The string used to indicate a sexp diary entry in diary-file. | |
372 | See the documentation for the function `list-sexp-diary-entries'.") | |
373 | ||
7e1dae73 | 374 | ;;;###autoload |
ecaa0527 | 375 | (defvar abbreviated-calendar-year t |
354d0644 JB |
376 | "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. |
377 | For the Gregorian calendar; similarly for the Hebrew and Islamic calendars. | |
378 | If this variable is nil, years must be written in full.") | |
ecaa0527 | 379 | |
7e1dae73 | 380 | ;;;###autoload |
ecaa0527 | 381 | (defvar european-calendar-style nil |
354d0644 JB |
382 | "*Use the European style of dates in the diary and in any displays. |
383 | If this variable is t, a date 1/2/1990 would be interpreted as February 1, | |
384 | 1990. The accepted European date styles are | |
ecaa0527 RS |
385 | |
386 | DAY/MONTH | |
387 | DAY/MONTH/YEAR | |
388 | DAY MONTHNAME | |
389 | DAY MONTHNAME YEAR | |
390 | DAYNAME | |
391 | ||
392 | Names can be capitalized or not, written in full, or abbreviated to three | |
393 | characters with or without a period.") | |
394 | ||
7e1dae73 | 395 | ;;;###autoload |
ecaa0527 RS |
396 | (defvar american-date-diary-pattern |
397 | '((month "/" day "[^/0-9]") | |
398 | (month "/" day "/" year "[^0-9]") | |
399 | (monthname " *" day "[^,0-9]") | |
400 | (monthname " *" day ", *" year "[^0-9]") | |
401 | (dayname "\\W")) | |
402 | "*List of pseudo-patterns describing the American patterns of date used. | |
6b1abbd1 | 403 | See the documentation of `diary-date-forms' for an explanation.") |
ecaa0527 | 404 | |
7e1dae73 | 405 | ;;;###autoload |
ecaa0527 RS |
406 | (defvar european-date-diary-pattern |
407 | '((day "/" month "[^/0-9]") | |
408 | (day "/" month "/" year "[^0-9]") | |
409 | (backup day " *" monthname "\\W+\\<[^*0-9]") | |
410 | (day " *" monthname " *" year "[^0-9]") | |
411 | (dayname "\\W")) | |
412 | "*List of pseudo-patterns describing the European patterns of date used. | |
6b1abbd1 | 413 | See the documentation of `diary-date-forms' for an explanation.") |
ecaa0527 RS |
414 | |
415 | (defvar diary-date-forms | |
416 | (if european-calendar-style | |
417 | european-date-diary-pattern | |
418 | american-date-diary-pattern) | |
419 | "*List of pseudo-patterns describing the forms of date used in the diary. | |
420 | The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match | |
421 | any portion of the diary entry itself, just the date component. | |
422 | ||
423 | A pseudo-pattern is a list of regular expressions and the keywords `month', | |
424 | `day', `year', `monthname', and `dayname'. The keyword `monthname' will | |
425 | match the name of the month, capitalized or not, or its three-letter | |
426 | abbreviation, followed by a period or not; it will also match `*'. | |
427 | Similarly, `dayname' will match the name of the day, capitalized or not, or | |
428 | its three-letter abbreviation, followed by a period or not. The keywords | |
429 | `month', `day', and `year' will match those numerical values, preceded by | |
430 | arbitrarily many zeros; they will also match `*'. | |
431 | ||
432 | The matching of the diary entries with the date forms is done with the | |
433 | standard syntax table from Fundamental mode, but with the `*' changed so | |
434 | that it is a word constituent. | |
435 | ||
436 | If, to be mutually exclusive, a pseudo-pattern must match a portion of the | |
437 | diary entry itself, the first element of the pattern MUST be `backup'. This | |
7e1dae73 JB |
438 | directive causes the date recognizer to back up to the beginning of the |
439 | current word of the diary entry, so in no case can the pattern match more than | |
440 | a portion of the first word of the diary entry.") | |
ecaa0527 | 441 | |
7e1dae73 | 442 | ;;;###autoload |
ecaa0527 | 443 | (defvar european-calendar-display-form |
7e1dae73 | 444 | '((if dayname (concat dayname ", ")) day " " monthname " " year) |
354d0644 | 445 | "*Pseudo-pattern governing the way a date appears in the European style. |
0d336f18 | 446 | See the documentation of calendar-date-display-form for an explanation.") |
ecaa0527 | 447 | |
7e1dae73 | 448 | ;;;###autoload |
ecaa0527 | 449 | (defvar american-calendar-display-form |
7e1dae73 | 450 | '((if dayname (concat dayname ", ")) monthname " " day ", " year) |
354d0644 | 451 | "*Pseudo-pattern governing the way a date appears in the American style. |
6b1abbd1 | 452 | See the documentation of `calendar-date-display-form' for an explanation.") |
ecaa0527 RS |
453 | |
454 | (defvar calendar-date-display-form | |
455 | (if european-calendar-style | |
456 | european-calendar-display-form | |
457 | american-calendar-display-form) | |
354d0644 JB |
458 | "*Pseudo-pattern governing the way a date appears. |
459 | ||
460 | Used by the function `calendar-date-string', a pseudo-pattern is a list of | |
461 | expressions that can involve the keywords `month', `day', and `year', all | |
462 | numbers in string form, and `monthname' and `dayname', both alphabetic | |
463 | strings. For example, the ISO standard would use the pseudo- pattern | |
ecaa0527 RS |
464 | |
465 | '(year \"-\" month \"-\" day) | |
466 | ||
467 | while a typical American form would be | |
468 | ||
469 | '(month \"/\" day \"/\" (substring year -2)) | |
470 | ||
471 | and | |
472 | ||
473 | '((format \"%9s, %9s %2s, %4s\" dayname monthname day year)) | |
474 | ||
475 | would give the usual American style in fixed-length fields. | |
476 | ||
477 | See the documentation of the function `calendar-date-string'.") | |
478 | ||
479 | (defun european-calendar () | |
480 | "Set the interpretation and display of dates to the European style." | |
481 | (interactive) | |
482 | (setq european-calendar-style t) | |
483 | (setq calendar-date-display-form european-calendar-display-form) | |
484 | (setq diary-date-forms european-date-diary-pattern) | |
485 | (update-calendar-mode-line)) | |
486 | ||
487 | (defun american-calendar () | |
488 | "Set the interpretation and display of dates to the American style." | |
489 | (interactive) | |
490 | (setq european-calendar-style nil) | |
491 | (setq calendar-date-display-form american-calendar-display-form) | |
492 | (setq diary-date-forms american-date-diary-pattern) | |
493 | (update-calendar-mode-line)) | |
494 | ||
7e1dae73 JB |
495 | ;;;###autoload |
496 | (defvar print-diary-entries-hook 'lpr-buffer | |
354d0644 JB |
497 | "*List of functions called after a temporary diary buffer is prepared. |
498 | The buffer shows only the diary entries currently visible in the diary | |
499 | buffer. The default just does the printing. Other uses might include, for | |
500 | example, rearranging the lines into order by day and time, saving the buffer | |
501 | instead of deleting it, or changing the function used to do the printing.") | |
ecaa0527 | 502 | |
e5d77022 | 503 | ;;;###autoload |
ecaa0527 | 504 | (defvar list-diary-entries-hook nil |
354d0644 JB |
505 | "*List of functions called after diary file is culled for relevant entries. |
506 | It is to be used for diary entries that are not found in the diary file. | |
ecaa0527 RS |
507 | |
508 | A function `include-other-diary-files' is provided for use as the value of | |
509 | this hook. This function enables you to use shared diary files together | |
6b1abbd1 | 510 | with your own. The files included are specified in the diary file by lines |
ecaa0527 RS |
511 | of the form |
512 | ||
513 | #include \"filename\" | |
514 | ||
515 | This is recursive; that is, #include directives in files thus included are | |
516 | obeyed. You can change the \"#include\" to some other string by changing | |
517 | the variable `diary-include-string'. When you use `include-other-diary-files' | |
518 | as part of the list-diary-entries-hook, you will probably also want to use the | |
6b1abbd1 | 519 | function `mark-included-diary-files' as part of `mark-diary-entries-hook'. |
ecaa0527 RS |
520 | |
521 | For example, you could use | |
522 | ||
523 | (setq list-diary-entries-hook | |
7e1dae73 | 524 | '(include-other-diary-files sort-diary-entries)) |
ecaa0527 RS |
525 | (setq diary-display-hook 'fancy-diary-display) |
526 | ||
6b1abbd1 | 527 | in your `.emacs' file to cause the fancy diary buffer to be displayed with |
ecaa0527 RS |
528 | diary entries from various included files, each day's entries sorted into |
529 | lexicographic order.") | |
530 | ||
e5d77022 | 531 | ;;;###autoload |
34fa2dc2 RS |
532 | (defvar diary-hook nil |
533 | "*List of functions called after the display of the diary. | |
534 | Can be used for appointment notification.") | |
535 | ||
536 | ;;;###autoload | |
537 | (defvar diary-display-hook nil | |
ecaa0527 | 538 | "*List of functions that handle the display of the diary. |
e555fdd8 | 539 | If nil (the default), `simple-diary-display' is used. Use `ignore' for no |
34fa2dc2 | 540 | diary display. |
ecaa0527 RS |
541 | |
542 | Ordinarily, this just displays the diary buffer (with holidays indicated in | |
543 | the mode line), if there are any relevant entries. At the time these | |
544 | functions are called, the variable `diary-entries-list' is a list, in order | |
545 | by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) | |
546 | STRING), where string is the diary entry for the given date. This can be | |
34fa2dc2 RS |
547 | used, for example, a different buffer for display (perhaps combined with |
548 | holidays), or produce hard copy output. | |
ecaa0527 RS |
549 | |
550 | A function `fancy-diary-display' is provided as an alternative | |
551 | choice for this hook; this function prepares a special noneditable diary | |
552 | buffer with the relevant diary entries that has neat day-by-day arrangement | |
553 | with headings. The fancy diary buffer will show the holidays unless the | |
554 | variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy | |
555 | diary buffer will not show days for which there are no diary entries, even | |
556 | if that day is a holiday; if you want such days to be shown in the fancy | |
557 | diary buffer, set the variable `diary-list-include-blanks' to t.") | |
558 | ||
e5d77022 | 559 | ;;;###autoload |
ecaa0527 | 560 | (defvar nongregorian-diary-listing-hook nil |
354d0644 JB |
561 | "*List of functions called for listing diary file and included files. |
562 | As the files are processed for diary entries, these functions are used to cull | |
563 | relevant entries. You can use either or both of `list-hebrew-diary-entries' | |
564 | and `list-islamic-diary-entries'. The documentation for these functions | |
565 | describes the style of such diary entries.") | |
ecaa0527 | 566 | |
7e1dae73 | 567 | ;;;###autoload |
ecaa0527 RS |
568 | (defvar mark-diary-entries-hook nil |
569 | "*List of functions called after marking diary entries in the calendar. | |
570 | ||
571 | A function `mark-included-diary-files' is also provided for use as the | |
572 | mark-diary-entries-hook; it enables you to use shared diary files together | |
6b1abbd1 | 573 | with your own. The files included are specified in the diary file by lines |
ecaa0527 RS |
574 | of the form |
575 | #include \"filename\" | |
576 | This is recursive; that is, #include directives in files thus included are | |
577 | obeyed. You can change the \"#include\" to some other string by changing the | |
578 | variable `diary-include-string'. When you use `mark-included-diary-files' as | |
579 | part of the mark-diary-entries-hook, you will probably also want to use the | |
6b1abbd1 | 580 | function `include-other-diary-files' as part of `list-diary-entries-hook'.") |
ecaa0527 | 581 | |
e5d77022 | 582 | ;;;###autoload |
ecaa0527 | 583 | (defvar nongregorian-diary-marking-hook nil |
354d0644 JB |
584 | "*List of functions called for marking diary file and included files. |
585 | As the files are processed for diary entries, these functions are used to cull | |
586 | relevant entries. You can use either or both of `mark-hebrew-diary-entries' | |
587 | and `mark-islamic-diary-entries'. The documentation for these functions | |
588 | describes the style of such diary entries.") | |
ecaa0527 | 589 | |
e5d77022 | 590 | ;;;###autoload |
ecaa0527 | 591 | (defvar diary-list-include-blanks nil |
354d0644 JB |
592 | "*If nil, do not include days with no diary entry in the list of diary entries. |
593 | Such days will then not be shown in the the fancy diary buffer, even if they | |
594 | are holidays.") | |
ecaa0527 | 595 | |
7e1dae73 | 596 | ;;;###autoload |
ecaa0527 | 597 | (defvar holidays-in-diary-buffer t |
e555fdd8 RS |
598 | "*Non-nil means include holidays in the diary display. |
599 | The holidays appear in the mode line of the diary buffer, or in the | |
354d0644 | 600 | fancy diary buffer next to the date. This slows down the diary functions |
e555fdd8 | 601 | somewhat; setting it to nil makes the diary display faster.") |
ecaa0527 | 602 | |
2ec778d0 RS |
603 | (defvar calendar-mark-ring nil) |
604 | ||
e555fdd8 RS |
605 | ;;;###autoload |
606 | (put 'general-holidays 'risky-local-variable t) | |
7e1dae73 JB |
607 | ;;;###autoload |
608 | (defvar general-holidays | |
354d0644 JB |
609 | '((holiday-fixed 1 1 "New Year's Day") |
610 | (holiday-float 1 1 3 "Martin Luther King Day") | |
611 | (holiday-fixed 2 2 "Ground Hog Day") | |
612 | (holiday-fixed 2 14 "Valentine's Day") | |
613 | (holiday-float 2 1 3 "President's Day") | |
614 | (holiday-fixed 3 17 "St. Patrick's Day") | |
615 | (holiday-fixed 4 1 "April Fool's Day") | |
616 | (holiday-float 5 0 2 "Mother's Day") | |
617 | (holiday-float 5 1 -1 "Memorial Day") | |
618 | (holiday-fixed 6 14 "Flag Day") | |
619 | (holiday-float 6 0 3 "Father's Day") | |
620 | (holiday-fixed 7 4 "Independence Day") | |
621 | (holiday-float 9 1 1 "Labor Day") | |
622 | (holiday-float 10 1 2 "Columbus Day") | |
623 | (holiday-fixed 10 31 "Halloween") | |
624 | (holiday-fixed 11 11 "Veteran's Day") | |
625 | (holiday-float 11 4 4 "Thanksgiving")) | |
626 | "*General holidays. Default value is for the United States. | |
627 | See the documentation for `calendar-holidays' for details.") | |
ecaa0527 | 628 | |
7086b78e ER |
629 | ;;;###autoload |
630 | (put 'oriental-holidays 'risky-local-variable t) | |
631 | ;;;###autoload | |
632 | (defvar oriental-holidays | |
633 | '((if (fboundp 'atan) | |
634 | (holiday-chinese-new-year))) | |
635 | "*Oriental holidays. | |
636 | See the documentation for `calendar-holidays' for details.") | |
637 | ||
e555fdd8 RS |
638 | ;;;###autoload |
639 | (put 'local-holidays 'risky-local-variable t) | |
7e1dae73 JB |
640 | ;;;###autoload |
641 | (defvar local-holidays nil | |
642 | "*Local holidays. | |
643 | See the documentation for `calendar-holidays' for details.") | |
644 | ||
e555fdd8 RS |
645 | ;;;###autoload |
646 | (put 'other-holidays 'risky-local-variable t) | |
7e1dae73 JB |
647 | ;;;###autoload |
648 | (defvar other-holidays nil | |
649 | "*User defined holidays. | |
650 | See the documentation for `calendar-holidays' for details.") | |
ecaa0527 | 651 | |
e555fdd8 RS |
652 | ;;;###autoload |
653 | (put 'hebrew-holidays-1 'risky-local-variable t) | |
7e1dae73 | 654 | ;;;###autoload |
97344751 | 655 | (defvar hebrew-holidays-1 |
354d0644 | 656 | '((holiday-rosh-hashanah-etc) |
ecaa0527 | 657 | (if all-hebrew-calendar-holidays |
354d0644 JB |
658 | (holiday-julian |
659 | 11 | |
660 | (let* ((m displayed-month) | |
661 | (y displayed-year) | |
662 | (year)) | |
663 | (increment-calendar-month m y -1) | |
664 | (let ((year (extract-calendar-year | |
665 | (calendar-julian-from-absolute | |
666 | (calendar-absolute-from-gregorian | |
667 | (list m 1 y)))))) | |
668 | (if (zerop (% (1+ year) 4)) | |
669 | 22 | |
97344751 RS |
670 | 21))) "\"Tal Umatar\" (evening)")))) |
671 | ||
e555fdd8 RS |
672 | ;;;###autoload |
673 | (put 'hebrew-holidays-2 'risky-local-variable t) | |
97344751 RS |
674 | ;;;###autoload |
675 | (defvar hebrew-holidays-2 | |
676 | '((if all-hebrew-calendar-holidays | |
354d0644 JB |
677 | (holiday-hanukkah) |
678 | (holiday-hebrew 9 25 "Hanukkah")) | |
ecaa0527 | 679 | (if all-hebrew-calendar-holidays |
354d0644 JB |
680 | (holiday-hebrew |
681 | 10 | |
682 | (let ((h-year (extract-calendar-year | |
683 | (calendar-hebrew-from-absolute | |
684 | (calendar-absolute-from-gregorian | |
685 | (list displayed-month 28 displayed-year)))))) | |
686 | (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year)) | |
687 | 7) | |
688 | 6) | |
689 | 11 10)) | |
690 | "Tzom Teveth")) | |
ecaa0527 | 691 | (if all-hebrew-calendar-holidays |
97344751 RS |
692 | (holiday-hebrew 11 15 "Tu B'Shevat")))) |
693 | ||
e555fdd8 RS |
694 | ;;;###autoload |
695 | (put 'hebrew-holidays-3 'risky-local-variable t) | |
97344751 | 696 | ;;;###autoload |
d7fa63b2 | 697 | (defvar hebrew-holidays-3 |
97344751 | 698 | '((if all-hebrew-calendar-holidays |
354d0644 | 699 | (holiday-hebrew |
ecaa0527 RS |
700 | 11 |
701 | (let ((m displayed-month) | |
702 | (y displayed-year)) | |
703 | (increment-calendar-month m y 1) | |
704 | (let* ((h-year (extract-calendar-year | |
705 | (calendar-hebrew-from-absolute | |
706 | (calendar-absolute-from-gregorian | |
707 | (list m | |
708 | (calendar-last-day-of-month m y) | |
709 | y))))) | |
710 | (s-s | |
711 | (calendar-hebrew-from-absolute | |
712 | (if (= | |
713 | (% (calendar-absolute-from-hebrew | |
714 | (list 7 1 h-year)) | |
715 | 7) | |
716 | 6) | |
717 | (calendar-dayname-on-or-before | |
718 | 6 (calendar-absolute-from-hebrew | |
719 | (list 11 17 h-year))) | |
720 | (calendar-dayname-on-or-before | |
721 | 6 (calendar-absolute-from-hebrew | |
722 | (list 11 16 h-year)))))) | |
723 | (day (extract-calendar-day s-s))) | |
724 | day)) | |
97344751 RS |
725 | "Shabbat Shirah")))) |
726 | ||
e555fdd8 RS |
727 | ;;;###autoload |
728 | (put 'hebrew-holidays-4 'risky-local-variable t) | |
97344751 RS |
729 | ;;;###autoload |
730 | (defvar hebrew-holidays-4 | |
731 | '((holiday-passover-etc) | |
ecaa0527 RS |
732 | (if (and all-hebrew-calendar-holidays |
733 | (let* ((m displayed-month) | |
734 | (y displayed-year) | |
735 | (year)) | |
736 | (increment-calendar-month m y -1) | |
737 | (let ((year (extract-calendar-year | |
738 | (calendar-julian-from-absolute | |
739 | (calendar-absolute-from-gregorian | |
740 | (list m 1 y)))))) | |
741 | (= 21 (% year 28))))) | |
354d0644 | 742 | (holiday-julian 3 26 "Kiddush HaHamah")) |
ecaa0527 | 743 | (if all-hebrew-calendar-holidays |
97344751 RS |
744 | (holiday-tisha-b-av-etc)))) |
745 | ||
e555fdd8 RS |
746 | ;;;###autoload |
747 | (put 'hebrew-holidays 'risky-local-variable t) | |
97344751 RS |
748 | ;;;###autoload |
749 | (defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2 | |
750 | hebrew-holidays-3 hebrew-holidays-4) | |
7e1dae73 JB |
751 | "*Jewish holidays. |
752 | See the documentation for `calendar-holidays' for details.") | |
753 | ||
e555fdd8 RS |
754 | ;;;###autoload |
755 | (put 'christian-holidays 'risky-local-variable t) | |
7e1dae73 JB |
756 | ;;;###autoload |
757 | (defvar christian-holidays | |
758 | '((if all-christian-calendar-holidays | |
354d0644 JB |
759 | (holiday-fixed 1 6 "Epiphany")) |
760 | (holiday-easter-etc) | |
7e1dae73 | 761 | (if all-christian-calendar-holidays |
354d0644 | 762 | (holiday-greek-orthodox-easter)) |
7e1dae73 | 763 | (if all-christian-calendar-holidays |
354d0644 | 764 | (holiday-fixed 8 15 "Assumption")) |
7e1dae73 | 765 | (if all-christian-calendar-holidays |
354d0644 JB |
766 | (holiday-advent)) |
767 | (holiday-fixed 12 25 "Christmas") | |
7e1dae73 | 768 | (if all-christian-calendar-holidays |
354d0644 | 769 | (holiday-julian 12 25 "Eastern Orthodox Christmas"))) |
7e1dae73 JB |
770 | "*Christian holidays. |
771 | See the documentation for `calendar-holidays' for details.") | |
ecaa0527 | 772 | |
e555fdd8 RS |
773 | ;;;###autoload |
774 | (put 'islamic-holidays 'risky-local-variable t) | |
7e1dae73 JB |
775 | ;;;###autoload |
776 | (defvar islamic-holidays | |
354d0644 JB |
777 | '((holiday-islamic |
778 | 1 1 | |
779 | (format "Islamic New Year %d" | |
780 | (let ((m displayed-month) | |
781 | (y displayed-year)) | |
782 | (increment-calendar-month m y 1) | |
783 | (extract-calendar-year | |
784 | (calendar-islamic-from-absolute | |
785 | (calendar-absolute-from-gregorian | |
786 | (list | |
787 | m (calendar-last-day-of-month m y) y))))))) | |
ecaa0527 | 788 | (if all-islamic-calendar-holidays |
354d0644 | 789 | (holiday-islamic 1 10 "Ashura")) |
ecaa0527 | 790 | (if all-islamic-calendar-holidays |
354d0644 | 791 | (holiday-islamic 3 12 "Mulad-al-Nabi")) |
ecaa0527 | 792 | (if all-islamic-calendar-holidays |
354d0644 | 793 | (holiday-islamic 7 26 "Shab-e-Mi'raj")) |
ecaa0527 | 794 | (if all-islamic-calendar-holidays |
354d0644 JB |
795 | (holiday-islamic 8 15 "Shab-e-Bara't")) |
796 | (holiday-islamic 9 1 "Ramadan Begins") | |
ecaa0527 | 797 | (if all-islamic-calendar-holidays |
354d0644 | 798 | (holiday-islamic 9 27 "Shab-e Qadr")) |
ecaa0527 | 799 | (if all-islamic-calendar-holidays |
354d0644 | 800 | (holiday-islamic 10 1 "Id-al-Fitr")) |
ecaa0527 | 801 | (if all-islamic-calendar-holidays |
354d0644 | 802 | (holiday-islamic 12 10 "Id-al-Adha"))) |
7e1dae73 JB |
803 | "*Islamic holidays. |
804 | See the documentation for `calendar-holidays' for details.") | |
805 | ||
e555fdd8 RS |
806 | ;;;###autoload |
807 | (put 'solar-holidays 'risky-local-variable t) | |
7e1dae73 JB |
808 | ;;;###autoload |
809 | (defvar solar-holidays | |
810 | '((if (fboundp 'atan) | |
811 | (solar-equinoxes-solstices)) | |
3b92bdd2 RS |
812 | (if (progn |
813 | (require 'cal-dst) | |
814 | t) | |
354d0644 | 815 | (funcall |
3b92bdd2 | 816 | 'holiday-sexp |
354d0644 JB |
817 | calendar-daylight-savings-starts |
818 | '(format "Daylight Savings Time Begins %s" | |
819 | (if (fboundp 'atan) | |
820 | (solar-time-string | |
8a7cdf3a ER |
821 | (/ calendar-daylight-savings-starts-time (float 60)) |
822 | calendar-standard-time-zone-name) | |
354d0644 JB |
823 | "")))) |
824 | (funcall | |
825 | 'holiday-sexp | |
826 | calendar-daylight-savings-ends | |
827 | '(format "Daylight Savings Time Ends %s" | |
828 | (if (fboundp 'atan) | |
829 | (solar-time-string | |
8a7cdf3a ER |
830 | (/ calendar-daylight-savings-ends-time (float 60)) |
831 | calendar-daylight-time-zone-name) | |
354d0644 | 832 | "")))) |
7e1dae73 JB |
833 | "*Sun-related holidays. |
834 | See the documentation for `calendar-holidays' for details.") | |
835 | ||
e555fdd8 RS |
836 | ;;;###autoload |
837 | (put 'calendar-holidays 'risky-local-variable t) | |
7e1dae73 | 838 | (defvar calendar-holidays |
354d0644 JB |
839 | (append general-holidays local-holidays other-holidays |
840 | christian-holidays hebrew-holidays islamic-holidays | |
7086b78e | 841 | oriental-holidays solar-holidays) |
7e1dae73 JB |
842 | "*List of notable days for the command M-x holidays. |
843 | ||
844 | Additional holidays are easy to add to the list, just put them in the list | |
845 | `other-holidays' in your .emacs file. Similarly, by setting any of | |
846 | `general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays', | |
7086b78e ER |
847 | `islamic-holidays', `oriental-holidays', or `solar-holidays' to nil in your |
848 | .emacs file, you can eliminate unwanted categories of holidays. The intention | |
849 | is that (in the US) `local-holidays' be set in site-init.el and | |
850 | `other-holidays' be set by the user. | |
7e1dae73 | 851 | |
354d0644 JB |
852 | Entries on the list are expressions that return (possibly empty) lists of |
853 | items of the form ((month day year) string) of a holiday in the in the | |
854 | three-month period centered around `displayed-month' of `displayed-year'. | |
855 | Several basic functions are provided for this purpose: | |
856 | ||
857 | (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar | |
858 | (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in | |
859 | MONTH on the Gregorian calendar (0 for Sunday, | |
860 | etc.); K<0 means count back from the end of the | |
861 | month. An optional parameter DAY means the Kth | |
862 | DAYNAME after/before MONTH DAY. | |
863 | (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar | |
864 | (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar | |
865 | (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar | |
866 | (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression | |
7e1dae73 JB |
867 | in the variable `year'; if it evaluates to |
868 | a visible date, that's the holiday; if it | |
354d0644 JB |
869 | evaluates to nil, there's no holiday. STRING |
870 | is an expression in the variable `date'. | |
ecaa0527 RS |
871 | |
872 | For example, to add Bastille Day, celebrated in France on July 14, add | |
873 | ||
354d0644 | 874 | (holiday-fixed 7 14 \"Bastille Day\") |
ecaa0527 RS |
875 | |
876 | to the list. To add Hurricane Supplication Day, celebrated in the Virgin | |
877 | Islands on the fourth Monday in August, add | |
878 | ||
354d0644 | 879 | (holiday-float 8 1 4 \"Hurricane Supplication Day\") |
ecaa0527 RS |
880 | |
881 | to the list (the last Monday would be specified with `-1' instead of `4'). | |
7e1dae73 | 882 | To add the last day of Hanukkah to the list, use |
ecaa0527 | 883 | |
354d0644 | 884 | (holiday-hebrew 10 2 \"Last day of Hanukkah\") |
ecaa0527 RS |
885 | |
886 | since the Hebrew months are numbered with 1 starting from Nisan, while to | |
887 | add the Islamic feast celebrating Mohammed's birthday use | |
888 | ||
354d0644 | 889 | (holiday-islamic 3 12 \"Mohammed's Birthday\") |
ecaa0527 RS |
890 | |
891 | since the Islamic months are numbered from 1 starting with Muharram. To | |
892 | add Thomas Jefferson's birthday, April 2, 1743 (Julian), use | |
893 | ||
354d0644 | 894 | (holiday-julian 4 2 \"Jefferson's Birthday\") |
ecaa0527 | 895 | |
354d0644 JB |
896 | To include a holiday conditionally, use the sexp form or a conditional. For |
897 | example, to include American presidential elections, which occur on the first | |
898 | Tuesday after the first Monday in November of years divisible by 4, add | |
ecaa0527 | 899 | |
354d0644 JB |
900 | (holiday-sexp |
901 | (if (zerop (% year 4)) | |
902 | (calendar-gregorian-from-absolute | |
903 | (1+ (calendar-dayname-on-or-before | |
904 | 1 (+ 6 (calendar-absolute-from-gregorian | |
905 | (list 11 1 year))))))) | |
906 | \"US Presidential Election\") | |
7e1dae73 JB |
907 | |
908 | or | |
909 | ||
ecaa0527 | 910 | (if (zerop (% displayed-year 4)) |
354d0644 | 911 | (holiday-fixed 11 |
ecaa0527 RS |
912 | (extract-calendar-day |
913 | (calendar-gregorian-from-absolute | |
914 | (1+ (calendar-dayname-on-or-before | |
915 | 1 (+ 6 (calendar-absolute-from-gregorian | |
916 | (list 11 1 displayed-year))))))) | |
917 | \"US Presidential Election\")) | |
918 | ||
919 | to the list. To include the phases of the moon, add | |
920 | ||
921 | (lunar-phases) | |
922 | ||
354d0644 JB |
923 | to the holiday list, where `lunar-phases' is an Emacs-Lisp function that |
924 | you've written to return a (possibly empty) list of the relevant VISIBLE dates | |
925 | with descriptive strings such as | |
ecaa0527 | 926 | |
354d0644 | 927 | (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... ).") |
ecaa0527 | 928 | |
ecaa0527 RS |
929 | (defconst calendar-buffer "*Calendar*" |
930 | "Name of the buffer used for the calendar.") | |
931 | ||
932 | (defconst holiday-buffer "*Holidays*" | |
933 | "Name of the buffer used for the displaying the holidays.") | |
934 | ||
935 | (defconst fancy-diary-buffer "*Fancy Diary Entries*" | |
936 | "Name of the buffer used for the optional fancy display of the diary.") | |
937 | ||
cba0c253 ER |
938 | (defconst lunar-phases-buffer "*Phases of Moon*" |
939 | "Name of the buffer used for the lunar phases.") | |
940 | ||
ecaa0527 | 941 | (defmacro increment-calendar-month (mon yr n) |
354d0644 JB |
942 | "Move the variables MON and YR to the month and year by N months. |
943 | Forward if N is positive or backward if N is negative." | |
ecaa0527 RS |
944 | (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) ))) |
945 | (setq (, mon) (1+ (% macro-y 12) )) | |
946 | (setq (, yr) (/ macro-y 12))))) | |
947 | ||
948 | (defmacro calendar-for-loop (var from init to final do &rest body) | |
949 | "Execute a for loop." | |
950 | (` (let (( (, var) (1- (, init)) )) | |
951 | (while (>= (, final) (setq (, var) (1+ (, var)))) | |
952 | (,@ body))))) | |
953 | ||
954 | (defmacro calendar-sum (index initial condition expression) | |
354d0644 | 955 | "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION." |
ecaa0527 RS |
956 | (` (let (( (, index) (, initial)) |
957 | (sum 0)) | |
958 | (while (, condition) | |
959 | (setq sum (+ sum (, expression) )) | |
960 | (setq (, index) (1+ (, index)))) | |
961 | sum))) | |
962 | ||
cba0c253 ER |
963 | ;; The following are in-line for speed; they can be called thousands of times |
964 | ;; when looking up holidays or processing the diary. Here, for example, are | |
965 | ;; the numbers of calls to calendar/diary/holiday functions in preparing the | |
e5d77022 JB |
966 | ;; fancy diary display, for a moderately complex diary file, with functions |
967 | ;; used instead of macros. There were a total of 10000 such calls: | |
968 | ;; | |
969 | ;; 1934 extract-calendar-month | |
970 | ;; 1852 extract-calendar-year | |
971 | ;; 1819 extract-calendar-day | |
972 | ;; 845 calendar-leap-year-p | |
973 | ;; 837 calendar-day-number | |
974 | ;; 775 calendar-absolute-from-gregorian | |
975 | ;; 346 calendar-last-day-of-month | |
976 | ;; 286 hebrew-calendar-last-day-of-month | |
977 | ;; 188 hebrew-calendar-leap-year-p | |
978 | ;; 180 hebrew-calendar-elapsed-days | |
979 | ;; 163 hebrew-calendar-last-month-of-year | |
980 | ;; 66 calendar-date-compare | |
981 | ;; 65 hebrew-calendar-days-in-year | |
982 | ;; 60 calendar-absolute-from-julian | |
983 | ;; 50 calendar-absolute-from-hebrew | |
984 | ;; 43 calendar-date-equal | |
985 | ;; 38 calendar-gregorian-from-absolute | |
986 | ;; . | |
987 | ;; . | |
988 | ;; . | |
989 | ;; | |
990 | ;; The use of these seven macros eliminates the overhead of 92% of the function | |
cba0c253 | 991 | ;; calls; it's faster this way. |
e5d77022 | 992 | |
cba0c253 | 993 | (defsubst extract-calendar-month (date) |
ecaa0527 | 994 | "Extract the month part of DATE which has the form (month day year)." |
cba0c253 | 995 | (car date)) |
ecaa0527 | 996 | |
cba0c253 | 997 | (defsubst extract-calendar-day (date) |
ecaa0527 | 998 | "Extract the day part of DATE which has the form (month day year)." |
cba0c253 | 999 | (car (cdr date))) |
ecaa0527 | 1000 | |
cba0c253 | 1001 | (defsubst extract-calendar-year (date) |
ecaa0527 | 1002 | "Extract the year part of DATE which has the form (month day year)." |
cba0c253 | 1003 | (car (cdr (cdr date)))) |
ecaa0527 | 1004 | |
cba0c253 | 1005 | (defsubst calendar-leap-year-p (year) |
e5d77022 | 1006 | "Returns t if YEAR is a Gregorian leap year." |
cba0c253 ER |
1007 | (and (zerop (% year 4)) |
1008 | (or (not (zerop (% year 100))) | |
1009 | (zerop (% year 400))))) | |
1010 | ||
354d0644 JB |
1011 | ;; The foregoing is a bit faster, but not as clear as the following: |
1012 | ;; | |
cba0c253 | 1013 | ;;(defsubst calendar-leap-year-p (year) |
7e1dae73 JB |
1014 | ;; "Returns t if YEAR is a Gregorian leap year." |
1015 | ;; (or | |
1016 | ;; (and (= (% year 4) 0) | |
1017 | ;; (/= (% year 100) 0)) | |
1018 | ;; (= (% year 400) 0))) | |
e5d77022 | 1019 | |
cba0c253 | 1020 | (defsubst calendar-last-day-of-month (month year) |
e5d77022 | 1021 | "The last day in MONTH during YEAR." |
cba0c253 ER |
1022 | (if (and (= month 2) (calendar-leap-year-p year)) |
1023 | 29 | |
1024 | (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) | |
1025 | ||
1026 | ;; An explanation of the calculation can be found in PascAlgorithms by | |
1027 | ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988. | |
1028 | ||
1029 | (defsubst calendar-day-number (date) | |
e5d77022 JB |
1030 | "Return the day number within the year of the date DATE. |
1031 | For example, (calendar-day-number '(1 1 1987)) returns the value 1, | |
1032 | while (calendar-day-number '(12 31 1980)) returns 366." | |
cba0c253 ER |
1033 | (let* ((month (extract-calendar-month date)) |
1034 | (day (extract-calendar-day date)) | |
1035 | (year (extract-calendar-year date)) | |
1036 | (day-of-year (+ day (* 31 (1- month))))) | |
1037 | (if (> month 2) | |
1038 | (progn | |
1039 | (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) | |
1040 | (if (calendar-leap-year-p year) | |
e5d77022 | 1041 | (setq day-of-year (1+ day-of-year))))) |
cba0c253 ER |
1042 | day-of-year)) |
1043 | ||
1044 | (defsubst calendar-absolute-from-gregorian (date) | |
e5d77022 JB |
1045 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. |
1046 | The Gregorian date Sunday, December 31, 1 BC is imaginary." | |
cba0c253 ER |
1047 | (let ((prior-years (1- (extract-calendar-year date)))) |
1048 | (+ (calendar-day-number date);; Days this year | |
1049 | (* 365 prior-years);; + Days in prior years | |
1050 | (/ prior-years 4);; + Julian leap years | |
1051 | (- (/ prior-years 100));; - century years | |
1052 | (/ prior-years 400))));; + Gregorian leap years | |
e5d77022 | 1053 | |
7086b78e ER |
1054 | (autoload 'calendar-goto-today "cal-move" |
1055 | "Reposition the calendar window so the current date is visible." | |
1056 | t) | |
1057 | ||
1058 | (autoload 'calendar-forward-month "cal-move" | |
1059 | "Move the cursor forward ARG months." | |
1060 | t) | |
1061 | ||
1062 | (autoload 'calendar-forward-year "cal-move" | |
1063 | "Move the cursor forward by ARG years." | |
1064 | t) | |
1065 | ||
1066 | (autoload 'calendar-backward-month "cal-move" | |
1067 | "Move the cursor backward by ARG months." | |
1068 | t) | |
1069 | ||
1070 | (autoload 'calendar-backward-year "cal-move" | |
1071 | "Move the cursor backward ARG years." | |
1072 | t) | |
1073 | ||
1074 | (autoload 'scroll-calendar-left "cal-move" | |
1075 | "Scroll the displayed calendar left by ARG months." | |
1076 | t) | |
1077 | ||
1078 | (autoload 'scroll-calendar-right "cal-move" | |
1079 | "Scroll the displayed calendar window right by ARG months." | |
1080 | t) | |
1081 | ||
1082 | (autoload 'scroll-calendar-left-three-months "cal-move" | |
1083 | "Scroll the displayed calendar window left by 3*ARG months." | |
1084 | t) | |
1085 | ||
1086 | (autoload 'scroll-calendar-right-three-months "cal-move" | |
1087 | "Scroll the displayed calendar window right by 3*ARG months." | |
1088 | t) | |
1089 | ||
1090 | (autoload 'calendar-cursor-to-nearest-date "cal-move" | |
1091 | "Move the cursor to the closest date." | |
1092 | t) | |
1093 | ||
1094 | (autoload 'calendar-forward-day "cal-move" | |
1095 | "Move the cursor forward ARG days." | |
1096 | t) | |
1097 | ||
1098 | (autoload 'calendar-backward-day "cal-move" | |
1099 | "Move the cursor back ARG days." | |
1100 | t) | |
1101 | ||
1102 | (autoload 'calendar-forward-week "cal-move" | |
1103 | "Move the cursor forward ARG weeks." | |
1104 | t) | |
1105 | ||
1106 | (autoload 'calendar-backward-week "cal-move" | |
1107 | "Move the cursor back ARG weeks." | |
1108 | t) | |
1109 | ||
1110 | (autoload 'calendar-beginning-of-week "cal-move" | |
1111 | "Move the cursor back ARG calendar-week-start-day's." | |
1112 | t) | |
1113 | ||
1114 | (autoload 'calendar-end-of-week "cal-move" | |
1115 | "Move the cursor forward ARG calendar-week-start-day+6's." | |
1116 | t) | |
1117 | ||
1118 | (autoload 'calendar-beginning-of-month "cal-move" | |
1119 | "Move the cursor backward ARG month beginnings." | |
1120 | t) | |
1121 | ||
1122 | (autoload 'calendar-end-of-month "cal-move" | |
1123 | "Move the cursor forward ARG month ends." | |
1124 | t) | |
1125 | ||
1126 | (autoload 'calendar-beginning-of-year "cal-move" | |
1127 | "Move the cursor backward ARG year beginnings." | |
1128 | t) | |
1129 | ||
1130 | (autoload 'calendar-end-of-year "cal-move" | |
1131 | "Move the cursor forward ARG year beginnings." | |
1132 | t) | |
1133 | ||
1134 | (autoload 'calendar-cursor-to-visible-date "cal-move" | |
1135 | "Move the cursor to DATE that is on the screen." | |
1136 | t) | |
1137 | ||
1138 | (autoload 'calendar-goto-date "cal-move" | |
1139 | "Move cursor to DATE." | |
1140 | t) | |
1141 | ||
1142 | (autoload 'calendar-one-frame-setup "cal-x" | |
1143 | "Start calendar and display it in a dedicated frame together with the diary.") | |
1144 | ||
1145 | (autoload 'calendar-two-frame-setup "cal-x" | |
1146 | "Start calendar and diary in separate, dedicated frames.") | |
1147 | ||
1148 | ;;;###autoload | |
1149 | (defvar calendar-setup nil | |
1150 | "The frame set up of the calendar. | |
1151 | The choices are `one-frame' (calendar and diary together in one separate, | |
a69472b3 | 1152 | dedicated frame) or `two-frames' (calendar and diary in separate, dedicated |
7086b78e ER |
1153 | frames); with any other value the current frame is used.") |
1154 | ||
94b304d7 | 1155 | ;;;###autoload |
ecaa0527 | 1156 | (defun calendar (&optional arg) |
7086b78e ER |
1157 | "Choose between the one frame, two frame, or basic calendar displays. |
1158 | The original function `calendar' has been renamed `calendar-basic-setup'." | |
1159 | (interactive "P") | |
1160 | (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg)) | |
1161 | ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg)) | |
1162 | (t (calendar-basic-setup arg)))) | |
1163 | ||
1164 | (defun calendar-basic-setup (&optional arg) | |
ecaa0527 RS |
1165 | "Display a three-month calendar in another window. |
1166 | The three months appear side by side, with the current month in the middle | |
1167 | surrounded by the previous and next months. The cursor is put on today's date. | |
1168 | ||
7e1dae73 JB |
1169 | If called with an optional prefix argument, prompts for month and year. |
1170 | ||
ecaa0527 RS |
1171 | This function is suitable for execution in a .emacs file; appropriate setting |
1172 | of the variable `view-diary-entries-initially' will cause the diary entries for | |
1173 | the current date to be displayed in another window. The value of the variable | |
1174 | `number-of-diary-entries' controls the number of days of diary entries | |
1175 | displayed upon initial display of the calendar. | |
1176 | ||
1177 | An optional prefix argument ARG causes the calendar displayed to be ARG | |
1178 | months in the future if ARG is positive or in the past if ARG is negative; | |
1179 | in this case the cursor goes on the first day of the month. | |
1180 | ||
1181 | Once in the calendar window, future or past months can be moved into view. | |
1182 | Arbitrary months can be displayed, or the calendar can be scrolled forward | |
1183 | or backward. | |
1184 | ||
1185 | The cursor can be moved forward or backward by one day, one week, one month, | |
1186 | or one year. All of these commands take prefix arguments which, when negative, | |
1187 | cause movement in the opposite direction. For convenience, the digit keys | |
1188 | and the minus sign are automatically prefixes. The window is replotted as | |
1189 | necessary to display the desired date. | |
1190 | ||
1191 | Diary entries can be marked on the calendar or displayed in another window. | |
1192 | ||
1193 | Use M-x describe-mode for details of the key bindings in the calendar window. | |
1194 | ||
1195 | The Gregorian calendar is assumed. | |
1196 | ||
7e1dae73 | 1197 | After loading the calendar, the hooks given by the variable |
2b803765 | 1198 | `calendar-load-hook' are run. This is the place to add key bindings to the |
7e1dae73 JB |
1199 | calendar-mode-map. |
1200 | ||
ecaa0527 RS |
1201 | After preparing the calendar window initially, the hooks given by the variable |
1202 | `initial-calendar-window-hook' are run. | |
1203 | ||
1204 | The hooks given by the variable `today-visible-calendar-hook' are run | |
a69472b3 | 1205 | every time the calendar window gets scrolled, if the current date is visible |
ecaa0527 RS |
1206 | in the window. If it is not visible, the hooks given by the variable |
1207 | `today-invisible-calendar-hook' are run. Thus, for example, setting | |
1208 | `today-visible-calendar-hook' to 'calendar-star-date will cause today's date | |
1209 | to be replaced by asterisks to highlight it whenever it is in the window." | |
1210 | (interactive "P") | |
ecaa0527 RS |
1211 | (set-buffer (get-buffer-create calendar-buffer)) |
1212 | (calendar-mode) | |
ecd42d42 | 1213 | (let* ((pop-up-windows t) |
7e1dae73 | 1214 | (split-height-threshold 1000) |
cba0c253 ER |
1215 | (date (if arg |
1216 | (calendar-read-date t) | |
1217 | (calendar-current-date))) | |
1218 | (month (extract-calendar-month date)) | |
1219 | (year (extract-calendar-year date))) | |
ecaa0527 | 1220 | (pop-to-buffer calendar-buffer) |
cba0c253 | 1221 | (increment-calendar-month month year (- calendar-offset)) |
7e1dae73 JB |
1222 | (generate-calendar-window month year) |
1223 | (if (and view-diary-entries-initially (calendar-date-is-visible-p date)) | |
1224 | (view-diary-entries | |
1225 | (if (vectorp number-of-diary-entries) | |
1226 | (aref number-of-diary-entries (calendar-day-of-week date)) | |
1227 | number-of-diary-entries)))) | |
1228 | (let* ((diary-buffer (get-file-buffer diary-file)) | |
1229 | (diary-window (if diary-buffer (get-buffer-window diary-buffer))) | |
1230 | (split-height-threshold (if diary-window 2 1000))) | |
1231 | (if view-calendar-holidays-initially | |
1232 | (list-calendar-holidays))) | |
ecaa0527 RS |
1233 | (run-hooks 'initial-calendar-window-hook)) |
1234 | ||
fb30f0ce | 1235 | (autoload 'view-diary-entries "diary-lib" |
ecaa0527 | 1236 | "Prepare and display a buffer with diary entries. |
6b1abbd1 | 1237 | Searches your diary file for entries that match ARG days starting with |
ecaa0527 RS |
1238 | the date indicated by the cursor position in the displayed three-month |
1239 | calendar." | |
1240 | t) | |
1241 | ||
7e1dae73 JB |
1242 | (autoload 'calendar-sunrise-sunset "solar" |
1243 | "Local time of sunrise and sunset for date under cursor." | |
1244 | t) | |
1245 | ||
1246 | (autoload 'calendar-phases-of-moon "lunar" | |
1247 | "Create a buffer of the phases of the moon for the current calendar window." | |
1248 | t) | |
1249 | ||
1250 | (autoload 'calendar-print-french-date "cal-french" | |
6a2aa94c | 1251 | "Show the French Revolutionary calendar equivalent of the date under the cursor." |
7e1dae73 JB |
1252 | t) |
1253 | ||
1254 | (autoload 'calendar-goto-french-date "cal-french" | |
1255 | "Move cursor to French Revolutionary date." | |
1256 | t) | |
1257 | ||
6a2aa94c | 1258 | (autoload 'calendar-french-date-string "cal-french" |
7086b78e | 1259 | "String of French Revolutionary date of Gregorian date." |
6a2aa94c RS |
1260 | t) |
1261 | ||
1262 | (autoload 'calendar-mayan-date-string "cal-mayan" | |
7086b78e | 1263 | "String of Mayan date of Gregorian date." |
6a2aa94c RS |
1264 | t) |
1265 | ||
7e1dae73 | 1266 | (autoload 'calendar-print-mayan-date "cal-mayan" |
6a2aa94c | 1267 | "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor." |
7e1dae73 JB |
1268 | t) |
1269 | ||
1270 | (autoload 'calendar-goto-mayan-long-count-date "cal-mayan" | |
1271 | "Move cursor to Mayan long count date." | |
1272 | t) | |
1273 | ||
1274 | (autoload 'calendar-next-haab-date "cal-mayan" | |
1275 | "Move cursor to next instance of Mayan Haab date." | |
1276 | t) | |
1277 | ||
1278 | (autoload 'calendar-previous-haab-date "cal-mayan" | |
1279 | "Move cursor to previous instance of Mayan Haab date." | |
1280 | t) | |
1281 | ||
1282 | (autoload 'calendar-next-tzolkin-date "cal-mayan" | |
1283 | "Move cursor to next instance of Mayan Tzolkin date." | |
1284 | t) | |
1285 | ||
1286 | (autoload 'calendar-previous-tzolkin-date "cal-mayan" | |
1287 | "Move cursor to previous instance of Mayan Tzolkin date." | |
1288 | t) | |
1289 | ||
1290 | (autoload 'calendar-next-calendar-round-date "cal-mayan" | |
a69472b3 | 1291 | "Move cursor to next instance of Mayan Haab/Tzolkin combination." |
7e1dae73 JB |
1292 | t) |
1293 | ||
1294 | (autoload 'calendar-previous-calendar-round-date "cal-mayan" | |
a69472b3 | 1295 | "Move cursor to previous instance of Mayan Haab/Tzolkin combination." |
7e1dae73 JB |
1296 | t) |
1297 | ||
7086b78e | 1298 | (autoload 'calendar-goto-chinese-date "cal-chinese" |
6cf0fb79 | 1299 | "Move cursor to Chinese date." |
7086b78e ER |
1300 | t) |
1301 | ||
1302 | (autoload 'calendar-print-chinese-date "cal-chinese" | |
1303 | "Show the Chinese date equivalents of date." | |
1304 | t) | |
1305 | ||
1306 | (autoload 'calendar-chinese-date-string "cal-chinese" | |
1307 | "String of Chinese date of Gregorian date." | |
1308 | t) | |
1309 | ||
6cf0fb79 ER |
1310 | (autoload 'calendar-absolute-from-astro |
1311 | "Absolute date of astronomical (Julian) day number D." | |
1312 | "cal-julian") | |
1313 | ||
14fcc701 KH |
1314 | (autoload 'calendar-astro-from-absolute "cal-julian" |
1315 | "Astronomical (Julian) day number of absolute date D.") | |
1316 | ||
6cf0fb79 ER |
1317 | (autoload 'calendar-astro-date-string "cal-julian" |
1318 | "String of astronomical (Julian) day number of Gregorian date." | |
1319 | t) | |
1320 | ||
1321 | (autoload 'calendar-goto-astro-date "cal-julian" | |
1322 | "Move cursor to astronomical (Julian) day number." | |
1323 | t) | |
1324 | ||
6dcba8a3 RS |
1325 | (autoload 'calendar-julian-from-absolute "cal-julian" |
1326 | "Compute the Julian (month day year) corresponding to the absolute DATE. | |
1327 | The absolute date is the number of days elapsed since the (imaginary) | |
1328 | Gregorian date Sunday, December 31, 1 BC.") | |
1329 | ||
7086b78e ER |
1330 | (autoload 'calendar-goto-julian-date "cal-julian" |
1331 | "Move cursor to Julian DATE; echo Julian date unless NOECHO is t." | |
1332 | t) | |
1333 | ||
07986bc4 RS |
1334 | (autoload 'calendar-julian-date-string "cal-julian" |
1335 | "String of Julian date of Gregorian DATE. | |
1336 | Defaults to today's date if DATE is not given. | |
1337 | Driven by the variable `calendar-date-display-form'." | |
1338 | t) | |
1339 | ||
7086b78e ER |
1340 | (autoload 'calendar-goto-iso-date "cal-iso" |
1341 | "Move cursor to ISO date." | |
1342 | t) | |
1343 | ||
1344 | (autoload 'calendar-print-iso-date "cal-iso" | |
1345 | "Show the ISO date equivalents of date." | |
1346 | t) | |
1347 | ||
1348 | (autoload 'calendar-iso-date-string "cal-iso" | |
1349 | "String of ISO date of Gregorian date." | |
1350 | t) | |
1351 | ||
1352 | (autoload 'calendar-print-islamic-date "cal-islamic" | |
1353 | "Show the Islamic date equivalents of date." | |
1354 | t) | |
1355 | ||
1356 | (autoload 'calendar-islamic-date-string "cal-islamic" | |
1357 | "String of Islamic date of Gregorian date." | |
1358 | t) | |
1359 | ||
1360 | (autoload 'calendar-goto-hebrew-date "cal-hebrew" | |
1361 | "Move cursor to Hebrew date date." | |
1362 | t) | |
1363 | ||
1364 | (autoload 'calendar-print-hebrew-date "cal-hebrew" | |
1365 | "Show the Hebrew date equivalents of date." | |
1366 | t) | |
1367 | ||
1368 | (autoload 'calendar-hebrew-date-string "cal-hebrew" | |
1369 | "String of Hebrew date of Gregorian date." | |
1370 | t) | |
1371 | ||
1372 | (autoload 'calendar-goto-coptic-date "cal-coptic" | |
1373 | "Move cursor to Coptic date date." | |
1374 | t) | |
1375 | ||
1376 | (autoload 'calendar-print-coptic-date "cal-coptic" | |
1377 | "Show the Coptic date equivalents of date." | |
1378 | t) | |
1379 | ||
1380 | (autoload 'calendar-coptic-date-string "cal-coptic" | |
1381 | "String of Coptic date of Gregorian date." | |
1382 | t) | |
1383 | ||
1384 | (autoload 'calendar-goto-ethiopic-date "cal-coptic" | |
1385 | "Move cursor to Ethiopic date date." | |
1386 | t) | |
1387 | ||
1388 | (autoload 'calendar-print-ethiopic-date "cal-coptic" | |
1389 | "Show the Ethiopic date equivalents of date." | |
1390 | t) | |
1391 | ||
1392 | (autoload 'calendar-ethiopic-date-string "cal-coptic" | |
1393 | "String of Ethiopic date of Gregorian date." | |
1394 | t) | |
1395 | ||
fb30f0ce | 1396 | (autoload 'show-all-diary-entries "diary-lib" |
6b1abbd1 RS |
1397 | "Show all of the diary entries in the diary file. |
1398 | This function gets rid of the selective display of the diary file so that | |
ecaa0527 RS |
1399 | all entries, not just some, are visible. If there is no diary buffer, one |
1400 | is created." | |
1401 | t) | |
1402 | ||
fb30f0ce | 1403 | (autoload 'mark-diary-entries "diary-lib" |
ecaa0527 | 1404 | "Mark days in the calendar window that have diary entries. |
6b1abbd1 | 1405 | Each entry in diary file visible in the calendar window is marked." |
ecaa0527 RS |
1406 | t) |
1407 | ||
fb30f0ce | 1408 | (autoload 'make-diary-entry "diary-lib" |
7086b78e ER |
1409 | "Insert a diary entry STRING which may be NONMARKING in FILE." |
1410 | t) | |
1411 | ||
fb30f0ce | 1412 | (autoload 'insert-diary-entry "diary-lib" |
ecaa0527 RS |
1413 | "Insert a diary entry for the date indicated by point." |
1414 | t) | |
1415 | ||
fb30f0ce | 1416 | (autoload 'insert-weekly-diary-entry "diary-lib" |
ecaa0527 RS |
1417 | "Insert a weekly diary entry for the day of the week indicated by point." |
1418 | t) | |
1419 | ||
354d0644 | 1420 | |
fb30f0ce | 1421 | (autoload 'insert-monthly-diary-entry "diary-lib" |
ecaa0527 RS |
1422 | "Insert a monthly diary entry for the day of the month indicated by point." |
1423 | t) | |
1424 | ||
fb30f0ce | 1425 | (autoload 'insert-yearly-diary-entry "diary-lib" |
ecaa0527 RS |
1426 | "Insert an annual diary entry for the day of the year indicated by point." |
1427 | t) | |
1428 | ||
fb30f0ce | 1429 | (autoload 'insert-anniversary-diary-entry "diary-lib" |
ecaa0527 RS |
1430 | "Insert an anniversary diary entry for the date indicated by point." |
1431 | t) | |
1432 | ||
fb30f0ce | 1433 | (autoload 'insert-block-diary-entry "diary-lib" |
ecaa0527 RS |
1434 | "Insert a block diary entry for the dates indicated by point and mark." |
1435 | t) | |
1436 | ||
fb30f0ce | 1437 | (autoload 'insert-cyclic-diary-entry "diary-lib" |
ecaa0527 RS |
1438 | "Insert a cyclic diary entry starting at the date indicated by point." |
1439 | t) | |
1440 | ||
7086b78e | 1441 | (autoload 'insert-hebrew-diary-entry "cal-hebrew" |
ecaa0527 RS |
1442 | "Insert a diary entry for the Hebrew date corresponding to the date |
1443 | indicated by point." | |
1444 | t) | |
1445 | ||
7086b78e | 1446 | (autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew" |
ecaa0527 RS |
1447 | "Insert a monthly diary entry for the day of the Hebrew month corresponding |
1448 | to the date indicated by point." | |
1449 | t) | |
1450 | ||
7086b78e | 1451 | (autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew" |
ecaa0527 RS |
1452 | "Insert an annual diary entry for the day of the Hebrew year corresponding |
1453 | to the date indicated by point." | |
1454 | t) | |
1455 | ||
7086b78e | 1456 | (autoload 'insert-islamic-diary-entry "cal-islamic" |
ecaa0527 RS |
1457 | "Insert a diary entry for the Islamic date corresponding to the date |
1458 | indicated by point." | |
1459 | t) | |
1460 | ||
7086b78e | 1461 | (autoload 'insert-monthly-islamic-diary-entry "cal-islamic" |
ecaa0527 RS |
1462 | "Insert a monthly diary entry for the day of the Islamic month corresponding |
1463 | to the date indicated by point." | |
1464 | t) | |
1465 | ||
7086b78e | 1466 | (autoload 'insert-yearly-islamic-diary-entry "cal-islamic" |
ecaa0527 RS |
1467 | "Insert an annual diary entry for the day of the Islamic year corresponding |
1468 | to the date indicated by point." | |
1469 | t) | |
1470 | ||
1471 | (autoload 'list-calendar-holidays "holidays" | |
1472 | "Create a buffer containing the holidays for the current calendar window. | |
1473 | The holidays are those in the list `calendar-notable-days'. Returns t if any | |
1474 | holidays are found, nil if not." | |
1475 | t) | |
1476 | ||
3076647c ER |
1477 | (autoload 'cal-tex-cursor-month "cal-tex" |
1478 | "Make a buffer with LaTeX commands for the month cursor is on. | |
1479 | Optional prefix argument specifies number of months to be produced. | |
1480 | Calendar is condensed onto one page.") | |
1481 | ||
1482 | (autoload 'cal-tex-cursor-month-landscape "cal-tex" | |
1483 | "Make a buffer with LaTeX commands for the month cursor is on. | |
1484 | Optional prefix argument specifies number of months to be produced.") | |
1485 | ||
1486 | (autoload 'cal-tex-cursor-day "cal-tex" | |
1487 | "Make a buffer with LaTeX commands for the day cursor is on.") | |
1488 | ||
1489 | (autoload 'cal-tex-cursor-week "cal-tex" | |
5a2c140a RS |
1490 | "Make a buffer with LaTeX commands for a two-page one-week calendar. |
1491 | It applies to the week that point is in. | |
1492 | Optional prefix argument specifies number of weeks. | |
1493 | Holidays are included if `cal-tex-holidays' is t.") | |
1494 | ||
1495 | (autoload 'cal-tex-cursor-week2 "cal-tex" | |
1496 | "Make a buffer with LaTeX commands for a two-page one-week calendar. | |
1497 | It applies to the week that point is in. | |
1498 | Optional prefix argument specifies number of weeks. | |
1499 | Holidays are included if `cal-tex-holidays' is t.") | |
1500 | ||
1501 | (autoload 'cal-tex-cursor-week-iso "cal-tex" | |
1502 | "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar. | |
07e4feff | 1503 | Optional prefix argument specifies number of weeks. |
5a2c140a RS |
1504 | Diary entries are included if `cal-tex-diary' is t. |
1505 | Holidays are included if `cal-tex-holidays' is t.") | |
1506 | ||
1507 | (autoload 'cal-tex-cursor-week-monday "cal-tex" | |
1508 | "Make a buffer with LaTeX commands for a two-page one-week calendar. | |
1509 | It applies to the week that point is in, and starts on Monday. | |
1510 | Optional prefix argument specifies number of weeks. | |
1511 | Holidays are included if `cal-tex-holidays' is t.") | |
1512 | ||
1513 | (autoload 'cal-tex-cursor-filofax-2week "cal-tex" | |
1514 | "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor. | |
1515 | Optional prefix argument specifies number of weeks. | |
1516 | Diary entries are included if cal-tex-diary is t. | |
1517 | Holidays are included if `cal-tex-holidays' is t.") | |
1518 | ||
1519 | (autoload 'cal-tex-cursor-filofax-week "cal-tex" | |
1520 | "One-week-at-a-glance Filofax style calendar for week indicated by cursor. | |
1521 | Optional prefix argument specifies number of weeks. | |
1522 | Weeks start on Monday. | |
1523 | Diary entries are included if cal-tex-diary is t. | |
1524 | Holidays are included if `cal-tex-holidays' is t.") | |
3076647c ER |
1525 | |
1526 | (autoload 'cal-tex-cursor-year "cal-tex" | |
1527 | "Make a buffer with LaTeX commands for a year's calendar. | |
a69472b3 | 1528 | Optional prefix argument specifies number of years.") |
3076647c ER |
1529 | |
1530 | (autoload 'cal-tex-cursor-year-landscape "cal-tex" | |
1531 | "Make a buffer with LaTeX commands for a year's calendar (landscape). | |
1532 | Optional prefix argument specifies number of years.") | |
1533 | ||
1534 | (autoload 'cal-tex-cursor-filofax-year "cal-tex" | |
1535 | "Make a buffer with LaTeX commands for a year's calendar (Filofax). | |
1536 | Optional prefix argument specifies number of years.") | |
1537 | ||
ecaa0527 RS |
1538 | (autoload 'mark-calendar-holidays "holidays" |
1539 | "Mark notable days in the calendar window." | |
1540 | t) | |
1541 | ||
1542 | (autoload 'calendar-cursor-holidays "holidays" | |
1543 | "Find holidays for the date specified by the cursor in the calendar window." | |
1544 | t) | |
1545 | ||
7e1dae73 JB |
1546 | (defun generate-calendar-window (&optional mon yr) |
1547 | "Generate the calendar window for the current date. | |
1548 | Or, for optional MON, YR." | |
ecaa0527 | 1549 | (let* ((buffer-read-only nil) |
ecaa0527 RS |
1550 | (today (calendar-current-date)) |
1551 | (month (extract-calendar-month today)) | |
1552 | (day (extract-calendar-day today)) | |
1553 | (year (extract-calendar-year today)) | |
7e1dae73 JB |
1554 | (today-visible |
1555 | (or (not mon) | |
1556 | (let ((offset (calendar-interval mon yr month year))) | |
1557 | (and (<= offset 1) (>= offset -1))))) | |
ecaa0527 RS |
1558 | (day-in-week (calendar-day-of-week today))) |
1559 | (update-calendar-mode-line) | |
7e1dae73 JB |
1560 | (if mon |
1561 | (generate-calendar mon yr) | |
1562 | (generate-calendar month year)) | |
ecaa0527 RS |
1563 | (calendar-cursor-to-visible-date |
1564 | (if today-visible today (list displayed-month 1 displayed-year))) | |
1565 | (set-buffer-modified-p nil) | |
1566 | (or (one-window-p t) | |
fd7fa35a | 1567 | (/= (frame-width) (window-width)) |
ecaa0527 RS |
1568 | (shrink-window (- (window-height) 9))) |
1569 | (sit-for 0) | |
1570 | (and mark-holidays-in-calendar | |
1571 | (mark-calendar-holidays) | |
1572 | (sit-for 0)) | |
1573 | (unwind-protect | |
1574 | (if mark-diary-entries-in-calendar (mark-diary-entries)) | |
1575 | (if today-visible | |
1576 | (run-hooks 'today-visible-calendar-hook) | |
1577 | (run-hooks 'today-invisible-calendar-hook))))) | |
1578 | ||
1579 | (defun generate-calendar (month year) | |
1580 | "Generate a three-month Gregorian calendar centered around MONTH, YEAR." | |
1581 | (if (< (+ month (* 12 (1- year))) 2) | |
1582 | (error "Months before February, 1 AD are not available.")) | |
1583 | (setq displayed-month month) | |
1584 | (setq displayed-year year) | |
1585 | (erase-buffer) | |
1586 | (increment-calendar-month month year -1) | |
1587 | (calendar-for-loop i from 0 to 2 do | |
1588 | (generate-calendar-month month year (+ 5 (* 25 i))) | |
1589 | (increment-calendar-month month year 1))) | |
1590 | ||
1591 | (defun generate-calendar-month (month year indent) | |
1592 | "Produce a calendar for MONTH, YEAR on the Gregorian calendar. | |
1593 | The calendar is inserted in the buffer starting at the line on which point | |
1594 | is currently located, but indented INDENT spaces. The indentation is done | |
1595 | from the first character on the line and does not disturb the first INDENT | |
1596 | characters on the line." | |
d8a200a7 | 1597 | (let* ((blank-days;; at start of month |
b6c0aabf | 1598 | (mod |
d8a200a7 RS |
1599 | (- (calendar-day-of-week (list month 1 year)) |
1600 | calendar-week-start-day) | |
1601 | 7)) | |
1602 | (last (calendar-last-day-of-month month year))) | |
1603 | (goto-char (point-min)) | |
1604 | (calendar-insert-indented | |
1605 | (calendar-string-spread | |
cbecb9f9 | 1606 | (list (format "%s %d" (calendar-month-name month) year)) ? 20) |
d8a200a7 RS |
1607 | indent t) |
1608 | (calendar-insert-indented "" indent);; Go to proper spot | |
1609 | (calendar-for-loop i from 0 to 6 do | |
1610 | (insert (substring (aref calendar-day-name-array | |
b6c0aabf | 1611 | (mod (+ calendar-week-start-day i) 7)) |
d8a200a7 RS |
1612 | 0 2)) |
1613 | (insert " ")) | |
1614 | (calendar-insert-indented "" 0 t);; Force onto following line | |
1615 | (calendar-insert-indented "" indent);; Go to proper spot | |
1616 | ;; Add blank days before the first of the month | |
1617 | (calendar-for-loop i from 1 to blank-days do (insert " ")) | |
1618 | ;; Put in the days of the month | |
1619 | (calendar-for-loop i from 1 to last do | |
1620 | (insert (format "%2d " i)) | |
7086b78e | 1621 | (put-text-property (- (point) 3) (1- (point)) |
55fbd565 | 1622 | 'mouse-face 'highlight) |
b6c0aabf | 1623 | (and (zerop (mod (+ i blank-days) 7)) |
d8a200a7 RS |
1624 | (/= i last) |
1625 | (calendar-insert-indented "" 0 t) ;; Force onto following line | |
1626 | (calendar-insert-indented "" indent)))));; Go to proper spot | |
ecaa0527 RS |
1627 | |
1628 | (defun calendar-insert-indented (string indent &optional newline) | |
1629 | "Insert STRING at column INDENT. | |
1630 | If the optional parameter NEWLINE is t, leave point at start of next line, | |
1631 | inserting a newline if there was no next line; otherwise, leave point after | |
1632 | the inserted text. Value is always t." | |
1633 | ;; Try to move to that column. | |
1634 | (move-to-column indent) | |
1635 | ;; If line is too short, indent out to that column. | |
1636 | (if (< (current-column) indent) | |
1637 | (indent-to indent)) | |
1638 | (insert string) | |
1639 | ;; Advance to next line, if requested. | |
1640 | (if newline | |
1641 | (progn | |
1642 | (end-of-line) | |
1643 | (if (eobp) | |
1644 | (newline) | |
1645 | (forward-line 1)))) | |
1646 | t) | |
1647 | ||
1648 | (defun redraw-calendar () | |
1649 | "Redraw the calendar display." | |
1650 | (interactive) | |
1651 | (let ((cursor-date (calendar-cursor-to-date))) | |
7e1dae73 | 1652 | (generate-calendar-window displayed-month displayed-year) |
ecaa0527 RS |
1653 | (calendar-cursor-to-visible-date cursor-date))) |
1654 | ||
354d0644 JB |
1655 | (defvar calendar-debug-sexp nil |
1656 | "*Turn debugging on when evaluating a sexp in the diary or holiday list.") | |
1657 | ||
ecaa0527 RS |
1658 | (defvar calendar-mode-map nil) |
1659 | (if calendar-mode-map | |
1660 | nil | |
1661 | (setq calendar-mode-map (make-sparse-keymap)) | |
6a2aa94c | 1662 | (if window-system (require 'cal-menu)) |
ecaa0527 RS |
1663 | (calendar-for-loop i from 0 to 9 do |
1664 | (define-key calendar-mode-map (int-to-string i) 'digit-argument)) | |
1665 | (let ((l (list 'narrow-to-region 'mark-word 'mark-sexp 'mark-paragraph | |
6b39e127 | 1666 | 'mark-defun 'mark-whole-buffer 'mark-page |
8f12817f ER |
1667 | 'downcase-region 'upcase-region 'kill-region |
1668 | 'copy-region-as-kill 'capitalize-region 'write-region))) | |
6b39e127 RS |
1669 | (while l |
1670 | (substitute-key-definition (car l) 'calendar-not-implemented | |
1671 | calendar-mode-map global-map) | |
1672 | (setq l (cdr l)))) | |
ecaa0527 RS |
1673 | (define-key calendar-mode-map "-" 'negative-argument) |
1674 | (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right) | |
0d336f18 | 1675 | (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months) |
ff4373ed | 1676 | (define-key calendar-mode-map "\ev" 'scroll-calendar-right-three-months) |
ecaa0527 | 1677 | (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left) |
0d336f18 | 1678 | (define-key calendar-mode-map [next] 'scroll-calendar-left-three-months) |
ff4373ed | 1679 | (define-key calendar-mode-map "\C-v" 'scroll-calendar-left-three-months) |
ecaa0527 RS |
1680 | (define-key calendar-mode-map "\C-b" 'calendar-backward-day) |
1681 | (define-key calendar-mode-map "\C-p" 'calendar-backward-week) | |
7e1dae73 | 1682 | (define-key calendar-mode-map "\e{" 'calendar-backward-month) |
ecaa0527 RS |
1683 | (define-key calendar-mode-map "\C-x[" 'calendar-backward-year) |
1684 | (define-key calendar-mode-map "\C-f" 'calendar-forward-day) | |
1685 | (define-key calendar-mode-map "\C-n" 'calendar-forward-week) | |
e9c78f07 RS |
1686 | (define-key calendar-mode-map [left] 'calendar-backward-day) |
1687 | (define-key calendar-mode-map [up] 'calendar-backward-week) | |
1688 | (define-key calendar-mode-map [right] 'calendar-forward-day) | |
1689 | (define-key calendar-mode-map [down] 'calendar-forward-week) | |
7e1dae73 | 1690 | (define-key calendar-mode-map "\e}" 'calendar-forward-month) |
ecaa0527 RS |
1691 | (define-key calendar-mode-map "\C-x]" 'calendar-forward-year) |
1692 | (define-key calendar-mode-map "\C-a" 'calendar-beginning-of-week) | |
1693 | (define-key calendar-mode-map "\C-e" 'calendar-end-of-week) | |
1694 | (define-key calendar-mode-map "\ea" 'calendar-beginning-of-month) | |
1695 | (define-key calendar-mode-map "\ee" 'calendar-end-of-month) | |
1696 | (define-key calendar-mode-map "\e<" 'calendar-beginning-of-year) | |
1697 | (define-key calendar-mode-map "\e>" 'calendar-end-of-year) | |
1698 | (define-key calendar-mode-map "\C-@" 'calendar-set-mark) | |
5e2a0ae4 RS |
1699 | ;; Many people are used to typing C-SPC and getting C-@. |
1700 | (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark) | |
ecaa0527 | 1701 | (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark) |
7e1dae73 JB |
1702 | (define-key calendar-mode-map "\e=" 'calendar-count-days-region) |
1703 | (define-key calendar-mode-map "gd" 'calendar-goto-date) | |
1704 | (define-key calendar-mode-map "gj" 'calendar-goto-julian-date) | |
1705 | (define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number) | |
1706 | (define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date) | |
1707 | (define-key calendar-mode-map "gi" 'calendar-goto-islamic-date) | |
7086b78e ER |
1708 | (define-key calendar-mode-map "gC" 'calendar-goto-chinese-date) |
1709 | (define-key calendar-mode-map "gk" 'calendar-goto-coptic-date) | |
1710 | (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date) | |
7e1dae73 JB |
1711 | (define-key calendar-mode-map "gc" 'calendar-goto-iso-date) |
1712 | (define-key calendar-mode-map "gf" 'calendar-goto-french-date) | |
1713 | (define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date) | |
1714 | (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date) | |
1715 | (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date) | |
1716 | (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date) | |
1717 | (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date) | |
1718 | (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date) | |
1719 | (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date) | |
1720 | (define-key calendar-mode-map "S" 'calendar-sunrise-sunset) | |
1721 | (define-key calendar-mode-map "M" 'calendar-phases-of-moon) | |
1722 | (define-key calendar-mode-map " " 'scroll-other-window) | |
ecaa0527 | 1723 | (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar) |
899b130e | 1724 | (define-key calendar-mode-map "." 'calendar-goto-today) |
7e1dae73 JB |
1725 | (define-key calendar-mode-map "o" 'calendar-other-month) |
1726 | (define-key calendar-mode-map "q" 'exit-calendar) | |
1727 | (define-key calendar-mode-map "a" 'list-calendar-holidays) | |
1728 | (define-key calendar-mode-map "h" 'calendar-cursor-holidays) | |
1729 | (define-key calendar-mode-map "x" 'mark-calendar-holidays) | |
1730 | (define-key calendar-mode-map "u" 'calendar-unmark) | |
1731 | (define-key calendar-mode-map "m" 'mark-diary-entries) | |
1732 | (define-key calendar-mode-map "d" 'view-diary-entries) | |
46e07c15 | 1733 | (define-key calendar-mode-map "D" 'view-other-diary-entries) |
7e1dae73 JB |
1734 | (define-key calendar-mode-map "s" 'show-all-diary-entries) |
1735 | (define-key calendar-mode-map "pd" 'calendar-print-day-of-year) | |
7086b78e ER |
1736 | (define-key calendar-mode-map "pC" 'calendar-print-chinese-date) |
1737 | (define-key calendar-mode-map "pk" 'calendar-print-coptic-date) | |
1738 | (define-key calendar-mode-map "pe" 'calendar-print-ethiopic-date) | |
7e1dae73 JB |
1739 | (define-key calendar-mode-map "pc" 'calendar-print-iso-date) |
1740 | (define-key calendar-mode-map "pj" 'calendar-print-julian-date) | |
1741 | (define-key calendar-mode-map "pa" 'calendar-print-astro-day-number) | |
1742 | (define-key calendar-mode-map "ph" 'calendar-print-hebrew-date) | |
1743 | (define-key calendar-mode-map "pi" 'calendar-print-islamic-date) | |
1744 | (define-key calendar-mode-map "pf" 'calendar-print-french-date) | |
1745 | (define-key calendar-mode-map "pm" 'calendar-print-mayan-date) | |
1746 | (define-key calendar-mode-map "id" 'insert-diary-entry) | |
1747 | (define-key calendar-mode-map "iw" 'insert-weekly-diary-entry) | |
1748 | (define-key calendar-mode-map "im" 'insert-monthly-diary-entry) | |
1749 | (define-key calendar-mode-map "iy" 'insert-yearly-diary-entry) | |
1750 | (define-key calendar-mode-map "ia" 'insert-anniversary-diary-entry) | |
1751 | (define-key calendar-mode-map "ib" 'insert-block-diary-entry) | |
1752 | (define-key calendar-mode-map "ic" 'insert-cyclic-diary-entry) | |
1753 | (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry) | |
1754 | (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry) | |
1755 | (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry) | |
1756 | (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry) | |
1757 | (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry) | |
1758 | (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry) | |
3076647c ER |
1759 | (define-key calendar-mode-map "?" 'calendar-goto-info-node) |
1760 | (define-key calendar-mode-map "tm" 'cal-tex-cursor-month) | |
1761 | (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape) | |
1762 | (define-key calendar-mode-map "td" 'cal-tex-cursor-day) | |
1763 | (define-key calendar-mode-map "tw1" 'cal-tex-cursor-week) | |
1764 | (define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2) | |
5a2c140a RS |
1765 | (define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso) |
1766 | (define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday) | |
1767 | (define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week) | |
1768 | (define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week) | |
3076647c ER |
1769 | (define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year) |
1770 | (define-key calendar-mode-map "ty" 'cal-tex-cursor-year) | |
1771 | (define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape)) | |
ecaa0527 RS |
1772 | |
1773 | (defun describe-calendar-mode () | |
1774 | "Create a help buffer with a brief description of the calendar-mode." | |
1775 | (interactive) | |
1776 | (with-output-to-temp-buffer "*Help*" | |
1777 | (princ | |
1778 | (format | |
1779 | "Calendar Mode:\nFor a complete description, type %s\n%s\n" | |
1780 | (substitute-command-keys | |
1781 | "\\<calendar-mode-map>\\[describe-mode] from within the calendar") | |
1782 | (substitute-command-keys "\\{calendar-mode-map}"))) | |
ddbfcbde KH |
1783 | (save-excursion |
1784 | (set-buffer standard-output) | |
1785 | (help-mode)) | |
ecaa0527 RS |
1786 | (print-help-return-message))) |
1787 | ||
1788 | ;; Calendar mode is suitable only for specially formatted data. | |
1789 | (put 'calendar-mode 'mode-class 'special) | |
1790 | ||
1791 | (defvar calendar-mode-line-format | |
7e1dae73 JB |
1792 | (list |
1793 | (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-left]") | |
1794 | "Calendar" | |
cba0c253 | 1795 | (substitute-command-keys "\\<calendar-mode-map>\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today") |
7e1dae73 JB |
1796 | '(calendar-date-string (calendar-current-date) t) |
1797 | (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-right]")) | |
ecaa0527 RS |
1798 | "The mode line of the calendar buffer.") |
1799 | ||
cba0c253 ER |
1800 | (defun calendar-goto-info-node () |
1801 | "Go to the info node for the calendar." | |
1802 | (interactive) | |
1803 | (require 'info) | |
83ff5106 RS |
1804 | (let ((where (save-window-excursion |
1805 | (Info-find-emacs-command-nodes 'calendar)))) | |
cba0c253 ER |
1806 | (if (not where) |
1807 | (error "Couldn't find documentation for the calendar.") | |
83ff5106 RS |
1808 | (let (same-window-buffer-names) |
1809 | (info)) | |
cba0c253 ER |
1810 | (Info-find-node (car (car where)) (car (cdr (car where))))))) |
1811 | ||
ecaa0527 | 1812 | (defun calendar-mode () |
7e1dae73 | 1813 | "A major mode for the calendar window. |
ecaa0527 | 1814 | |
cba0c253 ER |
1815 | For a complete description, type \ |
1816 | \\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar. | |
ecaa0527 | 1817 | |
cba0c253 | 1818 | \\<calendar-mode-map>\\{calendar-mode-map}" |
ecaa0527 RS |
1819 | |
1820 | (kill-all-local-variables) | |
1821 | (setq major-mode 'calendar-mode) | |
1822 | (setq mode-name "Calendar") | |
1823 | (use-local-map calendar-mode-map) | |
1824 | (setq buffer-read-only t) | |
1825 | (setq indent-tabs-mode nil) | |
7e1dae73 | 1826 | (update-calendar-mode-line) |
ecaa0527 | 1827 | (make-local-variable 'calendar-mark-ring) |
ecaa0527 RS |
1828 | (make-local-variable 'displayed-month);; Month in middle of window. |
1829 | (make-local-variable 'displayed-year));; Year in middle of window. | |
1830 | ||
7e1dae73 | 1831 | (defun calendar-string-spread (strings char length) |
cbecb9f9 ER |
1832 | "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. |
1833 | The effect is like mapconcat but the separating pieces are as balanced as | |
1834 | possible. Each item of STRINGS is evaluated before concatenation so it can | |
1835 | actually be an expression that evaluates to a string. If LENGTH is too short, | |
1836 | the STRINGS are just concatenated and the result truncated." | |
7e1dae73 JB |
1837 | ;; The algorithm is based on equation (3.25) on page 85 of Concrete |
1838 | ;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik, | |
1839 | ;; Addison-Wesley, Reading, MA, 1989 | |
cbecb9f9 ER |
1840 | (let* ((strings (mapcar 'eval |
1841 | (if (< (length strings) 2) | |
1842 | (append (list "") strings (list "")) | |
1843 | strings))) | |
7e1dae73 JB |
1844 | (n (- length (length (apply 'concat strings)))) |
1845 | (m (1- (length strings))) | |
1846 | (s (car strings)) | |
1847 | (strings (cdr strings)) | |
1848 | (i 0)) | |
1849 | (while strings | |
1850 | (setq s (concat s | |
1851 | (make-string (max 0 (/ (+ n i) m)) char) | |
1852 | (car strings))) | |
1853 | (setq i (1+ i)) | |
1854 | (setq strings (cdr strings))) | |
1855 | (substring s 0 length))) | |
1856 | ||
ecaa0527 RS |
1857 | (defun update-calendar-mode-line () |
1858 | "Update the calendar mode line with the current date and date style." | |
1859 | (if (bufferp (get-buffer calendar-buffer)) | |
1860 | (save-excursion | |
1861 | (set-buffer calendar-buffer) | |
1862 | (setq mode-line-format | |
7e1dae73 JB |
1863 | (calendar-string-spread |
1864 | calendar-mode-line-format ? (frame-width)))))) | |
ecaa0527 | 1865 | |
cba0c253 ER |
1866 | (defun calendar-window-list () |
1867 | "List of all calendar-related windows." | |
1868 | (let ((calendar-buffers (calendar-buffer-list)) | |
1869 | list) | |
1870 | (walk-windows '(lambda (w) | |
1871 | (if (memq (window-buffer w) calendar-buffers) | |
1872 | (setq list (cons w list)))) | |
1873 | nil t) | |
1874 | list)) | |
1875 | ||
1876 | (defun calendar-buffer-list () | |
1877 | "List of all calendar-related buffers." | |
1878 | (let* ((diary-buffer (get-file-buffer diary-file)) | |
1879 | (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer | |
1880 | fancy-diary-buffer diary-buffer calendar-buffer)) | |
1881 | (buffer-list nil) | |
1882 | b) | |
1883 | (while buffers | |
1884 | (setq b (car buffers)) | |
1885 | (setq b (cond ((stringp b) (get-buffer b)) | |
1886 | ((bufferp b) b) | |
1887 | (t nil))) | |
1888 | (if b (setq buffer-list (cons b buffer-list))) | |
1889 | (setq buffers (cdr buffers))) | |
1890 | buffer-list)) | |
1891 | ||
ecaa0527 | 1892 | (defun exit-calendar () |
cba0c253 | 1893 | "Get out of the calendar window and hide it and related buffers." |
ecaa0527 | 1894 | (interactive) |
cba0c253 ER |
1895 | (let* ((diary-buffer (get-file-buffer diary-file))) |
1896 | (if (and diary-buffer (buffer-modified-p diary-buffer) | |
1897 | (not | |
1898 | (yes-or-no-p | |
1899 | "Diary modified; do you really want to exit the calendar? "))) | |
1900 | (error) | |
1901 | ;; Need to do this multiple times because one time can replace some | |
1902 | ;; calendar-related buffers with other calendar-related buffers | |
1903 | (mapcar (lambda (x) | |
1904 | (mapcar 'calendar-hide-window (calendar-window-list))) | |
1905 | (calendar-window-list))))) | |
1906 | ||
1907 | (defun calendar-hide-window (window) | |
1908 | "Hide WINDOW if it is calendar-related." | |
1909 | (let ((buffer (if (window-live-p window) (window-buffer window)))) | |
1910 | (if (memq buffer (calendar-buffer-list)) | |
1911 | (cond | |
1912 | ((and window-system | |
1913 | (eq 'icon (cdr (assoc 'visibility | |
1914 | (frame-parameters | |
1915 | (window-frame window)))))) | |
1916 | nil) | |
1917 | ((and window-system (window-dedicated-p window)) | |
1918 | (iconify-frame (window-frame window))) | |
1919 | ((not (and (select-window window) (one-window-p window))) | |
1920 | (delete-window window)) | |
1921 | (t (set-buffer buffer) | |
1922 | (bury-buffer)))))) | |
ecaa0527 | 1923 | |
ecaa0527 | 1924 | (defun calendar-current-date () |
cba0c253 ER |
1925 | "Returns the current date in a list (month day year)." |
1926 | (let ((s (current-time-string))) | |
1927 | (list (length (member (substring s 4 7) | |
1928 | '("Dec" "Nov" "Oct" "Sep" "Aug" "Jul" | |
1929 | "Jun" "May" "Apr" "Mar" "Feb" "Jan"))) | |
1930 | (string-to-number (substring s 8 10)) | |
1931 | (string-to-number (substring s 20 24))))) | |
ecaa0527 | 1932 | |
ffd82264 | 1933 | (defun calendar-cursor-to-date (&optional error) |
cba0c253 | 1934 | "Returns a list (month day year) of current cursor position. |
ffd82264 RS |
1935 | If cursor is not on a specific date, signals an error if optional parameter |
1936 | ERROR is t, otherwise just returns nil." | |
c93b9aae ER |
1937 | (let* ((segment (/ (current-column) 25)) |
1938 | (month (% (+ displayed-month segment -1) 12)) | |
1939 | (month (if (= 0 month) 12 month)) | |
1940 | (year | |
1941 | (cond | |
1942 | ((and (= 12 month) (= segment 0)) (1- displayed-year)) | |
1943 | ((and (= 1 month) (= segment 2)) (1+ displayed-year)) | |
1944 | (t displayed-year)))) | |
7086b78e | 1945 | (if (and (looking-at "[ 0-9]?[0-9][^0-9]") |
c93b9aae ER |
1946 | (< 2 (count-lines (point-min) (point)))) |
1947 | (save-excursion | |
7086b78e ER |
1948 | (if (not (looking-at " ")) |
1949 | (re-search-backward "[^0-9]")) | |
c93b9aae ER |
1950 | (list month |
1951 | (string-to-int (buffer-substring (1+ (point)) (+ 4 (point)))) | |
1952 | year)) | |
21c8986e ER |
1953 | (if (looking-at "\\*") |
1954 | (save-excursion | |
1955 | (re-search-backward "[^*]") | |
1956 | (if (looking-at ".\\*\\*") | |
3a7f8079 | 1957 | (list month calendar-starred-day year) |
21c8986e ER |
1958 | (if error (error "Not on a date!")))) |
1959 | (if error (error "Not on a date!")))))) | |
ecaa0527 | 1960 | |
354d0644 JB |
1961 | ;; The following version of calendar-gregorian-from-absolute is preferred for |
1962 | ;; reasons of clarity, BUT it's much slower than the version that follows it. | |
1963 | ||
1964 | ;;(defun calendar-gregorian-from-absolute (date) | |
1965 | ;; "Compute the list (month day year) corresponding to the absolute DATE. | |
1966 | ;;The absolute date is the number of days elapsed since the (imaginary) | |
1967 | ;;Gregorian date Sunday, December 31, 1 BC." | |
1968 | ;; (let* ((approx (/ date 366));; Approximation from below. | |
1969 | ;; (year ;; Search forward from the approximation. | |
1970 | ;; (+ approx | |
1971 | ;; (calendar-sum y approx | |
1972 | ;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y)))) | |
1973 | ;; 1))) | |
1974 | ;; (month ;; Search forward from January. | |
1975 | ;; (1+ (calendar-sum m 1 | |
1976 | ;; (> date | |
1977 | ;; (calendar-absolute-from-gregorian | |
1978 | ;; (list m (calendar-last-day-of-month m year) year))) | |
1979 | ;; 1))) | |
1980 | ;; (day ;; Calculate the day by subtraction. | |
1981 | ;; (- date | |
1982 | ;; (1- (calendar-absolute-from-gregorian (list month 1 year)))))) | |
1983 | ;; (list month day year))) | |
1984 | ||
ecaa0527 RS |
1985 | (defun calendar-gregorian-from-absolute (date) |
1986 | "Compute the list (month day year) corresponding to the absolute DATE. | |
1987 | The absolute date is the number of days elapsed since the (imaginary) | |
1988 | Gregorian date Sunday, December 31, 1 BC." | |
354d0644 JB |
1989 | ;; See the footnote on page 384 of ``Calendrical Calculations, Part II: |
1990 | ;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. | |
1991 | ;; Clamen, Software--Practice and Experience, Volume 23, Number 4 | |
1992 | ;; (April, 1993), pages 383-404 for an explanation. | |
1993 | (let* ((d0 (1- date)) | |
1994 | (n400 (/ d0 146097)) | |
1995 | (d1 (% d0 146097)) | |
1996 | (n100 (/ d1 36524)) | |
1997 | (d2 (% d1 36524)) | |
1998 | (n4 (/ d2 1461)) | |
1999 | (d3 (% d2 1461)) | |
2000 | (n1 (/ d3 365)) | |
2001 | (day (1+ (% d3 365))) | |
2002 | (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1))) | |
2003 | (if (or (= n100 4) (= n1 4)) | |
2004 | (list 12 31 year) | |
2005 | (let ((year (1+ year)) | |
2006 | (month 1)) | |
2007 | (while (let ((mdays (calendar-last-day-of-month month year))) | |
2008 | (and (< mdays day) | |
2009 | (setq day (- day mdays)))) | |
2010 | (setq month (1+ month))) | |
2011 | (list month day year))))) | |
ecaa0527 | 2012 | |
ecaa0527 RS |
2013 | (defun calendar-other-month (month year) |
2014 | "Display a three-month calendar centered around MONTH and YEAR." | |
ecd42d42 | 2015 | (interactive (calendar-read-date 'noday)) |
ecaa0527 RS |
2016 | (if (and (= month displayed-month) |
2017 | (= year displayed-year)) | |
2018 | nil | |
2019 | (let ((old-date (calendar-cursor-to-date)) | |
2020 | (today (calendar-current-date))) | |
7e1dae73 | 2021 | (generate-calendar-window month year) |
ecaa0527 RS |
2022 | (calendar-cursor-to-visible-date |
2023 | (cond | |
2024 | ((calendar-date-is-visible-p old-date) old-date) | |
2025 | ((calendar-date-is-visible-p today) today) | |
2026 | (t (list month 1 year))))))) | |
2027 | ||
2028 | (defun calendar-set-mark (arg) | |
2029 | "Mark the date under the cursor, or jump to marked date. | |
2030 | With no prefix argument, push current date onto marked date ring. | |
2031 | With argument, jump to mark, pop it, and put point at end of ring." | |
2032 | (interactive "P") | |
ffd82264 | 2033 | (let ((date (calendar-cursor-to-date t))) |
ecaa0527 RS |
2034 | (if (null arg) |
2035 | (progn | |
2036 | (setq calendar-mark-ring (cons date calendar-mark-ring)) | |
2037 | ;; Since the top of the mark ring is the marked date in the | |
2038 | ;; calendar, the mark ring in the calendar is one longer than | |
2039 | ;; in other buffers to get the same effect. | |
2040 | (if (> (length calendar-mark-ring) (1+ mark-ring-max)) | |
2041 | (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil)) | |
2042 | (message "Mark set")) | |
2043 | (if (null calendar-mark-ring) | |
2044 | (error "No mark set in this buffer") | |
2045 | (calendar-goto-date (car calendar-mark-ring)) | |
2046 | (setq calendar-mark-ring | |
2047 | (cdr (nconc calendar-mark-ring (list date)))))))) | |
2048 | ||
2049 | (defun calendar-exchange-point-and-mark () | |
2050 | "Exchange the current cursor position with the marked date." | |
2051 | (interactive) | |
2052 | (let ((mark (car calendar-mark-ring)) | |
ffd82264 | 2053 | (date (calendar-cursor-to-date t))) |
ecaa0527 RS |
2054 | (if (null mark) |
2055 | (error "No mark set in this buffer") | |
2056 | (setq calendar-mark-ring (cons date (cdr calendar-mark-ring))) | |
2057 | (calendar-goto-date mark)))) | |
2058 | ||
2059 | (defun calendar-count-days-region () | |
2060 | "Count the number of days (inclusive) between point and the mark." | |
2061 | (interactive) | |
2062 | (let* ((days (- (calendar-absolute-from-gregorian | |
ffd82264 | 2063 | (calendar-cursor-to-date t)) |
ecaa0527 RS |
2064 | (calendar-absolute-from-gregorian |
2065 | (or (car calendar-mark-ring) | |
2066 | (error "No mark set in this buffer"))))) | |
2067 | (days (1+ (if (> days 0) days (- days))))) | |
2068 | (message "Region has %d day%s (inclusive)" | |
2069 | days (if (> days 1) "s" "")))) | |
2070 | ||
2071 | (defun calendar-not-implemented () | |
2072 | "Not implemented." | |
2073 | (interactive) | |
2074 | (error "%s not available in the calendar" | |
2075 | (global-key-binding (this-command-keys)))) | |
2076 | ||
2077 | (defun calendar-read (prompt acceptable &optional initial-contents) | |
2078 | "Return an object read from the minibuffer. | |
2079 | Prompt with the string PROMPT and use the function ACCEPTABLE to decide if | |
2080 | entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS | |
2081 | is a string to insert in the minibuffer before reading." | |
2082 | (let ((value (read-minibuffer prompt initial-contents))) | |
2083 | (while (not (funcall acceptable value)) | |
2084 | (setq value (read-minibuffer prompt initial-contents))) | |
2085 | value)) | |
2086 | ||
cba0c253 ER |
2087 | (defun calendar-read-date (&optional noday) |
2088 | "Prompt for Gregorian date. Returns a list (month day year). | |
2089 | If optional NODAY is t, does not ask for day, but just returns | |
ecd42d42 ER |
2090 | (month nil year); if NODAY is any other non-nil value the value returned is |
2091 | (month year) " | |
7e1dae73 JB |
2092 | (let* ((year (calendar-read |
2093 | "Year (>0): " | |
2094 | '(lambda (x) (> x 0)) | |
2095 | (int-to-string (extract-calendar-year | |
2096 | (calendar-current-date))))) | |
2097 | (month-array calendar-month-name-array) | |
2098 | (completion-ignore-case t) | |
2099 | (month (cdr (assoc | |
2100 | (capitalize | |
2101 | (completing-read | |
2102 | "Month name: " | |
2103 | (mapcar 'list (append month-array nil)) | |
2104 | nil t)) | |
2105 | (calendar-make-alist month-array 1 'capitalize)))) | |
cba0c253 | 2106 | (last (calendar-last-day-of-month month year))) |
ecd42d42 ER |
2107 | (if noday |
2108 | (if (eq noday t) | |
2109 | (list month nil year) | |
2110 | (list month year)) | |
2111 | (list month | |
2112 | (calendar-read (format "Day (1-%d): " last) | |
2113 | '(lambda (x) (and (< 0 x) (<= x last)))) | |
2114 | year)))) | |
7e1dae73 | 2115 | |
ecaa0527 | 2116 | (defun calendar-interval (mon1 yr1 mon2 yr2) |
7e1dae73 | 2117 | "The number of months difference between MON1, YR1 and MON2, YR2." |
ecaa0527 RS |
2118 | (+ (* 12 (- yr2 yr1)) |
2119 | (- mon2 mon1))) | |
2120 | ||
ecaa0527 RS |
2121 | (defun calendar-day-name (date) |
2122 | "Returns a string with the name of the day of the week of DATE." | |
2123 | (aref calendar-day-name-array (calendar-day-of-week date))) | |
2124 | ||
d8a200a7 | 2125 | (defvar calendar-day-name-array |
ecaa0527 RS |
2126 | ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) |
2127 | ||
d8a200a7 | 2128 | (defvar calendar-month-name-array |
ecaa0527 RS |
2129 | ["January" "February" "March" "April" "May" "June" |
2130 | "July" "August" "September" "October" "November" "December"]) | |
2131 | ||
2132 | (defun calendar-make-alist (sequence &optional start-index filter) | |
2133 | "Make an assoc list corresponding to SEQUENCE. | |
2134 | Start at index 1, unless optional START-INDEX is provided. | |
2135 | If FILTER is provided, apply it to each item in the list." | |
2136 | (let ((index (if start-index (1- start-index) 0))) | |
2137 | (mapcar | |
2138 | '(lambda (x) | |
2139 | (setq index (1+ index)) | |
2140 | (cons (if filter (funcall filter x) x) | |
2141 | index)) | |
2142 | (append sequence nil)))) | |
2143 | ||
2144 | (defun calendar-month-name (month) | |
2145 | "The name of MONTH." | |
2146 | (aref calendar-month-name-array (1- month))) | |
2147 | ||
2148 | (defun calendar-day-of-week (date) | |
2149 | "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc." | |
2150 | (% (calendar-absolute-from-gregorian date) 7)) | |
2151 | ||
ecaa0527 | 2152 | (defun calendar-unmark () |
6a2aa94c | 2153 | "Delete all diary/holiday marks/highlighting from the calendar." |
ecaa0527 | 2154 | (interactive) |
ecaa0527 | 2155 | (setq mark-holidays-in-calendar nil) |
6a2aa94c RS |
2156 | (setq mark-diary-entries-in-calendar nil) |
2157 | (redraw-calendar)) | |
ecaa0527 RS |
2158 | |
2159 | (defun calendar-date-is-visible-p (date) | |
2160 | "Returns t if DATE is legal and is visible in the calendar window." | |
2161 | (let ((gap (calendar-interval | |
2162 | displayed-month displayed-year | |
2163 | (extract-calendar-month date) (extract-calendar-year date)))) | |
2164 | (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap)))) | |
2165 | ||
2166 | (defun calendar-date-is-legal-p (date) | |
2167 | "Returns t if DATE is a legal date." | |
2168 | (let ((month (extract-calendar-month date)) | |
2169 | (day (extract-calendar-day date)) | |
2170 | (year (extract-calendar-year date))) | |
2171 | (and (<= 1 month) (<= month 12) | |
2172 | (<= 1 day) (<= day (calendar-last-day-of-month month year)) | |
2173 | (<= 1 year)))) | |
2174 | ||
2175 | (defun calendar-date-equal (date1 date2) | |
2176 | "Returns t if the DATE1 and DATE2 are the same." | |
2177 | (and | |
2178 | (= (extract-calendar-month date1) (extract-calendar-month date2)) | |
2179 | (= (extract-calendar-day date1) (extract-calendar-day date2)) | |
2180 | (= (extract-calendar-year date1) (extract-calendar-year date2)))) | |
2181 | ||
2182 | (defun mark-visible-calendar-date (date &optional mark) | |
6a2aa94c RS |
2183 | "Mark DATE in the calendar window with MARK. |
2184 | MARK is either a single-character string or a face. | |
2185 | MARK defaults to diary-entry-marker." | |
ecaa0527 RS |
2186 | (if (calendar-date-is-legal-p date) |
2187 | (save-excursion | |
2188 | (set-buffer calendar-buffer) | |
2189 | (calendar-cursor-to-visible-date date) | |
6a2aa94c RS |
2190 | (let ((mark (or mark diary-entry-marker))) |
2191 | (if (stringp mark) | |
2192 | (let ((buffer-read-only nil)) | |
2193 | (forward-char 1) | |
2194 | (delete-char 1) | |
2195 | (insert mark) | |
2196 | (forward-char -2)) | |
2197 | (overlay-put | |
7086b78e | 2198 | (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) |
ecaa0527 RS |
2199 | |
2200 | (defun calendar-star-date () | |
2201 | "Replace the date under the cursor in the calendar window with asterisks. | |
2202 | This function can be used with the today-visible-calendar-hook run after the | |
2203 | calendar window has been prepared." | |
2204 | (let ((buffer-read-only nil)) | |
c00f638d | 2205 | (make-variable-buffer-local 'calendar-starred-day) |
ecaa0527 | 2206 | (forward-char 1) |
c00f638d | 2207 | (setq calendar-starred-day |
7e1dae73 JB |
2208 | (string-to-int |
2209 | (buffer-substring (point) (- (point) 2)))) | |
ecaa0527 RS |
2210 | (delete-char -2) |
2211 | (insert "**") | |
2212 | (backward-char 1) | |
2213 | (set-buffer-modified-p nil))) | |
2214 | ||
2215 | (defun calendar-mark-today () | |
6a2aa94c RS |
2216 | "Mark the date under the cursor in the calendar window. |
2217 | The date is marked with calendar-today-marker. This function can be used with | |
2218 | the today-visible-calendar-hook run after the calendar window has been | |
2219 | prepared." | |
2220 | (mark-visible-calendar-date | |
2221 | (calendar-cursor-to-date) | |
2222 | calendar-today-marker)) | |
ecaa0527 RS |
2223 | |
2224 | (defun calendar-date-compare (date1 date2) | |
2225 | "Returns t if DATE1 is before DATE2, nil otherwise. | |
2226 | The actual dates are in the car of DATE1 and DATE2." | |
2227 | (< (calendar-absolute-from-gregorian (car date1)) | |
2228 | (calendar-absolute-from-gregorian (car date2)))) | |
2229 | ||
2230 | (defun calendar-date-string (date &optional abbreviate nodayname) | |
2231 | "A string form of DATE, driven by the variable `calendar-date-display-form'. | |
2232 | An optional parameter ABBREVIATE, when t, causes the month and day names to be | |
2233 | abbreviated to three characters. An optional parameter NODAYNAME, when t, | |
2234 | omits the name of the day of the week." | |
2235 | (let* ((dayname | |
2236 | (if nodayname | |
7e1dae73 | 2237 | nil |
ecaa0527 RS |
2238 | (if abbreviate |
2239 | (substring (calendar-day-name date) 0 3) | |
2240 | (calendar-day-name date)))) | |
2241 | (month (extract-calendar-month date)) | |
2242 | (monthname | |
2243 | (if abbreviate | |
2244 | (substring | |
2245 | (calendar-month-name month) 0 3) | |
2246 | (calendar-month-name month))) | |
2247 | (day (int-to-string (extract-calendar-day date))) | |
2248 | (month (int-to-string month)) | |
2249 | (year (int-to-string (extract-calendar-year date)))) | |
2250 | (mapconcat 'eval calendar-date-display-form ""))) | |
2251 | ||
2252 | (defun calendar-dayname-on-or-before (dayname date) | |
2253 | "Returns the absolute date of the DAYNAME on or before absolute DATE. | |
2254 | DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. | |
2255 | ||
2256 | Note: Applying this function to d+6 gives us the DAYNAME on or after an | |
2257 | absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to | |
2258 | absolute date d, applying it to d-1 gives the DAYNAME previous to absolute | |
2259 | date d, and applying it to d+7 gives the DAYNAME following absolute date d." | |
2260 | (- date (% (- date dayname) 7))) | |
2261 | ||
04d5d338 PE |
2262 | (defun calendar-nth-named-absday (n dayname month year &optional day) |
2263 | "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. | |
2264 | A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, | |
2265 | return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). | |
2266 | If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). | |
2267 | ||
2268 | If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." | |
2269 | (if (> n 0) | |
2270 | (+ (* 7 (1- n)) | |
2271 | (calendar-dayname-on-or-before | |
2272 | dayname | |
2273 | (+ 6 (calendar-absolute-from-gregorian | |
2274 | (list month (or day 1) year))))) | |
2275 | (+ (* 7 (1+ n)) | |
2276 | (calendar-dayname-on-or-before | |
2277 | dayname | |
2278 | (calendar-absolute-from-gregorian | |
2279 | (list month | |
2280 | (or day (calendar-last-day-of-month month year)) | |
2281 | year)))))) | |
2282 | ||
354d0644 JB |
2283 | (defun calendar-nth-named-day (n dayname month year &optional day) |
2284 | "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. | |
2285 | A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, | |
2286 | return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). | |
2287 | If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). | |
2288 | ||
2289 | If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." | |
ecaa0527 | 2290 | (calendar-gregorian-from-absolute |
04d5d338 | 2291 | (calendar-nth-named-absday n dayname month year day))) |
ecaa0527 | 2292 | |
6a2aa94c RS |
2293 | (defun calendar-day-of-year-string (&optional date) |
2294 | "String of day number of year of Gregorian DATE. | |
2295 | Defaults to today's date if DATE is not given." | |
2296 | (let* ((d (or date (calendar-current-date))) | |
2297 | (year (extract-calendar-year d)) | |
2298 | (day (calendar-day-number d)) | |
2299 | (days-remaining (- (calendar-day-number (list 12 31 year)) day))) | |
2300 | (format "Day %d of %d; %d day%s remaining in the year" | |
2301 | day year days-remaining (if (= days-remaining 1) "" "s")))) | |
2302 | ||
7e1dae73 | 2303 | (defun calendar-print-day-of-year () |
6a2aa94c | 2304 | "Show day number in year/days remaining in year for date under the cursor." |
ecaa0527 | 2305 | (interactive) |
ffd82264 | 2306 | (message (calendar-day-of-year-string (calendar-cursor-to-date t)))) |
ecaa0527 | 2307 | |
7e1dae73 JB |
2308 | (defun calendar-set-mode-line (str) |
2309 | "Set mode line to STR, centered, surrounded by dashes." | |
2310 | (setq mode-line-format | |
cbecb9f9 | 2311 | (calendar-string-spread (list str) ?- (frame-width)))) |
7e1dae73 | 2312 | |
7086b78e ER |
2313 | (defun calendar-mod (m n) |
2314 | "Non-negative remainder of M/N with N instead of 0." | |
2315 | (1+ (mod (1- m) n))) | |
7e1dae73 JB |
2316 | |
2317 | (run-hooks 'calendar-load-hook) | |
ecaa0527 RS |
2318 | |
2319 | (provide 'calendar) | |
2320 | ||
b578f267 EN |
2321 | ;;; Local variables: |
2322 | ;;; byte-compile-dynamic: t | |
2323 | ;;; End: | |
2324 | ||
94b304d7 | 2325 | ;;; calendar.el ends here |