1 ;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
3 ;; Copyright (C) 1988, 1989, 1992, 1994, 1995 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 free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
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 French Revolutionary calendar can be found in
32 ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by
33 ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and
34 ;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404.
36 ;; Comments, corrections, and improvements should be sent to
37 ;; Edward M. Reingold Department of Computer Science
38 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
39 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
40 ;; Urbana, Illinois 61801
46 (defvar french-calendar-accents
47 (and (char-table-p standard-display-table
)
48 (equal (aref standard-display-table
161) [161]))
49 "True if diacritical marks are available.")
51 (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
52 "Absolute date of start of French Revolutionary calendar = September 22, 1792.")
54 (defconst french-calendar-month-name-array
55 (if french-calendar-accents
56 ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
57 "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
58 ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
59 "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]))
61 (defconst french-calendar-day-name-array
62 ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
63 "Octidi" "Nonidi" "Decadi"])
65 (defconst french-calendar-special-days-array
66 (if french-calendar-accents
67 ["de la Vertu" "du Genie" "du Labour" "de la Raison"
68 "de la Récompense" "de la Révolution"]
69 ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense"
70 "de la Re'volution"]))
72 (defun french-calendar-leap-year-p (year)
73 "True if YEAR is a leap year on the French Revolutionary calendar.
74 For Gregorian years 1793 to 1805, the years of actual operation of the
75 calendar, uses historical practice based on equinoxes is followed (years 3, 7,
76 and 11 were leap years; 15 and 20 would have been leap years). For later
77 years uses the proposed rule of Romme (never adopted)--leap years fall every
78 four years except century years not divisible 400 and century years that are
80 (or (memq year '(3 7 11));; Actual practice--based on equinoxes
81 (memq year '(15 20)) ;; Anticipated practice--based on equinoxes
82 (and (> year 20) ;; Romme's proposal--never adopted
84 (not (memq (% year 400) '(100 200 300)))
85 (not (zerop (% year 4000))))))
87 (defun french-calendar-last-day-of-month (month year)
88 "Return last day of MONTH, YEAR on the French Revolutionary calendar.
89 The 13th month is not really a month, but the 5 (6 in leap years) day period of
90 `sansculottides' at the end of the year."
93 (if (french-calendar-leap-year-p year)
97 (defun calendar-absolute-from-french (date)
98 "Compute absolute date from French Revolutionary date DATE.
99 The absolute date is the number of days elapsed since the (imaginary)
100 Gregorian date Sunday, December 31, 1 BC."
101 (let ((month (extract-calendar-month date))
102 (day (extract-calendar-day date))
103 (year (extract-calendar-year date)))
104 (+ (* 365 (1- year));; Days in prior years
105 ;; Leap days in prior years
107 (/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15)
108 ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion)
109 (+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20
110 (- (/ (1- year) 100))
112 (- (/ (1- year) 4000))))
113 (* 30 (1- month));; Days in prior months this year
114 day;; Days so far this month
115 (1- french-calendar-epoch))));; Days before start of calendar
117 (defun calendar-french-from-absolute (date)
118 "Compute the French Revolutionary equivalent for absolute date DATE.
119 The result is a list of the form (MONTH DAY YEAR).
120 The absolute date is the number of days elapsed since the
121 \(imaginary) Gregorian date Sunday, December 31, 1 BC."
122 (if (< date french-calendar-epoch)
123 (list 0 0 0);; pre-French Revolutionary date
124 (let* ((approx ;; Approximation from below.
125 (/ (- date french-calendar-epoch) 366))
126 (year ;; Search forward from the approximation.
128 (calendar-sum y approx
129 (>= date (calendar-absolute-from-french (list 1 1 (1+ y))))
131 (month ;; Search forward from Vendemiaire.
132 (1+ (calendar-sum m 1
134 (calendar-absolute-from-french
136 (french-calendar-last-day-of-month m year)
139 (day ;; Calculate the day by subtraction.
141 (1- (calendar-absolute-from-french (list month 1 year))))))
142 (list month day year))))
144 (defun calendar-french-date-string (&optional date)
145 "String of French Revolutionary date of Gregorian DATE.
146 Returns the empty string if DATE is pre-French Revolutionary.
147 Defaults to today's date if DATE is not given."
148 (let* ((french-date (calendar-french-from-absolute
149 (calendar-absolute-from-gregorian
150 (or date (calendar-current-date)))))
151 (y (extract-calendar-year french-date))
152 (m (extract-calendar-month french-date))
153 (d (extract-calendar-day french-date)))
156 ((= m 13) (format (if french-calendar-accents
157 "Jour %s de l'Année %d de la Révolution"
158 "Jour %s de l'Anne'e %d de la Re'volution")
159 (aref french-calendar-special-days-array (1- d))
162 (if french-calendar-accents
163 "Décade %s, %s de %s de l'Année %d de la Révolution"
164 "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution")
165 (make-string (1+ (/ (1- d) 10)) ?I)
166 (aref french-calendar-day-name-array (% (1- d) 10))
167 (aref french-calendar-month-name-array (1- m))
170 (defun calendar-print-french-date ()
171 "Show the French Revolutionary calendar equivalent of the selected date."
173 (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
174 (if (string-equal f "")
175 (message "Date is pre-French Revolution")
178 (defun calendar-goto-french-date (date &optional noecho)
179 "Move cursor to French Revolutionary date DATE.
180 Echo French Revolutionary date unless NOECHO is t."
182 (let* ((year (calendar-read
183 (if french-calendar-accents
184 "Année de la Révolution (>0): "
185 "Anne'e de la Re'volution (>0): ")
186 '(lambda (x) (> x 0))
188 (extract-calendar-year
189 (calendar-french-from-absolute
190 (calendar-absolute-from-gregorian
191 (calendar-current-date)))))))
194 (append french-calendar-month-name-array
195 (if (french-calendar-leap-year-p year)
197 '(lambda (x) (concat "Jour " x))
198 french-calendar-special-days-array)
200 (cdr;; we don't want rev. day in a non-leap yr.
203 '(lambda (x) (concat "Jour " x))
204 french-calendar-special-days-array))))))))
205 (completion-ignore-case t)
209 "Mois ou Sansculottide: "
215 '(lambda (x) (capitalize (car x)))))))
216 (decade (if (> month 12)
219 (if french-calendar-accents
222 '(lambda (x) (memq x '(1 2 3))))))
223 (day (if (> month 12)
227 '(lambda (x) (and (<= 1 x) (<= x 10))))))
228 (month (if (> month 12) 13 month))
229 (day (+ day (* 10 (1- decade)))))
230 (list (list month day year))))
231 (calendar-goto-date (calendar-gregorian-from-absolute
232 (calendar-absolute-from-french date)))
233 (or noecho (calendar-print-french-date)))
235 (defun diary-french-date ()
236 "French calendar equivalent of date diary entry."
237 (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
238 (if (string-equal f "")
239 "Date is pre-French Revolution"
242 (provide 'cal-french)
244 ;;; cal-french.el ends here