-;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
+;;; cal-french.el --- calendar functions for the French Revolutionary calendar
-;; Copyright (C) 1988, 1989, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1989, 1992, 1994, 1995, 1997, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: French Revolutionary calendar, calendar, diary
;; This file is part of GNU Emacs.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This collection of functions implements the features of calendar.el and
;; diary.el that deal with the French Revolutionary calendar.
-;; Technical details of the Mayan calendrical calculations can be found in
-;; ``Calendrical Calculations, Part II: Three Historical Calendars''
-;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
-;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
-;; pages 383-404.
+;; Technical details of the French Revolutionary calendar can be found in
+;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
+;; and Nachum Dershowitz, Cambridge University Press (2001), and in
+;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by
+;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and
+;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404.
;; Comments, corrections, and improvements should be sent to
;; Edward M. Reingold Department of Computer Science
;;; Code:
+(defvar date)
+
(require 'calendar)
+(defun french-calendar-accents ()
+ "True if diacritical marks are available."
+ (and (or window-system
+ (terminal-coding-system))
+ (or enable-multibyte-characters
+ (and (char-table-p standard-display-table)
+ (equal (aref standard-display-table 161) [161])))))
+
+(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
+ "Absolute date of start of French Revolutionary calendar = September 22, 1792.")
+
(defconst french-calendar-month-name-array
["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
"Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])
+(defconst french-calendar-multibyte-month-name-array
+ ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
+ "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"])
+
(defconst french-calendar-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"])
+(defconst french-calendar-multibyte-special-days-array
+ ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses"
+ "de la Révolution"])
+
(defconst french-calendar-special-days-array
- ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Recompense"
- "de la Revolution"])
+ ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses"
+ "de la Re'volution"])
+
+(defun french-calendar-month-name-array ()
+ (if (french-calendar-accents)
+ french-calendar-multibyte-month-name-array
+ french-calendar-month-name-array))
+
+(defun french-calendar-day-name-array ()
+ french-calendar-day-name-array)
+
+(defun french-calendar-special-days-array ()
+ (if (french-calendar-accents)
+ french-calendar-multibyte-special-days-array
+ french-calendar-special-days-array))
(defun french-calendar-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
For Gregorian years 1793 to 1805, the years of actual operation of the
-calendar, uses historical practice based on equinoxes is followed (years 3, 7,
+calendar, follows historical practice based on equinoxes (years 3, 7,
and 11 were leap years; 15 and 20 would have been leap years). For later
years uses the proposed rule of Romme (never adopted)--leap years fall every
four years except century years not divisible 400 and century years that are
(- (/ (1- year) 4000))))
(* 30 (1- month));; Days in prior months this year
day;; Days so far this month
- 654414)));; Days before start of calendar (September 22, 1792).
+ (1- french-calendar-epoch))));; Days before start of calendar
(defun calendar-french-from-absolute (date)
"Compute the French Revolutionary equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
The absolute date is the number of days elapsed since the
-(imaginary) Gregorian date Sunday, December 31, 1 BC."
- (if (< date 654415)
+\(imaginary) Gregorian date Sunday, December 31, 1 BC."
+ (if (< date french-calendar-epoch)
(list 0 0 0);; pre-French Revolutionary date
- (let* ((approx (/ (- date 654414) 366));; Approximation from below.
+ (let* ((approx ;; Approximation from below.
+ (/ (- date french-calendar-epoch) 366))
(year ;; Search forward from the approximation.
(+ approx
(calendar-sum y approx
(1- (calendar-absolute-from-french (list month 1 year))))))
(list month day year))))
-(defun calendar-print-french-date ()
- "Show the French Revolutionary calendar equivalent of the selected date."
- (interactive)
+(defun calendar-french-date-string (&optional date)
+ "String of French Revolutionary date of Gregorian DATE.
+Returns the empty string if DATE is pre-French Revolutionary.
+Defaults to today's date if DATE is not given."
(let* ((french-date (calendar-french-from-absolute
(calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!")))))
+ (or date (calendar-current-date)))))
(y (extract-calendar-year french-date))
(m (extract-calendar-month french-date))
(d (extract-calendar-day french-date)))
- (if (< y 1)
+ (cond
+ ((< y 1) "")
+ ((= m 13) (format (if (french-calendar-accents)
+ "Jour %s de l'Année %d de la Révolution"
+ "Jour %s de l'Anne'e %d de la Re'volution")
+ (aref (french-calendar-special-days-array) (1- d))
+ y))
+ (t (format
+ (if (french-calendar-accents)
+ "%d %s an %d de la Révolution"
+ "%d %s an %d de la Re'volution")
+ d
+ (aref (french-calendar-month-name-array) (1- m))
+ y)))))
+
+(defun calendar-print-french-date ()
+ "Show the French Revolutionary calendar equivalent of the selected date."
+ (interactive)
+ (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
+ (if (string-equal f "")
(message "Date is pre-French Revolution")
- (if (= m 13)
- (message "Jour %s de l'Anne'e %d de la Revolution"
- (aref french-calendar-special-days-array (1- d))
- y)
- (message "Decade %s, %s de %s de l'Anne'e %d de la Revolution"
- (make-string (1+ (/ (1- d) 10)) ?I)
- (aref french-calendar-day-name-array (% (1- d) 10))
- (aref french-calendar-month-name-array (1- m))
- y)))))
+ (message "French Revolutionary date: %s" f))))
(defun calendar-goto-french-date (date &optional noecho)
"Move cursor to French Revolutionary date DATE.
Echo French Revolutionary date unless NOECHO is t."
(interactive
- (let* ((year (calendar-read
- "Anne'e de la Revolution (>0): "
- '(lambda (x) (> x 0))
- (int-to-string
- (extract-calendar-year
- (calendar-french-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-current-date)))))))
- (month-list
- (mapcar 'list
- (append french-calendar-month-name-array
- (if (french-calendar-leap-year-p year)
- (mapcar
- '(lambda (x) (concat "Jour " x))
- french-calendar-special-days-array)
- (cdr;; we don't want rev. day in a non-leap yr.
- (nreverse
- (mapcar
- '(lambda (x) (concat "Jour " x))
- french-calendar-special-days-array)))))))
- (completion-ignore-case t)
- (month (cdr (assoc
- (capitalize
- (completing-read
- "Mois ou Sansculottide: "
- month-list
- nil t))
- (calendar-make-alist
- month-list
- 1
- '(lambda (x) (capitalize (car x)))))))
- (decade (if (> month 12)
- 1
- (calendar-read
- "De'cade (1-3): "
- '(lambda (x) (memq x '(1 2 3))))))
- (day (if (> month 12)
- (- month 12)
- (calendar-read
- "Jour (1-10)): "
- '(lambda (x) (and (<= 1 x) (<= x 10))))))
- (month (if (> month 12) 13 month))
- (day (+ day (* 10 (1- decade)))))
- (list (list month day year))))
+ (let ((accents (french-calendar-accents))
+ (months (french-calendar-month-name-array))
+ (special-days (french-calendar-special-days-array)))
+ (let* ((year
+ (progn
+ (calendar-read
+ (if accents
+ "Année de la Révolution (>0): "
+ "Anne'e de la Re'volution (>0): ")
+ '(lambda (x) (> x 0))
+ (int-to-string
+ (extract-calendar-year
+ (calendar-french-from-absolute
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))))))
+ (month-list
+ (mapcar 'list
+ (append months
+ (if (french-calendar-leap-year-p year)
+ (mapcar
+ '(lambda (x) (concat "Jour " x))
+ french-calendar-special-days-array)
+ (reverse
+ (cdr;; we don't want rev. day in a non-leap yr.
+ (reverse
+ (mapcar
+ '(lambda (x)
+ (concat "Jour " x))
+ special-days))))))))
+ (completion-ignore-case t)
+ (month (cdr (assoc-string
+ (completing-read
+ "Mois ou Sansculottide: "
+ month-list
+ nil t)
+ (calendar-make-alist month-list 1 'car) t)))
+ (day (if (> month 12)
+ (- month 12)
+ (calendar-read
+ "Jour (1-30): "
+ '(lambda (x) (and (<= 1 x) (<= x 30))))))
+ (month (if (> month 12) 13 month)))
+ (list (list month day year)))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-french date)))
(or noecho (calendar-print-french-date)))
(defun diary-french-date ()
"French calendar equivalent of date diary entry."
- (let* ((french-date (calendar-french-from-absolute
- (calendar-absolute-from-gregorian date)))
- (y (extract-calendar-year french-date))
- (m (extract-calendar-month french-date))
- (d (extract-calendar-day french-date)))
- (if (> y 0)
- (if (= m 13)
- (format "Jour %s de l'Anne'e %d de la Revolution"
- (aref french-calendar-special-days-array (1- d))
- y)
- (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution"
- (make-string (1+ (/ (1- d) 10)) ?I)
- (aref french-calendar-day-name-array (% (1- d) 10))
- (aref french-calendar-month-name-array (1- m))
- y)))))
+ (let ((f (calendar-french-date-string date)))
+ (if (string-equal f "")
+ "Date is pre-French Revolution"
+ (format "French Revolutionary date: %s" f))))
(provide 'cal-french)
+;;; arch-tag: 7e8045a3-8609-46b5-9cde-cf40ce541cf9
;;; cal-french.el ends here