1 ;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
3 ;; Copyright (C) 1988, 1989, 1992, 1994 Free Software Foundation, Inc.
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Human-Keywords: French Revolutionary calendar, calendar, diary
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
13 ;; accepts responsibility to anyone for the consequences of using it
14 ;; or for whether it serves any particular purpose or works at all,
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
16 ;; License for full details.
18 ;; Everyone is granted permission to copy, modify and redistribute
19 ;; GNU Emacs, but only under the conditions described in the
20 ;; GNU Emacs General Public License. A copy of this license is
21 ;; supposed to have been given to you along with GNU Emacs so you
22 ;; can know your rights and responsibilities. It should be in a
23 ;; file named COPYING. Among other things, the copyright notice
24 ;; and this notice must be preserved on all copies.
28 ;; This collection of functions implements the features of calendar.el and
29 ;; diary.el that deal with the French Revolutionary calendar.
31 ;; Technical details of the Mayan calendrical calculations can be found in
32 ;; ``Calendrical Calculations, Part II: Three Historical Calendars''
33 ;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
34 ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
37 ;; Comments, corrections, and improvements should be sent to
38 ;; Edward M. Reingold Department of Computer Science
39 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
40 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
41 ;; Urbana, Illinois 61801
47 (defconst french-calendar-month-name-array
48 ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
49 "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])
51 (defconst french-calendar-day-name-array
52 ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
53 "Octidi" "Nonidi" "Decadi"])
55 (defconst french-calendar-special-days-array
56 ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Recompense"
59 (defun french-calendar-leap-year-p (year)
60 "True if YEAR is a leap year on the French Revolutionary calendar.
61 For Gregorian years 1793 to 1805, the years of actual operation of the
62 calendar, uses historical practice based on equinoxes is followed (years 3, 7,
63 and 11 were leap years; 15 and 20 would have been leap years). For later
64 years uses the proposed rule of Romme (never adopted)--leap years fall every
65 four years except century years not divisible 400 and century years that are
67 (or (memq year '(3 7 11));; Actual practice--based on equinoxes
68 (memq year '(15 20)) ;; Anticipated practice--based on equinoxes
69 (and (> year 20) ;; Romme's proposal--never adopted
71 (not (memq (% year 400) '(100 200 300)))
72 (not (zerop (% year 4000))))))
74 (defun french-calendar-last-day-of-month (month year)
75 "Return last day of MONTH, YEAR on the French Revolutionary calendar.
76 The 13th month is not really a month, but the 5 (6 in leap years) day period of
77 `sansculottides' at the end of the year."
80 (if (french-calendar-leap-year-p year)
84 (defun calendar-absolute-from-french (date)
85 "Compute absolute date from French Revolutionary date DATE.
86 The absolute date is the number of days elapsed since the (imaginary)
87 Gregorian date Sunday, December 31, 1 BC."
88 (let ((month (extract-calendar-month date))
89 (day (extract-calendar-day date))
90 (year (extract-calendar-year date)))
91 (+ (* 365 (1- year));; Days in prior years
92 ;; Leap days in prior years
94 (/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15)
95 ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion)
96 (+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20
99 (- (/ (1- year) 4000))))
100 (* 30 (1- month));; Days in prior months this year
101 day;; Days so far this month
102 654414)));; Days before start of calendar (September 22, 1792).
104 (defun calendar-french-from-absolute (date)
105 "Compute the French Revolutionary equivalent for absolute date DATE.
106 The result is a list of the form (MONTH DAY YEAR).
107 The absolute date is the number of days elapsed since the
108 (imaginary) Gregorian date Sunday, December 31, 1 BC."
110 (list 0 0 0);; pre-French Revolutionary date
111 (let* ((approx (/ (- date 654414) 366));; Approximation from below.
112 (year ;; Search forward from the approximation.
114 (calendar-sum y approx
115 (>= date (calendar-absolute-from-french (list 1 1 (1+ y))))
117 (month ;; Search forward from Vendemiaire.
118 (1+ (calendar-sum m 1
120 (calendar-absolute-from-french
122 (french-calendar-last-day-of-month m year)
125 (day ;; Calculate the day by subtraction.
127 (1- (calendar-absolute-from-french (list month 1 year))))))
128 (list month day year))))
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)))
142 ((= m 13) (format "Jour %s de l'Anne'e %d de la Revolution"
143 (aref french-calendar-special-days-array (1- d))
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))
151 (defun calendar-print-french-date ()
152 "Show the French Revolutionary calendar equivalent of the selected date."
154 (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
155 (if (string-equal f "")
156 (message "Date is pre-French Revolution")
159 (defun calendar-goto-french-date (date &optional noecho)
160 "Move cursor to French Revolutionary date DATE.
161 Echo French Revolutionary date unless NOECHO is t."
163 (let* ((year (calendar-read
164 "Anne'e de la Revolution (>0): "
165 '(lambda (x) (> x 0))
167 (extract-calendar-year
168 (calendar-french-from-absolute
169 (calendar-absolute-from-gregorian
170 (calendar-current-date)))))))
173 (append french-calendar-month-name-array
174 (if (french-calendar-leap-year-p year)
176 '(lambda (x) (concat "Jour " x))
177 french-calendar-special-days-array)
179 (cdr;; we don't want rev. day in a non-leap yr.
182 '(lambda (x) (concat "Jour " x))
183 french-calendar-special-days-array))))))))
184 (completion-ignore-case t)
188 "Mois ou Sansculottide: "
194 '(lambda (x) (capitalize (car x)))))))
195 (decade (if (> month 12)
199 '(lambda (x) (memq x '(1 2 3))))))
200 (day (if (> month 12)
204 '(lambda (x) (and (<= 1 x) (<= x 10))))))
205 (month (if (> month 12) 13 month))
206 (day (+ day (* 10 (1- decade)))))
207 (list (list month day year))))
208 (calendar-goto-date (calendar-gregorian-from-absolute
209 (calendar-absolute-from-french date)))
210 (or noecho (calendar-print-french-date)))
212 (defun diary-french-date ()
213 "French calendar equivalent of date diary entry."
214 (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
215 (if (string-equal f "")
216 "Date is pre-French Revolution"
219 (provide 'cal-french)
221 ;;; cal-french.el ends here