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 |