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