code.delx.au - gnu-emacs/blob - lisp/calendar/cal-china.el

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