Commit 9fadf1a5 authored by Edward M. Reingold's avatar Edward M. Reingold
Browse files

Minor fixes.

parent c29681e1
;;; 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, 1994 Free Software Foundation, Inc. ;; Copyright (C) 1988, 1989, 1992, 1994, 1995 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar ;; Keywords: calendar
...@@ -43,6 +43,9 @@ ...@@ -43,6 +43,9 @@
(require 'calendar) (require 'calendar)
(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 (defconst french-calendar-month-name-array
["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
"Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])
...@@ -52,8 +55,8 @@ ...@@ -52,8 +55,8 @@
"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 Recompense" ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense"
"de la Revolution"]) "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.
...@@ -98,16 +101,17 @@ Gregorian date Sunday, December 31, 1 BC." ...@@ -98,16 +101,17 @@ Gregorian date Sunday, December 31, 1 BC."
(- (/ (1- year) 4000)))) (- (/ (1- year) 4000))))
(* 30 (1- month));; Days in prior months this year (* 30 (1- month));; Days in prior months this year
day;; Days so far this month 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) (defun calendar-french-from-absolute (date)
"Compute the French Revolutionary equivalent for absolute date DATE. "Compute the French Revolutionary equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR). The result is a list of the form (MONTH DAY YEAR).
The absolute date is the number of days elapsed since the The absolute date is the number of days elapsed since the
\(imaginary) Gregorian date Sunday, December 31, 1 BC." \(imaginary) Gregorian date Sunday, December 31, 1 BC."
(if (< date 654415) (if (< date french-calendar-epoch)
(list 0 0 0);; pre-French Revolutionary date (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. (year ;; Search forward from the approximation.
(+ approx (+ approx
(calendar-sum y approx (calendar-sum y approx
...@@ -138,10 +142,10 @@ Defaults to today's date if DATE is not given." ...@@ -138,10 +142,10 @@ 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 Revolution" ((= m 13) (format "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 "Decade %s, %s de %s de l'Anne'e %d de la Revolution" (t (format "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution"
(make-string (1+ (/ (1- d) 10)) ?I) (make-string (1+ (/ (1- d) 10)) ?I)
(aref french-calendar-day-name-array (% (1- d) 10)) (aref french-calendar-day-name-array (% (1- d) 10))
(aref french-calendar-month-name-array (1- m)) (aref french-calendar-month-name-array (1- m))
...@@ -160,7 +164,7 @@ Defaults to today's date if DATE is not given." ...@@ -160,7 +164,7 @@ 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 Revolution (>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
...@@ -174,9 +178,9 @@ Echo French Revolutionary date unless NOECHO is t." ...@@ -174,9 +178,9 @@ Echo French Revolutionary date unless NOECHO is t."
(mapcar (mapcar
'(lambda (x) (concat "Jour " x)) '(lambda (x) (concat "Jour " x))
french-calendar-special-days-array) french-calendar-special-days-array)
(nreverse (reverse
(cdr;; we don't want rev. day in a non-leap yr. (cdr;; we don't want rev. day in a non-leap yr.
(nreverse (reverse
(mapcar (mapcar
'(lambda (x) (concat "Jour " x)) '(lambda (x) (concat "Jour " x))
french-calendar-special-days-array)))))))) french-calendar-special-days-array))))))))
......
;;; cal-mayan.el --- calendar functions for the Mayan calendars. ;;; cal-mayan.el --- calendar functions for the Mayan calendars.
;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu> ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu> ;; Edward M. Reingold <reingold@cs.uiuc.edu>
...@@ -52,10 +52,6 @@ ...@@ -52,10 +52,6 @@
(require 'calendar) (require 'calendar)
(defun mayan-adjusted-mod (m n)
"Non-negative remainder of M/N with N instead of 0."
(1+ (mod (1- m) n)))
(defconst calendar-mayan-days-before-absolute-zero 1137140 (defconst calendar-mayan-days-before-absolute-zero 1137140
"Number of days of the Mayan calendar epoch before absolute day 0. "Number of days of the Mayan calendar epoch before absolute day 0.
According to the Goodman-Martinez-Thompson correlation. This correlation is According to the Goodman-Martinez-Thompson correlation. This correlation is
...@@ -175,10 +171,10 @@ Echo Mayan date if NOECHO is t." ...@@ -175,10 +171,10 @@ Echo Mayan date if NOECHO is t."
(defun calendar-mayan-tzolkin-from-absolute (date) (defun calendar-mayan-tzolkin-from-absolute (date)
"Convert absolute DATE into a Mayan tzolkin date (a pair)." "Convert absolute DATE into a Mayan tzolkin date (a pair)."
(let* ((long-count (+ date calendar-mayan-days-before-absolute-zero)) (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
(day (mayan-adjusted-mod (day (calendar-mod
(+ long-count (car calendar-mayan-tzolkin-at-epoch)) (+ long-count (car calendar-mayan-tzolkin-at-epoch))
13)) 13))
(name (mayan-adjusted-mod (name (calendar-mod
(+ long-count (cdr calendar-mayan-tzolkin-at-epoch)) (+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
20))) 20)))
(cons day name))) (cons day name)))
......
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