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