diff options
| -rw-r--r-- | lisp/calendar/cal-french.el | 26 | ||||
| -rw-r--r-- | lisp/calendar/cal-mayan.el | 10 |
2 files changed, 18 insertions, 18 deletions
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index e77e876eca0..fe1b04e7638 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; cal-french.el --- calendar functions for the French Revolutionary calendar. | 1 | ;;; cal-french.el --- calendar functions for the French Revolutionary calendar. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1988, 1989, 1992, 1994 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1988, 1989, 1992, 1994, 1995 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | 5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 6 | ;; Keywords: calendar | 6 | ;; Keywords: calendar |
| @@ -43,6 +43,9 @@ | |||
| 43 | 43 | ||
| 44 | (require 'calendar) | 44 | (require 'calendar) |
| 45 | 45 | ||
| 46 | (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) | ||
| 47 | "Absolute date of start of French Revolutionary calendar = September 22, 1792.") | ||
| 48 | |||
| 46 | (defconst french-calendar-month-name-array | 49 | (defconst french-calendar-month-name-array |
| 47 | ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" | 50 | ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" |
| 48 | "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) | 51 | "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) |
| @@ -52,8 +55,8 @@ | |||
| 52 | "Octidi" "Nonidi" "Decadi"]) | 55 | "Octidi" "Nonidi" "Decadi"]) |
| 53 | 56 | ||
| 54 | (defconst french-calendar-special-days-array | 57 | (defconst french-calendar-special-days-array |
| 55 | ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Recompense" | 58 | ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" |
| 56 | "de la Revolution"]) | 59 | "de la Re'volution"]) |
| 57 | 60 | ||
| 58 | (defun french-calendar-leap-year-p (year) | 61 | (defun french-calendar-leap-year-p (year) |
| 59 | "True if YEAR is a leap year on the French Revolutionary calendar. | 62 | "True if YEAR is a leap year on the French Revolutionary calendar. |
| @@ -98,16 +101,17 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 98 | (- (/ (1- year) 4000)))) | 101 | (- (/ (1- year) 4000)))) |
| 99 | (* 30 (1- month));; Days in prior months this year | 102 | (* 30 (1- month));; Days in prior months this year |
| 100 | day;; Days so far this month | 103 | day;; Days so far this month |
| 101 | 654414)));; Days before start of calendar (September 22, 1792). | 104 | (1- french-calendar-epoch))));; Days before start of calendar |
| 102 | 105 | ||
| 103 | (defun calendar-french-from-absolute (date) | 106 | (defun calendar-french-from-absolute (date) |
| 104 | "Compute the French Revolutionary equivalent for absolute date DATE. | 107 | "Compute the French Revolutionary equivalent for absolute date DATE. |
| 105 | The result is a list of the form (MONTH DAY YEAR). | 108 | The result is a list of the form (MONTH DAY YEAR). |
| 106 | The absolute date is the number of days elapsed since the | 109 | The absolute date is the number of days elapsed since the |
| 107 | \(imaginary) Gregorian date Sunday, December 31, 1 BC." | 110 | \(imaginary) Gregorian date Sunday, December 31, 1 BC." |
| 108 | (if (< date 654415) | 111 | (if (< date french-calendar-epoch) |
| 109 | (list 0 0 0);; pre-French Revolutionary date | 112 | (list 0 0 0);; pre-French Revolutionary date |
| 110 | (let* ((approx (/ (- date 654414) 366));; Approximation from below. | 113 | (let* ((approx ;; Approximation from below. |
| 114 | (/ (- date french-calendar-epoch) 366)) | ||
| 111 | (year ;; Search forward from the approximation. | 115 | (year ;; Search forward from the approximation. |
| 112 | (+ approx | 116 | (+ approx |
| 113 | (calendar-sum y approx | 117 | (calendar-sum y approx |
| @@ -138,10 +142,10 @@ Defaults to today's date if DATE is not given." | |||
| 138 | (d (extract-calendar-day french-date))) | 142 | (d (extract-calendar-day french-date))) |
| 139 | (cond | 143 | (cond |
| 140 | ((< y 1) "") | 144 | ((< y 1) "") |
| 141 | ((= m 13) (format "Jour %s de l'Anne'e %d de la Revolution" | 145 | ((= m 13) (format "Jour %s de l'Anne'e %d de la Re'volution" |
| 142 | (aref french-calendar-special-days-array (1- d)) | 146 | (aref french-calendar-special-days-array (1- d)) |
| 143 | y)) | 147 | y)) |
| 144 | (t (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" | 148 | (t (format "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution" |
| 145 | (make-string (1+ (/ (1- d) 10)) ?I) | 149 | (make-string (1+ (/ (1- d) 10)) ?I) |
| 146 | (aref french-calendar-day-name-array (% (1- d) 10)) | 150 | (aref french-calendar-day-name-array (% (1- d) 10)) |
| 147 | (aref french-calendar-month-name-array (1- m)) | 151 | (aref french-calendar-month-name-array (1- m)) |
| @@ -160,7 +164,7 @@ Defaults to today's date if DATE is not given." | |||
| 160 | Echo French Revolutionary date unless NOECHO is t." | 164 | Echo French Revolutionary date unless NOECHO is t." |
| 161 | (interactive | 165 | (interactive |
| 162 | (let* ((year (calendar-read | 166 | (let* ((year (calendar-read |
| 163 | "Anne'e de la Revolution (>0): " | 167 | "Anne'e de la Re'volution (>0): " |
| 164 | '(lambda (x) (> x 0)) | 168 | '(lambda (x) (> x 0)) |
| 165 | (int-to-string | 169 | (int-to-string |
| 166 | (extract-calendar-year | 170 | (extract-calendar-year |
| @@ -174,9 +178,9 @@ Echo French Revolutionary date unless NOECHO is t." | |||
| 174 | (mapcar | 178 | (mapcar |
| 175 | '(lambda (x) (concat "Jour " x)) | 179 | '(lambda (x) (concat "Jour " x)) |
| 176 | french-calendar-special-days-array) | 180 | french-calendar-special-days-array) |
| 177 | (nreverse | 181 | (reverse |
| 178 | (cdr;; we don't want rev. day in a non-leap yr. | 182 | (cdr;; we don't want rev. day in a non-leap yr. |
| 179 | (nreverse | 183 | (reverse |
| 180 | (mapcar | 184 | (mapcar |
| 181 | '(lambda (x) (concat "Jour " x)) | 185 | '(lambda (x) (concat "Jour " x)) |
| 182 | french-calendar-special-days-array)))))))) | 186 | french-calendar-special-days-array)))))))) |
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index 9fbf0b08d65..1a602c75290 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; cal-mayan.el --- calendar functions for the Mayan calendars. | 1 | ;;; cal-mayan.el --- calendar functions for the Mayan calendars. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu> | 5 | ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu> |
| 6 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> | 6 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
| @@ -52,10 +52,6 @@ | |||
| 52 | 52 | ||
| 53 | (require 'calendar) | 53 | (require 'calendar) |
| 54 | 54 | ||
| 55 | (defun mayan-adjusted-mod (m n) | ||
| 56 | "Non-negative remainder of M/N with N instead of 0." | ||
| 57 | (1+ (mod (1- m) n))) | ||
| 58 | |||
| 59 | (defconst calendar-mayan-days-before-absolute-zero 1137140 | 55 | (defconst calendar-mayan-days-before-absolute-zero 1137140 |
| 60 | "Number of days of the Mayan calendar epoch before absolute day 0. | 56 | "Number of days of the Mayan calendar epoch before absolute day 0. |
| 61 | According to the Goodman-Martinez-Thompson correlation. This correlation is | 57 | According to the Goodman-Martinez-Thompson correlation. This correlation is |
| @@ -175,10 +171,10 @@ Echo Mayan date if NOECHO is t." | |||
| 175 | (defun calendar-mayan-tzolkin-from-absolute (date) | 171 | (defun calendar-mayan-tzolkin-from-absolute (date) |
| 176 | "Convert absolute DATE into a Mayan tzolkin date (a pair)." | 172 | "Convert absolute DATE into a Mayan tzolkin date (a pair)." |
| 177 | (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero)) | 173 | (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero)) |
| 178 | (day (mayan-adjusted-mod | 174 | (day (calendar-mod |
| 179 | (+ long-count (car calendar-mayan-tzolkin-at-epoch)) | 175 | (+ long-count (car calendar-mayan-tzolkin-at-epoch)) |
| 180 | 13)) | 176 | 13)) |
| 181 | (name (mayan-adjusted-mod | 177 | (name (calendar-mod |
| 182 | (+ long-count (cdr calendar-mayan-tzolkin-at-epoch)) | 178 | (+ long-count (cdr calendar-mayan-tzolkin-at-epoch)) |
| 183 | 20))) | 179 | 20))) |
| 184 | (cons day name))) | 180 | (cons day name))) |