Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-french.el --- calendar functions for the French Revolutionary calendar |
7e1dae73 | 2 | |
acaf905b | 3 | ;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2012 |
e9bffc61 | 4 | ;; Free Software Foundation, Inc. |
7e1dae73 JB |
5 | |
6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
dbfca9c4 | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
e9571d2a ER |
8 | ;; Keywords: calendar |
9 | ;; Human-Keywords: French Revolutionary calendar, calendar, diary | |
bd78fa1d | 10 | ;; Package: calendar |
7e1dae73 JB |
11 | |
12 | ;; This file is part of GNU Emacs. | |
13 | ||
2ed66575 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 15 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
16 | ;; the Free Software Foundation, either version 3 of the License, or |
17 | ;; (at your option) any later version. | |
59243403 | 18 | |
7e1dae73 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
7e1dae73 JB |
26 | |
27 | ;;; Commentary: | |
28 | ||
eaf7038f | 29 | ;; See calendar.el. |
7e1dae73 | 30 | |
7e1dae73 JB |
31 | ;;; Code: |
32 | ||
33 | (require 'calendar) | |
34 | ||
d8e55af8 | 35 | (defconst calendar-french-epoch (calendar-absolute-from-gregorian '(9 22 1792)) |
5424a530 | 36 | "Absolute date of start of French Revolutionary calendar = Sept 22, 1792.") |
9fadf1a5 | 37 | |
d8e55af8 | 38 | (defconst calendar-french-month-name-array |
780249f8 | 39 | ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" |
5424a530 GM |
40 | "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"] |
41 | "Array of month names in the French calendar.") | |
780249f8 | 42 | |
d8e55af8 | 43 | (defconst calendar-french-multibyte-month-name-array |
1a355d09 GM |
44 | ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" |
45 | "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] | |
5424a530 | 46 | "Array of multibyte month names in the French calendar.") |
7e1dae73 | 47 | |
d8e55af8 | 48 | (defconst calendar-french-day-name-array |
7e1dae73 | 49 | ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" |
5424a530 GM |
50 | "Octidi" "Nonidi" "Decadi"] |
51 | "Array of day names in the French calendar.") | |
52 | ||
d8e55af8 | 53 | (defconst calendar-french-special-days-array |
5424a530 GM |
54 | ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses" |
55 | "de la Re'volution"] | |
56 | "Array of special day names in the French calendar.") | |
7e1dae73 | 57 | |
d8e55af8 | 58 | (defconst calendar-french-multibyte-special-days-array |
1a355d09 GM |
59 | ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" |
60 | "de la Révolution"] | |
5424a530 | 61 | "Array of multibyte special day names in the French calendar.") |
780249f8 | 62 | |
d8e55af8 | 63 | (defun calendar-french-accents-p () |
071f8d93 | 64 | "Return non-nil if diacritical marks are available." |
5424a530 GM |
65 | (and (or window-system |
66 | (terminal-coding-system)) | |
67 | (or enable-multibyte-characters | |
68 | (and (char-table-p standard-display-table) | |
69 | (equal (aref standard-display-table 161) [161]))))) | |
7e1dae73 | 70 | |
d8e55af8 | 71 | (defun calendar-french-month-name-array () |
a4723d1f | 72 | "Return the array of month names, depending on whether accents are available." |
d8e55af8 GM |
73 | (if (calendar-french-accents-p) |
74 | calendar-french-multibyte-month-name-array | |
75 | calendar-french-month-name-array)) | |
09fd1a1a | 76 | |
d8e55af8 | 77 | (defun calendar-french-day-name-array () |
a4723d1f | 78 | "Return the array of day names." |
d8e55af8 | 79 | calendar-french-day-name-array) |
09fd1a1a | 80 | |
d8e55af8 | 81 | (defun calendar-french-special-days-array () |
a4723d1f | 82 | "Return the special day names, depending on whether accents are available." |
d8e55af8 GM |
83 | (if (calendar-french-accents-p) |
84 | calendar-french-multibyte-special-days-array | |
85 | calendar-french-special-days-array)) | |
54e7faba | 86 | |
d8e55af8 | 87 | (defun calendar-french-leap-year-p (year) |
7e1dae73 JB |
88 | "True if YEAR is a leap year on the French Revolutionary calendar. |
89 | For Gregorian years 1793 to 1805, the years of actual operation of the | |
780249f8 | 90 | calendar, follows historical practice based on equinoxes (years 3, 7, |
7e1dae73 JB |
91 | and 11 were leap years; 15 and 20 would have been leap years). For later |
92 | years uses the proposed rule of Romme (never adopted)--leap years fall every | |
93 | four years except century years not divisible 400 and century years that are | |
94 | multiples of 4000." | |
d3bdb2a4 GM |
95 | (or (memq year '(3 7 11)) ; actual practice--based on equinoxes |
96 | (memq year '(15 20)) ; anticipated practice--based on equinoxes | |
97 | (and (> year 20) ; Romme's proposal--never adopted | |
7e1dae73 JB |
98 | (zerop (% year 4)) |
99 | (not (memq (% year 400) '(100 200 300))) | |
100 | (not (zerop (% year 4000)))))) | |
101 | ||
d8e55af8 | 102 | (defun calendar-french-last-day-of-month (month year) |
67ead471 | 103 | "Return last day of MONTH, YEAR on the French Revolutionary calendar. |
7e1dae73 JB |
104 | The 13th month is not really a month, but the 5 (6 in leap years) day period of |
105 | `sansculottides' at the end of the year." | |
106 | (if (< month 13) | |
107 | 30 | |
d8e55af8 | 108 | (if (calendar-french-leap-year-p year) |
7e1dae73 JB |
109 | 6 |
110 | 5))) | |
111 | ||
d8e55af8 | 112 | (defun calendar-french-to-absolute (date) |
67ead471 | 113 | "Compute absolute date from French Revolutionary date DATE. |
7e1dae73 JB |
114 | The absolute date is the number of days elapsed since the (imaginary) |
115 | Gregorian date Sunday, December 31, 1 BC." | |
e803eab7 GM |
116 | (let ((month (calendar-extract-month date)) |
117 | (day (calendar-extract-day date)) | |
118 | (year (calendar-extract-year date))) | |
d3bdb2a4 GM |
119 | (+ (* 365 (1- year)) ; days in prior years |
120 | ;; Leap days in prior years. | |
7e1dae73 | 121 | (if (< year 20) |
d3bdb2a4 GM |
122 | (/ year 4) ; actual and anticipated practice (years 3, 7, 11, 15) |
123 | ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion). | |
124 | (+ (/ (1- year) 4) ; luckily, there were 4 leap years before year 20 | |
7e1dae73 JB |
125 | (- (/ (1- year) 100)) |
126 | (/ (1- year) 400) | |
127 | (- (/ (1- year) 4000)))) | |
d3bdb2a4 GM |
128 | (* 30 (1- month)) ; days in prior months this year |
129 | day ; days so far this month | |
d8e55af8 GM |
130 | (1- calendar-french-epoch)))) ; days before start of calendar |
131 | ||
132 | (define-obsolete-function-alias 'calendar-absolute-from-french | |
133 | 'calendar-french-to-absolute "23.1") | |
7e1dae73 JB |
134 | |
135 | (defun calendar-french-from-absolute (date) | |
67ead471 RS |
136 | "Compute the French Revolutionary equivalent for absolute date DATE. |
137 | The result is a list of the form (MONTH DAY YEAR). | |
138 | The absolute date is the number of days elapsed since the | |
a4e104bf | 139 | \(imaginary) Gregorian date Sunday, December 31, 1 BC." |
d8e55af8 | 140 | (if (< date calendar-french-epoch) |
d3bdb2a4 GM |
141 | (list 0 0 0) ; pre-French Revolutionary date |
142 | (let* ((approx ; approximation from below | |
d8e55af8 | 143 | (/ (- date calendar-french-epoch) 366)) |
d3bdb2a4 | 144 | (year ; search forward from the approximation |
7e1dae73 JB |
145 | (+ approx |
146 | (calendar-sum y approx | |
d8e55af8 | 147 | (>= date (calendar-french-to-absolute |
71ea27ee GM |
148 | (list 1 1 (1+ y)))) |
149 | 1))) | |
d3bdb2a4 | 150 | (month ; search forward from Vendemiaire |
7e1dae73 | 151 | (1+ (calendar-sum m 1 |
71ea27ee | 152 | (> date |
d8e55af8 | 153 | (calendar-french-to-absolute |
71ea27ee | 154 | (list m |
d8e55af8 | 155 | (calendar-french-last-day-of-month |
71ea27ee GM |
156 | m year) |
157 | year))) | |
158 | 1))) | |
d3bdb2a4 | 159 | (day ; calculate the day by subtraction |
7e1dae73 | 160 | (- date |
d8e55af8 | 161 | (1- (calendar-french-to-absolute (list month 1 year)))))) |
71ea27ee | 162 | (list month day year)))) |
7e1dae73 | 163 | |
1d0c7fdf | 164 | ;;;###cal-autoload |
adaeaa8e RS |
165 | (defun calendar-french-date-string (&optional date) |
166 | "String of French Revolutionary date of Gregorian DATE. | |
167 | Returns the empty string if DATE is pre-French Revolutionary. | |
168 | Defaults to today's date if DATE is not given." | |
7e1dae73 JB |
169 | (let* ((french-date (calendar-french-from-absolute |
170 | (calendar-absolute-from-gregorian | |
adaeaa8e | 171 | (or date (calendar-current-date))))) |
e803eab7 GM |
172 | (y (calendar-extract-year french-date)) |
173 | (m (calendar-extract-month french-date)) | |
174 | (d (calendar-extract-day french-date))) | |
adaeaa8e RS |
175 | (cond |
176 | ((< y 1) "") | |
d8e55af8 | 177 | ((= m 13) (format (if (calendar-french-accents-p) |
1a355d09 | 178 | "Jour %s de l'Année %d de la Révolution" |
327c8eb2 | 179 | "Jour %s de l'Anne'e %d de la Re'volution") |
d8e55af8 | 180 | (aref (calendar-french-special-days-array) (1- d)) |
adaeaa8e | 181 | y)) |
327c8eb2 | 182 | (t (format |
d8e55af8 | 183 | (if (calendar-french-accents-p) |
1a355d09 | 184 | "%d %s an %d de la Révolution" |
809a7959 GM |
185 | "%d %s an %d de la Re'volution") |
186 | d | |
d8e55af8 | 187 | (aref (calendar-french-month-name-array) (1- m)) |
327c8eb2 | 188 | y))))) |
adaeaa8e | 189 | |
1d0c7fdf | 190 | ;;;###cal-autoload |
d8e55af8 | 191 | (defun calendar-french-print-date () |
adaeaa8e RS |
192 | "Show the French Revolutionary calendar equivalent of the selected date." |
193 | (interactive) | |
9d26aa53 | 194 | (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) |
adaeaa8e | 195 | (if (string-equal f "") |
7e1dae73 | 196 | (message "Date is pre-French Revolution") |
42f5d1b0 | 197 | (message "French Revolutionary date: %s" f)))) |
7e1dae73 | 198 | |
d8e55af8 GM |
199 | (define-obsolete-function-alias 'calendar-print-french-date |
200 | 'calendar-french-print-date "23.1") | |
201 | ||
1d0c7fdf | 202 | ;;;###cal-autoload |
d8e55af8 | 203 | (defun calendar-french-goto-date (date &optional noecho) |
67ead471 | 204 | "Move cursor to French Revolutionary date DATE. |
5424a530 | 205 | Echo French Revolutionary date unless NOECHO is non-nil." |
7e1dae73 | 206 | (interactive |
d8e55af8 GM |
207 | (let* ((months (calendar-french-month-name-array)) |
208 | (special-days (calendar-french-special-days-array)) | |
eaf7038f GM |
209 | (year (progn |
210 | (calendar-read | |
d8e55af8 | 211 | (if (calendar-french-accents-p) |
1a355d09 | 212 | "Année de la Révolution (>0): " |
eaf7038f GM |
213 | "Anne'e de la Re'volution (>0): ") |
214 | (lambda (x) (> x 0)) | |
d92bcf94 | 215 | (number-to-string |
e803eab7 | 216 | (calendar-extract-year |
eaf7038f GM |
217 | (calendar-french-from-absolute |
218 | (calendar-absolute-from-gregorian | |
219 | (calendar-current-date)))))))) | |
220 | (month-list | |
221 | (mapcar 'list | |
222 | (append months | |
d8e55af8 | 223 | (if (calendar-french-leap-year-p year) |
eaf7038f GM |
224 | (mapcar |
225 | (lambda (x) (concat "Jour " x)) | |
d8e55af8 | 226 | calendar-french-special-days-array) |
eaf7038f GM |
227 | (reverse |
228 | (cdr ; we don't want rev. day in a non-leap yr | |
71ea27ee | 229 | (reverse |
eaf7038f GM |
230 | (mapcar |
231 | (lambda (x) | |
232 | (concat "Jour " x)) | |
233 | special-days)))))))) | |
234 | (completion-ignore-case t) | |
235 | (month (cdr (assoc-string | |
236 | (completing-read | |
237 | "Mois ou Sansculottide: " | |
238 | month-list | |
239 | nil t) | |
240 | (calendar-make-alist month-list 1 'car) t))) | |
241 | (day (if (> month 12) | |
242 | (- month 12) | |
243 | (calendar-read | |
244 | "Jour (1-30): " | |
245 | (lambda (x) (and (<= 1 x) (<= x 30)))))) | |
246 | (month (if (> month 12) 13 month))) | |
247 | (list (list month day year)))) | |
7e1dae73 | 248 | (calendar-goto-date (calendar-gregorian-from-absolute |
d8e55af8 GM |
249 | (calendar-french-to-absolute date))) |
250 | (or noecho (calendar-french-print-date))) | |
251 | ||
252 | (define-obsolete-function-alias 'calendar-goto-french-date | |
253 | 'calendar-french-goto-date "23.1") | |
7e1dae73 | 254 | |
9081fdbc GM |
255 | (defvar date) |
256 | ||
8c34d83e | 257 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
1d0c7fdf | 258 | ;;;###diary-autoload |
7e1dae73 JB |
259 | (defun diary-french-date () |
260 | "French calendar equivalent of date diary entry." | |
69b31c69 | 261 | (let ((f (calendar-french-date-string date))) |
adaeaa8e RS |
262 | (if (string-equal f "") |
263 | "Date is pre-French Revolution" | |
69b31c69 | 264 | (format "French Revolutionary date: %s" f)))) |
7e1dae73 JB |
265 | |
266 | (provide 'cal-french) | |
267 | ||
1a355d09 GM |
268 | ;; Local Variables: |
269 | ;; coding: utf-8 | |
270 | ;; End: | |
271 | ||
7e1dae73 | 272 | ;;; cal-french.el ends here |