diff options
| author | Glenn Morris | 2008-04-05 20:57:47 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-04-05 20:57:47 +0000 |
| commit | 0b41781b4b01d009a4f857cde0addecb6153d15b (patch) | |
| tree | 3a425d6157fa6fcfe2841b32f65770774709c0f5 | |
| parent | 8fc9e5a0c35a5c3c60d8ba46af7e3ca385b8cdb2 (diff) | |
| download | emacs-0b41781b4b01d009a4f857cde0addecb6153d15b.tar.gz emacs-0b41781b4b01d009a4f857cde0addecb6153d15b.zip | |
(calendar-chinese): Rename custom group from chinese-calendar. Update users.
(calendar-chinese-time-zone): Rename chinese-calendar-time-zone.
Keep old name as alias, update users.
(calendar-chinese-location-name): Rename chinese-calendar-location-name.
Keep old name as alias.
(calendar-chinese-daylight-time-offset):
Rename chinese-calendar-daylight-time-offset. Keep old name as alias,
update users.
(calendar-chinese-standard-time-zone-name):
Rename chinese-calendar-standard-time-zone-name.
Keep old name as alias, update users.
(calendar-chinese-daylight-saving-start):
Rename chinese-calendar-daylight-savings-starts.
Keep old name as alias, update users.
(calendar-chinese-daylight-saving-end):
Rename chinese-calendar-daylight-savings-ends. Keep old name as alias,
update users.
(calendar-chinese-daylight-saving-start-time):
Rename chinese-calendar-daylight-savings-starts-time.
Keep old name as alias, update users.
(calendar-chinese-daylight-saving-end-time):
Rename chinese-calendar-daylight-savings-ends-time.
Keep old name as alias, update users.
(calendar-chinese-celestial-stem): Rename
calendar-chinese-celestial-stem. Keep old name as alias, update users.
(calendar-chinese-terrestrial-branch):
Rename calendar-chinese-terrestrial-branch. Keep old name as alias,
update users.
(calendar-chinese-zodiac-sign-on-or-after):
Rename chinese-zodiac-sign-on-or-after. Update callers.
(calendar-chinese-new-moon-on-or-after): Rename chinese-new-moon-on-or-after.
Update callers.
(calendar-chinese-month-list): Rename chinese-month-list. Update callers.
(calendar-chinese-number-months): Rename number-chinese-months. Update callers.
(calendar-chinese-compute-year): Rename compute-chinese-year. Update callers.
(calendar-chinese-year-cache): Rename chinese-year-cache. Update users.
(calendar-chinese-year): Rename chinese-year. Update callers.
(calendar-chinese-year-cache-init): Rename chinese-year-cache-init.
(calendar-chinese-to-absolute): Rename calendar-absolute-from-chinese.
Keep old name as alias, update callers.
(calendar-chinese-print-date): Rename calendar-print-chinese-date.
Keep old name as alias, update callers.
(calendar-chinese-months-to-alist): Rename make-chinese-month-assoc-list.
Update callers.
(calendar-chinese-months): Rename chinese-months. Update callers.
(calendar-chinese-goto-date): Rename calendar-goto-chinese-date.
Keep old name as alias, update callers.
| -rw-r--r-- | lisp/calendar/cal-china.el | 266 |
1 files changed, 157 insertions, 109 deletions
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 116c2950df7..cf9dab4af8d 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el | |||
| @@ -55,11 +55,12 @@ | |||
| 55 | ;;;(require 'cal-julian) | 55 | ;;;(require 'cal-julian) |
| 56 | 56 | ||
| 57 | 57 | ||
| 58 | (defgroup chinese-calendar nil | 58 | (defgroup calendar-chinese nil |
| 59 | "Chinese calendar support." | 59 | "Chinese calendar support." |
| 60 | :prefix "calendar-chinese-" | ||
| 60 | :group 'calendar) | 61 | :group 'calendar) |
| 61 | 62 | ||
| 62 | (defcustom chinese-calendar-time-zone | 63 | (defcustom calendar-chinese-time-zone |
| 63 | '(if (< year 1928) | 64 | '(if (< year 1928) |
| 64 | (+ 465 (/ 40.0 60.0)) | 65 | (+ 465 (/ 40.0 60.0)) |
| 65 | 480) | 66 | 480) |
| @@ -67,23 +68,33 @@ | |||
| 67 | Default is for Beijing. This is an expression in `year' since it changed at | 68 | Default is for Beijing. This is an expression in `year' since it changed at |
| 68 | 1928-01-01 00:00:00 from UT+7:45:40 to UT+8." | 69 | 1928-01-01 00:00:00 from UT+7:45:40 to UT+8." |
| 69 | :type 'sexp | 70 | :type 'sexp |
| 70 | :group 'chinese-calendar) | 71 | :group 'calendar-chinese) |
| 71 | 72 | ||
| 72 | (defcustom chinese-calendar-location-name "Beijing" | 73 | (define-obsolete-variable-alias 'chinese-calendar-time-zone |
| 74 | 'calendar-chinese-time-zone "23.1") | ||
| 75 | |||
| 76 | ;; FIXME unused. | ||
| 77 | (defcustom calendar-chinese-location-name "Beijing" | ||
| 73 | "Name of location used for calculation of Chinese calendar." | 78 | "Name of location used for calculation of Chinese calendar." |
| 74 | :type 'string | 79 | :type 'string |
| 75 | :group 'chinese-calendar) | 80 | :group 'calendar-chinese) |
| 81 | |||
| 82 | (define-obsolete-variable-alias 'chinese-calendar-location-name | ||
| 83 | 'calendar-chinese-location-name "23.1") | ||
| 76 | 84 | ||
| 77 | (defcustom chinese-calendar-daylight-time-offset 0 | 85 | (defcustom calendar-chinese-daylight-time-offset 0 |
| 78 | ;; The correct value is as follows, but the Chinese calendrical | 86 | ;; The correct value is as follows, but the Chinese calendrical |
| 79 | ;; authorities do NOT use DST in determining astronomical events: | 87 | ;; authorities do NOT use DST in determining astronomical events: |
| 80 | ;; 60 | 88 | ;; 60 |
| 81 | "Minutes difference between daylight saving and standard time. | 89 | "Minutes difference between daylight saving and standard time. |
| 82 | Default is for no daylight saving time." | 90 | Default is for no daylight saving time." |
| 83 | :type 'integer | 91 | :type 'integer |
| 84 | :group 'chinese-calendar) | 92 | :group 'calendar-chinese) |
| 93 | |||
| 94 | (define-obsolete-variable-alias 'chinese-calendar-daylight-time-offset | ||
| 95 | 'calendar-chinese-daylight-time-offset "23.1") | ||
| 85 | 96 | ||
| 86 | (defcustom chinese-calendar-standard-time-zone-name | 97 | (defcustom calendar-chinese-standard-time-zone-name |
| 87 | '(if (< year 1928) | 98 | '(if (< year 1928) |
| 88 | "PMT" | 99 | "PMT" |
| 89 | "CST") | 100 | "CST") |
| @@ -91,14 +102,20 @@ Default is for no daylight saving time." | |||
| 91 | This is an expression depending on `year' because it changed | 102 | This is an expression depending on `year' because it changed |
| 92 | at 1928-01-01 00:00:00 from `PMT' to `CST'." | 103 | at 1928-01-01 00:00:00 from `PMT' to `CST'." |
| 93 | :type 'sexp | 104 | :type 'sexp |
| 94 | :group 'chinese-calendar) | 105 | :group 'calendar-chinese) |
| 95 | 106 | ||
| 96 | (defcustom chinese-calendar-daylight-time-zone-name "CDT" | 107 | (define-obsolete-variable-alias 'chinese-calendar-standard-time-zone-name |
| 108 | 'calendar-chinese-standard-time-zone-name "23.1") | ||
| 109 | |||
| 110 | (defcustom calendar-chinese-daylight-time-zone-name "CDT" | ||
| 97 | "Abbreviated name of daylight saving time zone used for Chinese calendar." | 111 | "Abbreviated name of daylight saving time zone used for Chinese calendar." |
| 98 | :type 'string | 112 | :type 'string |
| 99 | :group 'chinese-calendar) | 113 | :group 'calendar-chinese) |
| 114 | |||
| 115 | (define-obsolete-variable-alias 'chinese-calendar-daylight-time-zone-name | ||
| 116 | 'calendar-chinese-daylight-time-zone-name "23.1") | ||
| 100 | 117 | ||
| 101 | (defcustom chinese-calendar-daylight-savings-starts nil | 118 | (defcustom calendar-chinese-daylight-saving-start nil |
| 102 | ;; The correct value is as follows, but the Chinese calendrical | 119 | ;; The correct value is as follows, but the Chinese calendrical |
| 103 | ;; authorities do NOT use DST in determining astronomical events: | 120 | ;; authorities do NOT use DST in determining astronomical events: |
| 104 | ;; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) | 121 | ;; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) |
| @@ -108,9 +125,12 @@ at 1928-01-01 00:00:00 from `PMT' to `CST'." | |||
| 108 | Default is for no daylight saving time. See documentation of | 125 | Default is for no daylight saving time. See documentation of |
| 109 | `calendar-daylight-savings-starts'." | 126 | `calendar-daylight-savings-starts'." |
| 110 | :type 'sexp | 127 | :type 'sexp |
| 111 | :group 'chinese-calendar) | 128 | :group 'calendar-chinese) |
| 112 | 129 | ||
| 113 | (defcustom chinese-calendar-daylight-savings-ends nil | 130 | (define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts |
| 131 | 'calendar-chinese-daylight-saving-start "23.1") | ||
| 132 | |||
| 133 | (defcustom calendar-chinese-daylight-saving-end nil | ||
| 114 | ;; The correct value is as follows, but the Chinese calendrical | 134 | ;; The correct value is as follows, but the Chinese calendrical |
| 115 | ;; authorities do NOT use DST in determining astronomical events: | 135 | ;; authorities do NOT use DST in determining astronomical events: |
| 116 | ;; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) | 136 | ;; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) |
| @@ -118,24 +138,33 @@ Default is for no daylight saving time. See documentation of | |||
| 118 | Default is for no daylight saving time. See documentation of | 138 | Default is for no daylight saving time. See documentation of |
| 119 | `calendar-daylight-savings-ends'." | 139 | `calendar-daylight-savings-ends'." |
| 120 | :type 'sexp | 140 | :type 'sexp |
| 121 | :group 'chinese-calendar) | 141 | :group 'calendar-chinese) |
| 142 | |||
| 143 | (define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends | ||
| 144 | 'calendar-chinese-daylight-saving-end "23.1") | ||
| 122 | 145 | ||
| 123 | (defcustom chinese-calendar-daylight-savings-starts-time 0 | 146 | (defcustom calendar-chinese-daylight-saving-start-time 0 |
| 124 | "Number of minutes after midnight that daylight saving time starts. | 147 | "Number of minutes after midnight that daylight saving time starts. |
| 125 | Default is for no daylight saving time." | 148 | Default is for no daylight saving time." |
| 126 | :type 'integer | 149 | :type 'integer |
| 127 | :group 'chinese-calendar) | 150 | :group 'calendar-chinese) |
| 128 | 151 | ||
| 129 | (defcustom chinese-calendar-daylight-savings-ends-time 0 | 152 | (define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts-time |
| 153 | 'calendar-chinese-daylight-saving-start-time "23.1") | ||
| 154 | |||
| 155 | (defcustom calendar-chinese-daylight-saving-end-time 0 | ||
| 130 | "Number of minutes after midnight that daylight saving time ends. | 156 | "Number of minutes after midnight that daylight saving time ends. |
| 131 | Default is for no daylight saving time." | 157 | Default is for no daylight saving time." |
| 132 | :type 'integer | 158 | :type 'integer |
| 133 | :group 'chinese-calendar) | 159 | :group 'calendar-chinese) |
| 160 | |||
| 161 | (define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends-time | ||
| 162 | 'calendar-chinese-daylight-saving-end-time "23.1") | ||
| 134 | 163 | ||
| 135 | (defcustom chinese-calendar-celestial-stem | 164 | (defcustom calendar-chinese-celestial-stem |
| 136 | ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"] | 165 | ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"] |
| 137 | "Prefixes used by `calendar-chinese-sexagesimal-name'." | 166 | "Prefixes used by `calendar-chinese-sexagesimal-name'." |
| 138 | :group 'chinese-calendar | 167 | :group 'calendar-chinese |
| 139 | :type '(vector (string :tag "Jia") | 168 | :type '(vector (string :tag "Jia") |
| 140 | (string :tag "Yi") | 169 | (string :tag "Yi") |
| 141 | (string :tag "Bing") | 170 | (string :tag "Bing") |
| @@ -147,10 +176,13 @@ Default is for no daylight saving time." | |||
| 147 | (string :tag "Ren") | 176 | (string :tag "Ren") |
| 148 | (string :tag "Gui"))) | 177 | (string :tag "Gui"))) |
| 149 | 178 | ||
| 150 | (defcustom chinese-calendar-terrestrial-branch | 179 | (define-obsolete-variable-alias 'chinese-calendar-celestial-stem |
| 180 | 'calendar-chinese-celestial-stem "23.1") | ||
| 181 | |||
| 182 | (defcustom calendar-chinese-terrestrial-branch | ||
| 151 | ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"] | 183 | ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"] |
| 152 | "Suffixes used by `calendar-chinese-sexagesimal-name'." | 184 | "Suffixes used by `calendar-chinese-sexagesimal-name'." |
| 153 | :group 'chinese-calendar | 185 | :group 'calendar-chinese |
| 154 | :type '(vector (string :tag "Zi") | 186 | :type '(vector (string :tag "Zi") |
| 155 | (string :tag "Chou") | 187 | (string :tag "Chou") |
| 156 | (string :tag "Yin") | 188 | (string :tag "Yin") |
| @@ -164,6 +196,9 @@ Default is for no daylight saving time." | |||
| 164 | (string :tag "Xu") | 196 | (string :tag "Xu") |
| 165 | (string :tag "Hai"))) | 197 | (string :tag "Hai"))) |
| 166 | 198 | ||
| 199 | (define-obsolete-variable-alias 'chinese-calendar-terrestrial-branch | ||
| 200 | 'calendar-chinese-terrestrial-branch "23.1") | ||
| 201 | |||
| 167 | ;;; End of user options. | 202 | ;;; End of user options. |
| 168 | 203 | ||
| 169 | 204 | ||
| @@ -172,63 +207,63 @@ Default is for no daylight saving time." | |||
| 172 | N congruent to 1 gives the first name, N congruent to 2 gives the second name, | 207 | N congruent to 1 gives the first name, N congruent to 2 gives the second name, |
| 173 | ..., N congruent to 60 gives the sixtieth name." | 208 | ..., N congruent to 60 gives the sixtieth name." |
| 174 | (format "%s-%s" | 209 | (format "%s-%s" |
| 175 | (aref chinese-calendar-celestial-stem (% (1- n) 10)) | 210 | (aref calendar-chinese-celestial-stem (% (1- n) 10)) |
| 176 | (aref chinese-calendar-terrestrial-branch (% (1- n) 12)))) | 211 | (aref calendar-chinese-terrestrial-branch (% (1- n) 12)))) |
| 177 | 212 | ||
| 178 | (defun chinese-zodiac-sign-on-or-after (d) | 213 | (defun calendar-chinese-zodiac-sign-on-or-after (d) |
| 179 | "Absolute date of first new Zodiac sign on or after absolute date D. | 214 | "Absolute date of first new Zodiac sign on or after absolute date D. |
| 180 | The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees." | 215 | The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees." |
| 181 | (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) | 216 | (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) |
| 182 | (calendar-time-zone (eval chinese-calendar-time-zone)) ; uses year | 217 | (calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year |
| 183 | (calendar-daylight-time-offset | 218 | (calendar-daylight-time-offset |
| 184 | chinese-calendar-daylight-time-offset) | 219 | calendar-chinese-daylight-time-offset) |
| 185 | (calendar-standard-time-zone-name | 220 | (calendar-standard-time-zone-name |
| 186 | chinese-calendar-standard-time-zone-name) | 221 | calendar-chinese-standard-time-zone-name) |
| 187 | (calendar-daylight-time-zone-name | 222 | (calendar-daylight-time-zone-name |
| 188 | chinese-calendar-daylight-time-zone-name) | 223 | calendar-chinese-daylight-time-zone-name) |
| 189 | (calendar-calendar-daylight-savings-starts | 224 | (calendar-daylight-savings-starts |
| 190 | chinese-calendar-daylight-savings-starts) | 225 | calendar-chinese-daylight-saving-start) |
| 191 | (calendar-daylight-savings-ends | 226 | (calendar-daylight-savings-ends |
| 192 | chinese-calendar-daylight-savings-ends) | 227 | calendar-chinese-daylight-saving-end) |
| 193 | (calendar-daylight-savings-starts-time | 228 | (calendar-daylight-savings-starts-time |
| 194 | chinese-calendar-daylight-savings-starts-time) | 229 | calendar-chinese-daylight-saving-start-time) |
| 195 | (calendar-daylight-savings-ends-time | 230 | (calendar-daylight-savings-ends-time |
| 196 | chinese-calendar-daylight-savings-ends-time)) | 231 | calendar-chinese-daylight-saving-end-time)) |
| 197 | (floor | 232 | (floor |
| 198 | (calendar-astro-to-absolute | 233 | (calendar-astro-to-absolute |
| 199 | (solar-date-next-longitude (calendar-astro-from-absolute d) 30))))) | 234 | (solar-date-next-longitude (calendar-astro-from-absolute d) 30))))) |
| 200 | 235 | ||
| 201 | (defun chinese-new-moon-on-or-after (d) | 236 | (defun calendar-chinese-new-moon-on-or-after (d) |
| 202 | "Absolute date of first new moon on or after absolute date D." | 237 | "Absolute date of first new moon on or after absolute date D." |
| 203 | (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) | 238 | (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) |
| 204 | (calendar-time-zone (eval chinese-calendar-time-zone)) | 239 | (calendar-time-zone (eval calendar-chinese-time-zone)) |
| 205 | (calendar-daylight-time-offset | 240 | (calendar-daylight-time-offset |
| 206 | chinese-calendar-daylight-time-offset) | 241 | calendar-chinese-daylight-time-offset) |
| 207 | (calendar-standard-time-zone-name | 242 | (calendar-standard-time-zone-name |
| 208 | chinese-calendar-standard-time-zone-name) | 243 | calendar-chinese-standard-time-zone-name) |
| 209 | (calendar-daylight-time-zone-name | 244 | (calendar-daylight-time-zone-name |
| 210 | chinese-calendar-daylight-time-zone-name) | 245 | calendar-chinese-daylight-time-zone-name) |
| 211 | (calendar-calendar-daylight-savings-starts | 246 | (calendar-daylight-savings-starts |
| 212 | chinese-calendar-daylight-savings-starts) | 247 | calendar-chinese-daylight-saving-start) |
| 213 | (calendar-daylight-savings-ends | 248 | (calendar-daylight-savings-ends |
| 214 | chinese-calendar-daylight-savings-ends) | 249 | calendar-chinese-daylight-saving-end) |
| 215 | (calendar-daylight-savings-starts-time | 250 | (calendar-daylight-savings-starts-time |
| 216 | chinese-calendar-daylight-savings-starts-time) | 251 | calendar-chinese-daylight-saving-start-time) |
| 217 | (calendar-daylight-savings-ends-time | 252 | (calendar-daylight-savings-ends-time |
| 218 | chinese-calendar-daylight-savings-ends-time)) | 253 | calendar-chinese-daylight-saving-end-time)) |
| 219 | (floor | 254 | (floor |
| 220 | (calendar-astro-to-absolute | 255 | (calendar-astro-to-absolute |
| 221 | (lunar-new-moon-on-or-after (calendar-astro-from-absolute d)))))) | 256 | (lunar-new-moon-on-or-after (calendar-astro-from-absolute d)))))) |
| 222 | 257 | ||
| 223 | (defun chinese-month-list (start end) | 258 | (defun calendar-chinese-month-list (start end) |
| 224 | "List of starting dates of Chinese months from START to END." | 259 | "List of starting dates of Chinese months from START to END." |
| 225 | (if (<= start end) | 260 | (if (<= start end) |
| 226 | (let ((new-moon (chinese-new-moon-on-or-after start))) | 261 | (let ((new-moon (calendar-chinese-new-moon-on-or-after start))) |
| 227 | (if (<= new-moon end) | 262 | (if (<= new-moon end) |
| 228 | (cons new-moon | 263 | (cons new-moon |
| 229 | (chinese-month-list (1+ new-moon) end)))))) | 264 | (calendar-chinese-month-list (1+ new-moon) end)))))) |
| 230 | 265 | ||
| 231 | (defun number-chinese-months (list start) | 266 | (defun calendar-chinese-number-months (list start) |
| 232 | "Assign month numbers to the lunar months in LIST, starting with START. | 267 | "Assign month numbers to the lunar months in LIST, starting with START. |
| 233 | Numbers are assigned sequentially, START, START+1, ..., 11, with | 268 | Numbers are assigned sequentially, START, START+1, ..., 11, with |
| 234 | half numbers used for leap months. First and last months of list | 269 | half numbers used for leap months. First and last months of list |
| @@ -238,53 +273,55 @@ are never leap months." | |||
| 238 | ;; Remaining months. | 273 | ;; Remaining months. |
| 239 | (if (zerop (- 12 start (length list))) | 274 | (if (zerop (- 12 start (length list))) |
| 240 | ;; List is too short for a leap month. | 275 | ;; List is too short for a leap month. |
| 241 | (number-chinese-months (cdr list) (1+ start)) | 276 | (calendar-chinese-number-months (cdr list) (1+ start)) |
| 242 | (if (and (cddr list) ; at least two more months... | 277 | (if (and (cddr list) ; at least two more months... |
| 243 | (<= (nth 2 list) | 278 | (<= (nth 2 list) |
| 244 | (chinese-zodiac-sign-on-or-after (cadr list)))) | 279 | (calendar-chinese-zodiac-sign-on-or-after |
| 280 | (cadr list)))) | ||
| 245 | ;; Next month is a leap month. | 281 | ;; Next month is a leap month. |
| 246 | (cons (list (+ start 0.5) (cadr list)) | 282 | (cons (list (+ start 0.5) (cadr list)) |
| 247 | (number-chinese-months (cddr list) (1+ start))) | 283 | (calendar-chinese-number-months (cddr list) (1+ start))) |
| 248 | ;; Next month is not a leap month. | 284 | ;; Next month is not a leap month. |
| 249 | (number-chinese-months (cdr list) (1+ start))))))) | 285 | (calendar-chinese-number-months (cdr list) (1+ start))))))) |
| 250 | 286 | ||
| 251 | (defun compute-chinese-year (y) | 287 | (defun calendar-chinese-compute-year (y) |
| 252 | "Compute the structure of the Chinese year for Gregorian year Y. | 288 | "Compute the structure of the Chinese year for Gregorian year Y. |
| 253 | The result is a list of pairs (i d), where month i begins on absolute date d, | 289 | The result is a list of pairs (i d), where month i begins on absolute date d, |
| 254 | of the Chinese months from the Chinese month following the solstice in | 290 | of the Chinese months from the Chinese month following the solstice in |
| 255 | Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." | 291 | Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." |
| 256 | (let* ((next-solstice (chinese-zodiac-sign-on-or-after | 292 | (let* ((next-solstice (calendar-chinese-zodiac-sign-on-or-after |
| 257 | (calendar-absolute-from-gregorian | 293 | (calendar-absolute-from-gregorian |
| 258 | (list 12 15 y)))) | 294 | (list 12 15 y)))) |
| 259 | (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after | 295 | (list (calendar-chinese-month-list |
| 260 | (calendar-absolute-from-gregorian | 296 | (1+ (calendar-chinese-zodiac-sign-on-or-after |
| 261 | (list 12 15 (1- y))))) | 297 | (calendar-absolute-from-gregorian |
| 262 | next-solstice)) | 298 | (list 12 15 (1- y))))) |
| 263 | (next-sign (chinese-zodiac-sign-on-or-after (car list)))) | 299 | next-solstice)) |
| 300 | (next-sign (calendar-chinese-zodiac-sign-on-or-after (car list)))) | ||
| 264 | (if (= (length list) 12) | 301 | (if (= (length list) 12) |
| 265 | ;; No room for a leap month, just number them 12, 1, 2, ..., 11. | 302 | ;; No room for a leap month, just number them 12, 1, 2, ..., 11. |
| 266 | (cons (list 12 (car list)) | 303 | (cons (list 12 (car list)) |
| 267 | (number-chinese-months (cdr list) 1)) | 304 | (calendar-chinese-number-months (cdr list) 1)) |
| 268 | ;; Now we can assign numbers to the list for y. | 305 | ;; Now we can assign numbers to the list for y. |
| 269 | ;; The first month or two are special. | 306 | ;; The first month or two are special. |
| 270 | (if (or (> (car list) next-sign) (>= next-sign (cadr list))) | 307 | (if (or (> (car list) next-sign) (>= next-sign (cadr list))) |
| 271 | ;; First month on list is a leap month, second is not. | 308 | ;; First month on list is a leap month, second is not. |
| 272 | (append (list (list 11.5 (car list)) | 309 | (append (list (list 11.5 (car list)) |
| 273 | (list 12 (cadr list))) | 310 | (list 12 (cadr list))) |
| 274 | (number-chinese-months (cddr list) 1)) | 311 | (calendar-chinese-number-months (cddr list) 1)) |
| 275 | ;; First month on list is not a leap month. | 312 | ;; First month on list is not a leap month. |
| 276 | (append (list (list 12 (car list))) | 313 | (append (list (list 12 (car list))) |
| 277 | (if (>= (chinese-zodiac-sign-on-or-after (cadr list)) | 314 | (if (>= (calendar-chinese-zodiac-sign-on-or-after (cadr list)) |
| 278 | (nth 2 list)) | 315 | (nth 2 list)) |
| 279 | ;; Second month on list is a leap month. | 316 | ;; Second month on list is a leap month. |
| 280 | (cons (list 12.5 (cadr list)) | 317 | (cons (list 12.5 (cadr list)) |
| 281 | (number-chinese-months (cddr list) 1)) | 318 | (calendar-chinese-number-months (cddr list) 1)) |
| 282 | ;; Second month on list is not a leap month. | 319 | ;; Second month on list is not a leap month. |
| 283 | (number-chinese-months (cdr list) 1))))))) | 320 | (calendar-chinese-number-months (cdr list) 1))))))) |
| 284 | 321 | ||
| 285 | (defvar chinese-year-cache | 322 | (defvar calendar-chinese-year-cache |
| 286 | ;; Maintainers: delete existing value, position point at start of | 323 | ;; Maintainers: delete existing value, position point at start of |
| 287 | ;; empty line, then call M-: (chinese-year-cache-init N) | 324 | ;; empty line, then call M-: (calendar-chinese-year-cache-init N) |
| 288 | '((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273) | 325 | '((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273) |
| 289 | (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450)) | 326 | (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450)) |
| 290 | (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628) | 327 | (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628) |
| @@ -338,29 +375,30 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." | |||
| 338 | "Alist of Chinese year structures as determined by `chinese-year'. | 375 | "Alist of Chinese year structures as determined by `chinese-year'. |
| 339 | The default can be nil, but some values are precomputed for efficiency.") | 376 | The default can be nil, but some values are precomputed for efficiency.") |
| 340 | 377 | ||
| 341 | (defun chinese-year (y) | 378 | (defun calendar-chinese-year (y) |
| 342 | "The structure of the Chinese year for Gregorian year Y. | 379 | "The structure of the Chinese year for Gregorian year Y. |
| 343 | The result is a list of pairs (i d), where month i begins on absolute date d, | 380 | The result is a list of pairs (i d), where month i begins on absolute date d, |
| 344 | of the Chinese months from the Chinese month following the solstice in | 381 | of the Chinese months from the Chinese month following the solstice in |
| 345 | Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. | 382 | Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. |
| 346 | The list is cached in `chinese-year-cache' for further use." | 383 | The list is cached in `calendar-chinese-year-cache' for further use." |
| 347 | (let ((list (cdr (assoc y chinese-year-cache)))) | 384 | (let ((list (cdr (assoc y calendar-chinese-year-cache)))) |
| 348 | (or list | 385 | (or list |
| 349 | (setq list (compute-chinese-year y) | 386 | (setq list (calendar-chinese-compute-year y) |
| 350 | chinese-year-cache (append chinese-year-cache | 387 | calendar-chinese-year-cache (append calendar-chinese-year-cache |
| 351 | (list (cons y list))))) | 388 | (list (cons y list))))) |
| 352 | list)) | 389 | list)) |
| 353 | 390 | ||
| 354 | ;; Maintainer use. | 391 | ;; Maintainer use. |
| 355 | (defun chinese-year-cache-init (year) | 392 | (defun calendar-chinese-year-cache-init (year) |
| 356 | "Insert an initialization value for `chinese-year-cache' after point. | 393 | "Insert an initialization value for `calendar-chinese-year-cache' after point. |
| 357 | Computes values for 10 years either side of YEAR." | 394 | Computes values for 10 years either side of YEAR." |
| 358 | (setq year (- year 10)) | 395 | (setq year (- year 10)) |
| 359 | (let (chinese-year-cache end) | 396 | (let (calendar-chinese-year-cache end) |
| 360 | (save-excursion | 397 | (save-excursion |
| 361 | (insert "'(") | 398 | (insert "'(") |
| 362 | (dotimes (n 21) | 399 | (dotimes (n 21) |
| 363 | (princ (cons year (compute-chinese-year year)) (current-buffer)) | 400 | (princ (cons year (calendar-chinese-compute-year year)) |
| 401 | (current-buffer)) | ||
| 364 | (insert (if (= n 20) ")" "\n")) | 402 | (insert (if (= n 20) ")" "\n")) |
| 365 | (setq year (1+ year))) | 403 | (setq year (1+ year))) |
| 366 | (setq end (point))) | 404 | (setq end (point))) |
| @@ -372,7 +410,7 @@ Computes values for 10 years either side of YEAR." | |||
| 372 | (insert "\n"))) | 410 | (insert "\n"))) |
| 373 | (indent-region (point) end))) | 411 | (indent-region (point) end))) |
| 374 | 412 | ||
| 375 | (defun calendar-absolute-from-chinese (date) | 413 | (defun calendar-chinese-to-absolute (date) |
| 376 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. | 414 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. |
| 377 | DATE is a Chinese date (cycle year month day). The Gregorian date | 415 | DATE is a Chinese date (cycle year month day). The Gregorian date |
| 378 | Sunday, December 31, 1 BC is imaginary." | 416 | Sunday, December 31, 1 BC is imaginary." |
| @@ -385,9 +423,12 @@ Sunday, December 31, 1 BC is imaginary." | |||
| 385 | -2636))) ; years before absolute date 0 | 423 | -2636))) ; years before absolute date 0 |
| 386 | (+ (1- day) ; prior days this month | 424 | (+ (1- day) ; prior days this month |
| 387 | (cadr ; absolute date of start of this month | 425 | (cadr ; absolute date of start of this month |
| 388 | (assoc month (append (memq (assoc 1 (chinese-year g-year)) | 426 | (assoc month (append (memq (assoc 1 (calendar-chinese-year g-year)) |
| 389 | (chinese-year g-year)) | 427 | (calendar-chinese-year g-year)) |
| 390 | (chinese-year (1+ g-year)))))))) | 428 | (calendar-chinese-year (1+ g-year)))))))) |
| 429 | |||
| 430 | (define-obsolete-function-alias 'calendar-absolute-from-chinese | ||
| 431 | 'calendar-chinese-to-absolute "23.1") | ||
| 391 | 432 | ||
| 392 | (defun calendar-chinese-from-absolute (date) | 433 | (defun calendar-chinese-from-absolute (date) |
| 393 | "Compute Chinese date (cycle year month day) corresponding to absolute DATE. | 434 | "Compute Chinese date (cycle year month day) corresponding to absolute DATE. |
| @@ -396,9 +437,9 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 396 | (let* ((g-year (extract-calendar-year | 437 | (let* ((g-year (extract-calendar-year |
| 397 | (calendar-gregorian-from-absolute date))) | 438 | (calendar-gregorian-from-absolute date))) |
| 398 | (c-year (+ g-year 2695)) | 439 | (c-year (+ g-year 2695)) |
| 399 | (list (append (chinese-year (1- g-year)) | 440 | (list (append (calendar-chinese-year (1- g-year)) |
| 400 | (chinese-year g-year) | 441 | (calendar-chinese-year g-year) |
| 401 | (chinese-year (1+ g-year))))) | 442 | (calendar-chinese-year (1+ g-year))))) |
| 402 | (while (<= (cadr (cadr list)) date) | 443 | (while (<= (cadr (cadr list)) date) |
| 403 | ;; The first month on the list is in Chinese year c-year. | 444 | ;; The first month on the list is in Chinese year c-year. |
| 404 | ;; Date is on or after start of second month on list... | 445 | ;; Date is on or after start of second month on list... |
| @@ -430,9 +471,10 @@ Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian." | |||
| 430 | ;; one-sided test, namely: d-m <= 4 means CNY might be visible. | 471 | ;; one-sided test, namely: d-m <= 4 means CNY might be visible. |
| 431 | (increment-calendar-month m y 1) ; shift forward a month | 472 | (increment-calendar-month m y 1) ; shift forward a month |
| 432 | (and (< m 5) | 473 | (and (< m 5) |
| 433 | (calendar-date-is-visible-p (setq chinese-new-year | 474 | (calendar-date-is-visible-p |
| 434 | (calendar-gregorian-from-absolute | 475 | (setq chinese-new-year |
| 435 | (cadr (assoc 1 (chinese-year y)))))) | 476 | (calendar-gregorian-from-absolute |
| 477 | (cadr (assoc 1 (calendar-chinese-year y)))))) | ||
| 436 | (list | 478 | (list |
| 437 | (list chinese-new-year | 479 | (list chinese-new-year |
| 438 | (format "Chinese New Year (%s)" | 480 | (format "Chinese New Year (%s)" |
| @@ -449,9 +491,9 @@ Defaults to today's date if DATE is not given." | |||
| 449 | (year (cadr c-date)) | 491 | (year (cadr c-date)) |
| 450 | (month (nth 2 c-date)) | 492 | (month (nth 2 c-date)) |
| 451 | (day (nth 3 c-date)) | 493 | (day (nth 3 c-date)) |
| 452 | (this-month (calendar-absolute-from-chinese | 494 | (this-month (calendar-chinese-to-absolute |
| 453 | (list cycle year month 1))) | 495 | (list cycle year month 1))) |
| 454 | (next-month (calendar-absolute-from-chinese | 496 | (next-month (calendar-chinese-to-absolute |
| 455 | (list (if (= year 60) (1+ cycle) cycle) | 497 | (list (if (= year 60) (1+ cycle) cycle) |
| 456 | (if (= (floor month) 12) (1+ year) year) | 498 | (if (= (floor month) 12) (1+ year) year) |
| 457 | ;; Remainder of (1+(floor month))/12, with | 499 | ;; Remainder of (1+(floor month))/12, with |
| @@ -475,14 +517,17 @@ Defaults to today's date if DATE is not given." | |||
| 475 | day (calendar-chinese-sexagesimal-name (+ a-date 15))))) | 517 | day (calendar-chinese-sexagesimal-name (+ a-date 15))))) |
| 476 | 518 | ||
| 477 | ;;;###cal-autoload | 519 | ;;;###cal-autoload |
| 478 | (defun calendar-print-chinese-date () | 520 | (defun calendar-chinese-print-date () |
| 479 | "Show the Chinese date equivalents of date." | 521 | "Show the Chinese date equivalents of date." |
| 480 | (interactive) | 522 | (interactive) |
| 481 | (message "Computing Chinese date...") | 523 | (message "Computing Chinese date...") |
| 482 | (message "Chinese date: %s" | 524 | (message "Chinese date: %s" |
| 483 | (calendar-chinese-date-string (calendar-cursor-to-date t)))) | 525 | (calendar-chinese-date-string (calendar-cursor-to-date t)))) |
| 484 | 526 | ||
| 485 | (defun make-chinese-month-assoc-list (l) | 527 | (define-obsolete-function-alias 'calendar-print-chinese-date |
| 528 | 'calendar-chinese-print-date "23.1") | ||
| 529 | |||
| 530 | (defun calendar-chinese-months-to-alist (l) | ||
| 486 | "Make list of months L into an assoc list." | 531 | "Make list of months L into an assoc list." |
| 487 | (and l (car l) | 532 | (and l (car l) |
| 488 | (if (and (cdr l) (cadr l)) | 533 | (if (and (cdr l) (cadr l)) |
| @@ -490,32 +535,32 @@ Defaults to today's date if DATE is not given." | |||
| 490 | (append | 535 | (append |
| 491 | (list (cons (format "%s (first)" (car l)) (car l)) | 536 | (list (cons (format "%s (first)" (car l)) (car l)) |
| 492 | (cons (format "%s (second)" (car l)) (cadr l))) | 537 | (cons (format "%s (second)" (car l)) (cadr l))) |
| 493 | (make-chinese-month-assoc-list (cddr l))) | 538 | (calendar-chinese-months-to-alist (cddr l))) |
| 494 | (append | 539 | (append |
| 495 | (list (cons (int-to-string (car l)) (car l))) | 540 | (list (cons (int-to-string (car l)) (car l))) |
| 496 | (make-chinese-month-assoc-list (cdr l)))) | 541 | (calendar-chinese-months-to-alist (cdr l)))) |
| 497 | (list (cons (int-to-string (car l)) (car l)))))) | 542 | (list (cons (int-to-string (car l)) (car l)))))) |
| 498 | 543 | ||
| 499 | (defun chinese-months (c y) | 544 | (defun calendar-chinese-months (c y) |
| 500 | "A list of the months in cycle C, year Y of the Chinese calendar." | 545 | "A list of the months in cycle C, year Y of the Chinese calendar." |
| 501 | (memq 1 (append | 546 | (memq 1 (append |
| 502 | (mapcar (lambda (x) | 547 | (mapcar (lambda (x) |
| 503 | (car x)) | 548 | (car x)) |
| 504 | (chinese-year (extract-calendar-year | 549 | (calendar-chinese-year (extract-calendar-year |
| 505 | (calendar-gregorian-from-absolute | 550 | (calendar-gregorian-from-absolute |
| 506 | (calendar-absolute-from-chinese | 551 | (calendar-chinese-to-absolute |
| 507 | (list c y 1 1)))))) | 552 | (list c y 1 1)))))) |
| 508 | (mapcar (lambda (x) | 553 | (mapcar (lambda (x) |
| 509 | (if (> (car x) 11) (car x))) | 554 | (if (> (car x) 11) (car x))) |
| 510 | (chinese-year (extract-calendar-year | 555 | (calendar-chinese-year (extract-calendar-year |
| 511 | (calendar-gregorian-from-absolute | 556 | (calendar-gregorian-from-absolute |
| 512 | (calendar-absolute-from-chinese | 557 | (calendar-chinese-to-absolute |
| 513 | (list (if (= y 60) (1+ c) c) | 558 | (list (if (= y 60) (1+ c) c) |
| 514 | (if (= y 60) 1 y) | 559 | (if (= y 60) 1 y) |
| 515 | 1 1))))))))) | 560 | 1 1))))))))) |
| 516 | 561 | ||
| 517 | ;;;###cal-autoload | 562 | ;;;###cal-autoload |
| 518 | (defun calendar-goto-chinese-date (date &optional noecho) | 563 | (defun calendar-chinese-goto-date (date &optional noecho) |
| 519 | "Move cursor to Chinese date DATE. | 564 | "Move cursor to Chinese date DATE. |
| 520 | Echo Chinese date unless NOECHO is non-nil." | 565 | Echo Chinese date unless NOECHO is non-nil." |
| 521 | (interactive | 566 | (interactive |
| @@ -529,8 +574,8 @@ Echo Chinese date unless NOECHO is non-nil." | |||
| 529 | "Year in Chinese cycle (1..60): " | 574 | "Year in Chinese cycle (1..60): " |
| 530 | (lambda (x) (and (<= 1 x) (<= x 60))) | 575 | (lambda (x) (and (<= 1 x) (<= x 60))) |
| 531 | (int-to-string (cadr c)))) | 576 | (int-to-string (cadr c)))) |
| 532 | (month-list (make-chinese-month-assoc-list | 577 | (month-list (calendar-chinese-months-to-alist |
| 533 | (chinese-months cycle year))) | 578 | (calendar-chinese-months cycle year))) |
| 534 | (month (cdr (assoc | 579 | (month (cdr (assoc |
| 535 | (completing-read "Chinese calendar month: " | 580 | (completing-read "Chinese calendar month: " |
| 536 | month-list nil t) | 581 | month-list nil t) |
| @@ -539,7 +584,7 @@ Echo Chinese date unless NOECHO is non-nil." | |||
| 539 | (nth 2 | 584 | (nth 2 |
| 540 | (calendar-chinese-from-absolute | 585 | (calendar-chinese-from-absolute |
| 541 | (+ 29 | 586 | (+ 29 |
| 542 | (calendar-absolute-from-chinese | 587 | (calendar-chinese-to-absolute |
| 543 | (list cycle year month 1)))))) | 588 | (list cycle year month 1)))))) |
| 544 | 30 | 589 | 30 |
| 545 | 29)) | 590 | 29)) |
| @@ -548,8 +593,11 @@ Echo Chinese date unless NOECHO is non-nil." | |||
| 548 | (lambda (x) (and (<= 1 x) (<= x last)))))) | 593 | (lambda (x) (and (<= 1 x) (<= x last)))))) |
| 549 | (list (list cycle year month day)))) | 594 | (list (list cycle year month day)))) |
| 550 | (calendar-goto-date (calendar-gregorian-from-absolute | 595 | (calendar-goto-date (calendar-gregorian-from-absolute |
| 551 | (calendar-absolute-from-chinese date))) | 596 | (calendar-chinese-to-absolute date))) |
| 552 | (or noecho (calendar-print-chinese-date))) | 597 | (or noecho (calendar-chinese-print-date))) |
| 598 | |||
| 599 | (define-obsolete-function-alias 'calendar-goto-chinese-date | ||
| 600 | 'calendar-chinese-goto-date "23.1") | ||
| 553 | 601 | ||
| 554 | (defvar date) | 602 | (defvar date) |
| 555 | 603 | ||