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