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