aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-14 07:05:10 +0000
committerGlenn Morris2008-03-14 07:05:10 +0000
commit71855cc518b43c24fbb4d92d0dcf3fff163c4e45 (patch)
treee4302bcdf097d45a785859d0acee8217d9208e53
parent20a614c6c89381fdc59983b52623a177cd472cbc (diff)
downloademacs-71855cc518b43c24fbb4d92d0dcf3fff163c4e45.tar.gz
emacs-71855cc518b43c24fbb4d92d0dcf3fff163c4e45.zip
(displayed-month, displayed-year): Move declarations where needed.
(calendar-holiday-list, calendar-list-holidays) (holiday-filter-visible-calendar): Move definitions before use. (list-holidays): Use cadr. Relocate obsolete aliases after their replacements.
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/calendar/holidays.el204
2 files changed, 109 insertions, 102 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d1b76f9e0a6..49a88cd1f4d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -93,6 +93,13 @@
93 (calendar-buffer-list): Return buffers rather than strings (fixes 93 (calendar-buffer-list): Return buffers rather than strings (fixes
94 previous change). 94 previous change).
95 95
96 * calendar/holidays.el (displayed-month, displayed-year):
97 Move declarations where needed.
98 (calendar-holiday-list, calendar-list-holidays)
99 (holiday-filter-visible-calendar): Move definitions before use.
100 (list-holidays): Use cadr.
101 Relocate obsolete aliases after their replacements.
102
96 * textmodes/org-irc.el (top-level): CL not required when compiling. 103 * textmodes/org-irc.el (top-level): CL not required when compiling.
97 (org-irc-visit-erc): Replace runtime CL functions. 104 (org-irc-visit-erc): Replace runtime CL functions.
98 105
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 3ed7fcfdac0..cce73c9c203 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -47,14 +47,75 @@
47 47
48;;; Code: 48;;; Code:
49 49
50(defvar displayed-month)
51(defvar displayed-year)
52
53(require 'calendar) 50(require 'calendar)
54 51
55(eval-and-compile 52(eval-and-compile
56 (load "hol-loaddefs" nil 'quiet)) 53 (load "hol-loaddefs" nil 'quiet))
57 54
55(defvar displayed-month) ; from generate-calendar
56(defvar displayed-year)
57
58;;;###diary-autoload
59(defun calendar-holiday-list ()
60 "Form the list of holidays that occur on dates in the calendar window.
61The holidays are those in the list `calendar-holidays'."
62 (let (holiday-list)
63 (dolist (p calendar-holidays)
64 (let* ((holidays
65 (if calendar-debug-sexp
66 (let ((stack-trace-on-error t))
67 (eval p))
68 (condition-case nil
69 (eval p)
70 (error (beep)
71 (message "Bad holiday list item: %s" p)
72 (sleep-for 2))))))
73 (if holidays
74 (setq holiday-list (append holidays holiday-list)))))
75 (setq holiday-list (sort holiday-list 'calendar-date-compare))))
76
77;;;###cal-autoload
78(defun calendar-list-holidays ()
79 "Create a buffer containing the holidays for the current calendar window.
80The holidays are those in the list `calendar-notable-days'. Returns t if any
81holidays are found, nil if not."
82 (interactive)
83 (message "Looking up holidays...")
84 (let ((holiday-list (calendar-holiday-list))
85 (m1 displayed-month)
86 (y1 displayed-year)
87 (m2 displayed-month)
88 (y2 displayed-year))
89 (if (not holiday-list)
90 (progn
91 (message "Looking up holidays...none found")
92 nil)
93 (set-buffer (get-buffer-create holiday-buffer))
94 (setq buffer-read-only nil)
95 (increment-calendar-month m1 y1 -1)
96 (increment-calendar-month m2 y2 1)
97 (calendar-set-mode-line
98 (if (= y1 y2)
99 (format "Notable Dates from %s to %s, %d%%-"
100 (calendar-month-name m1) (calendar-month-name m2) y2)
101 (format "Notable Dates from %s, %d to %s, %d%%-"
102 (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
103 (erase-buffer)
104 (insert
105 (mapconcat
106 (lambda (x) (concat (calendar-date-string (car x))
107 ": " (cadr x)))
108 holiday-list "\n"))
109 (goto-char (point-min))
110 (set-buffer-modified-p nil)
111 (setq buffer-read-only t)
112 (display-buffer holiday-buffer)
113 (message "Looking up holidays...done")
114 t)))
115
116(define-obsolete-function-alias
117 'list-calendar-holidays 'calendar-list-holidays "23.1")
118
58;;;###autoload 119;;;###autoload
59(defun holidays (&optional arg) 120(defun holidays (&optional arg)
60 "Display the holidays for last month, this month, and next month. 121 "Display the holidays for last month, this month, and next month.
@@ -63,8 +124,7 @@ This function is suitable for execution in a .emacs file."
63 (interactive "P") 124 (interactive "P")
64 (save-excursion 125 (save-excursion
65 (let* ((completion-ignore-case t) 126 (let* ((completion-ignore-case t)
66 (date (if arg 127 (date (if arg (calendar-read-date t)
67 (calendar-read-date t)
68 (calendar-current-date))) 128 (calendar-current-date)))
69 (displayed-month (extract-calendar-month date)) 129 (displayed-month (extract-calendar-month date))
70 (displayed-year (extract-calendar-year date))) 130 (displayed-year (extract-calendar-year date)))
@@ -100,10 +160,10 @@ The optional LABEL is used to label the buffer created."
100 (int-to-string (extract-calendar-year 160 (int-to-string (extract-calendar-year
101 (calendar-current-date))))) 161 (calendar-current-date)))))
102 (end-year (calendar-read 162 (end-year (calendar-read
103 (format "Ending year (inclusive) of holidays (>=%s): " 163 (format "Ending year (inclusive) of holidays (>=%s): "
104 start-year) 164 start-year)
105 (lambda (x) (>= x start-year)) 165 (lambda (x) (>= x start-year))
106 (int-to-string start-year))) 166 (int-to-string start-year)))
107 (completion-ignore-case t) 167 (completion-ignore-case t)
108 (lists 168 (lists
109 (list 169 (list
@@ -161,7 +221,7 @@ The optional LABEL is used to label the buffer created."
161 (insert 221 (insert
162 (mapconcat 222 (mapconcat
163 (lambda (x) (concat (calendar-date-string (car x)) 223 (lambda (x) (concat (calendar-date-string (car x))
164 ": " (car (cdr x)))) 224 ": " (cadr x)))
165 holiday-list "\n")) 225 holiday-list "\n"))
166 (goto-char (point-min)) 226 (goto-char (point-min))
167 (set-buffer-modified-p nil) 227 (set-buffer-modified-p nil)
@@ -185,6 +245,9 @@ The holidays are those in the list `calendar-holidays'."
185 (setq holiday-list (append holiday-list (cdr h))))) 245 (setq holiday-list (append holiday-list (cdr h)))))
186 holiday-list)) 246 holiday-list))
187 247
248(define-obsolete-function-alias
249 'check-calendar-holidays 'calendar-check-holidays "23.1")
250
188;;;###cal-autoload 251;;;###cal-autoload
189(defun calendar-cursor-holidays () 252(defun calendar-cursor-holidays ()
190 "Find holidays for the date specified by the cursor in the calendar window." 253 "Find holidays for the date specified by the cursor in the calendar window."
@@ -217,67 +280,11 @@ The holidays are those in the list `calendar-holidays'."
217 (setq mark-holidays-in-calendar t) 280 (setq mark-holidays-in-calendar t)
218 (message "Marking holidays...") 281 (message "Marking holidays...")
219 (dolist (holiday (calendar-holiday-list)) 282 (dolist (holiday (calendar-holiday-list))
220 (mark-visible-calendar-date 283 (mark-visible-calendar-date (car holiday) calendar-holiday-marker))
221 (car holiday) calendar-holiday-marker))
222 (message "Marking holidays...done")) 284 (message "Marking holidays...done"))
223 285
224;;;###cal-autoload 286(define-obsolete-function-alias
225(defun calendar-list-holidays () 287 'mark-calendar-holidays 'calendar-mark-holidays "23.1")
226 "Create a buffer containing the holidays for the current calendar window.
227The holidays are those in the list `calendar-notable-days'. Returns t if any
228holidays are found, nil if not."
229 (interactive)
230 (message "Looking up holidays...")
231 (let ((holiday-list (calendar-holiday-list))
232 (m1 displayed-month)
233 (y1 displayed-year)
234 (m2 displayed-month)
235 (y2 displayed-year))
236 (if (not holiday-list)
237 (progn
238 (message "Looking up holidays...none found")
239 nil)
240 (set-buffer (get-buffer-create holiday-buffer))
241 (setq buffer-read-only nil)
242 (increment-calendar-month m1 y1 -1)
243 (increment-calendar-month m2 y2 1)
244 (calendar-set-mode-line
245 (if (= y1 y2)
246 (format "Notable Dates from %s to %s, %d%%-"
247 (calendar-month-name m1) (calendar-month-name m2) y2)
248 (format "Notable Dates from %s, %d to %s, %d%%-"
249 (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
250 (erase-buffer)
251 (insert
252 (mapconcat
253 (lambda (x) (concat (calendar-date-string (car x))
254 ": " (car (cdr x))))
255 holiday-list "\n"))
256 (goto-char (point-min))
257 (set-buffer-modified-p nil)
258 (setq buffer-read-only t)
259 (display-buffer holiday-buffer)
260 (message "Looking up holidays...done")
261 t)))
262
263;;;###diary-autoload
264(defun calendar-holiday-list ()
265 "Form the list of holidays that occur on dates in the calendar window.
266The holidays are those in the list `calendar-holidays'."
267 (let (holiday-list)
268 (dolist (p calendar-holidays)
269 (let* ((holidays
270 (if calendar-debug-sexp
271 (let ((stack-trace-on-error t))
272 (eval p))
273 (condition-case nil
274 (eval p)
275 (error (beep)
276 (message "Bad holiday list item: %s" p)
277 (sleep-for 2))))))
278 (if holidays
279 (setq holiday-list (append holidays holiday-list)))))
280 (setq holiday-list (sort holiday-list 'calendar-date-compare))))
281 288
282;; Below are the functions that calculate the dates of holidays; these 289;; Below are the functions that calculate the dates of holidays; these
283;; are eval'ed in the function calendar-holiday-list. If you 290;; are eval'ed in the function calendar-holiday-list. If you
@@ -293,7 +300,7 @@ STRING)). Returns nil if it is not visible in the current calendar window."
293 (y displayed-year)) 300 (y displayed-year))
294 (increment-calendar-month m y (- 11 month)) 301 (increment-calendar-month m y (- 11 month))
295 (if (> m 9) 302 (if (> m 9)
296 (list (list (list month day y) string))))) 303 (list (list (list month day y) string)))))
297 304
298(defun holiday-float (month dayname n string &optional day) 305(defun holiday-float (month dayname n string &optional day)
299 "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. 306 "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING.
@@ -305,18 +312,18 @@ If N<0, count backward from the end of MONTH.
305An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. 312An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
306 313
307Returns nil if it is not visible in the current calendar window." 314Returns nil if it is not visible in the current calendar window."
308;; This is messy because the holiday may be visible, while the date on which 315 ;; This is messy because the holiday may be visible, while the date on which
309;; it is based is not. For example, the first Monday after December 30 may be 316 ;; it is based is not. For example, the first Monday after December 30 may be
310;; visible when January is not. For large values of |n| the problem is more 317 ;; visible when January is not. For large values of |n| the problem is more
311;; grotesque. If we didn't have to worry about such cases, we could just use 318 ;; grotesque. If we didn't have to worry about such cases, we could just use
312 319
313;; (let ((m displayed-month) 320 ;; (let ((m displayed-month)
314;; (y displayed-year)) 321 ;; (y displayed-year))
315;; (increment-calendar-month m y (- 11 month)) 322 ;; (increment-calendar-month m y (- 11 month))
316;; (if (> m 9); month in year y is visible 323 ;; (if (> m 9); month in year y is visible
317;; (list (list (calendar-nth-named-day n dayname month y day) string))))) 324 ;; (list (list (calendar-nth-named-day n dayname month y day) string)))))
318 325
319;; which is the way the function was originally written. 326 ;; which is the way the function was originally written.
320 327
321 (let* ((m1 displayed-month) 328 (let* ((m1 displayed-month)
322 (y1 displayed-year) 329 (y1 displayed-year)
@@ -336,8 +343,8 @@ Returns nil if it is not visible in the current calendar window."
336 (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) 343 (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2)))
337 (y ; year of base date 344 (y ; year of base date
338 (if (or (= y1 y2) (> month 9)) 345 (if (or (= y1 y2) (> month 9))
339 y1 346 y1
340 y2)) 347 y2))
341 (d ; day of base date 348 (d ; day of base date
342 (or day (if (> n 0) 349 (or day (if (> n 0)
343 1 350 1
@@ -348,6 +355,18 @@ Returns nil if it is not visible in the current calendar window."
348 (list (list (calendar-nth-named-day n dayname month y d) 355 (list (list (calendar-nth-named-day n dayname month y d)
349 string)))))) 356 string))))))
350 357
358(defun holiday-filter-visible-calendar (l)
359 "Return a list of all visible holidays of those on L."
360 (let ((visible ()))
361 (dolist (p l)
362 (and (car p)
363 (calendar-date-is-visible-p (car p))
364 (push p visible)))
365 visible))
366
367(define-obsolete-function-alias
368 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
369
351(defun holiday-sexp (sexp string) 370(defun holiday-sexp (sexp string)
352 "Sexp holiday for dates in the calendar window. 371 "Sexp holiday for dates in the calendar window.
353SEXP is an expression in variable `year' evaluates to `date'. 372SEXP is an expression in variable `year' evaluates to `date'.
@@ -437,7 +456,7 @@ is non-nil)."
437 (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule 456 (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
438 (- ; ...corrected for the Gregorian century rule 457 (- ; ...corrected for the Gregorian century rule
439 (/ (* 3 century) 4)) 458 (/ (* 3 century) 4))
440 (/ ; ...corrected for Metonic cycle inaccuracy 459 (/ ; ...corrected for Metonic cycle inaccuracy
441 (+ 5 (* 8 century)) 25) 460 (+ 5 (* 8 century)) 25)
442 (* 30 century)) ; keeps value positive 461 (* 30 century)) ; keeps value positive
443 30)) 462 30))
@@ -480,25 +499,6 @@ is non-nil)."
480 (if (calendar-date-is-visible-p nicaean-easter) 499 (if (calendar-date-is-visible-p nicaean-easter)
481 (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) 500 (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
482 501
483(defun holiday-filter-visible-calendar (l)
484 "Return a list of all visible holidays of those on L."
485 (let ((visible ()))
486 (dolist (p l)
487 (and (car p)
488 (calendar-date-is-visible-p (car p))
489 (push p visible)))
490 visible))
491
492;; Backward compatibility.
493(define-obsolete-function-alias
494 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
495(define-obsolete-function-alias
496 'list-calendar-holidays 'calendar-list-holidays "23.1")
497(define-obsolete-function-alias
498 'mark-calendar-holidays 'calendar-mark-holidays "23.1")
499(define-obsolete-function-alias
500 'check-calendar-holidays 'calendar-check-holidays "23.1")
501
502(provide 'holidays) 502(provide 'holidays)
503 503
504;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 504;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37