aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-04-04 07:22:05 +0000
committerGlenn Morris2008-04-04 07:22:05 +0000
commitfdc22b389a54c2edaff71c5f0b58fc0f5c730224 (patch)
tree30aada9cda578457c6822df3fc01b7ee3cb64358
parent216a3e253c6ba8ff66ec5dedd9f5094f6240a371 (diff)
downloademacs-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.el59
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.
68The absolute date is the number of days elapsed since the (imaginary) 68The absolute date is the number of days elapsed since the (imaginary)
69Gregorian date Sunday, December 31, 1 BC." 69Gregorian 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.
167Reads a year, month, and day." 173Reads 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.
197Echo Persian date unless NOECHO is non-nil." 203Echo 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