Mercurial > emacs
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) |