Mercurial > emacs
comparison lisp/calendar/holidays.el @ 93580:b6cea5b391eb
(calendar-holiday-list): Fix previous change.
(holiday-filter-visible-calendar): Doc fix. Use mapcar.
(holiday-easter-etc): Fix nesting of result. Tweak holiday order.
Use calendar-date-is-visible-p, not holiday-filter-visible-calendar.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 03 Apr 2008 04:09:31 +0000 |
parents | 101c1d082feb |
children | f0a60a0ac089 |
comparison
equal
deleted
inserted
replaced
93579:7820edefcd2f | 93580:b6cea5b391eb |
---|---|
37 | 37 |
38 ;;;###diary-autoload | 38 ;;;###diary-autoload |
39 (defun calendar-holiday-list () | 39 (defun calendar-holiday-list () |
40 "Form the list of holidays that occur on dates in the calendar window. | 40 "Form the list of holidays that occur on dates in the calendar window. |
41 The holidays are those in the list `calendar-holidays'." | 41 The holidays are those in the list `calendar-holidays'." |
42 (sort (delq nil | 42 (let (res h) |
43 (mapcar (lambda (p) | 43 (sort |
44 (car | 44 (dolist (p calendar-holidays res) |
45 (if calendar-debug-sexp | 45 (if (setq h (if calendar-debug-sexp |
46 (let ((stack-trace-on-error t)) | 46 (let ((stack-trace-on-error t)) |
47 (eval p)) | 47 (eval p)) |
48 (condition-case nil | 48 (condition-case nil |
49 (eval p) | 49 (eval p) |
50 (error (beep) | 50 (error (beep) |
51 (message "Bad holiday list item: %s" p) | 51 (message "Bad holiday list item: %s" p) |
52 (sleep-for 2)))))) | 52 (sleep-for 2))))) |
53 calendar-holidays)) | 53 (setq res (append h res)))) |
54 'calendar-date-compare)) | 54 'calendar-date-compare))) |
55 | 55 |
56 (defvar displayed-month) ; from generate-calendar | 56 (defvar displayed-month) ; from generate-calendar |
57 (defvar displayed-year) | 57 (defvar displayed-year) |
58 | 58 |
59 ;;;###cal-autoload | 59 ;;;###cal-autoload |
320 (calendar-absolute-from-gregorian (list month d y)))) | 320 (calendar-absolute-from-gregorian (list month d y)))) |
321 (and (<= d1 date) (<= date d2) | 321 (and (<= d1 date) (<= date d2) |
322 (list (list (calendar-nth-named-day n dayname month y d) | 322 (list (list (calendar-nth-named-day n dayname month y d) |
323 string))))) | 323 string))))) |
324 | 324 |
325 (defun holiday-filter-visible-calendar (l) | 325 (defun holiday-filter-visible-calendar (hlist) |
326 "Return a list of all visible holidays of those on L." | 326 "Filter list of holidays HLIST, and return only the visible ones. |
327 (let (visible) | 327 HLIST is a list of elements of the form (DATE) TEXT." |
328 (dolist (p l visible) | 328 (delq nil (mapcar (lambda (p) |
329 (and (car p) | 329 (and (car p) (calendar-date-is-visible-p (car p)) p)) |
330 (calendar-date-is-visible-p (car p)) | 330 hlist))) |
331 (push p visible))))) | |
332 | 331 |
333 (define-obsolete-function-alias | 332 (define-obsolete-function-alias |
334 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") | 333 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") |
335 | 334 |
336 (defun holiday-sexp (sexp string) | 335 (defun holiday-sexp (sexp string) |
392 arguments, then it returns a list of \"standard\" Easter-related | 391 arguments, then it returns a list of \"standard\" Easter-related |
393 holidays (with more entries if `all-christian-calendar-holidays' | 392 holidays (with more entries if `all-christian-calendar-holidays' |
394 is non-nil)." | 393 is non-nil)." |
395 ;; Backwards compatibility layer. | 394 ;; Backwards compatibility layer. |
396 (if (not n) | 395 (if (not n) |
397 (delq nil ; filter out nil (not visible) dates | 396 (apply 'append |
398 (mapcar (lambda (e) | 397 (mapcar (lambda (e) |
399 (apply 'holiday-easter-etc e)) | 398 (apply 'holiday-easter-etc e)) |
400 (append | 399 ;; The combined list is not in order. |
401 (if all-christian-calendar-holidays | 400 (append |
402 '((-63 "Septuagesima Sunday") | 401 (if all-christian-calendar-holidays |
403 (-56 "Sexagesima Sunday") | 402 '((-63 "Septuagesima Sunday") |
404 (-49 "Shrove Sunday") | 403 (-56 "Sexagesima Sunday") |
405 (-48 "Shrove Monday") | 404 (-49 "Shrove Sunday") |
406 (-47 "Shrove Tuesday") | 405 (-48 "Shrove Monday") |
407 (-14 "Passion Sunday") | 406 (-47 "Shrove Tuesday") |
408 (-7 "Palm Sunday") | 407 (-14 "Passion Sunday") |
409 (-3 "Maundy Thursday") | 408 (-7 "Palm Sunday") |
410 (35 "Rogation Sunday") | 409 (-3 "Maundy Thursday") |
411 (39 "Ascension Day") | 410 (35 "Rogation Sunday") |
412 (49 "Pentecost (Whitsunday)") | 411 (39 "Ascension Day") |
413 (50 "Whitmonday") | 412 (49 "Pentecost (Whitsunday)") |
414 (56 "Trinity Sunday") | 413 (50 "Whitmonday") |
415 (60 "Corpus Christi"))) | 414 (56 "Trinity Sunday") |
416 '((0 "Easter Sunday") | 415 (60 "Corpus Christi"))) |
417 (-2 "Good Friday") | 416 '((-46 "Ash Wednesday") |
418 (-46 "Ash Wednesday"))))) | 417 (-2 "Good Friday") |
418 (0 "Easter Sunday"))))) | |
419 (let* ((century (1+ (/ displayed-year 100))) | 419 (let* ((century (1+ (/ displayed-year 100))) |
420 (shifted-epact ; age of moon for April 5... | 420 (shifted-epact ; age of moon for April 5... |
421 (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule | 421 (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule |
422 (- ; ...corrected for the Gregorian century rule | 422 (- ; ...corrected for the Gregorian century rule |
423 (/ (* 3 century) 4)) | 423 (/ (* 3 century) 4)) |
431 (1+ shifted-epact) | 431 (1+ shifted-epact) |
432 shifted-epact)) | 432 shifted-epact)) |
433 (paschal-moon ; day after the full moon on or after March 21 | 433 (paschal-moon ; day after the full moon on or after March 21 |
434 (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) | 434 (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) |
435 adjusted-epact)) | 435 adjusted-epact)) |
436 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))) | 436 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) |
437 (holiday-filter-visible-calendar | 437 (greg (calendar-gregorian-from-absolute (+ abs-easter n)))) |
438 (list (list (calendar-gregorian-from-absolute (+ abs-easter n)) | 438 (if (calendar-date-is-visible-p greg) |
439 string)))))) | 439 (list (list greg string)))))) |
440 | 440 |
441 ;; Prior call to calendar-julian-from-absolute will autoload cal-julian. | 441 ;; Prior call to calendar-julian-from-absolute will autoload cal-julian. |
442 (declare-function calendar-absolute-from-julian "cal-julian" (date)) | 442 (declare-function calendar-absolute-from-julian "cal-julian" (date)) |
443 | 443 |
444 (defun holiday-greek-orthodox-easter () | 444 (defun holiday-greek-orthodox-easter () |