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