Commit 7e1dae73 authored by Jim Blandy's avatar Jim Blandy
Browse files

entered into RCS

parent 9f34a2a0
......@@ -86,9 +86,23 @@ If NEW is a string, that is the `use instead' message."
(put fn 'byte-compile 'byte-compile-obsolete)))
fn)
(defun make-obsolete-variable (var new)
"Make the byte-compiler warn that VARIABLE is obsolete,
and NEW should be used instead. If NEW is a string, then that is the
`use instead' message."
(interactive
(list
(let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
(if (equal str "") (error ""))
(intern str))
(car (read-from-string (read-string "Obsoletion replacement: ")))))
(put var 'byte-obsolete-variable new)
var)
(put 'dont-compile 'lisp-indent-hook 0)
(defmacro dont-compile (&rest body)
"Like `progn', but the body always runs interpreted (not compiled)."
"Like `progn', but the body always runs interpreted (not compiled).
If you think you need this, you're probably making a mistake somewhere."
(list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
......
......@@ -107,29 +107,37 @@
;;; Code:
;;;###autoload
(defvar appt-issue-message t
"*Non-nil means check for appointments in the diary buffer.
To be detected, the diary entry must have the time
as the first thing on a line.")
;;;###autoload
(defvar appt-message-warning-time 10
"*Time in minutes before an appointment that the warning begins.")
;;;###autoload
(defvar appt-audible t
"*Non-nil means beep to indicate appointment.")
;;;###autoload
(defvar appt-visible t
"*Non-nil means display appointment message in echo area.")
;;;###autoload
(defvar appt-display-mode-line t
"*Non-nil means display minutes to appointment and time on the mode line.")
;;;###autoload
(defvar appt-msg-window t
"*Non-nil means display appointment message in another window.")
;;;###autoload
(defvar appt-display-duration 5
"*The number of seconds an appointment message is displayed.")
;;;###autoload
(defvar appt-display-diary t
"*Non-nil means to display the next days diary on the screen.
This will occur at midnight when the appointment list is updated.")
......
;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
;; Copyright (C) 1988, 1989, 1992 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: French Revolutionary calendar, calendar, diary
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;; This collection of functions implements the features of calendar.el and
;; diary.el that deal with the French Revolutionary calendar.
;; Technical details of the French Revolutionary calendrical calculations can
;; be found in ``Calendrical Calculations, Part II: Three Historical
;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; Report Number UIUCDCS-R-92-1743, Department of Computer Science,
;; University of Illinois, April, 1992.
;; Comments, corrections, and improvements should be sent to
;; Edward M. Reingold Department of Computer Science
;; (217) 333-6733 University of Illinois at Urbana-Champaign
;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
;;; Code:
(require 'calendar)
(defconst french-calendar-month-name-array
["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
"Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])
(defconst french-calendar-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"])
(defconst french-calendar-special-days-array
["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Recompense"
"de la Revolution"])
(defun french-calendar-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
For Gregorian years 1793 to 1805, the years of actual operation of the
calendar, uses historical practice based on equinoxes is followed (years 3, 7,
and 11 were leap years; 15 and 20 would have been leap years). For later
years uses the proposed rule of Romme (never adopted)--leap years fall every
four years except century years not divisible 400 and century years that are
multiples of 4000."
(or (memq year '(3 7 11));; Actual practice--based on equinoxes
(memq year '(15 20)) ;; Anticipated practice--based on equinoxes
(and (> year 20) ;; Romme's proposal--never adopted
(zerop (% year 4))
(not (memq (% year 400) '(100 200 300)))
(not (zerop (% year 4000))))))
(defun french-calendar-last-day-of-month (month year)
"Last day of MONTH, YEAR on the French Revolutionary calendar.
The 13th month is not really a month, but the 5 (6 in leap years) day period of
`sansculottides' at the end of the year."
(if (< month 13)
30
(if (french-calendar-leap-year-p year)
6
5)))
(defun calendar-absolute-from-french (date)
"Absolute date of French Revolutionary DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(+ (* 365 (1- year));; Days in prior years
;; Leap days in prior years
(if (< year 20)
(/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15)
;; Romme's proposed rule (using the Principle of Inclusion/Exclusion)
(+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20
(- (/ (1- year) 100))
(/ (1- year) 400)
(- (/ (1- year) 4000))))
(* 30 (1- month));; Days in prior months this year
day;; Days so far this month
654414)));; Days before start of calendar (September 22, 1792).
(defun calendar-french-from-absolute (date)
"Compute the French Revolutionary date (month day year) corresponding to
absolute DATE. The absolute date is the number of days elapsed since the
(imaginary) Gregorian date Sunday, December 31, 1 BC."
(if (< date 654415)
(list 0 0 0);; pre-French Revolutionary date
(let* ((approx (/ (- date 654414) 366));; Approximation from below.
(year ;; Search forward from the approximation.
(+ approx
(calendar-sum y approx
(>= date (calendar-absolute-from-french (list 1 1 (1+ y))))
1)))
(month ;; Search forward from Vendemiaire.
(1+ (calendar-sum m 1
(> date
(calendar-absolute-from-french
(list m
(french-calendar-last-day-of-month m year)
year)))
1)))
(day ;; Calculate the day by subtraction.
(- date
(1- (calendar-absolute-from-french (list month 1 year))))))
(list month day year))))
(defun calendar-print-french-date ()
"Show the French Revolutionary calendar equivalent of the date under the
cursor."
(interactive)
(let* ((french-date (calendar-french-from-absolute
(calendar-absolute-from-gregorian
(or (calendar-cursor-to-date)
(error "Cursor is not on a date!")))))
(y (extract-calendar-year french-date))
(m (extract-calendar-month french-date))
(d (extract-calendar-day french-date)))
(if (< y 1)
(message "Date is pre-French Revolution")
(if (= m 13)
(message "Jour %s de l'Anne'e %d de la Revolution"
(aref french-calendar-special-days-array (1- d))
y)
(message "Decade %s, %s de %s de l'Anne'e %d de la Revolution"
(make-string (1+ (/ (1- d) 10)) ?I)
(aref french-calendar-day-name-array (% (1- d) 10))
(aref french-calendar-month-name-array (1- m))
y)))))
(defun calendar-goto-french-date (date &optional noecho)
"Move cursor to French Revolutionary DATE.
Echo French Revolutionary date unless NOECHO is t."
(interactive
(let* ((year (calendar-read
"Anne'e de la Revolution (>0): "
'(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-french-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date)))))))
(month-list
(mapcar 'list
(append french-calendar-month-name-array
(if (french-calendar-leap-year-p year)
(mapcar
'(lambda (x) (concat "Jour " x))
french-calendar-special-days-array)
(cdr;; we don't want rev. day in a non-leap yr.
(nreverse
(mapcar
'(lambda (x) (concat "Jour " x))
french-calendar-special-days-array)))))))
(completion-ignore-case t)
(month (cdr (assoc
(capitalize
(completing-read
"Mois ou Sansculottide: "
month-list
nil t))
(calendar-make-alist
month-list
1
'(lambda (x) (capitalize (car x)))))))
(decade (if (> month 12)
1
(calendar-read
"De'cade (1-3): "
'(lambda (x) (memq x '(1 2 3))))))
(day (if (> month 12)
(- month 12)
(calendar-read
"Jour (1-10)): "
'(lambda (x) (and (<= 1 x) (<= x 10))))))
(month (if (> month 12) 13 month))
(day (+ day (* 10 (1- decade)))))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-french date)))
(or noecho (calendar-print-french-date)))
(defun diary-french-date ()
"French calendar equivalent of date diary entry."
(let* ((french-date (calendar-french-from-absolute
(calendar-absolute-from-gregorian date)))
(y (extract-calendar-year french-date))
(m (extract-calendar-month french-date))
(d (extract-calendar-day french-date)))
(if (> y 0)
(if (= m 13)
(format "Jour %s de l'Anne'e %d de la Revolution"
(aref french-calendar-special-days-array (1- d))
y)
(format "Decade %s, %s de %s de l'Anne'e %d de la Revolution"
(make-string (1+ (/ (1- d) 10)) ?I)
(aref french-calendar-day-name-array (% (1- d) 10))
(aref french-calendar-month-name-array (1- m))
y)))))
(provide 'cal-french)
;;; cal-french.el ends here
;;; cal-mayan.el --- calendar functions for the Mayan calendars.
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: Mayan calendar, Maya, calendar, diary
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;; This collection of functions implements the features of calendar.el and
;; diary.el that deal with the Mayan calendar. It was written jointly by
;; Stewart M. Clamen School of Computer Science
;; clamen@cs.cmu.edu Carnegie Mellon University
;; 5000 Forbes Avenue
;; Pittsburgh, PA 15213
;; and
;; Edward M. Reingold Department of Computer Science
;; (217) 333-6733 University of Illinois at Urbana-Champaign
;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
;; Comments, improvements, and bug reports should be sent to Reingold.
;; Technical details of the Mayan calendrical calculations can be found in
;; ``Calendrical Calculations, Part II: Three Historical Calendars''
;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; Report Number UIUCDCS-R-92-1743, Department of Computer Science,
;; University of Illinois, April, 1992.
;;; Code:
(require 'calendar)
(defun mayan-mod (m n)
"Returns M mod N; value is *always* non-negative when N>0."
(let ((v (% m n)))
(if (and (> 0 v) (> n 0))
(+ v n)
v)))
(defun mayan-adjusted-mod (m n)
"Non-negative remainder of M/N with N instead of 0."
(1+ (mayan-mod (1- m) n)))
(defconst calendar-mayan-days-before-absolute-zero 1137140
"Number of days of the Mayan calendar epoch before absolute day 0 (that is,
Dec 31, 0 (Gregorian)), 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 the
correlation used by Spinden.")
(defconst calendar-mayan-haab-at-epoch '(8 . 18)
"Mayan haab date at the epoch.")
(defconst calendar-mayan-haab-month-name-array
["Pop" "Uo" "Zip" "Zotz" "Tzec" "Xul" "Yaxkin" "Mol" "Chen" "Yax"
"Zac" "Ceh" "Mac" "Kankin" "Muan" "Pax" "Kayab" "Cumku"])
(defconst calendar-mayan-tzolkin-at-epoch '(4 . 20)
"Mayan tzolkin date at the epoch.")
(defconst calendar-mayan-tzolkin-names-array
["Imix" "Ik" "Akbal" "Kan" "Chicchan" "Cimi" "Manik" "Lamat" "Muluc" "Oc"
"Chuen" "Eb" "Ben" "Ix" "Men" "Cib" "Caban" "Etznab" "Cauac" "Ahau"])
(defun calendar-mayan-long-count-from-absolute (date)
"Compute the Mayan long count corresponding to the absolute DATE."
(let ((long-count (+ date calendar-mayan-days-before-absolute-zero)))
(let* ((baktun (/ long-count 144000))
(remainder (% long-count 144000))
(katun (/ remainder 7200))
(remainder (% remainder 7200))
(tun (/ remainder 360))
(remainder (% remainder 360))
(uinal (/ remainder 20))
(kin (% remainder 20)))
(list baktun katun tun uinal kin))))
(defun calendar-mayan-long-count-to-string (mayan-long-count)
"Convert MAYAN-LONG-COUNT into traditional written form."
(apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))
(defun calendar-string-to-mayan-long-count (str)
"Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of nums."
(let ((rlc nil)
(c (length str))
(cc 0))
(condition-case condition
(progn
(while (< cc c)
(let ((datum (read-from-string str cc)))
(if (not (integerp (car datum)))
(signal 'invalid-read-syntax (car datum))
(setq rlc (cons (car datum) rlc))
(setq cc (cdr datum)))))
(if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil)))
(invalid-read-syntax nil))
(reverse rlc)))
(defun calendar-mayan-haab-from-absolute (date)
"Convert absolute DATE into a Mayan haab date (a pair)."
(let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
(day-of-haab
(% (+ long-count
(car calendar-mayan-haab-at-epoch)
(* 20 (1- (cdr calendar-mayan-haab-at-epoch))))
365))
(day (% day-of-haab 20))
(month (1+ (/ day-of-haab 20))))
(cons day month)))
(defun calendar-mayan-haab-difference (date1 date2)
"Number of days from Mayan haab date DATE1 to the next occurrence of Mayan
haab date DATE2."
(mayan-mod (+ (* 20 (- (cdr date2) (cdr date1)))
(- (car date2) (car date1)))
365))
(defun calendar-mayan-haab-on-or-before (haab-date date)
"Absolute date of latest HAAB-DATE on or before absolute DATE."
(- date
(mod (- date
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0) haab-date))
365)))
(defun calendar-next-haab-date (haab-date &optional noecho)
"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
(calendar-gregorian-from-absolute
(calendar-mayan-haab-on-or-before
haab-date
(+ 365
(calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-haab-date (haab-date &optional noecho)
"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
(calendar-gregorian-from-absolute
(calendar-mayan-haab-on-or-before
haab-date
(1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-print-mayan-date)))
(defun calendar-mayan-haab-to-string (haab)
"Convert Mayan haab date (a pair) into its traditional written form."
(let ((month (cdr haab))
(day (car haab)))
;; 19th month consists of 5 special days
(if (= month 19)
(format "%d Uayeb" day)
(format "%d %s"
day
(aref calendar-mayan-haab-month-name-array (1- month))))))
(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
(+ long-count (car calendar-mayan-tzolkin-at-epoch))
13))
(name (mayan-adjusted-mod
(+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
20)))
(cons day name)))
(defun calendar-mayan-tzolkin-difference (date1 date2)
"Number of days from Mayan tzolkin date DATE1 to the next occurrence of
Mayan tzolkin date DATE2."
(let ((number-difference (- (car date2) (car date1)))
(name-difference (- (cdr date2) (cdr date1))))
(mayan-mod (+ number-difference
(* 13 (mayan-mod (* 3 (- number-difference name-difference))
20)))
260)))
(defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date)
"Absolute date of latest TZOLKIN-DATE on or before absolute DATE."
(- date
(mod (- date (calendar-mayan-tzolkin-difference
(calendar-mayan-tzolkin-from-absolute 0)
tzolkin-date))
260)))
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
"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
(calendar-gregorian-from-absolute
(calendar-mayan-tzolkin-on-or-before
tzolkin-date
(+ 260
(calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
"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
(calendar-gregorian-from-absolute
(calendar-mayan-tzolkin-on-or-before
tzolkin-date
(1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-print-mayan-date)))
(defun calendar-mayan-tzolkin-to-string (tzolkin)
"Convert Mayan tzolkin date (a pair) into its traditional written form."
(format "%d %s"
(car tzolkin)
(aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))
(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
"Absolute date of latest date on or before date that is Mayan TZOLKIN-DATE
and HAAB-DATE; returns nil if such a tzolkin-haab combination is impossible."
(let* ((haab-difference
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0)
haab-date))
(tzolkin-difference
(calendar-mayan-tzolkin-difference
(calendar-mayan-tzolkin-from-absolute 0)
tzolkin-date))
(difference (- tzolkin-difference haab-difference)))
(if (= (% difference 5) 0)
(- date
(mayan-mod (- date
(+ haab-difference (* 365 difference)))
18980))
nil)))
(defun calendar-read-mayan-haab-date ()
"Prompt for a Mayan haab date"
(let* ((completion-ignore-case t)
(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
(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)))))
(cons haab-day haab-month)))
(defun calendar-read-mayan-tzolkin-date ()
"Prompt for a Mayan tzolkin date"
(let* ((completion-ignore-case t)
(tzolkin-count (calendar-read
"Tzolkin kin (1-13): "
'(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: "
(mapcar 'list tzolkin-name-list)
nil t))
(calendar-make-alist
tzolkin-name-list 1 'capitalize)))))
(cons tzolkin-count tzolkin-name)))
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
"Move cursor to next instance of Mayan TZOLKIN-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)))
(let* ((date (calendar-absolute-from-gregorian (calendar-cursor-to-date)))
(tomorrow-tzolkin-date
(calendar-mayan-tzolkin-from-absolute (1+ date))))
(calendar-goto-date
(calendar-gregorian-from-absolute
(+ date 1
(calendar-mayan-tzolkin-difference
tomorrow-tzolkin-date tzolkin-date)))))
(or noecho (calendar-print-mayan-date)))
(defun calendar-next-calendar-round-date
(tzolkin-date haab-date &optional noecho)
"Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)
(calendar-read-mayan-haab-date)))
(let ((date (calendar-mayan-tzolkin-haab-on-or-before
tzolkin-date haab-date
(+ 18980 (calendar-absolute-from-gregorian
(calendar-cursor-to-date))))))
(if (not date)
(error "%s, %s does not exist in the Mayan calendar round"
(calendar-mayan-tzolkin-to-string tzolkin-date)
(calendar-mayan-haab-to-string haab-date))
(calendar-goto-date (calendar-gregorian-from-absolute date))
(or noecho (calendar-print-mayan-date)))))