/[emacs]/emacs/lisp/calendar/cal-mayan.el
ViewVC logotype

Diff of /emacs/lisp/calendar/cal-mayan.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19 by pj, Mon Jul 16 07:46:48 2001 UTC revision 1.19.8.1 by miles, Fri Apr 4 06:20:15 2003 UTC
# Line 137  but some use 1137140.  Using 1232041 giv Line 137  but some use 1137140.  Using 1232041 giv
137          365)))          365)))
138    
139  (defun calendar-next-haab-date (haab-date &optional noecho)  (defun calendar-next-haab-date (haab-date &optional noecho)
140    "Move cursor to next instance of Mayan HAAB-DATE.    "Move cursor to next instance of Mayan HAAB-DATE.
141  Echo Mayan date if NOECHO is t."  Echo Mayan date if NOECHO is t."
142    (interactive (list (calendar-read-mayan-haab-date)))    (interactive (list (calendar-read-mayan-haab-date)))
143    (calendar-goto-date    (calendar-goto-date
# Line 149  Echo Mayan date if NOECHO is t." Line 149  Echo Mayan date if NOECHO is t."
149    (or noecho (calendar-print-mayan-date)))    (or noecho (calendar-print-mayan-date)))
150    
151  (defun calendar-previous-haab-date (haab-date &optional noecho)  (defun calendar-previous-haab-date (haab-date &optional noecho)
152    "Move cursor to previous instance of Mayan HAAB-DATE.    "Move cursor to previous instance of Mayan HAAB-DATE.
153  Echo Mayan date if NOECHO is t."  Echo Mayan date if NOECHO is t."
154    (interactive (list (calendar-read-mayan-haab-date)))    (interactive (list (calendar-read-mayan-haab-date)))
155    (calendar-goto-date    (calendar-goto-date
# Line 199  Echo Mayan date if NOECHO is t." Line 199  Echo Mayan date if NOECHO is t."
199          260)))          260)))
200    
201  (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)  (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
202    "Move cursor to next instance of Mayan TZOLKIN-DATE.    "Move cursor to next instance of Mayan TZOLKIN-DATE.
203  Echo Mayan date if NOECHO is t."  Echo Mayan date if NOECHO is t."
204    (interactive (list (calendar-read-mayan-tzolkin-date)))    (interactive (list (calendar-read-mayan-tzolkin-date)))
205    (calendar-goto-date    (calendar-goto-date
# Line 211  Echo Mayan date if NOECHO is t." Line 211  Echo Mayan date if NOECHO is t."
211    (or noecho (calendar-print-mayan-date)))    (or noecho (calendar-print-mayan-date)))
212    
213  (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)  (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
214    "Move cursor to previous instance of Mayan TZOLKIN-DATE.    "Move cursor to previous instance of Mayan TZOLKIN-DATE.
215  Echo Mayan date if NOECHO is t."  Echo Mayan date if NOECHO is t."
216    (interactive (list (calendar-read-mayan-tzolkin-date)))    (interactive (list (calendar-read-mayan-tzolkin-date)))
217    (calendar-goto-date    (calendar-goto-date
# Line 230  Echo Mayan date if NOECHO is t." Line 230  Echo Mayan date if NOECHO is t."
230  (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)  (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
231    "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.    "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
232  Latest such date on or before DATE.  Latest such date on or before DATE.
233  Returns nil if such a tzolkin-haab combination is impossible."  Returns nil if such a tzolkin-haab combination is impossible."
234    (let* ((haab-difference    (let* ((haab-difference
235            (calendar-mayan-haab-difference            (calendar-mayan-haab-difference
236             (calendar-mayan-haab-from-absolute 0)             (calendar-mayan-haab-from-absolute 0)
# Line 253  Returns nil if such a tzolkin-haab combi Line 253  Returns nil if such a tzolkin-haab combi
253           (haab-day (calendar-read           (haab-day (calendar-read
254                      "Haab kin (0-19): "                      "Haab kin (0-19): "
255                      '(lambda (x) (and (>= x 0) (< x 20)))))                      '(lambda (x) (and (>= x 0) (< x 20)))))
256           (haab-month-list (append calendar-mayan-haab-month-name-array           (haab-month-list (append calendar-mayan-haab-month-name-array
257                                    (and (< haab-day 5) '("Uayeb"))))                                    (and (< haab-day 5) '("Uayeb"))))
258           (haab-month (cdr           (haab-month (cdr
259                        (assoc-ignore-case                        (assoc-ignore-case
# Line 272  Returns nil if such a tzolkin-haab combi Line 272  Returns nil if such a tzolkin-haab combi
272           (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))           (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
273           (tzolkin-name (cdr           (tzolkin-name (cdr
274                          (assoc-ignore-case                          (assoc-ignore-case
275                            (completing-read "Tzolkin uinal: "                            (completing-read "Tzolkin uinal: "
276                                             (mapcar 'list tzolkin-name-list)                                             (mapcar 'list tzolkin-name-list)
277                                             nil t)                                             nil t)
278                           (calendar-make-alist tzolkin-name-list 1)))))                           (calendar-make-alist tzolkin-name-list 1)))))
# Line 326  Long count is a list (baktun katun tun u Line 326  Long count is a list (baktun katun tun u
326  (defun calendar-mayan-date-string (&optional date)  (defun calendar-mayan-date-string (&optional date)
327    "String of Mayan date of Gregorian DATE.    "String of Mayan date of Gregorian DATE.
328  Defaults to today's date if DATE is not given."  Defaults to today's date if DATE is not given."
329    (let* ((d (calendar-absolute-from-gregorian    (let* ((d (calendar-absolute-from-gregorian
330               (or date (calendar-current-date))))               (or date (calendar-current-date))))
331           (tzolkin (calendar-mayan-tzolkin-from-absolute d))           (tzolkin (calendar-mayan-tzolkin-from-absolute d))
332           (haab (calendar-mayan-haab-from-absolute d))           (haab (calendar-mayan-haab-from-absolute d))
# Line 348  Defaults to today's date if DATE is not Line 348  Defaults to today's date if DATE is not
348     (let (lc)     (let (lc)
349       (while (not lc)       (while (not lc)
350         (let ((datum         (let ((datum
351                (calendar-string-to-mayan-long-count                (calendar-string-to-mayan-long-count
352                 (read-string "Mayan long count (baktun.katun.tun.uinal.kin): "                 (read-string "Mayan long count (baktun.katun.tun.uinal.kin): "
353                              (calendar-mayan-long-count-to-string                              (calendar-mayan-long-count-to-string
354                               (calendar-mayan-long-count-from-absolute                               (calendar-mayan-long-count-from-absolute
# Line 361  Defaults to today's date if DATE is not Line 361  Defaults to today's date if DATE is not
361     (calendar-gregorian-from-absolute     (calendar-gregorian-from-absolute
362      (calendar-absolute-from-mayan-long-count date)))      (calendar-absolute-from-mayan-long-count date)))
363    (or noecho (calendar-print-mayan-date)))    (or noecho (calendar-print-mayan-date)))
364                  
365  (defun calendar-mayan-long-count-common-era (lc)  (defun calendar-mayan-long-count-common-era (lc)
366    "T if long count represents date in the Common Era."    "T if long count represents date in the Common Era."
367    (let ((base (calendar-mayan-long-count-from-absolute 1)))    (let ((base (calendar-mayan-long-count-from-absolute 1)))

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.19.8.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26