Commit 327c8eb2 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(french-calendar-accents): New variable.

(french-calendar-month-name-array): Check that variable.
(french-calendar-special-days-array): Likewise.
(calendar-french-date-string): Likewise.
(calendar-goto-french-date): Likewise.
parent 1d08d733
...@@ -29,10 +29,9 @@ ...@@ -29,10 +29,9 @@
;; diary.el that deal with the French Revolutionary calendar. ;; diary.el that deal with the French Revolutionary calendar.
;; Technical details of the French Revolutionary calendar can be found in ;; Technical details of the French Revolutionary calendar can be found in
;; ``Calendrical Calculations, Part II: Three Historical Calendars'' ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by
;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and
;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404.
;; pages 383-404.
;; Comments, corrections, and improvements should be sent to ;; Comments, corrections, and improvements should be sent to
;; Edward M. Reingold Department of Computer Science ;; Edward M. Reingold Department of Computer Science
...@@ -44,20 +43,31 @@ ...@@ -44,20 +43,31 @@
(require 'calendar) (require 'calendar)
(defvar french-calendar-accents
(and (char-table-p standard-display-table)
(equal (aref standard-display-table 161) [161]))
"True if diacritical marks are available.")
(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
"Absolute date of start of French Revolutionary calendar = September 22, 1792.") "Absolute date of start of French Revolutionary calendar = September 22, 1792.")
(defconst french-calendar-month-name-array (defconst french-calendar-month-name-array
["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" (if french-calendar-accents
"Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) ["Vendmiaire" "Brumaire" "Frimaire" "Nivse" "Pluvise" "Ventse"
"Germinal" "Floral" "Prairial" "Messidor" "Thermidor" "Fructidor"]
["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
"Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]))
(defconst french-calendar-day-name-array (defconst french-calendar-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"]) "Octidi" "Nonidi" "Decadi"])
(defconst french-calendar-special-days-array (defconst french-calendar-special-days-array
["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" (if french-calendar-accents
"de la Re'volution"]) ["de la Vertu" "du Genie" "du Labour" "de la Raison"
"de la Rcompense" "de la Rvolution"]
["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense"
"de la Re'volution"]))
(defun french-calendar-leap-year-p (year) (defun french-calendar-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar. "True if YEAR is a leap year on the French Revolutionary calendar.
...@@ -143,14 +153,19 @@ Defaults to today's date if DATE is not given." ...@@ -143,14 +153,19 @@ Defaults to today's date if DATE is not given."
(d (extract-calendar-day french-date))) (d (extract-calendar-day french-date)))
(cond (cond
((< y 1) "") ((< y 1) "")
((= m 13) (format "Jour %s de l'Anne'e %d de la Re'volution" ((= m 13) (format (if french-calendar-accents
"Jour %s de l'Anne %d de la Rvolution"
"Jour %s de l'Anne'e %d de la Re'volution")
(aref french-calendar-special-days-array (1- d)) (aref french-calendar-special-days-array (1- d))
y)) y))
(t (format "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution" (t (format
(make-string (1+ (/ (1- d) 10)) ?I) (if french-calendar-accents
(aref french-calendar-day-name-array (% (1- d) 10)) "Dcade %s, %s de %s de l'Anne %d de la Rvolution"
(aref french-calendar-month-name-array (1- m)) "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution")
y))))) (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)))))
(defun calendar-print-french-date () (defun calendar-print-french-date ()
"Show the French Revolutionary calendar equivalent of the selected date." "Show the French Revolutionary calendar equivalent of the selected date."
...@@ -165,7 +180,9 @@ Defaults to today's date if DATE is not given." ...@@ -165,7 +180,9 @@ Defaults to today's date if DATE is not given."
Echo French Revolutionary date unless NOECHO is t." Echo French Revolutionary date unless NOECHO is t."
(interactive (interactive
(let* ((year (calendar-read (let* ((year (calendar-read
"Anne'e de la Re'volution (>0): " (if french-calendar-accents
"Anne de la Rvolution (>0): "
"Anne'e de la Re'volution (>0): ")
'(lambda (x) (> x 0)) '(lambda (x) (> x 0))
(int-to-string (int-to-string
(extract-calendar-year (extract-calendar-year
...@@ -199,7 +216,9 @@ Echo French Revolutionary date unless NOECHO is t." ...@@ -199,7 +216,9 @@ Echo French Revolutionary date unless NOECHO is t."
(decade (if (> month 12) (decade (if (> month 12)
1 1
(calendar-read (calendar-read
"De'cade (1-3): " (if french-calendar-accents
"Dcade (1-3): "
"De'cade (1-3): ")
'(lambda (x) (memq x '(1 2 3)))))) '(lambda (x) (memq x '(1 2 3))))))
(day (if (> month 12) (day (if (> month 12)
(- month 12) (- month 12)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment