Mercurial > emacs
comparison lisp/calendar/cal-french.el @ 93717:73275d7e89b7
(calendar-french-epoch): Rename french-calendar-epoch. Update callers.
(calendar-french-month-name-array): Rename variable and function
french-calendar-month-name-array. Update callers.
(calendar-french-multibyte-month-name-array): Rename
french-calendar-multibyte-month-name-array. Update callers.
(calendar-french-day-name-array): Rename variable and function
french-calendar-day-name-array. Update callers.
(calendar-french-special-days-array): Rename variable and function
french-calendar-special-days-array. Update callers.
(calendar-french-multibyte-special-days-array): Rename
french-calendar-multibyte-special-days-array. Update callers.
(calendar-french-accents-p): Rename french-calendar-accents. Update callers.
(calendar-french-leap-year-p): Rename french-calendar-leap-year-p.
Update callers.
(calendar-french-last-day-of-month): Rename french-calendar-last-day-of-month.
Update callers.
(calendar-french-to-absolute): Rename calendar-absolute-from-french.
Keep old name as alias, update callers.
(calendar-french-print-date): Rename calendar-print-french-date.
Keep old name as alias, update callers.
(calendar-french-goto-date): Rename calendar-goto-french-date.
Keep old name as alias.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 05 Apr 2008 19:14:28 +0000 |
parents | 2aa65ff3876d |
children | 1eed5494bf3f |
comparison
equal
deleted
inserted
replaced
93716:144a6495a5a4 | 93717:73275d7e89b7 |
---|---|
31 | 31 |
32 ;;; Code: | 32 ;;; Code: |
33 | 33 |
34 (require 'calendar) | 34 (require 'calendar) |
35 | 35 |
36 (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) | 36 (defconst calendar-french-epoch (calendar-absolute-from-gregorian '(9 22 1792)) |
37 "Absolute date of start of French Revolutionary calendar = Sept 22, 1792.") | 37 "Absolute date of start of French Revolutionary calendar = Sept 22, 1792.") |
38 | 38 |
39 (defconst french-calendar-month-name-array | 39 (defconst calendar-french-month-name-array |
40 ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" | 40 ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" |
41 "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"] | 41 "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"] |
42 "Array of month names in the French calendar.") | 42 "Array of month names in the French calendar.") |
43 | 43 |
44 (defconst french-calendar-multibyte-month-name-array | 44 (defconst calendar-french-multibyte-month-name-array |
45 ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" | 45 ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" |
46 "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] | 46 "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] |
47 "Array of multibyte month names in the French calendar.") | 47 "Array of multibyte month names in the French calendar.") |
48 | 48 |
49 (defconst french-calendar-day-name-array | 49 (defconst calendar-french-day-name-array |
50 ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" | 50 ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" |
51 "Octidi" "Nonidi" "Decadi"] | 51 "Octidi" "Nonidi" "Decadi"] |
52 "Array of day names in the French calendar.") | 52 "Array of day names in the French calendar.") |
53 | 53 |
54 (defconst french-calendar-special-days-array | 54 (defconst calendar-french-special-days-array |
55 ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses" | 55 ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses" |
56 "de la Re'volution"] | 56 "de la Re'volution"] |
57 "Array of special day names in the French calendar.") | 57 "Array of special day names in the French calendar.") |
58 | 58 |
59 (defconst french-calendar-multibyte-special-days-array | 59 (defconst calendar-french-multibyte-special-days-array |
60 ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" | 60 ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" |
61 "de la Révolution"] | 61 "de la Révolution"] |
62 "Array of multibyte special day names in the French calendar.") | 62 "Array of multibyte special day names in the French calendar.") |
63 | 63 |
64 (defun french-calendar-accents () | 64 (defun calendar-french-accents-p () |
65 "Return non-nil if diacritical marks are available." | 65 "Return non-nil if diacritical marks are available." |
66 (and (or window-system | 66 (and (or window-system |
67 (terminal-coding-system)) | 67 (terminal-coding-system)) |
68 (or enable-multibyte-characters | 68 (or enable-multibyte-characters |
69 (and (char-table-p standard-display-table) | 69 (and (char-table-p standard-display-table) |
70 (equal (aref standard-display-table 161) [161]))))) | 70 (equal (aref standard-display-table 161) [161]))))) |
71 | 71 |
72 (defun french-calendar-month-name-array () | 72 (defun calendar-french-month-name-array () |
73 "Return the array of month names, depending on whether accents are available." | 73 "Return the array of month names, depending on whether accents are available." |
74 (if (french-calendar-accents) | 74 (if (calendar-french-accents-p) |
75 french-calendar-multibyte-month-name-array | 75 calendar-french-multibyte-month-name-array |
76 french-calendar-month-name-array)) | 76 calendar-french-month-name-array)) |
77 | 77 |
78 (defun french-calendar-day-name-array () | 78 (defun calendar-french-day-name-array () |
79 "Return the array of day names." | 79 "Return the array of day names." |
80 french-calendar-day-name-array) | 80 calendar-french-day-name-array) |
81 | 81 |
82 (defun french-calendar-special-days-array () | 82 (defun calendar-french-special-days-array () |
83 "Return the special day names, depending on whether accents are available." | 83 "Return the special day names, depending on whether accents are available." |
84 (if (french-calendar-accents) | 84 (if (calendar-french-accents-p) |
85 french-calendar-multibyte-special-days-array | 85 calendar-french-multibyte-special-days-array |
86 french-calendar-special-days-array)) | 86 calendar-french-special-days-array)) |
87 | 87 |
88 (defun french-calendar-leap-year-p (year) | 88 (defun calendar-french-leap-year-p (year) |
89 "True if YEAR is a leap year on the French Revolutionary calendar. | 89 "True if YEAR is a leap year on the French Revolutionary calendar. |
90 For Gregorian years 1793 to 1805, the years of actual operation of the | 90 For Gregorian years 1793 to 1805, the years of actual operation of the |
91 calendar, follows historical practice based on equinoxes (years 3, 7, | 91 calendar, follows historical practice based on equinoxes (years 3, 7, |
92 and 11 were leap years; 15 and 20 would have been leap years). For later | 92 and 11 were leap years; 15 and 20 would have been leap years). For later |
93 years uses the proposed rule of Romme (never adopted)--leap years fall every | 93 years uses the proposed rule of Romme (never adopted)--leap years fall every |
98 (and (> year 20) ; Romme's proposal--never adopted | 98 (and (> year 20) ; Romme's proposal--never adopted |
99 (zerop (% year 4)) | 99 (zerop (% year 4)) |
100 (not (memq (% year 400) '(100 200 300))) | 100 (not (memq (% year 400) '(100 200 300))) |
101 (not (zerop (% year 4000)))))) | 101 (not (zerop (% year 4000)))))) |
102 | 102 |
103 (defun french-calendar-last-day-of-month (month year) | 103 (defun calendar-french-last-day-of-month (month year) |
104 "Return last day of MONTH, YEAR on the French Revolutionary calendar. | 104 "Return last day of MONTH, YEAR on the French Revolutionary calendar. |
105 The 13th month is not really a month, but the 5 (6 in leap years) day period of | 105 The 13th month is not really a month, but the 5 (6 in leap years) day period of |
106 `sansculottides' at the end of the year." | 106 `sansculottides' at the end of the year." |
107 (if (< month 13) | 107 (if (< month 13) |
108 30 | 108 30 |
109 (if (french-calendar-leap-year-p year) | 109 (if (calendar-french-leap-year-p year) |
110 6 | 110 6 |
111 5))) | 111 5))) |
112 | 112 |
113 (defun calendar-absolute-from-french (date) | 113 (defun calendar-french-to-absolute (date) |
114 "Compute absolute date from French Revolutionary date DATE. | 114 "Compute absolute date from French Revolutionary date DATE. |
115 The absolute date is the number of days elapsed since the (imaginary) | 115 The absolute date is the number of days elapsed since the (imaginary) |
116 Gregorian date Sunday, December 31, 1 BC." | 116 Gregorian date Sunday, December 31, 1 BC." |
117 (let ((month (extract-calendar-month date)) | 117 (let ((month (extract-calendar-month date)) |
118 (day (extract-calendar-day date)) | 118 (day (extract-calendar-day date)) |
126 (- (/ (1- year) 100)) | 126 (- (/ (1- year) 100)) |
127 (/ (1- year) 400) | 127 (/ (1- year) 400) |
128 (- (/ (1- year) 4000)))) | 128 (- (/ (1- year) 4000)))) |
129 (* 30 (1- month)) ; days in prior months this year | 129 (* 30 (1- month)) ; days in prior months this year |
130 day ; days so far this month | 130 day ; days so far this month |
131 (1- french-calendar-epoch)))) ; days before start of calendar | 131 (1- calendar-french-epoch)))) ; days before start of calendar |
132 | |
133 (define-obsolete-function-alias 'calendar-absolute-from-french | |
134 'calendar-french-to-absolute "23.1") | |
132 | 135 |
133 (defun calendar-french-from-absolute (date) | 136 (defun calendar-french-from-absolute (date) |
134 "Compute the French Revolutionary equivalent for absolute date DATE. | 137 "Compute the French Revolutionary equivalent for absolute date DATE. |
135 The result is a list of the form (MONTH DAY YEAR). | 138 The result is a list of the form (MONTH DAY YEAR). |
136 The absolute date is the number of days elapsed since the | 139 The absolute date is the number of days elapsed since the |
137 \(imaginary) Gregorian date Sunday, December 31, 1 BC." | 140 \(imaginary) Gregorian date Sunday, December 31, 1 BC." |
138 (if (< date french-calendar-epoch) | 141 (if (< date calendar-french-epoch) |
139 (list 0 0 0) ; pre-French Revolutionary date | 142 (list 0 0 0) ; pre-French Revolutionary date |
140 (let* ((approx ; approximation from below | 143 (let* ((approx ; approximation from below |
141 (/ (- date french-calendar-epoch) 366)) | 144 (/ (- date calendar-french-epoch) 366)) |
142 (year ; search forward from the approximation | 145 (year ; search forward from the approximation |
143 (+ approx | 146 (+ approx |
144 (calendar-sum y approx | 147 (calendar-sum y approx |
145 (>= date (calendar-absolute-from-french | 148 (>= date (calendar-french-to-absolute |
146 (list 1 1 (1+ y)))) | 149 (list 1 1 (1+ y)))) |
147 1))) | 150 1))) |
148 (month ; search forward from Vendemiaire | 151 (month ; search forward from Vendemiaire |
149 (1+ (calendar-sum m 1 | 152 (1+ (calendar-sum m 1 |
150 (> date | 153 (> date |
151 (calendar-absolute-from-french | 154 (calendar-french-to-absolute |
152 (list m | 155 (list m |
153 (french-calendar-last-day-of-month | 156 (calendar-french-last-day-of-month |
154 m year) | 157 m year) |
155 year))) | 158 year))) |
156 1))) | 159 1))) |
157 (day ; calculate the day by subtraction | 160 (day ; calculate the day by subtraction |
158 (- date | 161 (- date |
159 (1- (calendar-absolute-from-french (list month 1 year)))))) | 162 (1- (calendar-french-to-absolute (list month 1 year)))))) |
160 (list month day year)))) | 163 (list month day year)))) |
161 | 164 |
162 ;;;###cal-autoload | 165 ;;;###cal-autoload |
163 (defun calendar-french-date-string (&optional date) | 166 (defun calendar-french-date-string (&optional date) |
164 "String of French Revolutionary date of Gregorian DATE. | 167 "String of French Revolutionary date of Gregorian DATE. |
170 (y (extract-calendar-year french-date)) | 173 (y (extract-calendar-year french-date)) |
171 (m (extract-calendar-month french-date)) | 174 (m (extract-calendar-month french-date)) |
172 (d (extract-calendar-day french-date))) | 175 (d (extract-calendar-day french-date))) |
173 (cond | 176 (cond |
174 ((< y 1) "") | 177 ((< y 1) "") |
175 ((= m 13) (format (if (french-calendar-accents) | 178 ((= m 13) (format (if (calendar-french-accents-p) |
176 "Jour %s de l'Année %d de la Révolution" | 179 "Jour %s de l'Année %d de la Révolution" |
177 "Jour %s de l'Anne'e %d de la Re'volution") | 180 "Jour %s de l'Anne'e %d de la Re'volution") |
178 (aref (french-calendar-special-days-array) (1- d)) | 181 (aref (calendar-french-special-days-array) (1- d)) |
179 y)) | 182 y)) |
180 (t (format | 183 (t (format |
181 (if (french-calendar-accents) | 184 (if (calendar-french-accents-p) |
182 "%d %s an %d de la Révolution" | 185 "%d %s an %d de la Révolution" |
183 "%d %s an %d de la Re'volution") | 186 "%d %s an %d de la Re'volution") |
184 d | 187 d |
185 (aref (french-calendar-month-name-array) (1- m)) | 188 (aref (calendar-french-month-name-array) (1- m)) |
186 y))))) | 189 y))))) |
187 | 190 |
188 ;;;###cal-autoload | 191 ;;;###cal-autoload |
189 (defun calendar-print-french-date () | 192 (defun calendar-french-print-date () |
190 "Show the French Revolutionary calendar equivalent of the selected date." | 193 "Show the French Revolutionary calendar equivalent of the selected date." |
191 (interactive) | 194 (interactive) |
192 (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) | 195 (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) |
193 (if (string-equal f "") | 196 (if (string-equal f "") |
194 (message "Date is pre-French Revolution") | 197 (message "Date is pre-French Revolution") |
195 (message "French Revolutionary date: %s" f)))) | 198 (message "French Revolutionary date: %s" f)))) |
196 | 199 |
200 (define-obsolete-function-alias 'calendar-print-french-date | |
201 'calendar-french-print-date "23.1") | |
202 | |
197 ;;;###cal-autoload | 203 ;;;###cal-autoload |
198 (defun calendar-goto-french-date (date &optional noecho) | 204 (defun calendar-french-goto-date (date &optional noecho) |
199 "Move cursor to French Revolutionary date DATE. | 205 "Move cursor to French Revolutionary date DATE. |
200 Echo French Revolutionary date unless NOECHO is non-nil." | 206 Echo French Revolutionary date unless NOECHO is non-nil." |
201 (interactive | 207 (interactive |
202 (let* ((months (french-calendar-month-name-array)) | 208 (let* ((months (calendar-french-month-name-array)) |
203 (special-days (french-calendar-special-days-array)) | 209 (special-days (calendar-french-special-days-array)) |
204 (year (progn | 210 (year (progn |
205 (calendar-read | 211 (calendar-read |
206 (if (french-calendar-accents) | 212 (if (calendar-french-accents-p) |
207 "Année de la Révolution (>0): " | 213 "Année de la Révolution (>0): " |
208 "Anne'e de la Re'volution (>0): ") | 214 "Anne'e de la Re'volution (>0): ") |
209 (lambda (x) (> x 0)) | 215 (lambda (x) (> x 0)) |
210 (int-to-string | 216 (int-to-string |
211 (extract-calendar-year | 217 (extract-calendar-year |
213 (calendar-absolute-from-gregorian | 219 (calendar-absolute-from-gregorian |
214 (calendar-current-date)))))))) | 220 (calendar-current-date)))))))) |
215 (month-list | 221 (month-list |
216 (mapcar 'list | 222 (mapcar 'list |
217 (append months | 223 (append months |
218 (if (french-calendar-leap-year-p year) | 224 (if (calendar-french-leap-year-p year) |
219 (mapcar | 225 (mapcar |
220 (lambda (x) (concat "Jour " x)) | 226 (lambda (x) (concat "Jour " x)) |
221 french-calendar-special-days-array) | 227 calendar-french-special-days-array) |
222 (reverse | 228 (reverse |
223 (cdr ; we don't want rev. day in a non-leap yr | 229 (cdr ; we don't want rev. day in a non-leap yr |
224 (reverse | 230 (reverse |
225 (mapcar | 231 (mapcar |
226 (lambda (x) | 232 (lambda (x) |
239 "Jour (1-30): " | 245 "Jour (1-30): " |
240 (lambda (x) (and (<= 1 x) (<= x 30)))))) | 246 (lambda (x) (and (<= 1 x) (<= x 30)))))) |
241 (month (if (> month 12) 13 month))) | 247 (month (if (> month 12) 13 month))) |
242 (list (list month day year)))) | 248 (list (list month day year)))) |
243 (calendar-goto-date (calendar-gregorian-from-absolute | 249 (calendar-goto-date (calendar-gregorian-from-absolute |
244 (calendar-absolute-from-french date))) | 250 (calendar-french-to-absolute date))) |
245 (or noecho (calendar-print-french-date))) | 251 (or noecho (calendar-french-print-date))) |
252 | |
253 (define-obsolete-function-alias 'calendar-goto-french-date | |
254 'calendar-french-goto-date "23.1") | |
246 | 255 |
247 (defvar date) | 256 (defvar date) |
248 | 257 |
249 ;; To be called from list-sexp-diary-entries, where DATE is bound. | 258 ;; To be called from list-sexp-diary-entries, where DATE is bound. |
250 ;;;###diary-autoload | 259 ;;;###diary-autoload |