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