13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
1 ;;; cal-chinese.el --- calendar functions for the Chinese calendar.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
2
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
4
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
6 ;; Keywords: calendar
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
7 ;; Human-Keywords: Chinese calendar, calendar, holidays, diary
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
8
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
9 ;; This file is part of GNU Emacs.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
10
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
14 ;; any later version.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
15
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
19 ;; GNU General Public License for more details.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
20
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
24
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
25 ;;; Commentary:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
26
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
27 ;; This collection of functions implements the features of calendar.el,
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
28 ;; diary.el, and holidays.el that deal with the Chinese calendar. It was
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
29 ;; written by
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
30
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
31 ;; Edward M. Reingold Department of Computer Science
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
32 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
33 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
34 ;; Urbana, Illinois 61801
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
35
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
36 ;;; Code:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
37
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
38 (require 'lunar)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
39
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
40 (defvar chinese-calendar-terrestrial-branch
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
41 ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
42
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
43 (defvar chinese-calendar-celestial-stem
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
44 ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
45
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
46 (defvar chinese-calendar-time-zone
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
47 '(if (< year 1928)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
48 (+ 465 (/ 40.0 60.0))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
49 480)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
50 "*Number of minutes difference between local standard time for Chinese
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
51 calendar and Coordinated Universal (Greenwich) Time. Default is for Beijing.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
52 This is an expression in `year' since it changed at 1928-01-01 00:00:00 from
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
53 UT+7:45:40 to UT+8.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
54
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
55 (defvar chinese-calendar-location-name "Beijing"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
56 "*Name of location used for calculation of Chinese calendar.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
57
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
58 (defvar chinese-calendar-daylight-time-offset 0
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
59 ; The correct value is as follows, but I don't believe the Chinese calendrical
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
60 ; authorities would use DST in determining astronomical events:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
61 ; 60
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
62 "*Number of minutes difference between daylight savings and standard time
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
63 for Chinese calendar. Default is for no daylight savings time.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
64
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
65 (defvar chinese-calendar-standard-time-zone-name
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
66 '(if (< year 1928)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
67 "PMT"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
68 "CST")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
69 "*Abbreviated name of standard time zone used for Chinese calendar.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
70
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
71 (defvar chinese-calendar-daylight-time-zone-name "CDT"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
72 "*Abbreviated name of daylight-savings time zone used for Chinese calendar.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
73
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
74 (defvar chinese-calendar-daylight-savings-starts nil
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
75 ; The correct value is as follows, but I don't believe the Chinese calendrical
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
76 ; authorities would use DST in determining astronomical events:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
77 ; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
78 ; ((= 1986 year) '(5 4 1986))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
79 ; (t nil))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
80 "*Sexp giving the date on which daylight savings time starts for Chinese
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
81 calendar. Default is for no daylight savings time. See documentation of
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
82 `calendar-daylight-savings-starts'.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
83
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
84 (defvar chinese-calendar-daylight-savings-ends nil
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
85 ; The correct value is as follows, but I don't believe the Chinese calendrical
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
86 ; authorities would use DST in determining astronomical events:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
87 ; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
88 "*Sexp giving the date on which daylight savings time ends for Chinese
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
89 calendar. Default is for no daylight savings time. See documentation of
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
90 `calendar-daylight-savings-ends'.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
91
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
92 (defvar chinese-calendar-daylight-savings-starts-time 0
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
93 "*Number of minutes after midnight that daylight savings time starts for
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
94 Chinese calendar. Default is for no daylight savings time.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
95
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
96 (defvar chinese-calendar-daylight-savings-ends-time 0
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
97 "*Number of minutes after midnight that daylight savings time ends for
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
98 Chinese calendar. Default is for no daylight savings time.")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
99
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
100 (defun chinese-zodiac-sign-on-or-after (d)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
101 "Absolute date of first new Zodiac sign on or after absolute date d.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
102 The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
103 (let* ((year (extract-calendar-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
104 (calendar-gregorian-from-absolute
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
105 (floor (calendar-absolute-from-astro d)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
106 (calendar-time-zone (eval chinese-calendar-time-zone))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
107 (calendar-daylight-time-offset
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
108 chinese-calendar-daylight-time-offset)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
109 (calendar-standard-time-zone-name
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
110 chinese-calendar-standard-time-zone-name)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
111 (calendar-daylight-time-zone-name
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
112 chinese-calendar-daylight-time-zone-name)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
113 (calendar-calendar-daylight-savings-starts
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
114 chinese-calendar-daylight-savings-starts)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
115 (calendar-daylight-savings-ends
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
116 chinese-calendar-daylight-savings-ends)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
117 (calendar-daylight-savings-starts-time
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
118 chinese-calendar-daylight-savings-starts-time)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
119 (calendar-daylight-savings-ends-time
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
120 chinese-calendar-daylight-savings-ends-time))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
121 (floor
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
122 (calendar-absolute-from-astro
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
123 (solar-date-next-longitude
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
124 (calendar-astro-from-absolute d)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
125 30)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
126
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
127 (defun chinese-new-moon-on-or-after (d)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
128 "Absolute date of first new moon on or after absolute date d."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
129 (let* ((year (extract-calendar-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
130 (calendar-gregorian-from-absolute d)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
131 (calendar-time-zone (eval chinese-calendar-time-zone))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
132 (calendar-daylight-time-offset
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
133 chinese-calendar-daylight-time-offset)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
134 (calendar-standard-time-zone-name
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
135 chinese-calendar-standard-time-zone-name)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
136 (calendar-daylight-time-zone-name
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
137 chinese-calendar-daylight-time-zone-name)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
138 (calendar-calendar-daylight-savings-starts
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
139 chinese-calendar-daylight-savings-starts)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
140 (calendar-daylight-savings-ends
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
141 chinese-calendar-daylight-savings-ends)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
142 (calendar-daylight-savings-starts-time
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
143 chinese-calendar-daylight-savings-starts-time)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
144 (calendar-daylight-savings-ends-time
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
145 chinese-calendar-daylight-savings-ends-time))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
146 (floor
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
147 (calendar-absolute-from-astro
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
148 (lunar-new-moon-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
149 (calendar-astro-from-absolute d))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
150
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
151 (defun calendar-absolute-from-chinese (date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
152 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
153 The Gregorian date Sunday, December 31, 1 BC is imaginary."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
154 (let* ((cycle (car date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
155 (year (car (cdr date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
156 (month (car (cdr (cdr date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
157 (day (car (cdr (cdr (cdr date)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
158 (g-year (+ (* (1- cycle) 60);; years in prior cycles
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
159 (1- year);; prior years this cycle
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
160 -2636));; years before absolute date 0
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
161 (new-year (chinese-new-year g-year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
162 (current-month new-year)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
163 (current-month-number 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
164 (next-month (chinese-new-moon-on-or-after (1+ new-year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
165 (next-sign (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
166 (1+ (chinese-zodiac-sign-on-or-after current-month))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
167 (had-leap-month nil))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
168 (while (< current-month-number month)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
169 ;; current-month < next-month <= next-sign
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
170 (setq current-month next-month)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
171 (setq next-month (chinese-new-moon-on-or-after (1+ current-month)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
172 (if (and (<= next-month next-sign) (not had-leap-month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
173 (progn;; leap month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
174 (setq current-month-number (+ current-month-number 0.5))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
175 (setq had-leap-month t))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
176 (setq current-month-number (floor (1+ current-month-number)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
177 (setq next-sign (chinese-zodiac-sign-on-or-after (1+ next-sign)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
178 (+ current-month (1- day))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
179
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
180 (defun calendar-chinese-from-absolute (date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
181 "Compute Chinese date (cycle year month day) corresponding to absolute DATE.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
182 The absolute date is the number of days elapsed since the (imaginary)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
183 Gregorian date Sunday, December 31, 1 BC."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
184 (let* ((greg-date (calendar-gregorian-from-absolute date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
185 (greg-year (1- (extract-calendar-year greg-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
186 (greg-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
187 (+ greg-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
188 (calendar-sum y greg-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
189 (>= date (chinese-new-year (1+ y))) 1)) )
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
190 (chinese-year (+ greg-year 2697))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
191 (cycle (/ (1- chinese-year) 60)) ;; previous cycles
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
192 (year (calendar-mod chinese-year 60));; years this cycle
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
193 (current-month (chinese-new-year greg-year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
194 (month 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
195 (next-month (chinese-new-moon-on-or-after (1+ current-month)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
196 (next-sign (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
197 (1+ (chinese-zodiac-sign-on-or-after current-month))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
198 (had-leap-month nil))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
199 (while (<= next-month date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
200 ;; current-month < next-month <= next-sign
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
201 (setq current-month next-month)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
202 (setq next-month (chinese-new-moon-on-or-after (1+ current-month)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
203 (if (and (<= next-month next-sign) (not had-leap-month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
204 (progn;; leap month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
205 (setq month (+ month 0.5))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
206 (setq had-leap-month t))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
207 (setq month (floor (1+ month)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
208 (setq next-sign (chinese-zodiac-sign-on-or-after (1+ next-sign)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
209 (list cycle year month (1+ (- date current-month)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
210
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
211 (defun chinese-new-year (year)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
212 "The absolute date of Chinese New Year in Gregorian YEAR."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
213 (let* ((last-solstice (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
214 (calendar-absolute-from-gregorian
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
215 (list 12 15 (1- year)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
216 (twelfth-new-moon;; twelfth month of previous year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
217 (chinese-new-moon-on-or-after (1+ last-solstice)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
218 (thirteenth-new-moon;; maybe leap month, maybe New Year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
219 (chinese-new-moon-on-or-after (1+ twelfth-new-moon)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
220 (fourteenth-new-moon;; maybe New Year, maybe second month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
221 (chinese-new-moon-on-or-after (1+ thirteenth-new-moon)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
222 (next-solstice (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
223 (calendar-absolute-from-gregorian (list 12 15 year))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
224 (new-moons (+ 3 (calendar-sum m 0
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
225 (< (chinese-new-moon-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
226 (+ fourteenth-new-moon (* 29 m)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
227 next-solstice)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
228 1))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
229 (if (and (= new-moons 14)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
230 (< (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
231 (calendar-absolute-from-gregorian (list 2 15 year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
232 thirteenth-new-moon)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
233 (<= fourteenth-new-moon
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
234 (chinese-zodiac-sign-on-or-after
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
235 (calendar-absolute-from-gregorian (list 3 15 year)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
236 fourteeth-new-moon
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
237 thirteenth-new-moon)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
238
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
239 (defun holiday-chinese-new-year ()
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
240 "Date of Chinese New Year."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
241 (let ((m displayed-month)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
242 (y displayed-year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
243 (increment-calendar-month m y 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
244 (if (< m 5)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
245 (let ((chinese-new-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
246 (calendar-gregorian-from-absolute
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
247 (chinese-new-year y))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
248 (if (calendar-date-is-visible-p chinese-new-year)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
249 (list (list chinese-new-year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
250 (format "Chinese New Year (%s-%s)"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
251 (aref chinese-calendar-celestial-stem
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
252 (% (+ y 6) 10))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
253 (aref chinese-calendar-terrestrial-branch
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
254 (% (+ y 8) 12))))))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
255
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
256 (defun calendar-chinese-date-string (&optional date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
257 "String of Chinese date of Gregorian DATE.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
258 Defaults to today's date if DATE is not given."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
259 (let* ((a-date (calendar-absolute-from-gregorian
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
260 (or date (calendar-current-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
261 (c-date (calendar-chinese-from-absolute a-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
262 (cycle (car c-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
263 (year (car (cdr c-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
264 (month (car (cdr (cdr c-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
265 (day (car (cdr (cdr (cdr c-date)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
266 (this-month (calendar-absolute-from-chinese
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
267 (list cycle year month 1)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
268 (next-month (calendar-absolute-from-chinese
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
269 (list cycle year (1+ month) 1)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
270 (month (floor month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
271 (m-cycle (% (+ (* year 5) month) 60)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
272 (format "Cycle %s, year %s (%s-%s), %smonth %s, day %s (%s-%s)"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
273 cycle
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
274 year
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
275 (aref chinese-calendar-celestial-stem (% (+ year 9) 10))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
276 (aref chinese-calendar-terrestrial-branch (% (+ year 11) 12))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
277 (if (not (integerp month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
278 "second "
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
279 (if (< 30 (- next-month this-month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
280 "first "
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
281 ""))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
282 month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
283 day
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
284 (aref chinese-calendar-celestial-stem (% (+ a-date 4) 10))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
285 (aref chinese-calendar-terrestrial-branch (% (+ a-date 2) 12)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
286
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
287 (defun calendar-print-chinese-date ()
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
288 "Show the Chinese date equivalents of date."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
289 (interactive)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
290 (message "Computing Chinese date...")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
291 (message "Chinese date: %s"
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
292 (calendar-chinese-date-string (calendar-cursor-to-date t))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
293
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
294 (defun calendar-goto-chinese-date (date &optional noecho)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
295 "Move cursor to Chinese date DATE.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
296 Echo Chinese date unless NOECHO is t."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
297 (interactive
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
298 (let* ((c (calendar-chinese-from-absolute
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
299 (calendar-absolute-from-gregorian
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
300 (calendar-current-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
301 (cycle (calendar-read
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
302 "Cycle number (>44): "
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
303 '(lambda (x) (> x 44))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
304 (int-to-string (car c))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
305 (year (calendar-read
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
306 "Year in cycle (1..60): "
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
307 '(lambda (x) (and (<= 1 x) (<= x 60)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
308 (int-to-string (car (cdr c)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
309 (month (read-minibuffer "Month: "))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
310 (day (read-minibuffer "Day: ")))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
311 (list (list cycle year month day))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
312 (calendar-goto-date (calendar-gregorian-from-absolute
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
313 (calendar-absolute-from-chinese date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
314 (or noecho (calendar-print-chinese-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
315
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
316 (defun diary-chinese-date ()
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
317 "Chinese calendar equivalent of date diary entry."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
318 (format "Chinese date: %s" (calendar-chinese-date-string date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
319
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
320 (provide 'cal-chinese)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
321
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
322 ;;; cal-chinese ends here
|