Mercurial > emacs
comparison lisp/calendar/cal-french.el @ 5699:a2d78b648542
(calendar-french-date-string): New function.
(calendar-print-french-date, diary-french-date): Use it.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 30 Jan 1994 00:29:32 +0000 |
parents | 3733a396e16a |
children | 10ea561bcaa5 |
comparison
equal
deleted
inserted
replaced
5698:d127e0963a2c | 5699:a2d78b648542 |
---|---|
125 (day ;; Calculate the day by subtraction. | 125 (day ;; Calculate the day by subtraction. |
126 (- date | 126 (- date |
127 (1- (calendar-absolute-from-french (list month 1 year)))))) | 127 (1- (calendar-absolute-from-french (list month 1 year)))))) |
128 (list month day year)))) | 128 (list month day year)))) |
129 | 129 |
130 (defun calendar-french-date-string (&optional date) | |
131 "String of French Revolutionary date of Gregorian DATE. | |
132 Returns the empty string if DATE is pre-French Revolutionary. | |
133 Defaults to today's date if DATE is not given." | |
134 (let* ((french-date (calendar-french-from-absolute | |
135 (calendar-absolute-from-gregorian | |
136 (or date (calendar-current-date))))) | |
137 (y (extract-calendar-year french-date)) | |
138 (m (extract-calendar-month french-date)) | |
139 (d (extract-calendar-day french-date))) | |
140 (cond | |
141 ((< y 1) "") | |
142 ((= m 13) (format "Jour %s de l'Anne'e %d de la Revolution" | |
143 (aref french-calendar-special-days-array (1- d)) | |
144 y)) | |
145 (t (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" | |
146 (make-string (1+ (/ (1- d) 10)) ?I) | |
147 (aref french-calendar-day-name-array (% (1- d) 10)) | |
148 (aref french-calendar-month-name-array (1- m)) | |
149 y))))) | |
150 | |
130 (defun calendar-print-french-date () | 151 (defun calendar-print-french-date () |
131 "Show the French Revolutionary calendar equivalent of the selected date." | 152 "Show the French Revolutionary calendar equivalent of the selected date." |
132 (interactive) | 153 (interactive) |
133 (let* ((french-date (calendar-french-from-absolute | 154 (let ((f (calendar-french-date-string |
134 (calendar-absolute-from-gregorian | 155 (or (calendar-cursor-to-date) |
135 (or (calendar-cursor-to-date) | 156 (error "Cursor is not on a date!"))))) |
136 (error "Cursor is not on a date!"))))) | 157 (if (string-equal f "") |
137 (y (extract-calendar-year french-date)) | |
138 (m (extract-calendar-month french-date)) | |
139 (d (extract-calendar-day french-date))) | |
140 (if (< y 1) | |
141 (message "Date is pre-French Revolution") | 158 (message "Date is pre-French Revolution") |
142 (if (= m 13) | 159 (message f)))) |
143 (message "Jour %s de l'Anne'e %d de la Revolution" | |
144 (aref french-calendar-special-days-array (1- d)) | |
145 y) | |
146 (message "Decade %s, %s de %s de l'Anne'e %d de la Revolution" | |
147 (make-string (1+ (/ (1- d) 10)) ?I) | |
148 (aref french-calendar-day-name-array (% (1- d) 10)) | |
149 (aref french-calendar-month-name-array (1- m)) | |
150 y))))) | |
151 | 160 |
152 (defun calendar-goto-french-date (date &optional noecho) | 161 (defun calendar-goto-french-date (date &optional noecho) |
153 "Move cursor to French Revolutionary date DATE. | 162 "Move cursor to French Revolutionary date DATE. |
154 Echo French Revolutionary date unless NOECHO is t." | 163 Echo French Revolutionary date unless NOECHO is t." |
155 (interactive | 164 (interactive |
202 (calendar-absolute-from-french date))) | 211 (calendar-absolute-from-french date))) |
203 (or noecho (calendar-print-french-date))) | 212 (or noecho (calendar-print-french-date))) |
204 | 213 |
205 (defun diary-french-date () | 214 (defun diary-french-date () |
206 "French calendar equivalent of date diary entry." | 215 "French calendar equivalent of date diary entry." |
207 (let* ((french-date (calendar-french-from-absolute | 216 (let ((f (calendar-french-date-string |
208 (calendar-absolute-from-gregorian date))) | 217 (or (calendar-cursor-to-date) |
209 (y (extract-calendar-year french-date)) | 218 (error "Cursor is not on a date!"))))) |
210 (m (extract-calendar-month french-date)) | 219 (if (string-equal f "") |
211 (d (extract-calendar-day french-date))) | 220 "Date is pre-French Revolution" |
212 (if (> y 0) | 221 f))) |
213 (if (= m 13) | |
214 (format "Jour %s de l'Anne'e %d de la Revolution" | |
215 (aref french-calendar-special-days-array (1- d)) | |
216 y) | |
217 (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" | |
218 (make-string (1+ (/ (1- d) 10)) ?I) | |
219 (aref french-calendar-day-name-array (% (1- d) 10)) | |
220 (aref french-calendar-month-name-array (1- m)) | |
221 y))))) | |
222 | 222 |
223 (provide 'cal-french) | 223 (provide 'cal-french) |
224 | 224 |
225 ;;; cal-french.el ends here | 225 ;;; cal-french.el ends here |