Mercurial > emacs

comparison lisp/calendar/cal-mayan.el @ 92589:c11e81a389cf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Unquote lambda functions. Add autoload cookies to functions formerly autoloaded in calendar.el. Set `generated-autoload-file' to "cal-loaddefs.el".
author Glenn Morris <rgm@gnu.org>
date Sat, 08 Mar 2008 03:44:51 +0000
parents 974a828870fe
children 90e80e5b0c97
comparison
equal deleted inserted replaced
92588:91e9da1a1847 92589:c11e81a389cf
136 (% (- date 136 (% (- date
137 (calendar-mayan-haab-difference 137 (calendar-mayan-haab-difference
138 (calendar-mayan-haab-from-absolute 0) haab-date)) 138 (calendar-mayan-haab-from-absolute 0) haab-date))
139 365))) 139 365)))
140 140
141 ;;;###autoload
141 (defun calendar-next-haab-date (haab-date &optional noecho) 142 (defun calendar-next-haab-date (haab-date &optional noecho)
142 "Move cursor to next instance of Mayan HAAB-DATE. 143 "Move cursor to next instance of Mayan HAAB-DATE.
143 Echo Mayan date if NOECHO is t." 144 Echo Mayan date if NOECHO is t."
144 (interactive (list (calendar-read-mayan-haab-date))) 145 (interactive (list (calendar-read-mayan-haab-date)))
145 (calendar-goto-date 146 (calendar-goto-date
148 haab-date 149 haab-date
149 (+ 365 150 (+ 365
150 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) 151 (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
151 (or noecho (calendar-print-mayan-date))) 152 (or noecho (calendar-print-mayan-date)))
152 153
154 ;;;###autoload
153 (defun calendar-previous-haab-date (haab-date &optional noecho) 155 (defun calendar-previous-haab-date (haab-date &optional noecho)
154 "Move cursor to previous instance of Mayan HAAB-DATE. 156 "Move cursor to previous instance of Mayan HAAB-DATE.
155 Echo Mayan date if NOECHO is t." 157 Echo Mayan date if NOECHO is t."
156 (interactive (list (calendar-read-mayan-haab-date))) 158 (interactive (list (calendar-read-mayan-haab-date)))
157 (calendar-goto-date 159 (calendar-goto-date
198 (% (- date (calendar-mayan-tzolkin-difference 200 (% (- date (calendar-mayan-tzolkin-difference
199 (calendar-mayan-tzolkin-from-absolute 0) 201 (calendar-mayan-tzolkin-from-absolute 0)
200 tzolkin-date)) 202 tzolkin-date))
201 260))) 203 260)))
202 204
205 ;;;###autoload
203 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) 206 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
204 "Move cursor to next instance of Mayan TZOLKIN-DATE. 207 "Move cursor to next instance of Mayan TZOLKIN-DATE.
205 Echo Mayan date if NOECHO is t." 208 Echo Mayan date if NOECHO is t."
206 (interactive (list (calendar-read-mayan-tzolkin-date))) 209 (interactive (list (calendar-read-mayan-tzolkin-date)))
207 (calendar-goto-date 210 (calendar-goto-date
210 tzolkin-date 213 tzolkin-date
211 (+ 260 214 (+ 260
212 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) 215 (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
213 (or noecho (calendar-print-mayan-date))) 216 (or noecho (calendar-print-mayan-date)))
214 217
218 ;;;###autoload
215 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho) 219 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
216 "Move cursor to previous instance of Mayan TZOLKIN-DATE. 220 "Move cursor to previous instance of Mayan TZOLKIN-DATE.
217 Echo Mayan date if NOECHO is t." 221 Echo Mayan date if NOECHO is t."
218 (interactive (list (calendar-read-mayan-tzolkin-date))) 222 (interactive (list (calendar-read-mayan-tzolkin-date)))
219 (calendar-goto-date 223 (calendar-goto-date
252 (defun calendar-read-mayan-haab-date () 256 (defun calendar-read-mayan-haab-date ()
253 "Prompt for a Mayan haab date" 257 "Prompt for a Mayan haab date"
254 (let* ((completion-ignore-case t) 258 (let* ((completion-ignore-case t)
255 (haab-day (calendar-read 259 (haab-day (calendar-read
256 "Haab kin (0-19): " 260 "Haab kin (0-19): "
257 '(lambda (x) (and (>= x 0) (< x 20))))) 261 (lambda (x) (and (>= x 0) (< x 20)))))
258 (haab-month-list (append calendar-mayan-haab-month-name-array 262 (haab-month-list (append calendar-mayan-haab-month-name-array
259 (and (< haab-day 5) '("Uayeb")))) 263 (and (< haab-day 5) '("Uayeb"))))
260 (haab-month (cdr 264 (haab-month (cdr
261 (assoc-string 265 (assoc-string
262 (completing-read "Haab uinal: " 266 (completing-read "Haab uinal: "
268 (defun calendar-read-mayan-tzolkin-date () 272 (defun calendar-read-mayan-tzolkin-date ()
269 "Prompt for a Mayan tzolkin date" 273 "Prompt for a Mayan tzolkin date"
270 (let* ((completion-ignore-case t) 274 (let* ((completion-ignore-case t)
271 (tzolkin-count (calendar-read 275 (tzolkin-count (calendar-read
272 "Tzolkin kin (1-13): " 276 "Tzolkin kin (1-13): "
273 '(lambda (x) (and (> x 0) (< x 14))))) 277 (lambda (x) (and (> x 0) (< x 14)))))
274 (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) 278 (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
275 (tzolkin-name (cdr 279 (tzolkin-name (cdr
276 (assoc-string 280 (assoc-string
277 (completing-read "Tzolkin uinal: " 281 (completing-read "Tzolkin uinal: "
278 (mapcar 'list tzolkin-name-list) 282 (mapcar 'list tzolkin-name-list)
279 nil t) 283 nil t)
280 (calendar-make-alist tzolkin-name-list 1) t)))) 284 (calendar-make-alist tzolkin-name-list 1) t))))
281 (cons tzolkin-count tzolkin-name))) 285 (cons tzolkin-count tzolkin-name)))
282 286
287 ;;;###autoload
283 (defun calendar-next-calendar-round-date 288 (defun calendar-next-calendar-round-date
284 (tzolkin-date haab-date &optional noecho) 289 (tzolkin-date haab-date &optional noecho)
285 "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination. 290 "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination.
286 Echo Mayan date if NOECHO is t." 291 Echo Mayan date if NOECHO is t."
287 (interactive (list (calendar-read-mayan-tzolkin-date) 292 (interactive (list (calendar-read-mayan-tzolkin-date)
295 (calendar-mayan-tzolkin-to-string tzolkin-date) 300 (calendar-mayan-tzolkin-to-string tzolkin-date)
296 (calendar-mayan-haab-to-string haab-date)) 301 (calendar-mayan-haab-to-string haab-date))
297 (calendar-goto-date (calendar-gregorian-from-absolute date)) 302 (calendar-goto-date (calendar-gregorian-from-absolute date))
298 (or noecho (calendar-print-mayan-date))))) 303 (or noecho (calendar-print-mayan-date)))))
299 304
305 ;;;###autoload
300 (defun calendar-previous-calendar-round-date 306 (defun calendar-previous-calendar-round-date
301 (tzolkin-date haab-date &optional noecho) 307 (tzolkin-date haab-date &optional noecho)
302 "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination. 308 "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
303 Echo Mayan date if NOECHO is t." 309 Echo Mayan date if NOECHO is t."
304 (interactive (list (calendar-read-mayan-tzolkin-date) 310 (interactive (list (calendar-read-mayan-tzolkin-date)
323 (* (nth 3 c) 20) ; uinal 329 (* (nth 3 c) 20) ; uinal
324 (nth 4 c) ; kin (days) 330 (nth 4 c) ; kin (days)
325 (- ; days before absolute date 0 331 (- ; days before absolute date 0
326 calendar-mayan-days-before-absolute-zero))) 332 calendar-mayan-days-before-absolute-zero)))
327 333
334 ;;;###autoload
328 (defun calendar-mayan-date-string (&optional date) 335 (defun calendar-mayan-date-string (&optional date)
329 "String of Mayan date of Gregorian DATE. 336 "String of Mayan date of Gregorian DATE.
330 Defaults to today's date if DATE is not given." 337 Defaults to today's date if DATE is not given."
331 (let* ((d (calendar-absolute-from-gregorian 338 (let* ((d (calendar-absolute-from-gregorian
332 (or date (calendar-current-date)))) 339 (or date (calendar-current-date))))
336 (format "Long count = %s; tzolkin = %s; haab = %s" 343 (format "Long count = %s; tzolkin = %s; haab = %s"
337 (calendar-mayan-long-count-to-string long-count) 344 (calendar-mayan-long-count-to-string long-count)
338 (calendar-mayan-tzolkin-to-string tzolkin) 345 (calendar-mayan-tzolkin-to-string tzolkin)
339 (calendar-mayan-haab-to-string haab)))) 346 (calendar-mayan-haab-to-string haab))))
340 347
348 ;;;###autoload
341 (defun calendar-print-mayan-date () 349 (defun calendar-print-mayan-date ()
342 "Show the Mayan long count, tzolkin, and haab equivalents of date." 350 "Show the Mayan long count, tzolkin, and haab equivalents of date."
343 (interactive) 351 (interactive)
344 (message "Mayan date: %s" 352 (message "Mayan date: %s"
345 (calendar-mayan-date-string (calendar-cursor-to-date t)))) 353 (calendar-mayan-date-string (calendar-cursor-to-date t))))
346 354
355 ;;;###autoload
347 (defun calendar-goto-mayan-long-count-date (date &optional noecho) 356 (defun calendar-goto-mayan-long-count-date (date &optional noecho)
348 "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t." 357 "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t."
349 (interactive 358 (interactive
350 (let (lc) 359 (let (lc)
351 (while (not lc) 360 (while (not lc)
376 "Show the Mayan long count, haab, and tzolkin dates as a diary entry." 385 "Show the Mayan long count, haab, and tzolkin dates as a diary entry."
377 (format "Mayan date: %s" (calendar-mayan-date-string date))) 386 (format "Mayan date: %s" (calendar-mayan-date-string date)))
378 387
379 (provide 'cal-mayan) 388 (provide 'cal-mayan)
380 389
381 ;;; arch-tag: 54f35144-cd0f-4873-935a-a60129de07df 390 ;; Local Variables:
391 ;; generated-autoload-file: "cal-loaddefs.el"
392 ;; End:
393
394 ;; arch-tag: 54f35144-cd0f-4873-935a-a60129de07df
382 ;;; cal-mayan.el ends here 395 ;;; cal-mayan.el ends here