comparison lisp/calendar/cal-china.el @ 104864:f1938074431e

(holiday-chinese): Make it slightly more efficient.
author Glenn Morris <rgm@gnu.org>
date Sat, 05 Sep 2009 21:07:15 +0000
parents a9dc0e7c3f2b
children 1d1d5d9bd884
comparison
equal deleted inserted replaced
104863:03f15a6c0c31 104864:f1938074431e
515 (defun holiday-chinese (month day string) 515 (defun holiday-chinese (month day string)
516 "Holiday on Chinese MONTH, DAY called STRING. 516 "Holiday on Chinese MONTH, DAY called STRING.
517 If MONTH, DAY (Chinese) is visible, returns the corresponding 517 If MONTH, DAY (Chinese) is visible, returns the corresponding
518 Gregorian date as the list (((month day year) STRING)). 518 Gregorian date as the list (((month day year) STRING)).
519 Returns nil if it is not visible in the current calendar window." 519 Returns nil if it is not visible in the current calendar window."
520 ;; This is calendar-nongregorian-visible-p adapted for the form of 520 (let ((date
521 ;; chinese dates: (cycle year month day) as opposed to (month day year). 521 (calendar-gregorian-from-absolute
522 (let* ((m1 displayed-month) 522 ;; A basic optimization. Chinese year can only change if
523 (y1 displayed-year) 523 ;; Jan or Feb are visible. FIXME can we do more?
524 (m2 displayed-month) 524 (if (memq displayed-month '(12 1 2 3))
525 (y2 displayed-year) 525 ;; This is calendar-nongregorian-visible-p adapted for
526 ;; Absolute date of first/last dates in calendar window. 526 ;; the form of chinese dates: (cycle year month day) as
527 (start-date (progn 527 ;; opposed to (month day year).
528 (calendar-increment-month m1 y1 -1) 528 (let* ((m1 displayed-month)
529 (calendar-absolute-from-gregorian (list m1 1 y1)))) 529 (y1 displayed-year)
530 (end-date (progn 530 (m2 displayed-month)
531 (calendar-increment-month m2 y2 1) 531 (y2 displayed-year)
532 (calendar-absolute-from-gregorian 532 ;; Absolute date of first/last dates in calendar window.
533 (list m2 (calendar-last-day-of-month m2 y2) y2)))) 533 (start-date (progn
534 ;; Local date of first/last date in calendar window. 534 (calendar-increment-month m1 y1 -1)
535 (local-start (calendar-chinese-from-absolute start-date)) 535 (calendar-absolute-from-gregorian
536 ;; A basic optimization. We only care about the year part, 536 (list m1 1 y1))))
537 ;; and the Chinese year can only change if Jan or Feb are 537 (end-date (progn
538 ;; visible. FIXME can we do more? 538 (calendar-increment-month m2 y2 1)
539 (local-end (if (memq displayed-month '(12 1 2 3)) 539 (calendar-absolute-from-gregorian
540 (calendar-chinese-from-absolute end-date) 540 (list m2 (calendar-last-day-of-month m2 y2)
541 local-start)) 541 y2))))
542 ;; When Chinese New Year is visible on the far right of the 542 ;; Local date of first/last date in calendar window.
543 ;; calendar, what is the earliest Chinese month in the 543 (local-start (calendar-chinese-from-absolute start-date))
544 ;; previous year that might still visible? This test doesn't 544 (local-end (calendar-chinese-from-absolute end-date))
545 ;; have to be precise. 545 ;; When Chinese New Year is visible on the far
546 (local (if (< month 10) local-end local-start)) 546 ;; right of the calendar, what is the earliest
547 (cycle (car local)) 547 ;; Chinese month in the previous year that might
548 (year (cadr local)) 548 ;; still visible? This test doesn't have to be precise.
549 (date (calendar-gregorian-from-absolute 549 (local (if (< month 10) local-end local-start))
550 (calendar-chinese-to-absolute (list cycle year month day))))) 550 (cycle (car local))
551 (year (cadr local)))
552 (calendar-chinese-to-absolute (list cycle year month day)))
553 ;; Simple form for when new years are not visible.
554 (+ (cadr (assoc month (calendar-chinese-year displayed-year)))
555 (1- day))))))
551 (if (calendar-date-is-visible-p date) 556 (if (calendar-date-is-visible-p date)
552 (list (list date string))))) 557 (list (list date string)))))
553 558
554 ;;;###cal-autoload 559 ;;;###cal-autoload
555 (defun calendar-chinese-date-string (&optional date) 560 (defun calendar-chinese-date-string (&optional date)