]> code.delx.au - gnu-emacs/blobdiff - lisp/calendar/cal-mayan.el
(calendar-basic-setup): Set day to 1 in
[gnu-emacs] / lisp / calendar / cal-mayan.el
index 9fbf0b08d659f92f1eab335b4987273581d660fb..b2d111a4b189aa7c218ba823f0dd840ff3cb3f9b 100644 (file)
@@ -1,9 +1,11 @@
-;;; 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, 1997, 2001, 2002, 2003, 2004, 2005,
+;;   2006  Free Software Foundation, Inc.
 
 ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
 ;;     Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; Human-Keywords: Mayan calendar, Maya, calendar, diary
 
@@ -20,8 +22,9 @@
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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:
 
@@ -43,6 +46,8 @@
 ;; Comments, improvements, and bug reports should be sent to Reingold.
 
 ;; Technical details of the Mayan calendrical calculations 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),
 
 ;;; Code:
 
-(require 'calendar)
+(defvar date)
 
-(defun mayan-adjusted-mod (m n)
-  "Non-negative remainder of M/N with N instead of 0."
-  (1+ (mod (1- m) n)))
+(require 'calendar)
 
-(defconst calendar-mayan-days-before-absolute-zero 1137140
+(defconst calendar-mayan-days-before-absolute-zero 1137142
   "Number of days of the Mayan calendar epoch before absolute day 0.
-According to the Goodman-Martinez-Thompson correlation.  This correlation is
-not universally accepted, as it still a subject of astro-archeological
-research.  Using 1232041 will give you Spinden's correlation; using
-1142840 will give you Hochleitner's correlation.")
+This is the Goodman-Martinez-Thompson correlation used by almost all experts,
+but some use 1137140.  Using 1232041 gives you Spinden's correlation; using
+1142840 gives you Hochleitner's correlation.")
 
 (defconst calendar-mayan-haab-at-epoch '(8 . 18)
   "Mayan haab date at the epoch.")
@@ -139,7 +141,7 @@ research.  Using 1232041 will give you Spinden's correlation; using
        365)))
 
 (defun calendar-next-haab-date (haab-date &optional noecho)
-  "Move cursor to next instance of Mayan HAAB-DATE. 
+  "Move cursor to next instance of Mayan HAAB-DATE.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-haab-date)))
   (calendar-goto-date
@@ -151,7 +153,7 @@ Echo Mayan date if NOECHO is t."
   (or noecho (calendar-print-mayan-date)))
 
 (defun calendar-previous-haab-date (haab-date &optional noecho)
-  "Move cursor to previous instance of Mayan HAAB-DATE. 
+  "Move cursor to previous instance of Mayan HAAB-DATE.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-haab-date)))
   (calendar-goto-date
@@ -175,10 +177,10 @@ Echo Mayan date if NOECHO is t."
 (defun calendar-mayan-tzolkin-from-absolute (date)
   "Convert absolute DATE into a Mayan tzolkin date (a pair)."
   (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))
                13))
-         (name (mayan-adjusted-mod
+         (name (calendar-mod
                 (+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
                 20)))
     (cons day name)))
@@ -201,7 +203,7 @@ Echo Mayan date if NOECHO is t."
        260)))
 
 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
-  "Move cursor to next instance of Mayan TZOLKIN-DATE. 
+  "Move cursor to next instance of Mayan TZOLKIN-DATE.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-tzolkin-date)))
   (calendar-goto-date
@@ -213,7 +215,7 @@ Echo Mayan date if NOECHO is t."
   (or noecho (calendar-print-mayan-date)))
 
 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
-  "Move cursor to previous instance of Mayan TZOLKIN-DATE. 
+  "Move cursor to previous instance of Mayan TZOLKIN-DATE.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-tzolkin-date)))
   (calendar-goto-date
@@ -232,7 +234,7 @@ Echo Mayan date if NOECHO is t."
 (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
   "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
 Latest such date on or before DATE.
-Returns nil if such a tzolkin-haab combination is impossible." 
+Returns nil if such a tzolkin-haab combination is impossible."
   (let* ((haab-difference
           (calendar-mayan-haab-difference
            (calendar-mayan-haab-from-absolute 0)
@@ -255,16 +257,14 @@ Returns nil if such a tzolkin-haab combination is impossible."
          (haab-day (calendar-read
                     "Haab kin (0-19): "
                     '(lambda (x) (and (>= x 0) (< x 20)))))
-         (haab-month-list (append calendar-mayan-haab-month-name-array 
+         (haab-month-list (append calendar-mayan-haab-month-name-array
                                   (and (< haab-day 5) '("Uayeb"))))
          (haab-month (cdr
-                      (assoc
-                       (capitalize
-                        (completing-read "Haab uinal: "
-                                         (mapcar 'list haab-month-list)
-                                         nil t))
-                       (calendar-make-alist
-                        haab-month-list 1 'capitalize)))))
+                      (assoc-string
+                       (completing-read "Haab uinal: "
+                                        (mapcar 'list haab-month-list)
+                                        nil t)
+                       (calendar-make-alist haab-month-list 1) t))))
     (cons haab-day haab-month)))
 
 (defun calendar-read-mayan-tzolkin-date ()
@@ -275,18 +275,16 @@ Returns nil if such a tzolkin-haab combination is impossible."
                          '(lambda (x) (and (> x 0) (< x 14)))))
          (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
          (tzolkin-name (cdr
-                        (assoc
-                         (capitalize
-                          (completing-read "Tzolkin uinal: " 
+                        (assoc-string
+                          (completing-read "Tzolkin uinal: "
                                            (mapcar 'list tzolkin-name-list)
-                                           nil t))
-                         (calendar-make-alist
-                          tzolkin-name-list 1 'capitalize)))))
+                                           nil t)
+                         (calendar-make-alist tzolkin-name-list 1) t))))
     (cons tzolkin-count tzolkin-name)))
 
 (defun calendar-next-calendar-round-date
   (tzolkin-date haab-date &optional noecho)
-  "Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination.
+  "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-tzolkin-date)
                      (calendar-read-mayan-haab-date)))
@@ -303,7 +301,7 @@ Echo Mayan date if NOECHO is t."
 
 (defun calendar-previous-calendar-round-date
   (tzolkin-date haab-date &optional noecho)
-  "Move to previous instance of Mayan TZOKLIN-DATE HAAB-DATE combination.
+  "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
 Echo Mayan date if NOECHO is t."
   (interactive (list (calendar-read-mayan-tzolkin-date)
                      (calendar-read-mayan-haab-date)))
@@ -332,7 +330,7 @@ Long count is a list (baktun katun tun uinal kin)"
 (defun calendar-mayan-date-string (&optional date)
   "String of Mayan date of Gregorian DATE.
 Defaults to today's date if DATE is not given."
-  (let* ((d (calendar-absolute-from-gregorian 
+  (let* ((d (calendar-absolute-from-gregorian
              (or date (calendar-current-date))))
          (tzolkin (calendar-mayan-tzolkin-from-absolute d))
          (haab (calendar-mayan-haab-from-absolute d))
@@ -354,7 +352,7 @@ Defaults to today's date if DATE is not given."
    (let (lc)
      (while (not lc)
        (let ((datum
-              (calendar-string-to-mayan-long-count 
+              (calendar-string-to-mayan-long-count
                (read-string "Mayan long count (baktun.katun.tun.uinal.kin): "
                             (calendar-mayan-long-count-to-string
                              (calendar-mayan-long-count-from-absolute
@@ -367,7 +365,7 @@ Defaults to today's date if DATE is not given."
    (calendar-gregorian-from-absolute
     (calendar-absolute-from-mayan-long-count date)))
   (or noecho (calendar-print-mayan-date)))
-              
+
 (defun calendar-mayan-long-count-common-era (lc)
   "T if long count represents date in the Common Era."
   (let ((base (calendar-mayan-long-count-from-absolute 1)))
@@ -382,4 +380,5 @@ Defaults to today's date if DATE is not given."
 
 (provide 'cal-mayan)
 
+;;; arch-tag: 54f35144-cd0f-4873-935a-a60129de07df
 ;;; cal-mayan.el ends here