1;;; cal-french.el --- calendar functions for the French Revolutionary calendar 2 3;; Copyright (C) 1988, 1989, 1992, 1994, 1995, 1997, 2001, 2002, 2003, 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> 7;; Maintainer: Glenn Morris <rgm@gnu.org> 8;; Keywords: calendar 9;; Human-Keywords: French Revolutionary calendar, calendar, diary 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;; This collection of functions implements the features of calendar.el and 31;; diary.el that deal with the French Revolutionary calendar. 32 33;; Technical details of the French Revolutionary calendar can be found in 34;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold 35;; and Nachum Dershowitz, Cambridge University Press (2001), and in 36;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by 37;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and 38;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404. 39 40;;; Code: 41 42(defvar date) 43 44(require 'calendar) 45 46(defun french-calendar-accents () 47 "True if diacritical marks are available." 48 (and (or window-system 49 (terminal-coding-system)) 50 (or enable-multibyte-characters 51 (and (char-table-p standard-display-table) 52 (equal (aref standard-display-table 161) [161]))))) 53 54(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) 55 "Absolute date of start of French Revolutionary calendar = September 22, 1792.") 56 57(defconst french-calendar-month-name-array 58 ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" 59 "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) 60 61(defconst french-calendar-multibyte-month-name-array 62 ["Vend�miaire" "Brumaire" "Frimaire" "Niv�se" "Pluvi�se" "Vent�se" 63 "Germinal" "Flor�al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) 64 65(defconst french-calendar-day-name-array 66 ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" 67 "Octidi" "Nonidi" "Decadi"]) 68 69(defconst french-calendar-multibyte-special-days-array 70 ["de la Vertu" "du G�nie" "du Travail" "de la Raison" "des R�compenses" 71 "de la R�volution"]) 72 73(defconst french-calendar-special-days-array 74 ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses" 75 "de la Re'volution"]) 76 77(defun french-calendar-month-name-array () 78 (if (french-calendar-accents) 79 french-calendar-multibyte-month-name-array 80 french-calendar-month-name-array)) 81 82(defun french-calendar-day-name-array () 83 french-calendar-day-name-array) 84 85(defun french-calendar-special-days-array () 86 (if (french-calendar-accents) 87 french-calendar-multibyte-special-days-array 88 french-calendar-special-days-array)) 89 90(defun french-calendar-leap-year-p (year) 91 "True if YEAR is a leap year on the French Revolutionary calendar. 92For Gregorian years 1793 to 1805, the years of actual operation of the 93calendar, follows historical practice based on equinoxes (years 3, 7, 94and 11 were leap years; 15 and 20 would have been leap years). For later 95years uses the proposed rule of Romme (never adopted)--leap years fall every 96four years except century years not divisible 400 and century years that are 97multiples of 4000." 98 (or (memq year '(3 7 11));; Actual practice--based on equinoxes 99 (memq year '(15 20)) ;; Anticipated practice--based on equinoxes 100 (and (> year 20) ;; Romme's proposal--never adopted 101 (zerop (% year 4)) 102 (not (memq (% year 400) '(100 200 300))) 103 (not (zerop (% year 4000)))))) 104 105(defun french-calendar-last-day-of-month (month year) 106 "Return last day of MONTH, YEAR on the French Revolutionary calendar. 107The 13th month is not really a month, but the 5 (6 in leap years) day period of 108`sansculottides' at the end of the year." 109 (if (< month 13) 110 30 111 (if (french-calendar-leap-year-p year) 112 6 113 5))) 114 115(defun calendar-absolute-from-french (date) 116 "Compute absolute date from French Revolutionary date DATE. 117The absolute date is the number of days elapsed since the (imaginary) 118Gregorian date Sunday, December 31, 1 BC." 119 (let ((month (extract-calendar-month date)) 120 (day (extract-calendar-day date)) 121 (year (extract-calendar-year date))) 122 (+ (* 365 (1- year));; Days in prior years 123 ;; Leap days in prior years 124 (if (< year 20) 125 (/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15) 126 ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion) 127 (+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20 128 (- (/ (1- year) 100)) 129 (/ (1- year) 400) 130 (- (/ (1- year) 4000)))) 131 (* 30 (1- month));; Days in prior months this year 132 day;; Days so far this month 133 (1- french-calendar-epoch))));; Days before start of calendar 134 135(defun calendar-french-from-absolute (date) 136 "Compute the French Revolutionary equivalent for absolute date DATE. 137The result is a list of the form (MONTH DAY YEAR). 138The absolute date is the number of days elapsed since the 139\(imaginary) Gregorian date Sunday, December 31, 1 BC." 140 (if (< date french-calendar-epoch) 141 (list 0 0 0);; pre-French Revolutionary date 142 (let* ((approx ;; Approximation from below. 143 (/ (- date french-calendar-epoch) 366)) 144 (year ;; Search forward from the approximation. 145 (+ approx 146 (calendar-sum y approx 147 (>= date (calendar-absolute-from-french (list 1 1 (1+ y)))) 148 1))) 149 (month ;; Search forward from Vendemiaire. 150 (1+ (calendar-sum m 1 151 (> date 152 (calendar-absolute-from-french 153 (list m 154 (french-calendar-last-day-of-month m year) 155 year))) 156 1))) 157 (day ;; Calculate the day by subtraction. 158 (- date 159 (1- (calendar-absolute-from-french (list month 1 year)))))) 160 (list month day year)))) 161 162(defun calendar-french-date-string (&optional date) 163 "String of French Revolutionary date of Gregorian DATE. 164Returns the empty string if DATE is pre-French Revolutionary. 165Defaults to today's date if DATE is not given." 166 (let* ((french-date (calendar-french-from-absolute 167 (calendar-absolute-from-gregorian 168 (or date (calendar-current-date))))) 169 (y (extract-calendar-year french-date)) 170 (m (extract-calendar-month french-date)) 171 (d (extract-calendar-day french-date))) 172 (cond 173 ((< y 1) "") 174 ((= m 13) (format (if (french-calendar-accents) 175 "Jour %s de l'Ann�e %d de la R�volution" 176 "Jour %s de l'Anne'e %d de la Re'volution") 177 (aref (french-calendar-special-days-array) (1- d)) 178 y)) 179 (t (format 180 (if (french-calendar-accents) 181 "%d %s an %d de la R�volution" 182 "%d %s an %d de la Re'volution") 183 d 184 (aref (french-calendar-month-name-array) (1- m)) 185 y))))) 186 187(defun calendar-print-french-date () 188 "Show the French Revolutionary calendar equivalent of the selected date." 189 (interactive) 190 (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) 191 (if (string-equal f "") 192 (message "Date is pre-French Revolution") 193 (message "French Revolutionary date: %s" f)))) 194 195(defun calendar-goto-french-date (date &optional noecho) 196 "Move cursor to French Revolutionary date DATE. 197Echo French Revolutionary date unless NOECHO is t." 198 (interactive 199 (let ((accents (french-calendar-accents)) 200 (months (french-calendar-month-name-array)) 201 (special-days (french-calendar-special-days-array))) 202 (let* ((year 203 (progn 204 (calendar-read 205 (if accents 206 "Ann�e de la R�volution (>0): " 207 "Anne'e de la Re'volution (>0): ") 208 '(lambda (x) (> x 0)) 209 (int-to-string 210 (extract-calendar-year 211 (calendar-french-from-absolute 212 (calendar-absolute-from-gregorian 213 (calendar-current-date)))))))) 214 (month-list 215 (mapcar 'list 216 (append months 217 (if (french-calendar-leap-year-p year) 218 (mapcar 219 '(lambda (x) (concat "Jour " x)) 220 french-calendar-special-days-array) 221 (reverse 222 (cdr;; we don't want rev. day in a non-leap yr. 223 (reverse 224 (mapcar 225 '(lambda (x) 226 (concat "Jour " x)) 227 special-days)))))))) 228 (completion-ignore-case t) 229 (month (cdr (assoc-string 230 (completing-read 231 "Mois ou Sansculottide: " 232 month-list 233 nil t) 234 (calendar-make-alist month-list 1 'car) t))) 235 (day (if (> month 12) 236 (- month 12) 237 (calendar-read 238 "Jour (1-30): " 239 '(lambda (x) (and (<= 1 x) (<= x 30)))))) 240 (month (if (> month 12) 13 month))) 241 (list (list month day year))))) 242 (calendar-goto-date (calendar-gregorian-from-absolute 243 (calendar-absolute-from-french date))) 244 (or noecho (calendar-print-french-date))) 245 246(defun diary-french-date () 247 "French calendar equivalent of date diary entry." 248 (let ((f (calendar-french-date-string date))) 249 (if (string-equal f "") 250 "Date is pre-French Revolution" 251 (format "French Revolutionary date: %s" f)))) 252 253(provide 'cal-french) 254 255;;; arch-tag: 7e8045a3-8609-46b5-9cde-cf40ce541cf9 256;;; cal-french.el ends here 257