cal-china.el 20.4 KB
Newer Older
Edward M. Reingold's avatar
Edward M. Reingold committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
;;; cal-chinese.el --- calendar functions for the Chinese calendar.

;; Copyright (C) 1995 Free Software Foundation, Inc.

;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar
;; Human-Keywords: Chinese calendar, calendar, holidays, diary

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; This collection of functions implements the features of calendar.el,
Edward M. Reingold's avatar
Edward M. Reingold committed
28 29 30 31
;; diary.el, and holidays.el that deal with the Chinese calendar.  The rules
;; used for the Chinese calendar are those of Baolin Liu (see L. E. Doggett's
;; article "Calendars" in the Explanatory Supplement to the Astronomical
;; Almanac, second edition, 1992) for the calendar as revised at the beginning
32 33 34 35 36 37
;; of the Qing dynasty in 1644.  The nature of the astronomical calculations
;; is such that precise calculations cannot be made without great expense in
;; time, so that the calendars produced may not agree perfectly with published
;; tables--but no two pairs of published tables agree perfectly either!  Liu's
;; rules produce a calendar for 2033 which is not accepted by all authorities.
;; The date of Chinese New Year is correct from 1644-2051.
Edward M. Reingold's avatar
Edward M. Reingold committed
38 39

;; Comments, corrections, and improvements should be sent to
Edward M. Reingold's avatar
Edward M. Reingold committed
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
;;  Edward M. Reingold               Department of Computer Science
;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
;;                                   Urbana, Illinois 61801

;;; Code:

(require 'lunar)

(defvar chinese-calendar-terrestrial-branch
  ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])

(defvar chinese-calendar-celestial-stem
  ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])

(defvar chinese-calendar-time-zone 
  '(if (< year 1928)
       (+ 465 (/ 40.0 60.0))
     480)
  "*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.")

(defvar chinese-calendar-location-name "Beijing"
  "*Name of location used for calculation of Chinese calendar.")

67
(defvar chinese-calendar-daylight-time-offset 60
Edward M. Reingold's avatar
Edward M. Reingold committed
68
  "*Number of minutes difference between daylight savings and standard time
Edward M. Reingold's avatar
Edward M. Reingold committed
69
for Chinese calendar.")
Edward M. Reingold's avatar
Edward M. Reingold committed
70 71 72 73 74 75 76 77 78 79

(defvar chinese-calendar-standard-time-zone-name
  '(if (< year 1928)
       "PMT"
     "CST")
  "*Abbreviated name of standard time zone used for Chinese calendar.")

(defvar chinese-calendar-daylight-time-zone-name "CDT"
  "*Abbreviated name of daylight-savings time zone used for Chinese calendar.")

80 81 82 83
(defvar chinese-calendar-daylight-savings-starts
  '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10))
         ((= 1986 year) '(5 4 1986))
         (t nil))
Edward M. Reingold's avatar
Edward M. Reingold committed
84
  "*Sexp giving the date on which daylight savings time starts for Chinese
Edward M. Reingold's avatar
Edward M. Reingold committed
85
calendar.  See documentation of `calendar-daylight-savings-starts'.")
Edward M. Reingold's avatar
Edward M. Reingold committed
86

87 88
(defvar chinese-calendar-daylight-savings-ends
  '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11))
Edward M. Reingold's avatar
Edward M. Reingold committed
89
  "*Sexp giving the date on which daylight savings time ends for Chinese
Edward M. Reingold's avatar
Edward M. Reingold committed
90
calendar.  See documentation of `calendar-daylight-savings-ends'.")
Edward M. Reingold's avatar
Edward M. Reingold committed
91 92 93

(defvar chinese-calendar-daylight-savings-starts-time 0
  "*Number of minutes after midnight that daylight savings time starts for
Edward M. Reingold's avatar
Edward M. Reingold committed
94
Chinese calendar.")
Edward M. Reingold's avatar
Edward M. Reingold committed
95 96 97

(defvar chinese-calendar-daylight-savings-ends-time 0
  "*Number of minutes after midnight that daylight savings time ends for
Edward M. Reingold's avatar
Edward M. Reingold committed
98
Chinese calendar.")
Edward M. Reingold's avatar
Edward M. Reingold committed
99 100 101 102 103

(defun chinese-zodiac-sign-on-or-after (d)
  "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."
 (let* ((year (extract-calendar-year
Edward M. Reingold's avatar
Edward M. Reingold committed
104
                (calendar-gregorian-from-absolute d)))
Edward M. Reingold's avatar
Edward M. Reingold committed
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
         (calendar-time-zone (eval chinese-calendar-time-zone))
         (calendar-daylight-time-offset
          chinese-calendar-daylight-time-offset)
         (calendar-standard-time-zone-name
          chinese-calendar-standard-time-zone-name)
         (calendar-daylight-time-zone-name
          chinese-calendar-daylight-time-zone-name)
         (calendar-calendar-daylight-savings-starts
          chinese-calendar-daylight-savings-starts)
         (calendar-daylight-savings-ends
          chinese-calendar-daylight-savings-ends)
         (calendar-daylight-savings-starts-time
          chinese-calendar-daylight-savings-starts-time)
         (calendar-daylight-savings-ends-time
          chinese-calendar-daylight-savings-ends-time))
   (floor
    (calendar-absolute-from-astro
     (solar-date-next-longitude
      (calendar-astro-from-absolute d)
      30)))))

(defun chinese-new-moon-on-or-after (d)
  "Absolute date of first new moon on or after absolute date d."
  (let* ((year (extract-calendar-year
                (calendar-gregorian-from-absolute d)))
         (calendar-time-zone (eval chinese-calendar-time-zone))
         (calendar-daylight-time-offset
          chinese-calendar-daylight-time-offset)
         (calendar-standard-time-zone-name
          chinese-calendar-standard-time-zone-name)
         (calendar-daylight-time-zone-name
          chinese-calendar-daylight-time-zone-name)
         (calendar-calendar-daylight-savings-starts
          chinese-calendar-daylight-savings-starts)
         (calendar-daylight-savings-ends
          chinese-calendar-daylight-savings-ends)
         (calendar-daylight-savings-starts-time
          chinese-calendar-daylight-savings-starts-time)
         (calendar-daylight-savings-ends-time
          chinese-calendar-daylight-savings-ends-time))
    (floor
     (calendar-absolute-from-astro
      (lunar-new-moon-on-or-after
       (calendar-astro-from-absolute d))))))

Edward M. Reingold's avatar
Edward M. Reingold committed
150 151 152
(defvar chinese-year-cache
  '((1989 (12 . 726110) (1 . 726139) (2 . 726169) (3 . 726198) (4 . 726227)
          (5 . 726257) (6 . 726286) (7 . 726316) (8 . 726345) (9 . 726375)
153
 (10 . 726404) (11 . 726434))
Edward M. Reingold's avatar
Edward M. Reingold committed
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
    (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)))
  "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 1989-2000.  The code works just as well with this
set to nil initially (which is how the value for 1989-2000 was computed).")

(defun chinese-year (y)
  "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."
  (let ((list (cdr (assoc y chinese-year-cache))))
    (if (not list)
        (progn
          (setq list (compute-chinese-year y))
          (setq chinese-year-cache
                (append chinese-year-cache  (list (cons y list))))))
    list))

208
(defun number-chinese-months (list start)
Edward M. Reingold's avatar
Edward M. Reingold committed
209
  "Assign month numbers to the lunar months in LIST, starting with START.
210 211
Numbers are assigned sequentially, START, START+1, ..., 11, with half
numbers used for leap months.
Edward M. Reingold's avatar
Edward M. Reingold committed
212 213 214 215

If optional parameter NO-LEAP-MONTHS is true, just number the months
sequentially, ignoring the usual leap month rule.

216
First month of list will never be a leap month, nor will the last."
Edward M. Reingold's avatar
Edward M. Reingold committed
217
  (if list
218 219 220 221
      (if (zerop (- 12 start (length list)))
          ;; List is too short for a leap month
          (cons (cons start (car list))
                (number-chinese-months (cdr list) (1+ start)))
Edward M. Reingold's avatar
Edward M. Reingold committed
222
        (cons
223 224 225
         ;; First month
         (cons start (car list))
         ;; Remaining months
Edward M. Reingold's avatar
Edward M. Reingold committed
226 227 228
         (if (and (cdr (cdr list));; at least two more months...
                  (<= (car (cdr (cdr list)))
                      (chinese-zodiac-sign-on-or-after (car (cdr list)))))
229 230 231 232
             ;; Next month is a leap month
             (cons (cons (+ start 0.5) (car (cdr list)))
                   (number-chinese-months (cdr (cdr list)) (1+ start)))
           ;; Next month is not a leap month
Edward M. Reingold's avatar
Edward M. Reingold committed
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
           (number-chinese-months (cdr list) (1+ start)))))))

(defun chinese-month-list (start end)
  "List of starting dates of Chinese months from START to END."
  (if (<= start end)
      (let ((new-moon (chinese-new-moon-on-or-after start)))
        (if (<= new-moon end)
            (append (list new-moon)
                    (chinese-month-list (1+ new-moon) end))))))

(defun compute-chinese-year (y)
  "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."
  (let* ((next-solstice (chinese-zodiac-sign-on-or-after
                         (calendar-absolute-from-gregorian
                          (list 12 15 y))))
         (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after
                                        (calendar-absolute-from-gregorian
                                         (list 12 15 (1- y)))))
254 255
                                   next-solstice))
         (next-sign (chinese-zodiac-sign-on-or-after (car list))))
Edward M. Reingold's avatar
Edward M. Reingold committed
256 257
    (if (= (length list) 12)
        ;; No room for a leap month, just number them 12, 1, 2, ..., 11
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
        (cons (cons 12 (car list))
              (number-chinese-months (cdr list) 1))
      ;; Now we can assign numbers to the list for y
      ;; The first month or two are special
      (if (or (> (car list) next-sign) (>= next-sign (car (cdr list))))
          ;; First month on list is a leap month, second is not
          (append (list (cons 11.5 (car list))
                        (cons 12 (car (cdr list))))
                  (number-chinese-months (cdr (cdr list)) 1))
        ;; First month on list is not a leap month
        (append (list (cons 12 (car list)))
                (if (>= (chinese-zodiac-sign-on-or-after (car (cdr list)))
                        (car (cdr (cdr list))))
                    ;; Second month on list is a leap month
                    (list (cons 12.5 (car (cdr list)))
                          (number-chinese-months (cdr (cdr list)) 1))
                  ;; Second month on list is not a leap month
                  (number-chinese-months (cdr list) 1)))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
276

Edward M. Reingold's avatar
Edward M. Reingold committed
277 278 279 280 281 282 283 284
(defun calendar-absolute-from-chinese (date)
  "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."
  (let* ((cycle (car date))
         (year (car (cdr date)))
         (month (car (cdr (cdr date))))
         (day (car (cdr (cdr (cdr date)))))
         (g-year (+ (* (1- cycle) 60);; years in prior cycles
Edward M. Reingold's avatar
Edward M. Reingold committed
285 286 287 288 289 290 291
                    (1- year)        ;; prior years this cycle
                    -2636)))         ;; years before absolute date 0
    (+ (1- day);; prior days this month
       (cdr    ;; absolute date of start of this month
        (assoc month (append (memq (assoc 1 (chinese-year g-year))
                                       (chinese-year g-year))
                                 (chinese-year (1+ g-year))))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
292 293 294 295 296

(defun calendar-chinese-from-absolute (date)
  "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."
Edward M. Reingold's avatar
Edward M. Reingold committed
297 298 299 300 301 302 303 304 305 306 307 308 309 310
  (let* ((g-year (extract-calendar-year
                  (calendar-gregorian-from-absolute date)))
         (chinese-year (+ g-year 2695))
         (list (append (chinese-year (1- g-year))
                       (chinese-year g-year)
                       (chinese-year (1+ g-year)))))
    (while (<= (cdr (car (cdr list))) date)
      (if (= 1 (car (car (cdr list))))
          (setq chinese-year (1+ chinese-year)))
      (setq list (cdr list)))
    (list (/ (1- chinese-year) 60)
          (calendar-mod chinese-year 60)
          (car (car list))
          (1+ (- date (cdr (car list)))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
311 312 313 314 315 316 317 318 319

(defun holiday-chinese-new-year ()
  "Date of Chinese New Year."
  (let ((m displayed-month)
        (y displayed-year))
    (increment-calendar-month m y 1)
    (if (< m 5)
        (let ((chinese-new-year
               (calendar-gregorian-from-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
320
                (cdr (assoc 1 (chinese-year y))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
321
          (if (calendar-date-is-visible-p chinese-new-year)
322 323 324 325
          (list
           (list chinese-new-year
                 (format "Chinese New Year (%s)"
                         (calendar-chinese-sexagisimal-name (+ y 57))))))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
326 327 328 329 330 331 332 333 334 335 336 337 338 339

(defun calendar-chinese-date-string (&optional date)
  "String of Chinese date of Gregorian DATE.
Defaults to today's date if DATE is not given."
  (let* ((a-date (calendar-absolute-from-gregorian
                  (or date (calendar-current-date))))
         (c-date (calendar-chinese-from-absolute a-date))
         (cycle (car c-date))
         (year (car (cdr c-date)))
         (month (car (cdr (cdr c-date))))
         (day (car (cdr (cdr (cdr c-date)))))
         (this-month (calendar-absolute-from-chinese
                      (list cycle year month 1)))
         (next-month (calendar-absolute-from-chinese
340 341 342 343
                      (list (if (= year 60) (1+ cycle) cycle)
                            (if (= (floor month) 12) (1+ year) year)
                            (calendar-mod (1+ (floor month)) 12)
                            1)))
Edward M. Reingold's avatar
Edward M. Reingold committed
344
         (m-cycle (% (+ (* year 5) (floor month)) 60)))
345
    (format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)"
Edward M. Reingold's avatar
Edward M. Reingold committed
346
            cycle
347
            year (calendar-chinese-sexagisimal-name year)
Edward M. Reingold's avatar
Edward M. Reingold committed
348 349 350 351 352
            (if (not (integerp month))
                "second "
              (if (< 30 (- next-month this-month))
                  "first "
                ""))
Edward M. Reingold's avatar
Edward M. Reingold committed
353
            (floor month)
354 355 356 357 358 359 360 361 362 363 364 365 366
            (if (integerp month)
                (format " (%s)" (calendar-chinese-sexagisimal-name
                                 (+ (* 5 year) month 44)))
              "")
            day (calendar-chinese-sexagisimal-name (+ a-date 15)))))

(defun calendar-chinese-sexagisimal-name (n)
  "The N-th name of the Chinese sexagisimal 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."
  (format "%s-%s"
          (aref chinese-calendar-celestial-stem (% (1- n) 10))
          (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))
Edward M. Reingold's avatar
Edward M. Reingold committed
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382

(defun calendar-print-chinese-date ()
  "Show the Chinese date equivalents of date."
  (interactive)
  (message "Computing Chinese date...")
  (message "Chinese date: %s"
           (calendar-chinese-date-string (calendar-cursor-to-date t))))

(defun calendar-goto-chinese-date (date &optional noecho)
  "Move cursor to Chinese date DATE.
Echo Chinese date unless NOECHO is t."
  (interactive
   (let* ((c (calendar-chinese-from-absolute
              (calendar-absolute-from-gregorian
               (calendar-current-date))))
          (cycle (calendar-read
Edward M. Reingold's avatar
Edward M. Reingold committed
383
                  "Chinese calendar cycle number (>44): "
Edward M. Reingold's avatar
Edward M. Reingold committed
384 385 386
                  '(lambda (x) (> x 44))
                  (int-to-string (car c))))
          (year (calendar-read
Edward M. Reingold's avatar
Edward M. Reingold committed
387
                 "Year in Chinese cycle (1..60): "
Edward M. Reingold's avatar
Edward M. Reingold committed
388 389
                 '(lambda (x) (and (<= 1 x) (<= x 60)))
                 (int-to-string (car (cdr c)))))
Edward M. Reingold's avatar
Edward M. Reingold committed
390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
          (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))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
407 408 409 410 411
     (list (list cycle year month day))))
  (calendar-goto-date (calendar-gregorian-from-absolute
                       (calendar-absolute-from-chinese date)))
  (or noecho (calendar-print-chinese-date)))

Edward M. Reingold's avatar
Edward M. Reingold committed
412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444
(defun chinese-months (c y)
  "A list of the months in cycle C, year Y of the Chinese calendar."
  (let* ((l (memq 1 (append
                     (mapcar '(lambda (x)
                                (car x))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list c y 1 1))))))
                     (mapcar '(lambda (x)
                                (if (> (car x) 11) (car x)))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list (if (= y 60) (1+ c) c)
                                                    (if (= y 60) 1 y)
                                                    1 1))))))))))
    l))

(defun make-chinese-month-assoc-list (l)
  "Make list of months L into an assoc list."
  (if (and l (car l))
      (if (and (cdr l) (car (cdr l)))
          (if (= (car l) (floor (car (cdr l))))
              (append
               (list (cons (format "%s (first)" (car l)) (car l))
                     (cons (format "%s (second)" (car l)) (car (cdr l))))
               (make-chinese-month-assoc-list (cdr (cdr l))))
            (append
             (list (cons (int-to-string (car l)) (car l)))
             (make-chinese-month-assoc-list (cdr l))))
        (list (cons (int-to-string (car l)) (car l))))))

Edward M. Reingold's avatar
Edward M. Reingold committed
445 446 447 448 449 450 451
(defun diary-chinese-date ()
  "Chinese calendar equivalent of date diary entry."
  (format "Chinese date: %s" (calendar-chinese-date-string date)))

(provide 'cal-chinese)

;;; cal-chinese ends here