aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-04-05 19:08:04 +0000
committerGlenn Morris2008-04-05 19:08:04 +0000
commit990121a3f77131e85d7194544fd661fb094b5416 (patch)
tree4011c796951b738b6a47b4e659a1e8ea5e5ec0c5
parent94b73aefc4de5e0dc85bed3fc292b55f1d4d0236 (diff)
downloademacs-990121a3f77131e85d7194544fd661fb094b5416.tar.gz
emacs-990121a3f77131e85d7194544fd661fb094b5416.zip
(calendar-coptic-month-name-array): Rename coptic-calendar-month-name-array.
Update callers. (calendar-coptic-epoch): Rename coptic-calendar-epoch. Update callers. (calendar-coptic-name): Rename coptic-name. Update callers. (calendar-coptic-leap-year-p): Rename coptic-calendar-leap-year-p. Update callers. (calendar-coptic-last-day-of-month): Rename coptic-calendar-last-day-of-month. Update callers. (calendar-coptic-to-absolute): Rename calendar-absolute-from-coptic. Keep old name as alias, update callers. (calendar-coptic-print-date): Rename calendar-print-coptic-date. Keep old name as alias, update callers. (calendar-coptic-goto-date): Rename calendar-goto-coptic-date. Keep old name as alias, update callers. (calendar-ethiopic-month-name-array): Rename ethiopic-calendar-month-name-array. Update callers. (calendar-ethiopic-epoch): Rename ethiopic-calendar-epoch. Update callers. (calendar-ethiopic-name): Rename ethiopic-name. Update callers. (calendar-ethiopic-to-absolute): Rename calendar-absolute-from-ethiopic. Keep old name as alias, update callers. (calendar-ethiopic-print-date): Rename calendar-print-ethiopic-date. Keep old name as alias, update callers. (calendar-ethiopic-goto-date): Rename calendar-goto-ethiopic-date. Keep old name as alias, update callers.
-rw-r--r--lisp/calendar/cal-coptic.el128
1 files changed, 73 insertions, 55 deletions
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 961ce35bf98..217e861dc78 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -35,7 +35,7 @@
35 35
36;; Not constants because they get let-bound. 36;; Not constants because they get let-bound.
37 37
38(defvar coptic-calendar-month-name-array 38(defvar calendar-coptic-month-name-array
39 ["Tut" "Babah" "Hatur" "Kiyahk" "Tubah" "Amshir" "Baramhat" "Barmundah" 39 ["Tut" "Babah" "Hatur" "Kiyahk" "Tubah" "Amshir" "Baramhat" "Barmundah"
40 "Bashans" "Baunah" "Abib" "Misra" "al-Nasi"] 40 "Bashans" "Baunah" "Abib" "Misra" "al-Nasi"]
41 "Array of the month names in the Coptic calendar.") 41 "Array of the month names in the Coptic calendar.")
@@ -43,67 +43,70 @@
43(eval-and-compile 43(eval-and-compile
44 (autoload 'calendar-julian-to-absolute "cal-julian")) 44 (autoload 'calendar-julian-to-absolute "cal-julian"))
45 45
46(defvar coptic-calendar-epoch 46(defvar calendar-coptic-epoch
47 (eval-when-compile (calendar-julian-to-absolute '(8 29 284))) 47 (eval-when-compile (calendar-julian-to-absolute '(8 29 284)))
48 "Absolute date of start of Coptic calendar = August 29, 284 AD (Julian).") 48 "Absolute date of start of Coptic calendar = August 29, 284 AD (Julian).")
49 49
50(defvar coptic-name "Coptic" 50(defvar calendar-coptic-name "Coptic"
51 "Used in some message strings.") 51 "Used in some message strings.")
52 52
53(defun coptic-calendar-leap-year-p (year) 53(defun calendar-coptic-leap-year-p (year)
54 "True if YEAR is a leap year on the Coptic calendar." 54 "True if YEAR is a leap year on the Coptic calendar."
55 (zerop (mod (1+ year) 4))) 55 (zerop (mod (1+ year) 4)))
56 56
57(defun coptic-calendar-last-day-of-month (month year) 57(defun calendar-coptic-last-day-of-month (month year)
58 "Return last day of MONTH, YEAR on the Coptic calendar. 58 "Return last day of MONTH, YEAR on the Coptic calendar.
59The 13th month is not really a month, but the 5 (6 in leap years) day period of 59The 13th month is not really a month, but the 5 (6 in leap years) day period of
60Nisi (Kebus) at the end of the year." 60Nisi (Kebus) at the end of the year."
61 (if (< month 13) 61 (if (< month 13)
62 30 62 30
63 (if (coptic-calendar-leap-year-p year) 63 (if (calendar-coptic-leap-year-p year)
64 6 64 6
65 5))) 65 5)))
66 66
67(defun calendar-absolute-from-coptic (date) 67(defun calendar-coptic-to-absolute (date)
68 "Compute absolute date from Coptic date DATE. 68 "Compute absolute date from Coptic date DATE.
69The absolute date is the number of days elapsed since the (imaginary) 69The absolute date is the number of days elapsed since the (imaginary)
70Gregorian date Sunday, December 31, 1 BC." 70Gregorian date Sunday, December 31, 1 BC."
71 (let ((month (extract-calendar-month date)) 71 (let ((month (extract-calendar-month date))
72 (day (extract-calendar-day date)) 72 (day (extract-calendar-day date))
73 (year (extract-calendar-year date))) 73 (year (extract-calendar-year date)))
74 (+ (1- coptic-calendar-epoch) ; days before start of calendar 74 (+ (1- calendar-coptic-epoch) ; days before start of calendar
75 (* 365 (1- year)) ; days in prior years 75 (* 365 (1- year)) ; days in prior years
76 (/ year 4) ; leap days in prior years 76 (/ year 4) ; leap days in prior years
77 (* 30 (1- month)) ; days in prior months this year 77 (* 30 (1- month)) ; days in prior months this year
78 day))) ; days so far this month 78 day))) ; days so far this month
79 79
80(define-obsolete-function-alias 'calendar-absolute-from-coptic
81 'calendar-coptic-to-absolute "23.1")
82
80(defun calendar-coptic-from-absolute (date) 83(defun calendar-coptic-from-absolute (date)
81 "Compute the Coptic equivalent for absolute date DATE. 84 "Compute the Coptic equivalent for absolute date DATE.
82The result is a list of the form (MONTH DAY YEAR). 85The result is a list of the form (MONTH DAY YEAR).
83The absolute date is the number of days elapsed since the imaginary 86The absolute date is the number of days elapsed since the imaginary
84Gregorian date Sunday, December 31, 1 BC." 87Gregorian date Sunday, December 31, 1 BC."
85 (if (< date coptic-calendar-epoch) 88 (if (< date calendar-coptic-epoch)
86 (list 0 0 0) ; pre-Coptic date 89 (list 0 0 0) ; pre-Coptic date
87 (let* ((approx (/ (- date coptic-calendar-epoch) 90 (let* ((approx (/ (- date calendar-coptic-epoch)
88 366)) ; approximation from below 91 366)) ; approximation from below
89 (year ; search forward from the approximation 92 (year ; search forward from the approximation
90 (+ approx 93 (+ approx
91 (calendar-sum y approx 94 (calendar-sum y approx
92 (>= date (calendar-absolute-from-coptic 95 (>= date (calendar-coptic-to-absolute
93 (list 1 1 (1+ y)))) 96 (list 1 1 (1+ y))))
94 1))) 97 1)))
95 (month ; search forward from Tot 98 (month ; search forward from Tot
96 (1+ (calendar-sum m 1 99 (1+ (calendar-sum m 1
97 (> date 100 (> date
98 (calendar-absolute-from-coptic 101 (calendar-coptic-to-absolute
99 (list m 102 (list m
100 (coptic-calendar-last-day-of-month m 103 (calendar-coptic-last-day-of-month m
101 year) 104 year)
102 year))) 105 year)))
103 1))) 106 1)))
104 (day ; calculate the day by subtraction 107 (day ; calculate the day by subtraction
105 (- date 108 (- date
106 (1- (calendar-absolute-from-coptic (list month 1 year)))))) 109 (1- (calendar-coptic-to-absolute (list month 1 year))))))
107 (list month day year)))) 110 (list month day year))))
108 111
109;;;###cal-autoload 112;;;###cal-autoload
@@ -118,7 +121,7 @@ Defaults to today's date if DATE is not given."
118 (m (extract-calendar-month coptic-date))) 121 (m (extract-calendar-month coptic-date)))
119 (if (< y 1) 122 (if (< y 1)
120 "" 123 ""
121 (let ((monthname (aref coptic-calendar-month-name-array (1- m))) 124 (let ((monthname (aref calendar-coptic-month-name-array (1- m)))
122 (day (int-to-string (extract-calendar-day coptic-date))) 125 (day (int-to-string (extract-calendar-day coptic-date)))
123 (dayname nil) 126 (dayname nil)
124 (month (int-to-string m)) 127 (month (int-to-string m))
@@ -126,20 +129,23 @@ Defaults to today's date if DATE is not given."
126 (mapconcat 'eval calendar-date-display-form ""))))) 129 (mapconcat 'eval calendar-date-display-form "")))))
127 130
128;;;###cal-autoload 131;;;###cal-autoload
129(defun calendar-print-coptic-date () 132(defun calendar-coptic-print-date ()
130 "Show the Coptic calendar equivalent of the selected date." 133 "Show the Coptic calendar equivalent of the selected date."
131 (interactive) 134 (interactive)
132 (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t)))) 135 (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t))))
133 (if (string-equal f "") 136 (if (string-equal f "")
134 (message "Date is pre-%s calendar" coptic-name) 137 (message "Date is pre-%s calendar" calendar-coptic-name)
135 (message "%s date: %s" coptic-name f)))) 138 (message "%s date: %s" calendar-coptic-name f))))
139
140(define-obsolete-function-alias 'calendar-print-coptic-date
141 'calendar-coptic-print-date "23.1")
136 142
137(defun calendar-coptic-read-date () 143(defun calendar-coptic-read-date ()
138 "Interactively read the arguments for a Coptic date command. 144 "Interactively read the arguments for a Coptic date command.
139Reads a year, month, and day." 145Reads a year, month, and day."
140 (let* ((today (calendar-current-date)) 146 (let* ((today (calendar-current-date))
141 (year (calendar-read 147 (year (calendar-read
142 (format "%s calendar year (>0): " coptic-name) 148 (format "%s calendar year (>0): " calendar-coptic-name)
143 (lambda (x) (> x 0)) 149 (lambda (x) (> x 0))
144 (int-to-string 150 (int-to-string
145 (extract-calendar-year 151 (extract-calendar-year
@@ -148,29 +154,32 @@ Reads a year, month, and day."
148 (completion-ignore-case t) 154 (completion-ignore-case t)
149 (month (cdr (assoc-string 155 (month (cdr (assoc-string
150 (completing-read 156 (completing-read
151 (format "%s calendar month name: " coptic-name) 157 (format "%s calendar month name: " calendar-coptic-name)
152 (mapcar 'list 158 (mapcar 'list
153 (append coptic-calendar-month-name-array nil)) 159 (append calendar-coptic-month-name-array nil))
154 nil t) 160 nil t)
155 (calendar-make-alist coptic-calendar-month-name-array 161 (calendar-make-alist calendar-coptic-month-name-array
156 1) t))) 162 1) t)))
157 (last (coptic-calendar-last-day-of-month month year)) 163 (last (calendar-coptic-last-day-of-month month year))
158 (day (calendar-read 164 (day (calendar-read
159 (format "%s calendar day (1-%d): " coptic-name last) 165 (format "%s calendar day (1-%d): " calendar-coptic-name last)
160 (lambda (x) (and (< 0 x) (<= x last)))))) 166 (lambda (x) (and (< 0 x) (<= x last))))))
161 (list (list month day year)))) 167 (list (list month day year))))
162 168
163(define-obsolete-function-alias 169(define-obsolete-function-alias 'coptic-prompt-for-date
164 'coptic-prompt-for-date 'calendar-coptic-read-date "23.1") 170 'calendar-coptic-read-date "23.1")
165 171
166;;;###cal-autoload 172;;;###cal-autoload
167(defun calendar-goto-coptic-date (date &optional noecho) 173(defun calendar-coptic-goto-date (date &optional noecho)
168 "Move cursor to Coptic date DATE. 174 "Move cursor to Coptic date DATE.
169Echo Coptic date unless NOECHO is t." 175Echo Coptic date unless NOECHO is t."
170 (interactive (calendar-coptic-read-date)) 176 (interactive (calendar-coptic-read-date))
171 (calendar-goto-date (calendar-gregorian-from-absolute 177 (calendar-goto-date (calendar-gregorian-from-absolute
172 (calendar-absolute-from-coptic date))) 178 (calendar-coptic-to-absolute date)))
173 (or noecho (calendar-print-coptic-date))) 179 (or noecho (calendar-coptic-print-date)))
180
181(define-obsolete-function-alias 'calendar-goto-coptic-date
182 'calendar-coptic-goto-date "23.1")
174 183
175(defvar date) 184(defvar date)
176 185
@@ -180,33 +189,36 @@ Echo Coptic date unless NOECHO is t."
180 "Coptic calendar equivalent of date diary entry." 189 "Coptic calendar equivalent of date diary entry."
181 (let ((f (calendar-coptic-date-string date))) 190 (let ((f (calendar-coptic-date-string date)))
182 (if (string-equal f "") 191 (if (string-equal f "")
183 (format "Date is pre-%s calendar" coptic-name) 192 (format "Date is pre-%s calendar" calendar-coptic-name)
184 (format "%s date: %s" coptic-name f)))) 193 (format "%s date: %s" calendar-coptic-name f))))
185 194
186(defconst ethiopic-calendar-month-name-array 195(defconst calendar-ethiopic-month-name-array
187 ["Maskaram" "Teqemt" "Khedar" "Takhsas" "Ter" "Yakatit" "Magabit" "Miyazya" 196 ["Maskaram" "Teqemt" "Khedar" "Takhsas" "Ter" "Yakatit" "Magabit" "Miyazya"
188 "Genbot" "Sane" "Hamle" "Nahas" "Paguem"] 197 "Genbot" "Sane" "Hamle" "Nahas" "Paguem"]
189 "Array of the month names in the Ethiopic calendar.") 198 "Array of the month names in the Ethiopic calendar.")
190 199
191(defconst ethiopic-calendar-epoch 2796 200(defconst calendar-ethiopic-epoch 2796
192 "Absolute date of start of Ethiopic calendar = August 29, 8 C.E. (Julian).") 201 "Absolute date of start of Ethiopic calendar = August 29, 8 C.E. (Julian).")
193 202
194(defconst ethiopic-name "Ethiopic" 203(defconst calendar-ethiopic-name "Ethiopic"
195 "Used in some message strings.") 204 "Used in some message strings.")
196 205
197(defun calendar-absolute-from-ethiopic (date) 206(defun calendar-ethiopic-to-absolute (date)
198 "Compute absolute date from Ethiopic date DATE. 207 "Compute absolute date from Ethiopic date DATE.
199The absolute date is the number of days elapsed since the (imaginary) 208The absolute date is the number of days elapsed since the (imaginary)
200Gregorian date Sunday, December 31, 1 BC." 209Gregorian date Sunday, December 31, 1 BC."
201 (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) 210 (let ((calendar-coptic-epoch calendar-ethiopic-epoch))
202 (calendar-absolute-from-coptic date))) 211 (calendar-coptic-to-absolute date)))
212
213(define-obsolete-function-alias 'calendar-absolute-from-ethiopic
214 'calendar-ethiopic-to-absolute "23.1")
203 215
204(defun calendar-ethiopic-from-absolute (date) 216(defun calendar-ethiopic-from-absolute (date)
205 "Compute the Ethiopic equivalent for absolute date DATE. 217 "Compute the Ethiopic equivalent for absolute date DATE.
206The result is a list of the form (MONTH DAY YEAR). 218The result is a list of the form (MONTH DAY YEAR).
207The absolute date is the number of days elapsed since the imaginary 219The absolute date is the number of days elapsed since the imaginary
208Gregorian date Sunday, December 31, 1 BC." 220Gregorian date Sunday, December 31, 1 BC."
209 (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) 221 (let ((calendar-coptic-epoch calendar-ethiopic-epoch))
210 (calendar-coptic-from-absolute date))) 222 (calendar-coptic-from-absolute date)))
211 223
212;;;###cal-autoload 224;;;###cal-autoload
@@ -214,40 +226,46 @@ Gregorian date Sunday, December 31, 1 BC."
214 "String of Ethiopic date of Gregorian DATE. 226 "String of Ethiopic date of Gregorian DATE.
215Returns the empty string if DATE is pre-Ethiopic calendar. 227Returns the empty string if DATE is pre-Ethiopic calendar.
216Defaults to today's date if DATE is not given." 228Defaults to today's date if DATE is not given."
217 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) 229 (let ((calendar-coptic-epoch calendar-ethiopic-epoch)
218 (coptic-name ethiopic-name) 230 (calendar-coptic-name calendar-ethiopic-name)
219 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) 231 (calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
220 (calendar-coptic-date-string date))) 232 (calendar-coptic-date-string date)))
221 233
222;;;###cal-autoload 234;;;###cal-autoload
223(defun calendar-print-ethiopic-date () 235(defun calendar-ethiopic-print-date ()
224 "Show the Ethiopic calendar equivalent of the selected date." 236 "Show the Ethiopic calendar equivalent of the selected date."
225 (interactive) 237 (interactive)
226 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) 238 (let ((calendar-coptic-epoch calendar-ethiopic-epoch)
227 (coptic-name ethiopic-name) 239 (calendar-coptic-name calendar-ethiopic-name)
228 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) 240 (calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
229 (call-interactively 'calendar-print-coptic-date))) 241 (call-interactively 'calendar-coptic-print-date)))
242
243(define-obsolete-function-alias 'calendar-print-ethiopic-date
244 'calendar-ethiopic-print-date "23.1")
230 245
231;;;###cal-autoload 246;;;###cal-autoload
232(defun calendar-goto-ethiopic-date (date &optional noecho) 247(defun calendar-ethiopic-goto-date (date &optional noecho)
233 "Move cursor to Ethiopic date DATE. 248 "Move cursor to Ethiopic date DATE.
234Echo Ethiopic date unless NOECHO is t." 249Echo Ethiopic date unless NOECHO is t."
235 (interactive 250 (interactive
236 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) 251 (let ((calendar-coptic-epoch calendar-ethiopic-epoch)
237 (coptic-name ethiopic-name) 252 (calendar-coptic-name calendar-ethiopic-name)
238 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) 253 (calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
239 (calendar-coptic-read-date))) 254 (calendar-coptic-read-date)))
240 (calendar-goto-date (calendar-gregorian-from-absolute 255 (calendar-goto-date (calendar-gregorian-from-absolute
241 (calendar-absolute-from-ethiopic date))) 256 (calendar-ethiopic-to-absolute date)))
242 (or noecho (calendar-print-ethiopic-date))) 257 (or noecho (calendar-ethiopic-print-date)))
258
259(define-obsolete-function-alias 'calendar-goto-ethiopic-date
260 'calendar-ethiopic-goto-date "23.1")
243 261
244;; To be called from list-sexp-diary-entries, where DATE is bound. 262;; To be called from list-sexp-diary-entries, where DATE is bound.
245;;;###diary-autoload 263;;;###diary-autoload
246(defun diary-ethiopic-date () 264(defun diary-ethiopic-date ()
247 "Ethiopic calendar equivalent of date diary entry." 265 "Ethiopic calendar equivalent of date diary entry."
248 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) 266 (let ((calendar-coptic-epoch calendar-ethiopic-epoch)
249 (coptic-name ethiopic-name) 267 (calendar-coptic-name calendar-ethiopic-name)
250 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) 268 (calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
251 (diary-coptic-date))) 269 (diary-coptic-date)))
252 270
253(provide 'cal-coptic) 271(provide 'cal-coptic)