Mercurial > emacs
comparison lisp/calendar/cal-coptic.el @ 92580:2a9b05a547d4
Unquote lambda functions. Add autoload cookies to functions formerly
autoloaded in calendar.el. Set `generated-autoload-file' to
"cal-loaddefs.el".
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 08 Mar 2008 03:40:14 +0000 |
parents | 974a828870fe |
children | 28583a8ab749 |
comparison
equal
deleted
inserted
replaced
92579:8ddfb879916b | 92580:2a9b05a547d4 |
---|---|
102 (day ;; Calculate the day by subtraction. | 102 (day ;; Calculate the day by subtraction. |
103 (- date | 103 (- date |
104 (1- (calendar-absolute-from-coptic (list month 1 year)))))) | 104 (1- (calendar-absolute-from-coptic (list month 1 year)))))) |
105 (list month day year)))) | 105 (list month day year)))) |
106 | 106 |
107 ;;;###autoload | |
107 (defun calendar-coptic-date-string (&optional date) | 108 (defun calendar-coptic-date-string (&optional date) |
108 "String of Coptic date of Gregorian DATE. | 109 "String of Coptic date of Gregorian DATE. |
109 Returns the empty string if DATE is pre-Coptic calendar. | 110 Returns the empty string if DATE is pre-Coptic calendar. |
110 Defaults to today's date if DATE is not given." | 111 Defaults to today's date if DATE is not given." |
111 (let* ((coptic-date (calendar-coptic-from-absolute | 112 (let* ((coptic-date (calendar-coptic-from-absolute |
120 (dayname nil) | 121 (dayname nil) |
121 (month (int-to-string m)) | 122 (month (int-to-string m)) |
122 (year (int-to-string y))) | 123 (year (int-to-string y))) |
123 (mapconcat 'eval calendar-date-display-form ""))))) | 124 (mapconcat 'eval calendar-date-display-form ""))))) |
124 | 125 |
126 ;;;###autoload | |
125 (defun calendar-print-coptic-date () | 127 (defun calendar-print-coptic-date () |
126 "Show the Coptic calendar equivalent of the selected date." | 128 "Show the Coptic calendar equivalent of the selected date." |
127 (interactive) | 129 (interactive) |
128 (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t)))) | 130 (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t)))) |
129 (if (string-equal f "") | 131 (if (string-equal f "") |
130 (message "Date is pre-%s calendar" coptic-name) | 132 (message "Date is pre-%s calendar" coptic-name) |
131 (message "%s date: %s" coptic-name f)))) | 133 (message "%s date: %s" coptic-name f)))) |
132 | 134 |
135 ;;;###autoload | |
133 (defun calendar-goto-coptic-date (date &optional noecho) | 136 (defun calendar-goto-coptic-date (date &optional noecho) |
134 "Move cursor to Coptic date DATE. | 137 "Move cursor to Coptic date DATE. |
135 Echo Coptic date unless NOECHO is t." | 138 Echo Coptic date unless NOECHO is t." |
136 (interactive (coptic-prompt-for-date)) | 139 (interactive (coptic-prompt-for-date)) |
137 (calendar-goto-date (calendar-gregorian-from-absolute | 140 (calendar-goto-date (calendar-gregorian-from-absolute |
141 (defun coptic-prompt-for-date () | 144 (defun coptic-prompt-for-date () |
142 "Ask for a Coptic date." | 145 "Ask for a Coptic date." |
143 (let* ((today (calendar-current-date)) | 146 (let* ((today (calendar-current-date)) |
144 (year (calendar-read | 147 (year (calendar-read |
145 (format "%s calendar year (>0): " coptic-name) | 148 (format "%s calendar year (>0): " coptic-name) |
146 '(lambda (x) (> x 0)) | 149 (lambda (x) (> x 0)) |
147 (int-to-string | 150 (int-to-string |
148 (extract-calendar-year | 151 (extract-calendar-year |
149 (calendar-coptic-from-absolute | 152 (calendar-coptic-from-absolute |
150 (calendar-absolute-from-gregorian today)))))) | 153 (calendar-absolute-from-gregorian today)))))) |
151 (completion-ignore-case t) | 154 (completion-ignore-case t) |
158 (calendar-make-alist coptic-calendar-month-name-array | 161 (calendar-make-alist coptic-calendar-month-name-array |
159 1) t))) | 162 1) t))) |
160 (last (coptic-calendar-last-day-of-month month year)) | 163 (last (coptic-calendar-last-day-of-month month year)) |
161 (day (calendar-read | 164 (day (calendar-read |
162 (format "%s calendar day (1-%d): " coptic-name last) | 165 (format "%s calendar day (1-%d): " coptic-name last) |
163 '(lambda (x) (and (< 0 x) (<= x last)))))) | 166 (lambda (x) (and (< 0 x) (<= x last)))))) |
164 (list (list month day year)))) | 167 (list (list month day year)))) |
165 | 168 |
166 (defun diary-coptic-date () | 169 (defun diary-coptic-date () |
167 "Coptic calendar equivalent of date diary entry." | 170 "Coptic calendar equivalent of date diary entry." |
168 (let ((f (calendar-coptic-date-string date))) | 171 (let ((f (calendar-coptic-date-string date))) |
192 The absolute date is the number of days elapsed since the imaginary | 195 The absolute date is the number of days elapsed since the imaginary |
193 Gregorian date Sunday, December 31, 1 BC." | 196 Gregorian date Sunday, December 31, 1 BC." |
194 (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) | 197 (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) |
195 (calendar-coptic-from-absolute date))) | 198 (calendar-coptic-from-absolute date))) |
196 | 199 |
200 ;;;###autoload | |
197 (defun calendar-ethiopic-date-string (&optional date) | 201 (defun calendar-ethiopic-date-string (&optional date) |
198 "String of Ethiopic date of Gregorian DATE. | 202 "String of Ethiopic date of Gregorian DATE. |
199 Returns the empty string if DATE is pre-Ethiopic calendar. | 203 Returns the empty string if DATE is pre-Ethiopic calendar. |
200 Defaults to today's date if DATE is not given." | 204 Defaults to today's date if DATE is not given." |
201 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) | 205 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) |
202 (coptic-name ethiopic-name) | 206 (coptic-name ethiopic-name) |
203 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) | 207 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) |
204 (calendar-coptic-date-string date))) | 208 (calendar-coptic-date-string date))) |
205 | 209 |
210 ;;;###autoload | |
206 (defun calendar-print-ethiopic-date () | 211 (defun calendar-print-ethiopic-date () |
207 "Show the Ethiopic calendar equivalent of the selected date." | 212 "Show the Ethiopic calendar equivalent of the selected date." |
208 (interactive) | 213 (interactive) |
209 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) | 214 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) |
210 (coptic-name ethiopic-name) | 215 (coptic-name ethiopic-name) |
211 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) | 216 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) |
212 (call-interactively 'calendar-print-coptic-date))) | 217 (call-interactively 'calendar-print-coptic-date))) |
213 | 218 |
219 ;;;###autoload | |
214 (defun calendar-goto-ethiopic-date (date &optional noecho) | 220 (defun calendar-goto-ethiopic-date (date &optional noecho) |
215 "Move cursor to Ethiopic date DATE. | 221 "Move cursor to Ethiopic date DATE. |
216 Echo Ethiopic date unless NOECHO is t." | 222 Echo Ethiopic date unless NOECHO is t." |
217 (interactive | 223 (interactive |
218 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) | 224 (let ((coptic-calendar-epoch ethiopic-calendar-epoch) |
230 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) | 236 (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) |
231 (diary-coptic-date))) | 237 (diary-coptic-date))) |
232 | 238 |
233 (provide 'cal-coptic) | 239 (provide 'cal-coptic) |
234 | 240 |
235 ;;; arch-tag: 72d49161-25df-4072-9312-b182cdca7627 | 241 ;; Local Variables: |
242 ;; generated-autoload-file: "cal-loaddefs.el" | |
243 ;; End: | |
244 | |
245 ;; arch-tag: 72d49161-25df-4072-9312-b182cdca7627 | |
236 ;;; cal-coptic.el ends here | 246 ;;; cal-coptic.el ends here |