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 () |