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 |