lisp/calendar/cal-china.el

   1 ;;; cal-china.el --- calendar functions for the Chinese calendar
   2
   3 ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
   7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
   8 ;; Keywords: calendar
   9 ;; Human-Keywords: Chinese calendar, calendar, holidays, diary
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This collection of functions implements the features of calendar.el,
  31 ;; diary.el, and holidays.el that deal with the Chinese calendar.  The rules
  32 ;; used for the Chinese calendar are those of Baolin Liu (see L. E. Doggett's
  33 ;; article "Calendars" in the Explanatory Supplement to the Astronomical
  34 ;; Almanac, second edition, 1992) for the calendar as revised at the beginning
  35 ;; of the Qing dynasty in 1644.  The nature of the astronomical calculations
  36 ;; is such that precise calculations cannot be made without great expense in
  37 ;; time, so that the calendars produced may not agree perfectly with published
  38 ;; tables--but no two pairs of published tables agree perfectly either!  Liu's
  39 ;; rules produce a calendar for 2033 which is not accepted by all authorities.
  40 ;; The date of Chinese New Year is correct from 1644-2051.
  41
  42 ;; Technical details of all the calendrical calculations can be found in
  43 ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
  44 ;; and Nachum Dershowitz, Cambridge University Press (2001).
  45
  46 ;;; Code:
  47
  48 (defvar date)
  49 (defvar displayed-month)
  50 (defvar displayed-year)
  51
  52 (require 'lunar)
  53
  54 (defvar chinese-calendar-celestial-stem
  55   ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])
  56
  57 (defvar chinese-calendar-terrestrial-branch
  58   ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
  59
  60 (defcustom chinese-calendar-time-zone
  61   '(if (< year 1928)
  62        (+ 465 (/ 40.0 60.0))
  63      480)
  64   "*Number of minutes difference between local standard time for Chinese
  65 calendar and Coordinated Universal (Greenwich) Time.  Default is for Beijing.
  66 This is an expression in `year' since it changed at 1928-01-01 00:00:00 from
  67 UT+7:45:40 to UT+8."
  68   :type 'sexp
  69   :group 'chinese-calendar)
  70
  71 (defcustom chinese-calendar-location-name "Beijing"
  72   "*Name of location used for calculation of Chinese calendar."
  73   :type 'string
  74   :group 'chinese-calendar)
  75
  76 (defcustom chinese-calendar-daylight-time-offset 0
  77 ; The correct value is as follows, but the Chinese calendrical
  78 ; authorities do NOT use DST in determining astronomical events:
  79 ;  60
  80   "*Number of minutes difference between daylight saving and standard time
  81 for Chinese calendar.  Default is for no daylight saving time."
  82   :type 'integer
  83   :group 'chinese-calendar)
  84
  85 (defcustom chinese-calendar-standard-time-zone-name
  86   '(if (< year 1928)
  87        "PMT"
  88      "CST")
  89   "*Abbreviated name of standard time zone used for Chinese calendar.
  90 This is an expression depending on `year' because it changed
  91 at 1928-01-01 00:00:00 from `PMT' to `CST'."
  92   :type 'sexp
  93   :group 'chinese-calendar)
  94
  95 (defcustom chinese-calendar-daylight-time-zone-name "CDT"
  96   "*Abbreviated name of daylight saving time zone used for Chinese calendar."
  97   :type 'string
  98   :group 'chinese-calendar)
  99
 100 (defcustom chinese-calendar-daylight-savings-starts nil
 101 ; The correct value is as follows, but the Chinese calendrical
 102 ; authorities do NOT use DST in determining astronomical events:
 103 ;  '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10))
 104 ;         ((= 1986 year) '(5 4 1986))
 105 ;         (t nil))
 106   "*Sexp giving the date on which daylight saving time starts for Chinese
 107 calendar.  Default is for no daylight saving time.  See documentation of
 108 `calendar-daylight-savings-starts'."
 109   :type 'sexp
 110   :group 'chinese-calendar)
 111
 112 (defcustom chinese-calendar-daylight-savings-ends nil
 113 ; The correct value is as follows, but the Chinese calendrical
 114 ; authorities do NOT use DST in determining astronomical events:
 115 ;  '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11))
 116   "*Sexp giving the date on which daylight saving time ends for Chinese
 117 calendar.  Default is for no daylight saving time.  See documentation of
 118 `calendar-daylight-savings-ends'."
 119   :type 'sexp
 120   :group 'chinese-calendar)
 121
 122 (defcustom chinese-calendar-daylight-savings-starts-time 0
 123   "*Number of minutes after midnight that daylight saving time starts for
 124 Chinese calendar.  Default is for no daylight saving time."
 125   :type 'integer
 126   :group 'chinese-calendar)
 127
 128 (defcustom chinese-calendar-daylight-savings-ends-time 0
 129   "*Number of minutes after midnight that daylight saving time ends for
 130 Chinese calendar.  Default is for no daylight saving time."
 131   :type 'integer
 132   :group 'chinese-calendar)
 133
 134 (defun chinese-zodiac-sign-on-or-after (d)
 135   "Absolute date of first new Zodiac sign on or after absolute date d.
 136 The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
 137  (let* ((year (extract-calendar-year
 138                 (calendar-gregorian-from-absolute d)))
 139          (calendar-time-zone (eval chinese-calendar-time-zone))
 140          (calendar-daylight-time-offset
 141           chinese-calendar-daylight-time-offset)
 142          (calendar-standard-time-zone-name
 143           chinese-calendar-standard-time-zone-name)
 144          (calendar-daylight-time-zone-name
 145           chinese-calendar-daylight-time-zone-name)
 146          (calendar-calendar-daylight-savings-starts
 147           chinese-calendar-daylight-savings-starts)
 148          (calendar-daylight-savings-ends
 149           chinese-calendar-daylight-savings-ends)
 150          (calendar-daylight-savings-starts-time
 151           chinese-calendar-daylight-savings-starts-time)
 152          (calendar-daylight-savings-ends-time
 153           chinese-calendar-daylight-savings-ends-time))
 154    (floor
 155     (calendar-absolute-from-astro
 156      (solar-date-next-longitude
 157       (calendar-astro-from-absolute d)
 158       30)))))
 159
 160 (defun chinese-new-moon-on-or-after (d)
 161   "Absolute date of first new moon on or after absolute date d."
 162   (let* ((year (extract-calendar-year
 163                 (calendar-gregorian-from-absolute d)))
 164          (calendar-time-zone (eval chinese-calendar-time-zone))
 165          (calendar-daylight-time-offset
 166           chinese-calendar-daylight-time-offset)
 167          (calendar-standard-time-zone-name
 168           chinese-calendar-standard-time-zone-name)
 169          (calendar-daylight-time-zone-name
 170           chinese-calendar-daylight-time-zone-name)
 171          (calendar-calendar-daylight-savings-starts
 172           chinese-calendar-daylight-savings-starts)
 173          (calendar-daylight-savings-ends
 174           chinese-calendar-daylight-savings-ends)
 175          (calendar-daylight-savings-starts-time
 176           chinese-calendar-daylight-savings-starts-time)
 177          (calendar-daylight-savings-ends-time
 178           chinese-calendar-daylight-savings-ends-time))
 179     (floor
 180      (calendar-absolute-from-astro
 181       (lunar-new-moon-on-or-after
 182        (calendar-astro-from-absolute d))))))
 183
 184 (defvar chinese-year-cache
 185   '((1990 (12 726464) (1 726494) (2 726523) (3 726553) (4 726582) (5 726611)
 186           (5.5 726641) (6 726670) (7 726699) (8 726729) (9 726758) (10 726788)
 187           (11 726818))
 188     (1991 (12 726848) (1 726878) (2 726907) (3 726937) (4 726966) (5 726995)
 189           (6 727025) (7 727054) (8 727083) (9 727113) (10 727142) (11 727172))
 190     (1992 (12 727202) (1 727232) (2 727261) (3 727291) (4 727321) (5 727350)
 191           (6 727379) (7 727409) (8 727438) (9 727467) (10 727497) (11 727526))
 192     (1993 (12 727556) (1 727586) (2 727615) (3 727645) (3.5 727675) (4 727704)
 193           (5 727734) (6 727763) (7 727793) (8 727822) (9 727851) (10 727881)
 194           (11 727910))
 195     (1994 (12 727940) (1 727969) (2 727999) (3 728029) (4 728059) (5 728088)
 196           (6 728118) (7 728147) (8 728177) (9 728206) (10 728235) (11 728265))
 197     (1995 (12 728294) (1 728324) (2 728353) (3 728383) (4 728413) (5 728442)
 198           (6 728472) (7 728501) (8 728531) (8.5 728561) (9 728590) (10 728619)
 199           (11 728649))
 200     (1996 (12 728678) (1 728708) (2 728737) (3 728767) (4 728796) (5 728826)
 201           (6 728856) (7 728885) (8 728915) (9 728944) (10 728974) (11 729004))
 202     (1997 (12 729033) (1 729062) (2 729092) (3 729121) (4 729151) (5 729180)
 203           (6 729210) (7 729239) (8 729269) (9 729299) (10 729328) (11 729358))
 204     (1998 (12 729388) (1 729417) (2 729447) (3 729476) (4 729505) (5 729535)
 205           (5.5 729564) (6 729593) (7 729623) (8 729653) (9 729682) (10 729712)
 206           (11 729742))
 207     (1999 (12 729771) (1 729801) (2 729831) (3 729860) (4 729889) (5 729919)
 208           (6 729948) (7 729977) (8 730007) (9 730036) (10 730066) (11 730096))
 209     (2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273)
 210           (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450))
 211     (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628)
 212           (5 730657) (6 730687) (7 730716) (8 730745) (9 730775) (10 730804)
 213           (11 730834))
 214     (2002 (12 730863) (1 730893) (2 730923) (3 730953) (4 730982) (5 731012)
 215           (6 731041) (7 731071) (8 731100) (9 731129) (10 731159) (11 731188))
 216     (2003 (12 731218) (1 731247) (2 731277) (3 731307) (4 731336) (5 731366)
 217           (6 731396) (7 731425) (8 731455) (9 731484) (10 731513) (11 731543))
 218     (2004 (12 731572) (1 731602) (2 731631) (2.5 731661) (3 731690) (4 731720)
 219           (5 731750) (6 731779) (7 731809) (8 731838) (9 731868) (10 731897)
 220           (11 731927))
 221     (2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104)
 222           (6 732133) (7 732163) (8 732193) (9 732222) (10 732252) (11 732281))
 223     (2006 (12 732311) (1 732340) (2 732370) (3 732399) (4 732429) (5 732458)
 224           (6 732488) (7 732517) (7.5 732547) (8 732576) (9 732606) (10 732636)
 225           (11 732665))
 226     (2007 (12 732695) (1 732725) (2 732754) (3 732783) (4 732813) (5 732842)
 227           (6 732871) (7 732901) (8 732930) (9 732960) (10 732990) (11 733020))
 228     (2008 (12 733049) (1 733079) (2 733109) (3 733138) (4 733167) (5 733197)
 229           (6 733226) (7 733255) (8 733285) (9 733314) (10 733344) (11 733374))
 230     (2009 (12 733403) (1 733433) (2 733463) (3 733493) (4 733522) (5 733551)
 231           (5.5 733581) (6 733610) (7 733639) (8 733669) (9 733698) (10 733728)
 232           (11 733757))
 233     (2010 (12 733787) (1 733817) (2 733847) (3 733876) (4 733906) (5 733935)
 234           (6 733965) (7 733994) (8 734023) (9 734053) (10 734082) (11 734112)))
 235   "An assoc list of Chinese year structures as determined by `chinese-year'.
 236
 237 Values are computed as needed, but to save time, the initial value consists
 238 of the precomputed years 1990-2010.  The code works just as well with this
 239 set to nil initially (which is how the value for 1990-2010 was computed).")
 240
 241 (defun chinese-year (y)
 242   "The structure of the Chinese year for Gregorian year Y.
 243 The result is a list of pairs (i d), where month i begins on absolute date d,
 244 of the Chinese months from the Chinese month following the solstice in
 245 Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y.
 246
 247 The list is cached for further use."
 248   (let ((list (cdr (assoc y chinese-year-cache))))
 249     (if (not list)
 250         (progn
 251           (setq list (compute-chinese-year y))
 252           (setq chinese-year-cache
 253                 (append chinese-year-cache (list (cons y list))))))
 254     list))
 255
 256 (defun number-chinese-months (list start)
 257   "Assign month numbers to the lunar months in LIST, starting with START.
 258 Numbers are assigned sequentially, START, START+1, ..., 11, with half
 259 numbers used for leap months.
 260
 261 First month of list will never be a leap month, nor will the last."
 262   (if list
 263       (if (zerop (- 12 start (length list)))
 264           ;; List is too short for a leap month
 265           (cons (list start (car list))
 266                 (number-chinese-months (cdr list) (1+ start)))
 267         (cons
 268          ;; First month
 269          (list start (car list))
 270          ;; Remaining months
 271          (if (and (cdr (cdr list));; at least two more months...
 272                   (<= (car (cdr (cdr list)))
 273                       (chinese-zodiac-sign-on-or-after (car (cdr list)))))
 274              ;; Next month is a leap month
 275              (cons (list (+ start 0.5) (car (cdr list)))
 276                    (number-chinese-months (cdr (cdr list)) (1+ start)))
 277            ;; Next month is not a leap month
 278            (number-chinese-months (cdr list) (1+ start)))))))
 279
 280 (defun chinese-month-list (start end)
 281   "List of starting dates of Chinese months from START to END."
 282   (if (<= start end)
 283       (let ((new-moon (chinese-new-moon-on-or-after start)))
 284         (if (<= new-moon end)
 285             (cons new-moon
 286                   (chinese-month-list (1+ new-moon) end))))))
 287
 288 (defun compute-chinese-year (y)
 289   "Compute the structure of the Chinese year for Gregorian year Y.
 290 The result is a list of pairs (i d), where month i begins on absolute date d,
 291 of the Chinese months from the Chinese month following the solstice in
 292 Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
 293   (let* ((next-solstice (chinese-zodiac-sign-on-or-after
 294                          (calendar-absolute-from-gregorian
 295                           (list 12 15 y))))
 296          (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after
 297                                         (calendar-absolute-from-gregorian
 298                                          (list 12 15 (1- y)))))
 299                                    next-solstice))
 300          (next-sign (chinese-zodiac-sign-on-or-after (car list))))
 301     (if (= (length list) 12)
 302         ;; No room for a leap month, just number them 12, 1, 2, ..., 11
 303         (cons (list 12 (car list))
 304               (number-chinese-months (cdr list) 1))
 305       ;; Now we can assign numbers to the list for y
 306       ;; The first month or two are special
 307       (if (or (> (car list) next-sign) (>= next-sign (car (cdr list))))
 308           ;; First month on list is a leap month, second is not
 309           (append (list (list 11.5 (car list))
 310                         (list 12 (car (cdr list))))
 311                   (number-chinese-months (cdr (cdr list)) 1))
 312         ;; First month on list is not a leap month
 313         (append (list (list 12 (car list)))
 314                 (if (>= (chinese-zodiac-sign-on-or-after (car (cdr list)))
 315                         (car (cdr (cdr list))))
 316                     ;; Second month on list is a leap month
 317                     (cons (list 12.5 (car (cdr list)))
 318                           (number-chinese-months (cdr (cdr list)) 1))
 319                   ;; Second month on list is not a leap month
 320                   (number-chinese-months (cdr list) 1)))))))
 321
 322 (defun calendar-absolute-from-chinese (date)
 323   "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
 324 The Gregorian date Sunday, December 31, 1 BC is imaginary."
 325   (let* ((cycle (car date))
 326          (year (car (cdr date)))
 327          (month (car (cdr (cdr date))))
 328          (day (car (cdr (cdr (cdr date)))))
 329          (g-year (+ (* (1- cycle) 60);; years in prior cycles
 330                     (1- year)        ;; prior years this cycle
 331                     -2636)))         ;; years before absolute date 0
 332     (+ (1- day);; prior days this month
 333        (car
 334         (cdr    ;; absolute date of start of this month
 335          (assoc month (append (memq (assoc 1 (chinese-year g-year))
 336                                     (chinese-year g-year))
 337                               (chinese-year (1+ g-year)))))))))
 338
 339 (defun calendar-chinese-from-absolute (date)
 340   "Compute Chinese date (cycle year month day) corresponding to absolute DATE.
 341 The absolute date is the number of days elapsed since the (imaginary)
 342 Gregorian date Sunday, December 31, 1 BC."
 343   (let* ((g-year (extract-calendar-year
 344                   (calendar-gregorian-from-absolute date)))
 345          (c-year (+ g-year 2695))
 346          (list (append (chinese-year (1- g-year))
 347                        (chinese-year g-year)
 348                        (chinese-year (1+ g-year)))))
 349     (while (<= (car (cdr (car (cdr list)))) date)
 350       ;; the first month on the list is in Chinese year c-year
 351       ;; date is on or after start of second month on list...
 352       (if (= 1 (car (car (cdr list))))
 353           ;; second month on list is a new Chinese year
 354           (setq c-year (1+ c-year)))
 355       ;; ...so first month on list is of no interest
 356       (setq list (cdr list)))
 357     (list (/ (1- c-year) 60)
 358           (calendar-mod c-year 60)
 359           (car (car list))
 360           (1+ (- date (car (cdr (car list))))))))
 361
 362 (defun holiday-chinese-new-year ()
 363   "Date of Chinese New Year."
 364   (let ((m displayed-month)
 365         (y displayed-year))
 366     (increment-calendar-month m y 1)
 367     (if (< m 5)
 368         (let ((chinese-new-year
 369                (calendar-gregorian-from-absolute
 370                 (car (cdr (assoc 1 (chinese-year y)))))))
 371           (if (calendar-date-is-visible-p chinese-new-year)
 372           (list
 373            (list chinese-new-year
 374                  (format "Chinese New Year (%s)"
 375                          (calendar-chinese-sexagesimal-name (+ y 57))))))))))
 376
 377 (defun calendar-chinese-date-string (&optional date)
 378   "String of Chinese date of Gregorian DATE.
 379 Defaults to today's date if DATE is not given."
 380   (let* ((a-date (calendar-absolute-from-gregorian
 381                   (or date (calendar-current-date))))
 382          (c-date (calendar-chinese-from-absolute a-date))
 383          (cycle (car c-date))
 384          (year (car (cdr c-date)))
 385          (month (car (cdr (cdr c-date))))
 386          (day (car (cdr (cdr (cdr c-date)))))
 387          (this-month (calendar-absolute-from-chinese
 388                       (list cycle year month 1)))
 389          (next-month (calendar-absolute-from-chinese
 390                       (list (if (= year 60) (1+ cycle) cycle)
 391                             (if (= (floor month) 12) (1+ year) year)
 392                             (calendar-mod (1+ (floor month)) 12)
 393                             1)))
 394          (m-cycle (% (+ (* year 5) (floor month)) 60)))
 395     (format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)"
 396             cycle
 397             year (calendar-chinese-sexagesimal-name year)
 398             (if (not (integerp month))
 399                 "second "
 400               (if (< 30 (- next-month this-month))
 401                   "first "
 402                 ""))
 403             (floor month)
 404             (if (integerp month)
 405                 (format " (%s)" (calendar-chinese-sexagesimal-name
 406                                  (+ (* 12 year) month 50)))
 407               "")
 408             day (calendar-chinese-sexagesimal-name (+ a-date 15)))))
 409
 410 (defun calendar-chinese-sexagesimal-name (n)
 411   "The N-th name of the Chinese sexagesimal cycle.
 412 N congruent to 1 gives the first name, N congruent to 2 gives the second name,
 413 ..., N congruent to 60 gives the sixtieth name."
 414   (format "%s-%s"
 415           (aref chinese-calendar-celestial-stem (% (1- n) 10))
 416           (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))
 417
 418 (defun calendar-print-chinese-date ()
 419   "Show the Chinese date equivalents of date."
 420   (interactive)
 421   (message "Computing Chinese date...")
 422   (message "Chinese date: %s"
 423            (calendar-chinese-date-string (calendar-cursor-to-date t))))
 424
 425 (defun calendar-goto-chinese-date (date &optional noecho)
 426   "Move cursor to Chinese date DATE.
 427 Echo Chinese date unless NOECHO is t."
 428   (interactive
 429    (let* ((c (calendar-chinese-from-absolute
 430               (calendar-absolute-from-gregorian
 431                (calendar-current-date))))
 432           (cycle (calendar-read
 433                   "Chinese calendar cycle number (>44): "
 434                   '(lambda (x) (> x 44))
 435                   (int-to-string (car c))))
 436           (year (calendar-read
 437                  "Year in Chinese cycle (1..60): "
 438                  '(lambda (x) (and (<= 1 x) (<= x 60)))
 439                  (int-to-string (car (cdr c)))))
 440           (month-list (make-chinese-month-assoc-list
 441                        (chinese-months cycle year)))
 442           (month (cdr (assoc
 443                        (completing-read "Chinese calendar month: "
 444                                         month-list nil t)
 445                        month-list)))
 446           (last (if (= month
 447                        (car (cdr (cdr
 448                                   (calendar-chinese-from-absolute
 449                                    (+ 29
 450                                       (calendar-absolute-from-chinese
 451                                        (list cycle year month 1))))))))
 452                     30
 453                   29))
 454           (day (calendar-read
 455                 (format "Chinese calendar day (1-%d): " last)
 456                 '(lambda (x) (and (<= 1 x) (<= x last))))))
 457      (list (list cycle year month day))))
 458   (calendar-goto-date (calendar-gregorian-from-absolute
 459                        (calendar-absolute-from-chinese date)))
 460   (or noecho (calendar-print-chinese-date)))
 461
 462 (defun chinese-months (c y)
 463   "A list of the months in cycle C, year Y of the Chinese calendar."
 464   (let* ((l (memq 1 (append
 465                      (mapcar '(lambda (x)
 466                                 (car x))
 467                              (chinese-year (extract-calendar-year
 468                                             (calendar-gregorian-from-absolute
 469                                              (calendar-absolute-from-chinese
 470                                               (list c y 1 1))))))
 471                      (mapcar '(lambda (x)
 472                                 (if (> (car x) 11) (car x)))
 473                              (chinese-year (extract-calendar-year
 474                                             (calendar-gregorian-from-absolute
 475                                              (calendar-absolute-from-chinese
 476                                               (list (if (= y 60) (1+ c) c)
 477                                                     (if (= y 60) 1 y)
 478                                                     1 1))))))))))
 479     l))
 480
 481 (defun make-chinese-month-assoc-list (l)
 482   "Make list of months L into an assoc list."
 483   (if (and l (car l))
 484       (if (and (cdr l) (car (cdr l)))
 485           (if (= (car l) (floor (car (cdr l))))
 486               (append
 487                (list (cons (format "%s (first)" (car l)) (car l))
 488                      (cons (format "%s (second)" (car l)) (car (cdr l))))
 489                (make-chinese-month-assoc-list (cdr (cdr l))))
 490             (append
 491              (list (cons (int-to-string (car l)) (car l)))
 492              (make-chinese-month-assoc-list (cdr l))))
 493         (list (cons (int-to-string (car l)) (car l))))))
 494
 495 (defun diary-chinese-date ()
 496   "Chinese calendar equivalent of date diary entry."
 497   (format "Chinese date: %s" (calendar-chinese-date-string date)))
 498
 499 (provide 'cal-china)
 500
 501 ;;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
 502 ;;; cal-china.el ends here