;ELC ;;; Compiled by pot@pot.cnuce.cnr.it on Tue Mar 18 15:36:53 2003 ;;; from file /home/pot/gnu/emacs-pretest.new/lisp/calendar/cal-china.el ;;; in Emacs version 21.3 ;;; with bytecomp version 2.85.4.1 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`cal-china.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\303\304!\210\301B\305\301!\204\306\302B\305\302!\204\307\303\207" [current-load-list chinese-calendar-celestial-stem chinese-calendar-terrestrial-branch require lunar boundp ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"] ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]] 2) #@246 *Number of minutes difference between local standard time for Chinese calendar and Coordinated Universal (Greenwich) Time. Default is for Beijing. This is an expression in `year' since it changed at 1928-01-01 00:00:00 from UT+7:45:40 to UT+8. (custom-declare-variable 'chinese-calendar-time-zone ''(if (< year 1928) (+ 465 (/ 40.0 60.0)) 480) '(#$ . -966) :type 'sexp :group 'chinese-calendar) #@61 *Name of location used for calculation of Chinese calendar. (custom-declare-variable 'chinese-calendar-location-name '"Beijing" '(#$ . -1368) :type 'string :group 'chinese-calendar) #@138 *Number of minutes difference between daylight savings and standard time for Chinese calendar. Default is for no daylight savings time. (custom-declare-variable 'chinese-calendar-daylight-time-offset '0 '(#$ . -1557) :type 'integer :group 'chinese-calendar) #@173 *Abbreviated name of standard time zone used for Chinese calendar. This is an expression depending on `year' because it changed at 1928-01-01 00:00:00 from `PMT' to `CST'. (custom-declare-variable 'chinese-calendar-standard-time-zone-name ''(if (< year 1928) "PMT" "CST") '(#$ . -1823) :type 'sexp :group 'chinese-calendar) #@76 *Abbreviated name of daylight-savings time zone used for Chinese calendar. (custom-declare-variable 'chinese-calendar-daylight-time-zone-name '"CDT" '(#$ . -2153) :type 'string :group 'chinese-calendar) #@183 *Sexp giving the date on which daylight savings time starts for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-starts'. (custom-declare-variable 'chinese-calendar-daylight-savings-starts 'nil '(#$ . -2363) :type 'sexp :group 'chinese-calendar) #@179 *Sexp giving the date on which daylight savings time ends for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-ends'. (custom-declare-variable 'chinese-calendar-daylight-savings-ends 'nil '(#$ . -2676) :type 'sexp :group 'chinese-calendar) #@133 *Number of minutes after midnight that daylight savings time starts for Chinese calendar. Default is for no daylight savings time. (custom-declare-variable 'chinese-calendar-daylight-savings-starts-time '0 '(#$ . -2983) :type 'integer :group 'chinese-calendar) #@131 *Number of minutes after midnight that daylight savings time ends for Chinese calendar. Default is for no daylight savings time. (custom-declare-variable 'chinese-calendar-daylight-savings-ends-time '0 '(#$ . -3252) :type 'integer :group 'chinese-calendar) #@146 Absolute date of first new Zodiac sign on or after absolute date d. The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees. (defalias 'chinese-zodiac-sign-on-or-after #[(d) "\306!\211AA@)\307 !  \310\311\312\313!\314\"!!. \207" [d date year chinese-calendar-time-zone calendar-time-zone chinese-calendar-daylight-time-offset calendar-gregorian-from-absolute eval floor calendar-absolute-from-astro solar-date-next-longitude calendar-astro-from-absolute 30 calendar-daylight-time-offset chinese-calendar-standard-time-zone-name calendar-standard-time-zone-name chinese-calendar-daylight-time-zone-name calendar-daylight-time-zone-name chinese-calendar-daylight-savings-starts calendar-calendar-daylight-savings-starts chinese-calendar-daylight-savings-ends calendar-daylight-savings-ends chinese-calendar-daylight-savings-starts-time calendar-daylight-savings-starts-time chinese-calendar-daylight-savings-ends-time calendar-daylight-savings-ends-time] 6 (#$ . 3517)]) #@62 Absolute date of first new moon on or after absolute date d. (defalias 'chinese-new-moon-on-or-after #[(d) "\306!\211AA@)\307 ! \f \310\311\312\313!!!!. \207" [d date year chinese-calendar-time-zone calendar-time-zone chinese-calendar-daylight-time-offset calendar-gregorian-from-absolute eval floor calendar-absolute-from-astro lunar-new-moon-on-or-after calendar-astro-from-absolute calendar-daylight-time-offset chinese-calendar-standard-time-zone-name calendar-standard-time-zone-name chinese-calendar-daylight-time-zone-name calendar-daylight-time-zone-name chinese-calendar-daylight-savings-starts calendar-calendar-daylight-savings-starts chinese-calendar-daylight-savings-ends calendar-daylight-savings-ends chinese-calendar-daylight-savings-starts-time calendar-daylight-savings-starts-time chinese-calendar-daylight-savings-ends-time calendar-daylight-savings-ends-time] 6 (#$ . 4542)]) #@301 An assoc list of Chinese year structures as determined by `chinese-year'. Values are computed as needed, but to save time, the initial value consists of the precomputed years 1990-2010. The code works just as well with this set to nil initially (which is how the value for 1990-2010 was computed). (defvar chinese-year-cache '((1990 (12 726464) (1 726494) (2 726523) (3 726553) (4 726582) (5 726611) (5.5 726641) (6 726670) (7 726699) (8 726729) (9 726758) (10 726788) (11 726818)) (1991 (12 726848) (1 726878) (2 726907) (3 726937) (4 726966) (5 726995) (6 727025) (7 727054) (8 727083) (9 727113) (10 727142) (11 727172)) (1992 (12 727202) (1 727232) (2 727261) (3 727291) (4 727321) (5 727350) (6 727379) (7 727409) (8 727438) (9 727467) (10 727497) (11 727526)) (1993 (12 727556) (1 727586) (2 727615) (3 727645) (3.5 727675) (4 727704) (5 727734) (6 727763) (7 727793) (8 727822) (9 727851) (10 727881) (11 727910)) (1994 (12 727940) (1 727969) (2 727999) (3 728029) (4 728059) (5 728088) (6 728118) (7 728147) (8 728177) (9 728206) (10 728235) (11 728265)) (1995 (12 728294) (1 728324) (2 728353) (3 728383) (4 728413) (5 728442) (6 728472) (7 728501) (8 728531) (8.5 728561) (9 728590) (10 728619) (11 728649)) (1996 (12 728678) (1 728708) (2 728737) (3 728767) (4 728796) (5 728826) (6 728856) (7 728885) (8 728915) (9 728944) (10 728974) (11 729004)) (1997 (12 729033) (1 729062) (2 729092) (3 729121) (4 729151) (5 729180) (6 729210) (7 729239) (8 729269) (9 729299) (10 729328) (11 729358)) (1998 (12 729388) (1 729417) (2 729447) (3 729476) (4 729505) (5 729535) (5.5 729564) (6 729593) (7 729623) (8 729653) (9 729682) (10 729712) (11 729742)) (1999 (12 729771) (1 729801) (2 729831) (3 729860) (4 729889) (5 729919) (6 729948) (7 729977) (8 730007) (9 730036) (10 730066) (11 730096)) (2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273) (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450)) (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628) (5 730657) (6 730687) (7 730716) (8 730745) (9 730775) (10 730804) (11 730834)) (2002 (12 730863) (1 730893) (2 730923) (3 730953) (4 730982) (5 731012) (6 731041) (7 731071) (8 731100) (9 731129) (10 731159) (11 731188)) (2003 (12 731218) (1 731247) (2 731277) (3 731307) (4 731336) (5 731366) (6 731396) (7 731425) (8 731455) (9 731484) (10 731513) (11 731543)) (2004 (12 731572) (1 731602) (2 731631) (2.5 731661) (3 731690) (4 731720) (5 731750) (6 731779) (7 731809) (8 731838) (9 731868) (10 731897) (11 731927)) (2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104) (6 732133) (7 732163) (8 732193) (9 732222) (10 732252) (11 732281)) (2006 (12 732311) (1 732340) (2 732370) (3 732399) (4 732429) (5 732458) (6 732488) (7 732517) (7.5 732547) (8 732576) (9 732606) (10 732636) (11 732665)) (2007 (12 732695) (1 732725) (2 732754) (3 732783) (4 732813) (5 732842) (6 732871) (7 732901) (8 732930) (9 732960) (10 732990) (11 733020)) (2008 (12 733049) (1 733079) (2 733109) (3 733138) (4 733167) (5 733197) (6 733226) (7 733255) (8 733285) (9 733314) (10 733344) (11 733374)) (2009 (12 733403) (1 733433) (2 733463) (3 733493) (4 733522) (5 733551) (5.5 733581) (6 733610) (7 733639) (8 733669) (9 733698) (10 733728) (11 733757)) (2010 (12 733787) (1 733817) (2 733847) (3 733876) (4 733906) (5 733935) (6 733965) (7 733994) (8 734023) (9 734053) (10 734082) (11 734112))) (#$ . 5475)) #@320 The structure of the Chinese year for Gregorian year Y. The result is a list of pairs (i d), where month i begins on absolute date d, of the Chinese months from the Chinese month following the solstice in Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. The list is cached for further use. (defalias 'chinese-year #[(y) "\303 \"A\211\204\304!\305 \nBC\"\n)\207" [y chinese-year-cache list assoc compute-chinese-year append] 5 (#$ . 8911)]) #@240 Assign month numbers to the lunar months in LIST, starting with START. Numbers are assigned sequentially, START, START+1, ..., 11, with half numbers used for leap months. First month of list will never be a leap month, nor will the last. (defalias 'number-chinese-months #[(list start) "\205K\302\303 ZGZ!\203 @D\304A T\"B\207 @DAA\203DAA@\305A@!X\203D \306\\A@D\304AA T\"B\202J\304A T\"B\207" [list start zerop 12 number-chinese-months chinese-zodiac-sign-on-or-after 0.5] 5 (#$ . 9395)]) #@61 List of starting dates of Chinese months from START to END. (defalias 'chinese-month-list #[(start end) " X\205\303!\211 X\205\n\304\nT \"B)\207" [start end new-moon chinese-new-moon-on-or-after chinese-month-list] 5 (#$ . 9909)]) #@291 Compute the structure of the Chinese year for Gregorian year Y. The result is a list of pairs (i d), where month i begins on absolute date d, of the Chinese months from the Chinese month following the solstice in Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. (defalias 'compute-chinese-year #[(y) "\306\307\310E\311 !S\312 !\313\n_\\\n\314\245\\\n\315\245[\\\n\316\245\\*!\317\306\307\310SE\311 !S\312 !\313\n_\\\n\314\245\\\n\315\245[\\\n\316\245\\*!T \"\306\f@!\fG\307U\203b\307\f@D\320\fA\321\"B\202\256\f@ V\204q \fA@Y\203\206\322\323\f@D\307\fA@DD\320\fAA\321\"\"\202\256\322\307\f@DC\306\fA@!\fAA@Y\203\250\324\fA@D\320\fAA\321\"B\202\255\320\fA\321\"\"+\207" [y date prior-years next-solstice list next-sign chinese-zodiac-sign-on-or-after 12 15 extract-calendar-year calendar-day-number 365 4 100 400 chinese-month-list number-chinese-months 1 append 11.5 12.5] 6 (#$ . 10154)]) #@135 The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The Gregorian date Sunday, December 31, 1 BC is imaginary. (defalias 'calendar-absolute-from-chinese #[(date) "@A@AA@AAA@ S\306_\nS\\\307\\\fS\310 \311\310\312\313 !\"\313 !>\313 T!\"\"A@\\-\207" [date cycle year month day g-year 60 -2636 assoc append 1 chinese-year] 8 (#$ . 11095)]) #@189 Compute Chinese date (cycle year month day) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'calendar-chinese-from-absolute #[(date) "\304!\211AA@)\211\305\\\306\307 S!\307 !\307 T!#\211A@A@X\2039 A@@\310U\2032\nT A\211\202\nS\311\245\312\n\311\" @@ @A@ZTF+\207" [date g-year c-year list calendar-gregorian-from-absolute 2695 append chinese-year 1 60 calendar-mod] 6 (#$ . 11471)]) #@27 Date of Chinese New Year. (defalias 'holiday-chinese-new-year #[nil " \n\306_ \\\211\306\246T\f\306\245) \307W\2057\310\311\312\313\n!\"A@!\314 !\2056 \315\316\317\n\320\\!\"DC)*\207" [displayed-month displayed-year y m macro-y chinese-new-year 12 5 calendar-gregorian-from-absolute assoc 1 chinese-year calendar-date-is-visible-p format "Chinese New Year (%s)" calendar-chinese-sexagesimal-name 57] 7 (#$ . 11978)]) #@90 String of Chinese date of Gregorian DATE. Defaults to today's date if DATE is not given. (defalias 'calendar-chinese-date-string #[(&optional date) "\206\306 \307!S\310!\311 _\\ \312\245\\ \313\245[\\ \314\245\\*\315\n!\211@ A@ AA@ AAA@ \316\f \317F!!\316 \320U\203P\fT\202Q\f\321!\322U\203_ T\202` \323\321!T\322\"\317F!\" \324_\321!\\\320\246#\325\326\f \327 !\250\204\212\330\202\231\331\"!ZW\203\230\332\202\231\333\321!\250\203\263\325\334\327 \322_\\\335\\!\"\202\264\333 \327\n\336\\!& . \207" [date prior-years a-date c-date cycle year calendar-current-date extract-calendar-year calendar-day-number 365 4 100 400 calendar-chinese-from-absolute calendar-absolute-from-chinese 1 60 floor 12 calendar-mod 5 format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)" calendar-chinese-sexagesimal-name "second " 30 "first " "" " (%s)" 50 15 month day this-month next-month m-cycle] 13 (#$ . 12410)]) #@176 The N-th name of the Chinese sexagesimal cycle. N congruent to 1 gives the first name, N congruent to 2 gives the second name, ..., N congruent to 60 gives the sixtieth name. (defalias 'calendar-chinese-sexagesimal-name #[(n) "\303\304 S\305\246H\n S\306\246H#\207" [chinese-calendar-celestial-stem n chinese-calendar-terrestrial-branch format "%s-%s" 10 12] 6 (#$ . 13367)]) #@44 Show the Chinese date equivalents of date. (defalias 'calendar-print-chinese-date #[nil "\300\301!\210\300\302\303\304\305!!\"\207" [message "Computing Chinese date..." "Chinese date: %s" calendar-chinese-date-string calendar-cursor-to-date t] 5 (#$ . 13750) nil]) #@73 Move cursor to Chinese date DATE. Echo Chinese date unless NOECHO is t. (defalias 'calendar-goto-chinese-date #[(date &optional noecho) "\302\303\304!!!\210 \206\305 \207" [date noecho calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-chinese calendar-print-chinese-date] 4 (#$ . 14021) (let* ((c (calendar-chinese-from-absolute (calendar-absolute-from-gregorian (calendar-current-date)))) (cycle (calendar-read "Chinese calendar cycle number (>44): " '(lambda (x) (> x 44)) (int-to-string (car c)))) (year (calendar-read "Year in Chinese cycle (1..60): " '(lambda (x) (and (<= 1 x) (<= x 60))) (int-to-string (car (cdr c))))) (month-list (make-chinese-month-assoc-list (chinese-months cycle year))) (month (cdr (assoc (completing-read "Chinese calendar month: " month-list nil t) month-list))) (last (if (= month (car (cdr (cdr (calendar-chinese-from-absolute (+ 29 (calendar-absolute-from-chinese (list cycle year month 1)))))))) 30 29)) (day (calendar-read (format "Chinese calendar day (1-%d): " last) '(lambda (x) (and (<= 1 x) (<= x last)))))) (list (list cycle year month day)))]) #@66 A list of the months in cycle C, year Y of the Chinese calendar. (defalias 'chinese-months #[(c y) "\303\304\305\306\307\310\311 \303\211F!!\211AA@)!\"\305\312\307\310\311 \313U\203&T\202' \313U\2031\303\2022 \303\211F!!\211AA@)!\"\">\207" [c y date 1 append mapcar #[(x) "@\207" [x] 1] chinese-year calendar-gregorian-from-absolute calendar-absolute-from-chinese #[(x) "@\301V\205 @\207" [x 11] 2] 60] 13 (#$ . 15143)]) #@43 Make list of months L into an assoc list. (defalias 'make-chinese-month-assoc-list #[(l) "\205P@\205PA\203HA@\203H@\301A@!U\2039\302\303\304@\"@B\303\305@\"A@BD\306AA!\"\207\302\307@!@BC\306A!\"\207\307@!@BC\207" [l floor append format "%s (first)" "%s (second)" make-chinese-month-assoc-list int-to-string] 5 (#$ . 15583)]) #@50 Chinese calendar equivalent of date diary entry. (defalias 'diary-chinese-date #[nil "\301\302\303!\"\207" [date format "Chinese date: %s" calendar-chinese-date-string] 4 (#$ . 15935)]) (provide 'cal-china)