aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-04-05 20:57:47 +0000
committerGlenn Morris2008-04-05 20:57:47 +0000
commit0b41781b4b01d009a4f857cde0addecb6153d15b (patch)
tree3a425d6157fa6fcfe2841b32f65770774709c0f5
parent8fc9e5a0c35a5c3c60d8ba46af7e3ca385b8cdb2 (diff)
downloademacs-0b41781b4b01d009a4f857cde0addecb6153d15b.tar.gz
emacs-0b41781b4b01d009a4f857cde0addecb6153d15b.zip
(calendar-chinese): Rename custom group from chinese-calendar. Update users.
(calendar-chinese-time-zone): Rename chinese-calendar-time-zone. Keep old name as alias, update users. (calendar-chinese-location-name): Rename chinese-calendar-location-name. Keep old name as alias. (calendar-chinese-daylight-time-offset): Rename chinese-calendar-daylight-time-offset. Keep old name as alias, update users. (calendar-chinese-standard-time-zone-name): Rename chinese-calendar-standard-time-zone-name. Keep old name as alias, update users. (calendar-chinese-daylight-saving-start): Rename chinese-calendar-daylight-savings-starts. Keep old name as alias, update users. (calendar-chinese-daylight-saving-end): Rename chinese-calendar-daylight-savings-ends. Keep old name as alias, update users. (calendar-chinese-daylight-saving-start-time): Rename chinese-calendar-daylight-savings-starts-time. Keep old name as alias, update users. (calendar-chinese-daylight-saving-end-time): Rename chinese-calendar-daylight-savings-ends-time. Keep old name as alias, update users. (calendar-chinese-celestial-stem): Rename calendar-chinese-celestial-stem. Keep old name as alias, update users. (calendar-chinese-terrestrial-branch): Rename calendar-chinese-terrestrial-branch. Keep old name as alias, update users. (calendar-chinese-zodiac-sign-on-or-after): Rename chinese-zodiac-sign-on-or-after. Update callers. (calendar-chinese-new-moon-on-or-after): Rename chinese-new-moon-on-or-after. Update callers. (calendar-chinese-month-list): Rename chinese-month-list. Update callers. (calendar-chinese-number-months): Rename number-chinese-months. Update callers. (calendar-chinese-compute-year): Rename compute-chinese-year. Update callers. (calendar-chinese-year-cache): Rename chinese-year-cache. Update users. (calendar-chinese-year): Rename chinese-year. Update callers. (calendar-chinese-year-cache-init): Rename chinese-year-cache-init. (calendar-chinese-to-absolute): Rename calendar-absolute-from-chinese. Keep old name as alias, update callers. (calendar-chinese-print-date): Rename calendar-print-chinese-date. Keep old name as alias, update callers. (calendar-chinese-months-to-alist): Rename make-chinese-month-assoc-list. Update callers. (calendar-chinese-months): Rename chinese-months. Update callers. (calendar-chinese-goto-date): Rename calendar-goto-chinese-date. Keep old name as alias, update callers.
-rw-r--r--lisp/calendar/cal-china.el266
1 files changed, 157 insertions, 109 deletions
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 116c2950df7..cf9dab4af8d 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -55,11 +55,12 @@
55;;;(require 'cal-julian) 55;;;(require 'cal-julian)
56 56
57 57
58(defgroup chinese-calendar nil 58(defgroup calendar-chinese nil
59 "Chinese calendar support." 59 "Chinese calendar support."
60 :prefix "calendar-chinese-"
60 :group 'calendar) 61 :group 'calendar)
61 62
62(defcustom chinese-calendar-time-zone 63(defcustom calendar-chinese-time-zone
63 '(if (< year 1928) 64 '(if (< year 1928)
64 (+ 465 (/ 40.0 60.0)) 65 (+ 465 (/ 40.0 60.0))
65 480) 66 480)
@@ -67,23 +68,33 @@
67Default is for Beijing. This is an expression in `year' since it changed at 68Default is for Beijing. This is an expression in `year' since it changed at
681928-01-01 00:00:00 from UT+7:45:40 to UT+8." 691928-01-01 00:00:00 from UT+7:45:40 to UT+8."
69 :type 'sexp 70 :type 'sexp
70 :group 'chinese-calendar) 71 :group 'calendar-chinese)
71 72
72(defcustom chinese-calendar-location-name "Beijing" 73(define-obsolete-variable-alias 'chinese-calendar-time-zone
74 'calendar-chinese-time-zone "23.1")
75
76;; FIXME unused.
77(defcustom calendar-chinese-location-name "Beijing"
73 "Name of location used for calculation of Chinese calendar." 78 "Name of location used for calculation of Chinese calendar."
74 :type 'string 79 :type 'string
75 :group 'chinese-calendar) 80 :group 'calendar-chinese)
81
82(define-obsolete-variable-alias 'chinese-calendar-location-name
83 'calendar-chinese-location-name "23.1")
76 84
77(defcustom chinese-calendar-daylight-time-offset 0 85(defcustom calendar-chinese-daylight-time-offset 0
78;; The correct value is as follows, but the Chinese calendrical 86;; The correct value is as follows, but the Chinese calendrical
79;; authorities do NOT use DST in determining astronomical events: 87;; authorities do NOT use DST in determining astronomical events:
80;; 60 88;; 60
81 "Minutes difference between daylight saving and standard time. 89 "Minutes difference between daylight saving and standard time.
82Default is for no daylight saving time." 90Default is for no daylight saving time."
83 :type 'integer 91 :type 'integer
84 :group 'chinese-calendar) 92 :group 'calendar-chinese)
93
94(define-obsolete-variable-alias 'chinese-calendar-daylight-time-offset
95 'calendar-chinese-daylight-time-offset "23.1")
85 96
86(defcustom chinese-calendar-standard-time-zone-name 97(defcustom calendar-chinese-standard-time-zone-name
87 '(if (< year 1928) 98 '(if (< year 1928)
88 "PMT" 99 "PMT"
89 "CST") 100 "CST")
@@ -91,14 +102,20 @@ Default is for no daylight saving time."
91This is an expression depending on `year' because it changed 102This is an expression depending on `year' because it changed
92at 1928-01-01 00:00:00 from `PMT' to `CST'." 103at 1928-01-01 00:00:00 from `PMT' to `CST'."
93 :type 'sexp 104 :type 'sexp
94 :group 'chinese-calendar) 105 :group 'calendar-chinese)
95 106
96(defcustom chinese-calendar-daylight-time-zone-name "CDT" 107(define-obsolete-variable-alias 'chinese-calendar-standard-time-zone-name
108 'calendar-chinese-standard-time-zone-name "23.1")
109
110(defcustom calendar-chinese-daylight-time-zone-name "CDT"
97 "Abbreviated name of daylight saving time zone used for Chinese calendar." 111 "Abbreviated name of daylight saving time zone used for Chinese calendar."
98 :type 'string 112 :type 'string
99 :group 'chinese-calendar) 113 :group 'calendar-chinese)
114
115(define-obsolete-variable-alias 'chinese-calendar-daylight-time-zone-name
116 'calendar-chinese-daylight-time-zone-name "23.1")
100 117
101(defcustom chinese-calendar-daylight-savings-starts nil 118(defcustom calendar-chinese-daylight-saving-start nil
102;; The correct value is as follows, but the Chinese calendrical 119;; The correct value is as follows, but the Chinese calendrical
103;; authorities do NOT use DST in determining astronomical events: 120;; authorities do NOT use DST in determining astronomical events:
104;; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) 121;; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10))
@@ -108,9 +125,12 @@ at 1928-01-01 00:00:00 from `PMT' to `CST'."
108Default is for no daylight saving time. See documentation of 125Default is for no daylight saving time. See documentation of
109`calendar-daylight-savings-starts'." 126`calendar-daylight-savings-starts'."
110 :type 'sexp 127 :type 'sexp
111 :group 'chinese-calendar) 128 :group 'calendar-chinese)
112 129
113(defcustom chinese-calendar-daylight-savings-ends nil 130(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts
131 'calendar-chinese-daylight-saving-start "23.1")
132
133(defcustom calendar-chinese-daylight-saving-end nil
114;; The correct value is as follows, but the Chinese calendrical 134;; The correct value is as follows, but the Chinese calendrical
115;; authorities do NOT use DST in determining astronomical events: 135;; authorities do NOT use DST in determining astronomical events:
116;; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) 136;; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11))
@@ -118,24 +138,33 @@ Default is for no daylight saving time. See documentation of
118Default is for no daylight saving time. See documentation of 138Default is for no daylight saving time. See documentation of
119`calendar-daylight-savings-ends'." 139`calendar-daylight-savings-ends'."
120 :type 'sexp 140 :type 'sexp
121 :group 'chinese-calendar) 141 :group 'calendar-chinese)
142
143(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends
144 'calendar-chinese-daylight-saving-end "23.1")
122 145
123(defcustom chinese-calendar-daylight-savings-starts-time 0 146(defcustom calendar-chinese-daylight-saving-start-time 0
124 "Number of minutes after midnight that daylight saving time starts. 147 "Number of minutes after midnight that daylight saving time starts.
125Default is for no daylight saving time." 148Default is for no daylight saving time."
126 :type 'integer 149 :type 'integer
127 :group 'chinese-calendar) 150 :group 'calendar-chinese)
128 151
129(defcustom chinese-calendar-daylight-savings-ends-time 0 152(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts-time
153 'calendar-chinese-daylight-saving-start-time "23.1")
154
155(defcustom calendar-chinese-daylight-saving-end-time 0
130 "Number of minutes after midnight that daylight saving time ends. 156 "Number of minutes after midnight that daylight saving time ends.
131Default is for no daylight saving time." 157Default is for no daylight saving time."
132 :type 'integer 158 :type 'integer
133 :group 'chinese-calendar) 159 :group 'calendar-chinese)
160
161(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends-time
162 'calendar-chinese-daylight-saving-end-time "23.1")
134 163
135(defcustom chinese-calendar-celestial-stem 164(defcustom calendar-chinese-celestial-stem
136 ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"] 165 ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]
137 "Prefixes used by `calendar-chinese-sexagesimal-name'." 166 "Prefixes used by `calendar-chinese-sexagesimal-name'."
138 :group 'chinese-calendar 167 :group 'calendar-chinese
139 :type '(vector (string :tag "Jia") 168 :type '(vector (string :tag "Jia")
140 (string :tag "Yi") 169 (string :tag "Yi")
141 (string :tag "Bing") 170 (string :tag "Bing")
@@ -147,10 +176,13 @@ Default is for no daylight saving time."
147 (string :tag "Ren") 176 (string :tag "Ren")
148 (string :tag "Gui"))) 177 (string :tag "Gui")))
149 178
150(defcustom chinese-calendar-terrestrial-branch 179(define-obsolete-variable-alias 'chinese-calendar-celestial-stem
180 'calendar-chinese-celestial-stem "23.1")
181
182(defcustom calendar-chinese-terrestrial-branch
151 ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"] 183 ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]
152 "Suffixes used by `calendar-chinese-sexagesimal-name'." 184 "Suffixes used by `calendar-chinese-sexagesimal-name'."
153 :group 'chinese-calendar 185 :group 'calendar-chinese
154 :type '(vector (string :tag "Zi") 186 :type '(vector (string :tag "Zi")
155 (string :tag "Chou") 187 (string :tag "Chou")
156 (string :tag "Yin") 188 (string :tag "Yin")
@@ -164,6 +196,9 @@ Default is for no daylight saving time."
164 (string :tag "Xu") 196 (string :tag "Xu")
165 (string :tag "Hai"))) 197 (string :tag "Hai")))
166 198
199(define-obsolete-variable-alias 'chinese-calendar-terrestrial-branch
200 'calendar-chinese-terrestrial-branch "23.1")
201
167;;; End of user options. 202;;; End of user options.
168 203
169 204
@@ -172,63 +207,63 @@ Default is for no daylight saving time."
172N congruent to 1 gives the first name, N congruent to 2 gives the second name, 207N congruent to 1 gives the first name, N congruent to 2 gives the second name,
173..., N congruent to 60 gives the sixtieth name." 208..., N congruent to 60 gives the sixtieth name."
174 (format "%s-%s" 209 (format "%s-%s"
175 (aref chinese-calendar-celestial-stem (% (1- n) 10)) 210 (aref calendar-chinese-celestial-stem (% (1- n) 10))
176 (aref chinese-calendar-terrestrial-branch (% (1- n) 12)))) 211 (aref calendar-chinese-terrestrial-branch (% (1- n) 12))))
177 212
178(defun chinese-zodiac-sign-on-or-after (d) 213(defun calendar-chinese-zodiac-sign-on-or-after (d)
179 "Absolute date of first new Zodiac sign on or after absolute date D. 214 "Absolute date of first new Zodiac sign on or after absolute date D.
180The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees." 215The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
181 (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) 216 (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d)))
182 (calendar-time-zone (eval chinese-calendar-time-zone)) ; uses year 217 (calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
183 (calendar-daylight-time-offset 218 (calendar-daylight-time-offset
184 chinese-calendar-daylight-time-offset) 219 calendar-chinese-daylight-time-offset)
185 (calendar-standard-time-zone-name 220 (calendar-standard-time-zone-name
186 chinese-calendar-standard-time-zone-name) 221 calendar-chinese-standard-time-zone-name)
187 (calendar-daylight-time-zone-name 222 (calendar-daylight-time-zone-name
188 chinese-calendar-daylight-time-zone-name) 223 calendar-chinese-daylight-time-zone-name)
189 (calendar-calendar-daylight-savings-starts 224 (calendar-daylight-savings-starts
190 chinese-calendar-daylight-savings-starts) 225 calendar-chinese-daylight-saving-start)
191 (calendar-daylight-savings-ends 226 (calendar-daylight-savings-ends
192 chinese-calendar-daylight-savings-ends) 227 calendar-chinese-daylight-saving-end)
193 (calendar-daylight-savings-starts-time 228 (calendar-daylight-savings-starts-time
194 chinese-calendar-daylight-savings-starts-time) 229 calendar-chinese-daylight-saving-start-time)
195 (calendar-daylight-savings-ends-time 230 (calendar-daylight-savings-ends-time
196 chinese-calendar-daylight-savings-ends-time)) 231 calendar-chinese-daylight-saving-end-time))
197 (floor 232 (floor
198 (calendar-astro-to-absolute 233 (calendar-astro-to-absolute
199 (solar-date-next-longitude (calendar-astro-from-absolute d) 30))))) 234 (solar-date-next-longitude (calendar-astro-from-absolute d) 30)))))
200 235
201(defun chinese-new-moon-on-or-after (d) 236(defun calendar-chinese-new-moon-on-or-after (d)
202 "Absolute date of first new moon on or after absolute date D." 237 "Absolute date of first new moon on or after absolute date D."
203 (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) 238 (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d)))
204 (calendar-time-zone (eval chinese-calendar-time-zone)) 239 (calendar-time-zone (eval calendar-chinese-time-zone))
205 (calendar-daylight-time-offset 240 (calendar-daylight-time-offset
206 chinese-calendar-daylight-time-offset) 241 calendar-chinese-daylight-time-offset)
207 (calendar-standard-time-zone-name 242 (calendar-standard-time-zone-name
208 chinese-calendar-standard-time-zone-name) 243 calendar-chinese-standard-time-zone-name)
209 (calendar-daylight-time-zone-name 244 (calendar-daylight-time-zone-name
210 chinese-calendar-daylight-time-zone-name) 245 calendar-chinese-daylight-time-zone-name)
211 (calendar-calendar-daylight-savings-starts 246 (calendar-daylight-savings-starts
212 chinese-calendar-daylight-savings-starts) 247 calendar-chinese-daylight-saving-start)
213 (calendar-daylight-savings-ends 248 (calendar-daylight-savings-ends
214 chinese-calendar-daylight-savings-ends) 249 calendar-chinese-daylight-saving-end)
215 (calendar-daylight-savings-starts-time 250 (calendar-daylight-savings-starts-time
216 chinese-calendar-daylight-savings-starts-time) 251 calendar-chinese-daylight-saving-start-time)
217 (calendar-daylight-savings-ends-time 252 (calendar-daylight-savings-ends-time
218 chinese-calendar-daylight-savings-ends-time)) 253 calendar-chinese-daylight-saving-end-time))
219 (floor 254 (floor
220 (calendar-astro-to-absolute 255 (calendar-astro-to-absolute
221 (lunar-new-moon-on-or-after (calendar-astro-from-absolute d)))))) 256 (lunar-new-moon-on-or-after (calendar-astro-from-absolute d))))))
222 257
223(defun chinese-month-list (start end) 258(defun calendar-chinese-month-list (start end)
224 "List of starting dates of Chinese months from START to END." 259 "List of starting dates of Chinese months from START to END."
225 (if (<= start end) 260 (if (<= start end)
226 (let ((new-moon (chinese-new-moon-on-or-after start))) 261 (let ((new-moon (calendar-chinese-new-moon-on-or-after start)))
227 (if (<= new-moon end) 262 (if (<= new-moon end)
228 (cons new-moon 263 (cons new-moon
229 (chinese-month-list (1+ new-moon) end)))))) 264 (calendar-chinese-month-list (1+ new-moon) end))))))
230 265
231(defun number-chinese-months (list start) 266(defun calendar-chinese-number-months (list start)
232 "Assign month numbers to the lunar months in LIST, starting with START. 267 "Assign month numbers to the lunar months in LIST, starting with START.
233Numbers are assigned sequentially, START, START+1, ..., 11, with 268Numbers are assigned sequentially, START, START+1, ..., 11, with
234half numbers used for leap months. First and last months of list 269half numbers used for leap months. First and last months of list
@@ -238,53 +273,55 @@ are never leap months."
238 ;; Remaining months. 273 ;; Remaining months.
239 (if (zerop (- 12 start (length list))) 274 (if (zerop (- 12 start (length list)))
240 ;; List is too short for a leap month. 275 ;; List is too short for a leap month.
241 (number-chinese-months (cdr list) (1+ start)) 276 (calendar-chinese-number-months (cdr list) (1+ start))
242 (if (and (cddr list) ; at least two more months... 277 (if (and (cddr list) ; at least two more months...
243 (<= (nth 2 list) 278 (<= (nth 2 list)
244 (chinese-zodiac-sign-on-or-after (cadr list)))) 279 (calendar-chinese-zodiac-sign-on-or-after
280 (cadr list))))
245 ;; Next month is a leap month. 281 ;; Next month is a leap month.
246 (cons (list (+ start 0.5) (cadr list)) 282 (cons (list (+ start 0.5) (cadr list))
247 (number-chinese-months (cddr list) (1+ start))) 283 (calendar-chinese-number-months (cddr list) (1+ start)))
248 ;; Next month is not a leap month. 284 ;; Next month is not a leap month.
249 (number-chinese-months (cdr list) (1+ start))))))) 285 (calendar-chinese-number-months (cdr list) (1+ start)))))))
250 286
251(defun compute-chinese-year (y) 287(defun calendar-chinese-compute-year (y)
252 "Compute the structure of the Chinese year for Gregorian year Y. 288 "Compute the structure of the Chinese year for Gregorian year Y.
253The result is a list of pairs (i d), where month i begins on absolute date d, 289The result is a list of pairs (i d), where month i begins on absolute date d,
254of the Chinese months from the Chinese month following the solstice in 290of the Chinese months from the Chinese month following the solstice in
255Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." 291Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
256 (let* ((next-solstice (chinese-zodiac-sign-on-or-after 292 (let* ((next-solstice (calendar-chinese-zodiac-sign-on-or-after
257 (calendar-absolute-from-gregorian 293 (calendar-absolute-from-gregorian
258 (list 12 15 y)))) 294 (list 12 15 y))))
259 (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after 295 (list (calendar-chinese-month-list
260 (calendar-absolute-from-gregorian 296 (1+ (calendar-chinese-zodiac-sign-on-or-after
261 (list 12 15 (1- y))))) 297 (calendar-absolute-from-gregorian
262 next-solstice)) 298 (list 12 15 (1- y)))))
263 (next-sign (chinese-zodiac-sign-on-or-after (car list)))) 299 next-solstice))
300 (next-sign (calendar-chinese-zodiac-sign-on-or-after (car list))))
264 (if (= (length list) 12) 301 (if (= (length list) 12)
265 ;; No room for a leap month, just number them 12, 1, 2, ..., 11. 302 ;; No room for a leap month, just number them 12, 1, 2, ..., 11.
266 (cons (list 12 (car list)) 303 (cons (list 12 (car list))
267 (number-chinese-months (cdr list) 1)) 304 (calendar-chinese-number-months (cdr list) 1))
268 ;; Now we can assign numbers to the list for y. 305 ;; Now we can assign numbers to the list for y.
269 ;; The first month or two are special. 306 ;; The first month or two are special.
270 (if (or (> (car list) next-sign) (>= next-sign (cadr list))) 307 (if (or (> (car list) next-sign) (>= next-sign (cadr list)))
271 ;; First month on list is a leap month, second is not. 308 ;; First month on list is a leap month, second is not.
272 (append (list (list 11.5 (car list)) 309 (append (list (list 11.5 (car list))
273 (list 12 (cadr list))) 310 (list 12 (cadr list)))
274 (number-chinese-months (cddr list) 1)) 311 (calendar-chinese-number-months (cddr list) 1))
275 ;; First month on list is not a leap month. 312 ;; First month on list is not a leap month.
276 (append (list (list 12 (car list))) 313 (append (list (list 12 (car list)))
277 (if (>= (chinese-zodiac-sign-on-or-after (cadr list)) 314 (if (>= (calendar-chinese-zodiac-sign-on-or-after (cadr list))
278 (nth 2 list)) 315 (nth 2 list))
279 ;; Second month on list is a leap month. 316 ;; Second month on list is a leap month.
280 (cons (list 12.5 (cadr list)) 317 (cons (list 12.5 (cadr list))
281 (number-chinese-months (cddr list) 1)) 318 (calendar-chinese-number-months (cddr list) 1))
282 ;; Second month on list is not a leap month. 319 ;; Second month on list is not a leap month.
283 (number-chinese-months (cdr list) 1))))))) 320 (calendar-chinese-number-months (cdr list) 1)))))))
284 321
285(defvar chinese-year-cache 322(defvar calendar-chinese-year-cache
286 ;; Maintainers: delete existing value, position point at start of 323 ;; Maintainers: delete existing value, position point at start of
287 ;; empty line, then call M-: (chinese-year-cache-init N) 324 ;; empty line, then call M-: (calendar-chinese-year-cache-init N)
288 '((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273) 325 '((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273)
289 (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450)) 326 (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450))
290 (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628) 327 (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628)
@@ -338,29 +375,30 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
338 "Alist of Chinese year structures as determined by `chinese-year'. 375 "Alist of Chinese year structures as determined by `chinese-year'.
339The default can be nil, but some values are precomputed for efficiency.") 376The default can be nil, but some values are precomputed for efficiency.")
340 377
341(defun chinese-year (y) 378(defun calendar-chinese-year (y)
342 "The structure of the Chinese year for Gregorian year Y. 379 "The structure of the Chinese year for Gregorian year Y.
343The result is a list of pairs (i d), where month i begins on absolute date d, 380The result is a list of pairs (i d), where month i begins on absolute date d,
344of the Chinese months from the Chinese month following the solstice in 381of the Chinese months from the Chinese month following the solstice in
345Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. 382Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y.
346The list is cached in `chinese-year-cache' for further use." 383The list is cached in `calendar-chinese-year-cache' for further use."
347 (let ((list (cdr (assoc y chinese-year-cache)))) 384 (let ((list (cdr (assoc y calendar-chinese-year-cache))))
348 (or list 385 (or list
349 (setq list (compute-chinese-year y) 386 (setq list (calendar-chinese-compute-year y)
350 chinese-year-cache (append chinese-year-cache 387 calendar-chinese-year-cache (append calendar-chinese-year-cache
351 (list (cons y list))))) 388 (list (cons y list)))))
352 list)) 389 list))
353 390
354;; Maintainer use. 391;; Maintainer use.
355(defun chinese-year-cache-init (year) 392(defun calendar-chinese-year-cache-init (year)
356 "Insert an initialization value for `chinese-year-cache' after point. 393 "Insert an initialization value for `calendar-chinese-year-cache' after point.
357Computes values for 10 years either side of YEAR." 394Computes values for 10 years either side of YEAR."
358 (setq year (- year 10)) 395 (setq year (- year 10))
359 (let (chinese-year-cache end) 396 (let (calendar-chinese-year-cache end)
360 (save-excursion 397 (save-excursion
361 (insert "'(") 398 (insert "'(")
362 (dotimes (n 21) 399 (dotimes (n 21)
363 (princ (cons year (compute-chinese-year year)) (current-buffer)) 400 (princ (cons year (calendar-chinese-compute-year year))
401 (current-buffer))
364 (insert (if (= n 20) ")" "\n")) 402 (insert (if (= n 20) ")" "\n"))
365 (setq year (1+ year))) 403 (setq year (1+ year)))
366 (setq end (point))) 404 (setq end (point)))
@@ -372,7 +410,7 @@ Computes values for 10 years either side of YEAR."
372 (insert "\n"))) 410 (insert "\n")))
373 (indent-region (point) end))) 411 (indent-region (point) end)))
374 412
375(defun calendar-absolute-from-chinese (date) 413(defun calendar-chinese-to-absolute (date)
376 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. 414 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
377DATE is a Chinese date (cycle year month day). The Gregorian date 415DATE is a Chinese date (cycle year month day). The Gregorian date
378Sunday, December 31, 1 BC is imaginary." 416Sunday, December 31, 1 BC is imaginary."
@@ -385,9 +423,12 @@ Sunday, December 31, 1 BC is imaginary."
385 -2636))) ; years before absolute date 0 423 -2636))) ; years before absolute date 0
386 (+ (1- day) ; prior days this month 424 (+ (1- day) ; prior days this month
387 (cadr ; absolute date of start of this month 425 (cadr ; absolute date of start of this month
388 (assoc month (append (memq (assoc 1 (chinese-year g-year)) 426 (assoc month (append (memq (assoc 1 (calendar-chinese-year g-year))
389 (chinese-year g-year)) 427 (calendar-chinese-year g-year))
390 (chinese-year (1+ g-year)))))))) 428 (calendar-chinese-year (1+ g-year))))))))
429
430(define-obsolete-function-alias 'calendar-absolute-from-chinese
431 'calendar-chinese-to-absolute "23.1")
391 432
392(defun calendar-chinese-from-absolute (date) 433(defun calendar-chinese-from-absolute (date)
393 "Compute Chinese date (cycle year month day) corresponding to absolute DATE. 434 "Compute Chinese date (cycle year month day) corresponding to absolute DATE.
@@ -396,9 +437,9 @@ Gregorian date Sunday, December 31, 1 BC."
396 (let* ((g-year (extract-calendar-year 437 (let* ((g-year (extract-calendar-year
397 (calendar-gregorian-from-absolute date))) 438 (calendar-gregorian-from-absolute date)))
398 (c-year (+ g-year 2695)) 439 (c-year (+ g-year 2695))
399 (list (append (chinese-year (1- g-year)) 440 (list (append (calendar-chinese-year (1- g-year))
400 (chinese-year g-year) 441 (calendar-chinese-year g-year)
401 (chinese-year (1+ g-year))))) 442 (calendar-chinese-year (1+ g-year)))))
402 (while (<= (cadr (cadr list)) date) 443 (while (<= (cadr (cadr list)) date)
403 ;; The first month on the list is in Chinese year c-year. 444 ;; The first month on the list is in Chinese year c-year.
404 ;; Date is on or after start of second month on list... 445 ;; Date is on or after start of second month on list...
@@ -430,9 +471,10 @@ Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian."
430 ;; one-sided test, namely: d-m <= 4 means CNY might be visible. 471 ;; one-sided test, namely: d-m <= 4 means CNY might be visible.
431 (increment-calendar-month m y 1) ; shift forward a month 472 (increment-calendar-month m y 1) ; shift forward a month
432 (and (< m 5) 473 (and (< m 5)
433 (calendar-date-is-visible-p (setq chinese-new-year 474 (calendar-date-is-visible-p
434 (calendar-gregorian-from-absolute 475 (setq chinese-new-year
435 (cadr (assoc 1 (chinese-year y)))))) 476 (calendar-gregorian-from-absolute
477 (cadr (assoc 1 (calendar-chinese-year y))))))
436 (list 478 (list
437 (list chinese-new-year 479 (list chinese-new-year
438 (format "Chinese New Year (%s)" 480 (format "Chinese New Year (%s)"
@@ -449,9 +491,9 @@ Defaults to today's date if DATE is not given."
449 (year (cadr c-date)) 491 (year (cadr c-date))
450 (month (nth 2 c-date)) 492 (month (nth 2 c-date))
451 (day (nth 3 c-date)) 493 (day (nth 3 c-date))
452 (this-month (calendar-absolute-from-chinese 494 (this-month (calendar-chinese-to-absolute
453 (list cycle year month 1))) 495 (list cycle year month 1)))
454 (next-month (calendar-absolute-from-chinese 496 (next-month (calendar-chinese-to-absolute
455 (list (if (= year 60) (1+ cycle) cycle) 497 (list (if (= year 60) (1+ cycle) cycle)
456 (if (= (floor month) 12) (1+ year) year) 498 (if (= (floor month) 12) (1+ year) year)
457 ;; Remainder of (1+(floor month))/12, with 499 ;; Remainder of (1+(floor month))/12, with
@@ -475,14 +517,17 @@ Defaults to today's date if DATE is not given."
475 day (calendar-chinese-sexagesimal-name (+ a-date 15))))) 517 day (calendar-chinese-sexagesimal-name (+ a-date 15)))))
476 518
477;;;###cal-autoload 519;;;###cal-autoload
478(defun calendar-print-chinese-date () 520(defun calendar-chinese-print-date ()
479 "Show the Chinese date equivalents of date." 521 "Show the Chinese date equivalents of date."
480 (interactive) 522 (interactive)
481 (message "Computing Chinese date...") 523 (message "Computing Chinese date...")
482 (message "Chinese date: %s" 524 (message "Chinese date: %s"
483 (calendar-chinese-date-string (calendar-cursor-to-date t)))) 525 (calendar-chinese-date-string (calendar-cursor-to-date t))))
484 526
485(defun make-chinese-month-assoc-list (l) 527(define-obsolete-function-alias 'calendar-print-chinese-date
528 'calendar-chinese-print-date "23.1")
529
530(defun calendar-chinese-months-to-alist (l)
486 "Make list of months L into an assoc list." 531 "Make list of months L into an assoc list."
487 (and l (car l) 532 (and l (car l)
488 (if (and (cdr l) (cadr l)) 533 (if (and (cdr l) (cadr l))
@@ -490,32 +535,32 @@ Defaults to today's date if DATE is not given."
490 (append 535 (append
491 (list (cons (format "%s (first)" (car l)) (car l)) 536 (list (cons (format "%s (first)" (car l)) (car l))
492 (cons (format "%s (second)" (car l)) (cadr l))) 537 (cons (format "%s (second)" (car l)) (cadr l)))
493 (make-chinese-month-assoc-list (cddr l))) 538 (calendar-chinese-months-to-alist (cddr l)))
494 (append 539 (append
495 (list (cons (int-to-string (car l)) (car l))) 540 (list (cons (int-to-string (car l)) (car l)))
496 (make-chinese-month-assoc-list (cdr l)))) 541 (calendar-chinese-months-to-alist (cdr l))))
497 (list (cons (int-to-string (car l)) (car l)))))) 542 (list (cons (int-to-string (car l)) (car l))))))
498 543
499(defun chinese-months (c y) 544(defun calendar-chinese-months (c y)
500 "A list of the months in cycle C, year Y of the Chinese calendar." 545 "A list of the months in cycle C, year Y of the Chinese calendar."
501 (memq 1 (append 546 (memq 1 (append
502 (mapcar (lambda (x) 547 (mapcar (lambda (x)
503 (car x)) 548 (car x))
504 (chinese-year (extract-calendar-year 549 (calendar-chinese-year (extract-calendar-year
505 (calendar-gregorian-from-absolute 550 (calendar-gregorian-from-absolute
506 (calendar-absolute-from-chinese 551 (calendar-chinese-to-absolute
507 (list c y 1 1)))))) 552 (list c y 1 1))))))
508 (mapcar (lambda (x) 553 (mapcar (lambda (x)
509 (if (> (car x) 11) (car x))) 554 (if (> (car x) 11) (car x)))
510 (chinese-year (extract-calendar-year 555 (calendar-chinese-year (extract-calendar-year
511 (calendar-gregorian-from-absolute 556 (calendar-gregorian-from-absolute
512 (calendar-absolute-from-chinese 557 (calendar-chinese-to-absolute
513 (list (if (= y 60) (1+ c) c) 558 (list (if (= y 60) (1+ c) c)
514 (if (= y 60) 1 y) 559 (if (= y 60) 1 y)
515 1 1))))))))) 560 1 1)))))))))
516 561
517;;;###cal-autoload 562;;;###cal-autoload
518(defun calendar-goto-chinese-date (date &optional noecho) 563(defun calendar-chinese-goto-date (date &optional noecho)
519 "Move cursor to Chinese date DATE. 564 "Move cursor to Chinese date DATE.
520Echo Chinese date unless NOECHO is non-nil." 565Echo Chinese date unless NOECHO is non-nil."
521 (interactive 566 (interactive
@@ -529,8 +574,8 @@ Echo Chinese date unless NOECHO is non-nil."
529 "Year in Chinese cycle (1..60): " 574 "Year in Chinese cycle (1..60): "
530 (lambda (x) (and (<= 1 x) (<= x 60))) 575 (lambda (x) (and (<= 1 x) (<= x 60)))
531 (int-to-string (cadr c)))) 576 (int-to-string (cadr c))))
532 (month-list (make-chinese-month-assoc-list 577 (month-list (calendar-chinese-months-to-alist
533 (chinese-months cycle year))) 578 (calendar-chinese-months cycle year)))
534 (month (cdr (assoc 579 (month (cdr (assoc
535 (completing-read "Chinese calendar month: " 580 (completing-read "Chinese calendar month: "
536 month-list nil t) 581 month-list nil t)
@@ -539,7 +584,7 @@ Echo Chinese date unless NOECHO is non-nil."
539 (nth 2 584 (nth 2
540 (calendar-chinese-from-absolute 585 (calendar-chinese-from-absolute
541 (+ 29 586 (+ 29
542 (calendar-absolute-from-chinese 587 (calendar-chinese-to-absolute
543 (list cycle year month 1)))))) 588 (list cycle year month 1))))))
544 30 589 30
545 29)) 590 29))
@@ -548,8 +593,11 @@ Echo Chinese date unless NOECHO is non-nil."
548 (lambda (x) (and (<= 1 x) (<= x last)))))) 593 (lambda (x) (and (<= 1 x) (<= x last))))))
549 (list (list cycle year month day)))) 594 (list (list cycle year month day))))
550 (calendar-goto-date (calendar-gregorian-from-absolute 595 (calendar-goto-date (calendar-gregorian-from-absolute
551 (calendar-absolute-from-chinese date))) 596 (calendar-chinese-to-absolute date)))
552 (or noecho (calendar-print-chinese-date))) 597 (or noecho (calendar-chinese-print-date)))
598
599(define-obsolete-function-alias 'calendar-goto-chinese-date
600 'calendar-chinese-goto-date "23.1")
553 601
554(defvar date) 602(defvar date)
555 603