diff options
| author | Glenn Morris | 2008-04-04 07:22:05 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-04-04 07:22:05 +0000 |
| commit | fdc22b389a54c2edaff71c5f0b58fc0f5c730224 (patch) | |
| tree | 30aada9cda578457c6822df3fc01b7ee3cb64358 | |
| parent | 216a3e253c6ba8ff66ec5dedd9f5094f6240a371 (diff) | |
| download | emacs-fdc22b389a54c2edaff71c5f0b58fc0f5c730224.tar.gz emacs-fdc22b389a54c2edaff71c5f0b58fc0f5c730224.zip | |
Update for cal-julian name changes.
(calendar-persian-month-name-array): Rename persian-calendar-month-name-array.
Update callers.
(calendar-persian-epoch): Rename persian-calendar-epoch. Update callers.
(calendar-persian-leap-year-p): Rename persian-calendar-leap-year-p.
Update callers.
(calendar-persian-last-day-of-month): Rename persian-calendar-last-day-of-month.
Update callers.
(calendar-persian-to-absolute): Rename calendar-absolute-from-persian.
Update callers, keep old name as alias.
(calendar-persian-print-date): Rename calendar-print-persian-date.
Update callers, keep old name as alias.
(calendar-persian-goto-date): Rename calendar-goto-persian-date.
Keep old name as alias.
| -rw-r--r-- | lisp/calendar/cal-persia.el | 59 |
1 files changed, 34 insertions, 25 deletions
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 3855a31557e..0b7ffe117ad 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el | |||
| @@ -33,19 +33,19 @@ | |||
| 33 | 33 | ||
| 34 | (require 'calendar) | 34 | (require 'calendar) |
| 35 | 35 | ||
| 36 | (defconst persian-calendar-month-name-array | 36 | (defconst calendar-persian-month-name-array |
| 37 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" | 37 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" |
| 38 | "Azar" "Dey" "Bahman" "Esfand"] | 38 | "Azar" "Dey" "Bahman" "Esfand"] |
| 39 | "Names of the months in the Persian calendar.") | 39 | "Names of the months in the Persian calendar.") |
| 40 | 40 | ||
| 41 | (eval-and-compile | 41 | (eval-and-compile |
| 42 | (autoload 'calendar-absolute-from-julian "cal-julian")) | 42 | (autoload 'calendar-julian-to-absolute "cal-julian")) |
| 43 | 43 | ||
| 44 | (defconst persian-calendar-epoch | 44 | (defconst calendar-persian-epoch |
| 45 | (eval-when-compile (calendar-absolute-from-julian '(3 19 622))) | 45 | (eval-when-compile (calendar-julian-to-absolute '(3 19 622))) |
| 46 | "Absolute date of start of Persian calendar = March 19, 622 AD (Julian).") | 46 | "Absolute date of start of Persian calendar = March 19, 622 AD (Julian).") |
| 47 | 47 | ||
| 48 | (defun persian-calendar-leap-year-p (year) | 48 | (defun calendar-persian-leap-year-p (year) |
| 49 | "True if YEAR is a leap year on the Persian calendar." | 49 | "True if YEAR is a leap year on the Persian calendar." |
| 50 | (< (mod (* (mod (mod (if (<= 0 year) | 50 | (< (mod (* (mod (mod (if (<= 0 year) |
| 51 | (+ year 2346) ; no year zero | 51 | (+ year 2346) ; no year zero |
| @@ -56,14 +56,14 @@ | |||
| 56 | 2820) | 56 | 2820) |
| 57 | 683)) | 57 | 683)) |
| 58 | 58 | ||
| 59 | (defun persian-calendar-last-day-of-month (month year) | 59 | (defun calendar-persian-last-day-of-month (month year) |
| 60 | "Return last day of MONTH, YEAR on the Persian calendar." | 60 | "Return last day of MONTH, YEAR on the Persian calendar." |
| 61 | (cond | 61 | (cond |
| 62 | ((< month 7) 31) | 62 | ((< month 7) 31) |
| 63 | ((or (< month 12) (persian-calendar-leap-year-p year)) 30) | 63 | ((or (< month 12) (calendar-persian-leap-year-p year)) 30) |
| 64 | (t 29))) | 64 | (t 29))) |
| 65 | 65 | ||
| 66 | (defun calendar-absolute-from-persian (date) | 66 | (defun calendar-persian-to-absolute (date) |
| 67 | "Compute absolute date from Persian date DATE. | 67 | "Compute absolute date from Persian date DATE. |
| 68 | The absolute date is the number of days elapsed since the (imaginary) | 68 | The absolute date is the number of days elapsed since the (imaginary) |
| 69 | Gregorian date Sunday, December 31, 1 BC." | 69 | Gregorian date Sunday, December 31, 1 BC." |
| @@ -71,10 +71,10 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 71 | (day (extract-calendar-day date)) | 71 | (day (extract-calendar-day date)) |
| 72 | (year (extract-calendar-year date))) | 72 | (year (extract-calendar-year date))) |
| 73 | (if (< year 0) | 73 | (if (< year 0) |
| 74 | (+ (calendar-absolute-from-persian | 74 | (+ (calendar-persian-to-absolute |
| 75 | (list month day (1+ (mod year 2820)))) | 75 | (list month day (1+ (mod year 2820)))) |
| 76 | (* 1029983 (floor year 2820))) | 76 | (* 1029983 (floor year 2820))) |
| 77 | (+ (1- persian-calendar-epoch) ; days before epoch | 77 | (+ (1- calendar-persian-epoch) ; days before epoch |
| 78 | (* 365 (1- year)) ; days in prior years | 78 | (* 365 (1- year)) ; days in prior years |
| 79 | (* 683 ; leap days in prior 2820-year cycles | 79 | (* 683 ; leap days in prior 2820-year cycles |
| 80 | (floor (+ year 2345) 2820)) | 80 | (floor (+ year 2345) 2820)) |
| @@ -86,13 +86,16 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 86 | -568 ; leap years in Persian years -2345...-1 | 86 | -568 ; leap years in Persian years -2345...-1 |
| 87 | (calendar-sum ; days in prior months this year | 87 | (calendar-sum ; days in prior months this year |
| 88 | m 1 (< m month) | 88 | m 1 (< m month) |
| 89 | (persian-calendar-last-day-of-month m year)) | 89 | (calendar-persian-last-day-of-month m year)) |
| 90 | day)))) ; days so far this month | 90 | day)))) ; days so far this month |
| 91 | 91 | ||
| 92 | (define-obsolete-function-alias 'calendar-absolute-from-persian | ||
| 93 | 'calendar-persian-to-absolute "23.1") | ||
| 94 | |||
| 92 | (defun calendar-persian-year-from-absolute (date) | 95 | (defun calendar-persian-year-from-absolute (date) |
| 93 | "Persian year corresponding to the absolute DATE." | 96 | "Persian year corresponding to the absolute DATE." |
| 94 | (let* ((d0 ; prior days since start of 2820 cycles | 97 | (let* ((d0 ; prior days since start of 2820 cycles |
| 95 | (- date (calendar-absolute-from-persian (list 1 1 -2345)))) | 98 | (- date (calendar-persian-to-absolute (list 1 1 -2345)))) |
| 96 | (n2820 ; completed 2820-year cycles | 99 | (n2820 ; completed 2820-year cycles |
| 97 | (floor d0 1029983)) | 100 | (floor d0 1029983)) |
| 98 | (d1 ; prior days not in n2820 | 101 | (d1 ; prior days not in n2820 |
| @@ -129,14 +132,14 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 129 | (month ; search forward from Farvardin | 132 | (month ; search forward from Farvardin |
| 130 | (1+ (calendar-sum m 1 | 133 | (1+ (calendar-sum m 1 |
| 131 | (> date | 134 | (> date |
| 132 | (calendar-absolute-from-persian | 135 | (calendar-persian-to-absolute |
| 133 | (list | 136 | (list |
| 134 | m | 137 | m |
| 135 | (persian-calendar-last-day-of-month m year) | 138 | (calendar-persian-last-day-of-month m year) |
| 136 | year))) | 139 | year))) |
| 137 | 1))) | 140 | 1))) |
| 138 | (day ; calculate the day by subtraction | 141 | (day ; calculate the day by subtraction |
| 139 | (- date (1- (calendar-absolute-from-persian | 142 | (- date (1- (calendar-persian-to-absolute |
| 140 | (list month 1 year)))))) | 143 | (list month 1 year)))))) |
| 141 | (list month day year))) | 144 | (list month day year))) |
| 142 | 145 | ||
| @@ -148,7 +151,7 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 148 | (or date (calendar-current-date))))) | 151 | (or date (calendar-current-date))))) |
| 149 | (y (extract-calendar-year persian-date)) | 152 | (y (extract-calendar-year persian-date)) |
| 150 | (m (extract-calendar-month persian-date)) | 153 | (m (extract-calendar-month persian-date)) |
| 151 | (monthname (aref persian-calendar-month-name-array (1- m))) | 154 | (monthname (aref calendar-persian-month-name-array (1- m))) |
| 152 | (day (int-to-string (extract-calendar-day persian-date))) | 155 | (day (int-to-string (extract-calendar-day persian-date))) |
| 153 | (year (int-to-string y)) | 156 | (year (int-to-string y)) |
| 154 | (month (int-to-string m)) | 157 | (month (int-to-string m)) |
| @@ -156,12 +159,15 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 156 | (mapconcat 'eval calendar-date-display-form ""))) | 159 | (mapconcat 'eval calendar-date-display-form ""))) |
| 157 | 160 | ||
| 158 | ;;;###cal-autoload | 161 | ;;;###cal-autoload |
| 159 | (defun calendar-print-persian-date () | 162 | (defun calendar-persian-print-date () |
| 160 | "Show the Persian calendar equivalent of the selected date." | 163 | "Show the Persian calendar equivalent of the selected date." |
| 161 | (interactive) | 164 | (interactive) |
| 162 | (message "Persian date: %s" | 165 | (message "Persian date: %s" |
| 163 | (calendar-persian-date-string (calendar-cursor-to-date t)))) | 166 | (calendar-persian-date-string (calendar-cursor-to-date t)))) |
| 164 | 167 | ||
| 168 | (define-obsolete-function-alias 'calendar-print-persian-date | ||
| 169 | 'calendar-persian-print-date "23.1") | ||
| 170 | |||
| 165 | (defun calendar-persian-read-date () | 171 | (defun calendar-persian-read-date () |
| 166 | "Interactively read the arguments for a Persian date command. | 172 | "Interactively read the arguments for a Persian date command. |
| 167 | Reads a year, month, and day." | 173 | Reads a year, month, and day." |
| @@ -178,27 +184,30 @@ Reads a year, month, and day." | |||
| 178 | (completing-read | 184 | (completing-read |
| 179 | "Persian calendar month name: " | 185 | "Persian calendar month name: " |
| 180 | (mapcar 'list | 186 | (mapcar 'list |
| 181 | (append persian-calendar-month-name-array nil)) | 187 | (append calendar-persian-month-name-array nil)) |
| 182 | nil t) | 188 | nil t) |
| 183 | (calendar-make-alist persian-calendar-month-name-array | 189 | (calendar-make-alist calendar-persian-month-name-array |
| 184 | 1)))) | 190 | 1)))) |
| 185 | (last (persian-calendar-last-day-of-month month year)) | 191 | (last (calendar-persian-last-day-of-month month year)) |
| 186 | (day (calendar-read | 192 | (day (calendar-read |
| 187 | (format "Persian calendar day (1-%d): " last) | 193 | (format "Persian calendar day (1-%d): " last) |
| 188 | (lambda (x) (and (< 0 x) (<= x last)))))) | 194 | (lambda (x) (and (< 0 x) (<= x last)))))) |
| 189 | (list (list month day year)))) | 195 | (list (list month day year)))) |
| 190 | 196 | ||
| 191 | (define-obsolete-function-alias | 197 | (define-obsolete-function-alias 'persian-prompt-for-date |
| 192 | 'persian-prompt-for-date 'calendar-persian-read-date "23.1") | 198 | 'calendar-persian-read-date "23.1") |
| 193 | 199 | ||
| 194 | ;;;###cal-autoload | 200 | ;;;###cal-autoload |
| 195 | (defun calendar-goto-persian-date (date &optional noecho) | 201 | (defun calendar-persian-goto-date (date &optional noecho) |
| 196 | "Move cursor to Persian date DATE. | 202 | "Move cursor to Persian date DATE. |
| 197 | Echo Persian date unless NOECHO is non-nil." | 203 | Echo Persian date unless NOECHO is non-nil." |
| 198 | (interactive (calendar-persian-read-date)) | 204 | (interactive (calendar-persian-read-date)) |
| 199 | (calendar-goto-date (calendar-gregorian-from-absolute | 205 | (calendar-goto-date (calendar-gregorian-from-absolute |
| 200 | (calendar-absolute-from-persian date))) | 206 | (calendar-persian-to-absolute date))) |
| 201 | (or noecho (calendar-print-persian-date))) | 207 | (or noecho (calendar-persian-print-date))) |
| 208 | |||
| 209 | (define-obsolete-function-alias 'calendar-goto-persian-date | ||
| 210 | 'calendar-persian-goto-date "23.1") | ||
| 202 | 211 | ||
| 203 | (defvar date) | 212 | (defvar date) |
| 204 | 213 | ||