entered into RCS

13 files changed, 2800 insertions, 619 deletions

diff --git a/lisp/byte-run.el b/lisp/byte-run.el
index b0bd59b98d1..1a09ec6ac11 100644
--- a/lisp/byte-run.el
+++ b/lisp/byte-run.el
@@ -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)))))
 
 
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 30ba686fa37..84a553ed0fe 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -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.")
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
new file mode 100644
index 00000000000..5babcdf512a
--- /dev/null
+++ b/lisp/calendar/cal-french.el
@@ -0,0 +1,223 @@
+;;; 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
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
new file mode 100644
index 00000000000..965909a8214
--- /dev/null
+++ b/lisp/calendar/cal-mayan.el
@@ -0,0 +1,409 @@
+;;; 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)))))
+
+(defun calendar-previous-calendar-round-date
+  (tzolkin-date haab-date &optional noecho)
+  "Move cursor to previous instance of Mayan TZOKLIN-DATE HAAB-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
+               (1- (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)))))
+
+(defun calendar-absolute-from-mayan-long-count (c)
+  "Compute the absolute date corresponding to the Mayan Long
+Count $c$, which is a list (baktun katun tun uinal kin)"
+  (+ (* (nth 0 c) 144000)        ; baktun
+     (* (nth 1 c) 7200)          ; katun
+     (* (nth 2 c) 360)           ; tun
+     (* (nth 3 c) 20)            ; uinal
+     (nth 4 c)                   ; kin (days)
+     (-                          ; days before absolute date 0
+      calendar-mayan-days-before-absolute-zero)))
+
+(defun calendar-print-mayan-date ()
+  "Show the Mayan long count, tzolkin, and haab equivalents of the date
+under the cursor."
+  (interactive)
+  (let* ((d (calendar-absolute-from-gregorian
+            (or (calendar-cursor-to-date)
+                (error "Cursor is not on a date!"))))
+         (tzolkin (calendar-mayan-tzolkin-from-absolute d))
+         (haab (calendar-mayan-haab-from-absolute d))
+         (long-count (calendar-mayan-long-count-from-absolute d)))
+      (message "Mayan date: Long count = %s; tzolkin = %s; haab = %s"
+               (calendar-mayan-long-count-to-string long-count)
+               (calendar-mayan-tzolkin-to-string haab)
+               (calendar-mayan-haab-to-string tzolkin))))
+
+(defun calendar-goto-mayan-long-count-date (date &optional noecho)
+  "Move cursor to Mayan long count DATE.  Echo Mayan date unless NOECHO is t."
+  (interactive
+   (let (lc)
+     (while (not lc)
+       (let ((datum
+              (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
+                               (calendar-absolute-from-gregorian
+                                (calendar-current-date))))))))
+         (if (calendar-mayan-long-count-common-era datum)
+             (setq lc datum))))
+     (list lc)))
+  (calendar-goto-date
+   (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)))
+    (while (and (not (null base)) (= (car lc) (car base)))
+      (setq lc (cdr lc)
+            base (cdr base)))
+    (or (null lc) (> (car lc) (car base)))))
+
+(defun diary-mayan-date ()
+  "Show the Mayan long count, haab, and tzolkin dates as a diary entry."
+  (let* ((d (calendar-absolute-from-gregorian date))
+         (tzolkin (calendar-mayan-tzolkin-from-absolute d))
+         (haab (calendar-mayan-haab-from-absolute d))
+         (long-count (calendar-mayan-long-count-from-absolute d)))
+    (format "Mayan date: Long count = %s; tzolkin = %s; haab = %s"
+            (calendar-mayan-long-count-to-string  long-count)
+            (calendar-mayan-tzolkin-to-string haab)
+            (calendar-mayan-haab-to-string tzolkin))))
+
+(provide 'cal-mayan)
+
+;;; cal-mayan.el ends here
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 001abdce4bf..52bb556a7b1 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,11 +1,12 @@
 ;;; calendar.el --- Calendar functions.
 
-;;; Copyright (C) 1988, 1989, 1990, 1991 Free Software Foundation, Inc.
+;;; Copyright (C) 1988, 1989, 1990, 1991, 1992 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keyword: calendar
+;; Keywords: calendar, Gregorian calendar, Julian calendar, Hebrew calendar,
+;;      Islamic calendar, ISO calendar, Julian day number, diary, holidays
 
-(defconst calendar-version "Version 4.02, released June 14, 1992")
+(defconst calendar-version "Version 5, released August 10, 1992")
 
 ;; This file is part of GNU Emacs.
 
@@ -26,25 +27,37 @@
 
 ;;; Commentary:
 
-;; This collection of functions implements a calendar window.  It generates
-;; generates a calendar for the current month, together with the previous and
-;; coming months, or for any other three-month period.  The calendar can be
-;; scrolled forward and backward in the window to show months in the past or
-;; future; the cursor can move forward and backward by days, weeks, or months,
-;; making it possible, for instance, to jump to the date a specified number of
-;; days, weeks, or months from the date under the cursor.  The user can
-;; display a list of holidays and other notable days for the period shown; the
-;; notable days can be marked on the calendar, if desired.  The user can also
-;; specify that dates having corresponding diary entries (in a file that the
-;; user specifies) be marked; the diary entries for any date can be viewed in
-;; a separate window.  The diary and the notable days can be viewed
-;; independently of the calendar.  Dates can be translated from the (usual)
-;; Gregorian calendar to the day of the year/days remaining in year, to the
-;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew
-;; calendar, to the Islamic calendar, and to the French Revolutionary calendar.
-
-;; The diary related functions are in diary.el; the holiday related functions
-;; are in holiday.el
+;; This collection of functions implements a calendar window.  It
+;; generates a calendar for the current month, together with the previous
+;; and coming months, or for any other three-month period.  The calendar
+;; can be scrolled forward and backward in the window to show months in
+;; the past or future; the cursor can move forward and backward by days,
+;; weeks, or months, making it possible, for instance, to jump to the
+;; date a specified number of days, weeks, or months from the date under
+;; the cursor.  The user can display a list of holidays and other notable
+;; days for the period shown; the notable days can be marked on the
+;; calendar, if desired.  The user can also specify that dates having
+;; corresponding diary entries (in a file that the user specifies) be
+;; marked; the diary entries for any date can be viewed in a separate
+;; window.  The diary and the notable days can be viewed independently of
+;; the calendar.  Dates can be translated from the (usual) Gregorian
+;; calendar to the day of the year/days remaining in year, to the ISO
+;; commercial calendar, to the Julian (old style) calendar, to the Hebrew
+;; calendar, to the Islamic calendar, to the French Revolutionary calendar,
+;; to the Mayan calendar, and to the astronomical (Julian) day number.
+;; When floating point is available, times of sunrise/sunset can be displayed,
+;; as can the phases of the moon.  Appointment notication for diary entries
+;; is available.
+
+;; The following files are part of the calendar/diary code:
+
+;;       diary.el, diary-insert.el     Diary functions
+;;       holidays.el                   Holiday functions
+;;       cal-french.el                 French Revolutionary calendar
+;;       cal-mayan.el                  Mayan calendars
+;;       solar.el                      Sunrise/sunset, equinoxes/solstices
+;;       lunar.el                      Phases of the moon
+;;       appt.el                       Appointment notification
 
 ;; Comments, corrections, and improvements should be sent to
 ;;  Edward M. Reingold               Department of Computer Science
@@ -70,18 +83,28 @@
 ;;                                   Urbana, Illinois 61801
 
 ;; Technical details of all the calendrical calculations can be found in
+
 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
 ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
-;; pages 899-928.
+;; pages 899-928.  ``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.
+
+;; Hard copies of these two papers can be obtained by sending email to
+;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
+;; the message BODY containing your mailing address (snail).
 
 ;;; Code:
 
+;;;###autoload
 (defvar view-diary-entries-initially nil
-  "*If T, the diary entries for the current date will be displayed on entry.
+  "*If t, the diary entries for the current date will be displayed on entry.
 The diary is displayed in another window when the calendar is first displayed,
 if the current date is visible.  The number of days of diary entries displayed
 is governed by the variable `number-of-diary-entries'.")
 
+;;;###autoload
 (defvar number-of-diary-entries 1
   "*Specifies how many days of diary entries are to be displayed initially.
 This variable affects the diary display when the command M-x diary is used,
@@ -97,13 +120,16 @@ Saturday.  This variable does not affect the diary display with the `d'
 command from the calendar; in that case, the prefix argument controls the
 number of days of diary entries displayed.")
 
+;;;###autoload
 (defvar mark-diary-entries-in-calendar nil
   "*If t, dates with diary entries will be marked in the calendar window.
 The marking symbol is specified by the variable `diary-entry-marker'.")
 
+;;;###autoload
 (defvar diary-entry-marker "+"
   "*The symbol used to mark dates that have diary entries.")
 
+;;;###autoload
 (defvar view-calendar-holidays-initially nil
   "*If t, the holidays for the current three month period will be displayed
 on entry.  The holidays are displayed in another window when the calendar is
@@ -114,6 +140,7 @@ first displayed.")
   "*If t, dates of holidays will be marked in the calendar window.
 The marking symbol is specified by the variable `calendar-holiday-marker'.")
 
+;;;###autoload
 (defvar calendar-holiday-marker "*"
   "*The symbol used to mark notable dates in the calendar.")
 
@@ -138,12 +165,19 @@ include only those days of such major interest as to appear on secular
 calendars.  If t, the holidays shown in the calendar will include all
 special days that would be shown on a complete Islamic calendar.")
 
+;;;###autoload
+(defvar calendar-load-hook nil
+  "*List of functions to be called after the calendar is first loaded.
+This is the place to add key bindings to calendar-mode-map.")
+
+;;;###autoload
 (defvar initial-calendar-window-hook nil
   "*List of functions to be called when the calendar window is first opened.
 The functions invoked are called after the calendar window is opened, but
 once opened is never called again.  Leaving the calendar with the `q' command
 and reentering it will cause these functions to be called again.")
 
+;;;###autoload
 (defvar today-visible-calendar-hook nil
   "*List of functions called whenever the current date is visible.
 This can be used, for example, to replace today's date with asterisks; a
@@ -161,6 +195,7 @@ Other than the use of the provided functions, the changing of any
 characters in the calendar buffer by the hooks may cause the failure of the
 functions that move by days and weeks.")
 
+;;;###autoload
 (defvar today-invisible-calendar-hook nil
   "*List of functions called whenever the current date is not visible.
 
@@ -172,6 +207,7 @@ Other than the use of the provided functions, the changing of any
 characters in the calendar buffer by the hooks may cause the failure of the
 functions that move by days and weeks.")
 
+;;;###autoload
 (defvar diary-file "~/diary"
   "*Name of the file in which one's personal diary of dates is kept.
 
@@ -251,9 +287,12 @@ Diary entries can be based on Lisp sexps.  For example, the diary entry
 
 causes the diary entry \"Vacation\" to appear from November 1 through November
 10, 1990.  Other functions available are `diary-float', `diary-anniversary',
-`diary-cyclic', `day-of-year', `iso-date', `commercial-date', `french-date',
-`hebrew-date', `islamic-date', `parasha', `omer', and `rosh-hodesh'.  See the
-documentation for the function `list-sexp-diary-entries' for more details.
+`diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date',
+`diary-hebrew-date', `diary-islamic-date', `diary-mayan-date',
+`diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon',
+`diary-parasha', `diary-omer', `diary-rosh-hodesh', and
+`diary-sabbath-candles'.  See the documentation for the function
+`list-sexp-diary-entries' for more details.
 
 Diary entries based on the Hebrew and/or the Islamic calendar are also
 possible, but because these are somewhat slow, they are ignored
@@ -264,32 +303,39 @@ for these functions for details.
 Diary files can contain directives to include the contents of other files; for
 details, see the documentation for the variable `list-diary-entries-hook'.")
 
+;;;###autoload
 (defvar diary-nonmarking-symbol "&"
   "*The symbol used to indicate that a diary entry is not to be marked in the
 calendar window.")
 
+;;;###autoload
 (defvar hebrew-diary-entry-symbol "H"
   "*The symbol used to indicate that a diary entry is according to the
 Hebrew calendar.")
 
+;;;###autoload
 (defvar islamic-diary-entry-symbol "I"
   "*The symbol used to indicate that a diary entry is according to the
 Islamic calendar.")
 
+;;;###autoload
 (defvar diary-include-string "#include"
   "*The string used to indicate the inclusion of another file of diary entries
 in diary-file.  See the documentation for the function
 `include-other-diary-files'.")
 
+;;;###autoload
 (defvar sexp-diary-entry-symbol "%%"
   "*The string used to indicate a sexp diary entry in diary-file.
 See the documentation for the function `list-sexp-diary-entries'.")
 
+;;;###autoload
 (defvar abbreviated-calendar-year t
   "*Interpret a two-digit year DD in a diary entry as being either 19DD or
 20DD, as appropriate, for the Gregorian calendar; similarly for the Hebrew and
 Islamic calendars.  If this variable is nil, years must be written in full.")
 
+;;;###autoload
 (defvar european-calendar-style nil
   "*Use the European style of dates in the diary and in any displays.  If this
 variable is t, a date 1/2/1990 would be interpreted as February 1, 1990.
@@ -304,6 +350,7 @@ The accepted European date styles are
 Names can be capitalized or not, written in full, or abbreviated to three
 characters with or without a period.")
 
+;;;###autoload
 (defvar american-date-diary-pattern
   '((month "/" day "[^/0-9]")
     (month "/" day "/" year "[^0-9]")
@@ -313,6 +360,7 @@ characters with or without a period.")
   "*List of pseudo-patterns describing the American patterns of date used.
 See the documentation of diary-date-forms for an explanantion.")
 
+;;;###autoload
 (defvar european-date-diary-pattern
   '((day "/" month "[^/0-9]")
     (day "/" month "/" year "[^0-9]")
@@ -322,6 +370,7 @@ See the documentation of diary-date-forms for an explanantion.")
   "*List of pseudo-patterns describing the European patterns of date used.
 See the documentation of diary-date-forms for an explanantion.")
 
+;;;###autoload
 (defvar diary-date-forms
   (if european-calendar-style
       european-date-diary-pattern
@@ -345,22 +394,25 @@ that it is a word constituent.
 
 If, to be mutually exclusive, a pseudo-pattern must match a portion of the
 diary entry itself, the first element of the pattern MUST be `backup'.  This
-directive causes the the date recognizer to back up to the beginning of the
-current word of the diary entry, so in no case can the pattern match more
-than a portion of the first word of the diary entry.")
+directive causes the date recognizer to back up to the beginning of the
+current word of the diary entry, so in no case can the pattern match more than
+a portion of the first word of the diary entry.")
 
+;;;###autoload
 (defvar european-calendar-display-form
-  '(dayname ", " day " " monthname " " year)
+  '((if dayname (concat dayname ", ")) day " " monthname " " year)
   "*The pseudo-pattern that governs the way a Gregorian date is formatted
 in the European style.  See the documentation of calendar-date-display-forms
 for an explanantion.")
 
+;;;###autoload
 (defvar american-calendar-display-form
-  '(dayname ", " monthname " " day ", " year)
+  '((if dayname (concat dayname ", ")) monthname " " day ", " year)
   "*The pseudo-pattern that governs the way a Gregorian date is formatted
 in the American style.  See the documentation of calendar-date-display-forms
 for an explanantion.")
 
+;;;###autoload
 (defvar calendar-date-display-form
   (if european-calendar-style
       european-calendar-display-form
@@ -386,6 +438,96 @@ would give the usual American style in fixed-length fields.
 
 See the documentation of the function `calendar-date-string'.")
 
+;;;###autoload
+(defvar calendar-time-display-form
+  '(12-hours ":" minutes am-pm
+    (if time-zone " (") time-zone (if time-zone ")"))
+  "*The pseudo-pattern that governs the way a time of day is formatted.
+
+A pseudo-pattern is a list of expressions that can involve the keywords
+`12-hours', `24-hours', and `minutes',  all numbers in string form,
+and `am-pm' and `time-zone',  both alphabetic strings.
+
+For example, the form
+
+  '(24-hours \":\" minutes
+    (if time-zone \" (\") time-zone (if time-zone \")\"))
+
+would give military-style times like `21:07 (UT)'.")
+
+;;;###autoload
+(defvar calendar-latitude nil
+  "*Latitude of `calendar-location-name' in degrees, + north, - south.
+For example, 40.7 for New York City.")
+
+;;;###autoload
+(defvar calendar-longitude nil
+  "*Longitude of `calendar-location-name' in degrees, + east, - west.
+For example, -74.0 for New York City.")
+
+;;;###autoload
+(defvar calendar-location-name
+  '(let ((float-output-format "%.1f"))
+     (format "%s%s, %s%s"
+             (abs calendar-latitude)
+             (if (> calendar-latitude 0) "N" "S")
+             (abs calendar-longitude)
+             (if (> calendar-longitude 0) "E" "W")))
+  "*An expression that evaluates to the name of the location at
+`calendar-longitude', calendar-latitude'.  Default value is just the latitude,
+longitude pair.")
+
+;;;###autoload
+(defvar calendar-time-zone (car (current-time-zone))
+  "*Number of minutes difference between local standard time at
+`calendar-location-name' and Universal (Greenwich) Time.  For example, -300
+for New York City, -480 for Los Angeles.")
+
+;;;###autoload
+(defvar calendar-standard-time-zone-name (car (nthcdr 2 (current-time-zone)))
+  "*Abbreviated name of standard time zone at `calendar-location-name'.
+For example, \"EST\" in New York City, \"PST\" for Los Angeles.")
+
+;;;###autoload
+(defvar calendar-daylight-time-zone-name (car (nthcdr 3 (current-time-zone)))
+  "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
+For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
+
+;;;###autoload
+(defvar calendar-daylight-savings-starts
+  '(calendar-nth-named-day 1 0 4 year)
+  "*A sexp in the variable `year' that gives the Gregorian date, in the form
+of a list (month day year), on which daylight savings time starts.  This is
+used to determine the starting date of daylight savings time for the holiday
+list and for correcting times of day in the solar and lunar calculations.  The
+default value is the American rule of the first Sunday in April.
+
+For example, if daylight savings time is mandated to start on October 1,
+you would set `calendar-daylight-savings-starts' to
+
+      '(10 1 year)
+
+For a more complex example, if daylight savings time begins on the first of
+Nisan on the Hebrew calendar, we would set `calendar-daylight-savings-starts'
+to
+
+      '(calendar-gregorian-from-absolute
+         (calendar-absolute-from-hebrew
+            (list 1 1 (+ year 3760))))
+
+because Nisan is the first month in the Hebrew calendar.")
+
+;;;###autoload
+(defvar calendar-daylight-savings-ends
+  '(calendar-nth-named-day -1 0 10 year)
+  "*An expression in the variable `year' that gives the Gregorian date, in the
+form of a list (month day year), on which daylight savings time ends.  This
+is used to determine the ending date of daylight savings time for the holiday
+list and for correcting times of day in the solar and lunar calculations.
+The default value is the American rule of the last Sunday in October.
+See the documentation for `calendar-daylight-savings-starts' for other
+examples.")
+
 (defun european-calendar ()
   "Set the interpretation and display of dates to the European style."
   (interactive)
@@ -402,15 +544,13 @@ See the documentation of the function `calendar-date-string'.")
   (setq diary-date-forms american-date-diary-pattern)
   (update-calendar-mode-line))
 
-(defvar print-diary-entries-hook
-  '(add-diary-heading lpr-buffer (lambda nil (kill-buffer temp-buffer)))
-  "*List of functions to be called after a temporary buffer is prepared
-with the diary entries currently visible in the diary buffer.  The default
-value adds a heading (formed from the information in the mode line of the
-diary buffer), does the printing, and kills the buffer.  Other uses might
-include, for example, rearranging the lines into order by day and time,
-saving the buffer instead of deleting it, or changing the function used to
-do the printing.")
+;;;###autoload
+(defvar print-diary-entries-hook 'lpr-buffer
+  "*List of functions to be called after a temporary buffer is prepared with
+the diary entries currently visible in the diary buffer.  The default just
+does the printing.  Other uses might include, for example, rearranging the
+lines into order by day and time, saving the buffer instead of deleting it, or
+changing the function used to do the printing.")
 
 ;;;###autoload
 (defvar list-diary-entries-hook nil
@@ -434,10 +574,7 @@ function `mark-included-diary-files' as part of the mark-diary-entries-hook.
 For example, you could use
 
      (setq list-diary-entries-hook
-           '(include-other-diary-files
-             (lambda nil
-                     (setq diary-entries-list
-                           (sort diary-entries-list 'diary-entry-compare)))))
+       '(include-other-diary-files sort-diary-entries))
      (setq diary-display-hook 'fancy-diary-display)
 
 in your .emacs file to cause the fancy diary buffer to be displayed with
@@ -470,10 +607,10 @@ diary buffer, set the variable `diary-list-include-blanks' to t.")
 (defvar nongregorian-diary-listing-hook nil
   "*List of functions to be called for the diary file and included files as
 they are processed for listing diary entries.  You can use any or all of
-`list-hebrew-diary-entries', `yahrzeit-diary-entry', and
-`list-islamic-diary-entries'.  The documentation for these functions
-describes the style of such diary entries.")
+`list-hebrew-diary-entries' and `list-islamic-diary-entries'.  The
+documentation for these functions describes the style of such diary entries.")
 
+;;;###autoload
 (defvar mark-diary-entries-hook nil
   "*List of functions called after marking diary entries in the calendar.
 
@@ -501,22 +638,21 @@ for these functions describes the style of such diary entries.")
 entries.  Such days will then not be shown in the the fancy diary buffer,
 even if they are holidays.")
 
+;;;###autoload
 (defvar holidays-in-diary-buffer t
   "*If t, the holidays will be indicated in the mode line of the diary buffer
 (or in the fancy diary buffer next to the date).  This slows down the diary
 functions somewhat; setting it to nil will make the diary display faster.")
 
-(defvar calendar-holidays
-  '(
-;;  General Holidays (American)
-    (fixed 1 1 "New Year's Day")
+;;;###autoload
+(defvar general-holidays
+  '((fixed 1 1 "New Year's Day")
     (float 1 1 3 "Martin Luther King Day")
     (fixed 2 2 "Ground Hog Day")
     (fixed 2 14 "Valentine's Day")
     (float 2 1 3 "President's Day")
     (fixed 3 17 "St. Patrick's Day")
     (fixed 4 1 "April Fool's Day")
-    (float 4 0 1 "Daylight Savings Time Begins")
     (float 5 0 2 "Mother's Day")
     (float 5 1 -1 "Memorial Day")
     (fixed 6 14 "Flag Day")
@@ -524,25 +660,25 @@ functions somewhat; setting it to nil will make the diary display faster.")
     (fixed 7 4 "Independence Day")
     (float 9 1 1 "Labor Day")
     (float 10 1 2 "Columbus Day")
-    (float 10 0 -1 "Daylight Savings Time Ends")
     (fixed 10 31 "Halloween")
     (fixed 11 11 "Veteran's Day")
-    (float 11 4 4 "Thanksgiving")
+    (float 11 4 4 "Thanksgiving"))
+  "*General holidays.  Default value is for the United States.  See the
+documentation for `calendar-holidays' for details.")
 
-;;  Christian Holidays
-    (if all-christian-calendar-holidays
-        (fixed 1 6 "Epiphany"))
-    (easter-etc)
-    (if all-christian-calendar-holidays
-        (fixed 8 15 "Assumption"))
-    (if all-christian-calendar-holidays
-        (advent))
-    (fixed 12 25 "Christmas")
-    (if all-christian-calendar-holidays
-        (julian 12 25 "Eastern Orthodox Christmas"))
+;;;###autoload
+(defvar local-holidays nil
+  "*Local holidays.
+See the documentation for `calendar-holidays' for details.")
+
+;;;###autoload
+(defvar other-holidays nil
+  "*User defined holidays.
+See the documentation for `calendar-holidays' for details.")
 
-;;  Jewish Holidays
-    (rosh-hashanah-etc)
+;;;###autoload
+(defvar hebrew-holidays
+  '((rosh-hashanah-etc)
     (if all-hebrew-calendar-holidays
         (julian 11
                 (let* ((m displayed-month)
@@ -613,10 +749,30 @@ functions somewhat; setting it to nil will make the diary display faster.")
                  (= 21 (% year 28)))))
         (julian 3 26 "Kiddush HaHamah"))
     (if all-hebrew-calendar-holidays
-        (tisha-b-av-etc))
+        (tisha-b-av-etc)))
+  "*Jewish holidays.
+See the documentation for `calendar-holidays' for details.")
+
+;;;###autoload
+(defvar christian-holidays
+  '((if all-christian-calendar-holidays
+        (fixed 1 6 "Epiphany"))
+    (easter-etc)
+    (if all-christian-calendar-holidays
+        (greek-orthodox-easter))
+    (if all-christian-calendar-holidays
+        (fixed 8 15 "Assumption"))
+    (if all-christian-calendar-holidays
+        (advent))
+    (fixed 12 25 "Christmas")
+    (if all-christian-calendar-holidays
+        (julian 12 25 "Eastern Orthodox Christmas")))
+  "*Christian holidays.
+See the documentation for `calendar-holidays' for details.")
 
-;;  Islamic Holidays
-    (islamic 1 1 (format "Islamic New Year %d"
+;;;###autoload
+(defvar islamic-holidays
+  '((islamic 1 1 (format "Islamic New Year %d"
                          (let ((m displayed-month)
                                (y displayed-year))
                            (increment-calendar-month m y 1)
@@ -639,9 +795,36 @@ functions somewhat; setting it to nil will make the diary display faster.")
         (islamic 10 1 "Id-al-Fitr"))
     (if all-islamic-calendar-holidays
         (islamic 12 10 "Id-al-Adha")))
-  "List of notable days for the command M-x holidays.
-Additional holidays are easy to add to the list.  The possible holiday-forms
-are as follows:
+  "*Islamic holidays.
+See the documentation for `calendar-holidays' for details.")
+
+;;;###autoload
+(defvar solar-holidays
+  '((if (fboundp 'atan)
+        (solar-equinoxes-solstices))
+    (sexp (eval calendar-daylight-savings-starts)
+          "Daylight Savings Time Begins")
+    (sexp (eval calendar-daylight-savings-ends)
+          "Daylight Savings Time Ends"))
+  "*Sun-related holidays.
+See the documentation for `calendar-holidays' for details.")
+
+;;;###autoload
+(defvar calendar-holidays
+  (append general-holidays local-holidays other-holidays
+          christian-holidays hebrew-holidays islamic-holidays
+          solar-holidays)
+  "*List of notable days for the command M-x holidays.
+
+Additional holidays are easy to add to the list, just put them in the list
+`other-holidays' in your .emacs file.  Similarly, by setting any of
+`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
+`islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can
+eliminate unwanted categories of holidays.  The intention is that (in the US)
+`local-holidays' be set in site-init.el and `other-holidays' be set by the
+user.
+
+The possible holiday-forms are as follows:
 
     (fixed MONTH DAY STRING)   a fixed date on the Gregorian calendar
     (float MONTH DAYNAME K STRING) the Kth DAYNAME in MONTH on the Gregorian
@@ -650,6 +833,10 @@ are as follows:
     (hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
     (islamic MONTH DAY STRING) a fixed date on the Islamic calendar
     (julian MONTH DAY STRING)  a fixed date on the Julian calendar
+    (sexp SEXP STRING)         SEXP is a Gregorian-date-valued expression
+                               in the variable `year'; if it evaluates to
+                               a visible date, that's the holiday; if it
+                               evaluates to nil, there's no holiday
     (if BOOLEAN HOLIDAY-FORM &optional HOLIDAY-FORM) gives a choice between
                                two holidays based on the value of BOOLEAN
     (FUNCTION &optional ARGS)  dates requiring special computation; ARGS,
@@ -666,9 +853,9 @@ Islands on the fourth Monday in August, add
      (float 8 1 4 \"Hurricane Supplication Day\")
 
 to the list (the last Monday would be specified with `-1' instead of `4').
-To add the last day of Hanukah to the list, use
+To add the last day of Hanukkah to the list, use
 
-     (hebrew 10 2 \"Last day of Hanukah\")
+     (hebrew 10 2 \"Last day of Hanukkah\")
 
 since the Hebrew months are numbered with 1 starting from Nisan, while to
 add the Islamic feast celebrating Mohammed's birthday use
@@ -680,10 +867,19 @@ add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
 
      (julian 4 2 \"Jefferson's Birthday\")
 
-To include a holiday conditionally, use the if form.  For example, to
-include American presidential elections, which occur on the first Tuesday
+To include a holiday conditionally, use the if or the sexp form.  For example,
+to include American presidential elections, which occur on the first Tuesday
 after the first Monday in November of years divisble by 4, add
 
+     (sexp (if (zerop (% year 4))
+               (calendar-gregorian-from-absolute
+                  (1+ (calendar-dayname-on-or-before
+                        1 (+ 6 (calendar-absolute-from-gregorian
+                                 (list 11 1 year)))))))
+            \"US Presidential Election\")
+
+or
+
      (if (zerop (% displayed-year 4))
          (fixed 11
                 (extract-calendar-day
@@ -703,11 +899,12 @@ the relevant VISIBLE dates with descriptive strings such as
 
      (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )
 
-The fixed, float, hebrew, islamic, julian and if forms are implemented by
-the inclusion of the functions `calendar-holiday-function-fixed',
+The fixed, float, hebrew, islamic, julian, sexp, and if forms are implemented
+by the inclusion of the functions `calendar-holiday-function-fixed',
 `calendar-holiday-function-float', `calendar-holiday-function-hebrew',
 `calendar-holiday-function-islamic', `calendar-holiday-function-julian',
-and `calendar-holiday-function-if', respectively.")
+`calendar-holiday-function-sexp', and `calendar-holiday-function-if',
+respectively.")
 
 (defconst calendar-buffer "*Calendar*"
   "Name of the buffer used for the calendar.")
@@ -770,19 +967,29 @@ sum EXPRESSION."
 ;;     .
 ;;
 ;; The use of these seven macros eliminates the overhead of 92% of the function
-;; calls; it's faster this way.
+;; calls; it's faster this way.  For clarity, the defun form of each is given
+;; in comments after the defmacro form.
 
 (defmacro extract-calendar-month (date)
   "Extract the month part of DATE which has the form (month day year)."
   (` (car (, date))))
+;;(defun extract-calendar-month (date)
+;;  "Extract the month part of DATE which has the form (month day year)."
+;;  (car date))
 
 (defmacro extract-calendar-day (date)
   "Extract the day part of DATE which has the form (month day year)."
   (` (car (cdr (, date)))))
+;;(defun extract-calendar-day (date)
+;;  "Extract the day part of DATE which has the form (month day year)."
+;;  (car (cdr date)))
 
 (defmacro extract-calendar-year (date)
   "Extract the year part of DATE which has the form (month day year)."
   (` (car (cdr (cdr (, date))))))
+;;(defun extract-calendar-year (date)
+;;  "Extract the year part of DATE which has the form (month day year)."
+;;  (car (cdr (cdr date))))
 
 (defmacro calendar-leap-year-p (year)
   "Returns t if YEAR is a Gregorian leap year."
@@ -790,6 +997,12 @@ sum EXPRESSION."
         (and (=  (% (, year) 4) 0)
              (/= (% (, year) 100) 0))
         (= (% (, year) 400) 0))))
+;;(defun calendar-leap-year-p (year)
+;;  "Returns t if YEAR is a Gregorian leap year."
+;;  (or
+;;    (and (=  (% year   4) 0)
+;;         (/= (% year 100) 0))
+;;    (= (% year 400) 0)))
 
 (defmacro calendar-last-day-of-month (month year)
   "The last day in MONTH during YEAR."
@@ -798,6 +1011,11 @@ sum EXPRESSION."
             (= (, month) 2))
            29
          (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- (, month))))))
+;;(defun calendar-last-day-of-month (month year)
+;;  "The last day in MONTH during YEAR."
+;;  (if (and (calendar-leap-year-p year) (= month 2))
+;;      29
+;;    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
 
 (defmacro calendar-day-number (date)
   "Return the day number within the year of the date DATE.
@@ -817,6 +1035,20 @@ while (calendar-day-number '(12 31 1980)) returns 366."
             (if (, (macroexpand (` (calendar-leap-year-p year))))
                 (setq day-of-year (1+ day-of-year)))))
        day-of-year)))
+;;(defun calendar-day-number (date)
+;;  "Return the day number within the year of the date DATE.
+;;For example, (calendar-day-number '(1 1 1987)) returns the value 1,
+;;while (calendar-day-number '(12 31 1980)) returns 366."
+;;    (let* ((month (extract-calendar-month date))
+;;           (day (extract-calendar-day date))
+;;           (year (extract-calendar-year date))
+;;         (day-of-year (+ day (* 31 (1- month)))))
+;;      (if (> month 2)
+;;          (progn
+;;            (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
+;;            (if (calendar-leap-year-p year)
+;;                (setq day-of-year (1+ day-of-year)))))
+;;      day-of-year))
 
 (defmacro calendar-absolute-from-gregorian (date)
   "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
@@ -829,6 +1061,17 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
           (/ (1- year) 4);;          + Julian leap years
           (- (/ (1- year) 100));;    - century years
           (/ (1- year) 400)))));;     + Gregorian leap years
+;;(defun calendar-absolute-from-gregorian (date)
+;;  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
+;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
+;;  (let ((month (extract-calendar-month date))
+;;        (day (extract-calendar-day date))
+;;        (year (extract-calendar-year date)))
+;;    (+ (calendar-day-number date);; Days this year
+;;       (* 365 (1- year));;        + Days in prior years
+;;       (/ (1- year) 4);;          + Julian leap years
+;;       (- (/ (1- year) 100));;    - century years
+;;       (/ (1- year) 400))));;     + Gregorian leap years
 
 ;;;###autoload
 (defun calendar (&optional arg)
@@ -836,6 +1079,8 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
 The three months appear side by side, with the current month in the middle
 surrounded by the previous and next months.  The cursor is put on today's date.
 
+If called with an optional prefix argument, prompts for month and year.
+
 This function is suitable for execution in a .emacs file; appropriate setting
 of the variable `view-diary-entries-initially' will cause the diary entries for
 the current date to be displayed in another window.  The value of the variable
@@ -862,6 +1107,10 @@ Use M-x describe-mode for details of the key bindings in the calendar window.
 
 The Gregorian calendar is assumed.
 
+After loading the calendar, the hooks given by the variable
+`calendar-load-hook' are run.  This the place to add key bindings to the
+calendar-mode-map.
+
 After preparing the calendar window initially, the hooks given by the variable
 `initial-calendar-window-hook' are run.
 
@@ -872,25 +1121,42 @@ in the window.  If it is not visible, the hooks given by the variable
 `today-visible-calendar-hook' to 'calendar-star-date will cause today's date
 to be replaced by asterisks to highlight it whenever it is in the window."
   (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
   (set-buffer (get-buffer-create calendar-buffer))
   (calendar-mode)
   (setq calendar-window-configuration (current-window-configuration))
-  (let ((pop-up-windows t)
-        (split-height-threshold 1000))
+  (let* ((completion-ignore-case t)
+         (pop-up-windows t)
+         (split-height-threshold 1000)
+         (date (calendar-current-date))
+         (month
+          (if arg
+              (cdr (assoc
+                    (capitalize
+                     (completing-read
+                      "Month name: "
+                      (mapcar 'list (append calendar-month-name-array nil))
+                      nil t))
+                    (calendar-make-alist calendar-month-name-array)))
+            (extract-calendar-month date)))
+         (year
+          (if arg
+              (calendar-read
+               "Year (>0): "
+               '(lambda (x) (> x 0))
+               (int-to-string (extract-calendar-year date)))
+            (extract-calendar-year date))))
     (pop-to-buffer calendar-buffer)
-    (regenerate-calendar-window arg)
-    (let ((date (list current-month current-day current-year)))
-      (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
-          (view-diary-entries
-           (if (vectorp number-of-diary-entries)
-               (aref number-of-diary-entries (calendar-day-of-week date))
-             number-of-diary-entries))))
-    (let* ((diary-buffer (get-file-buffer diary-file))
-           (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
-           (split-height-threshold (if diary-window 2 1000)))
-      (if view-calendar-holidays-initially
-          (list-calendar-holidays))))
+    (generate-calendar-window month year)
+    (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
+        (view-diary-entries
+         (if (vectorp number-of-diary-entries)
+             (aref number-of-diary-entries (calendar-day-of-week date))
+           number-of-diary-entries))))
+  (let* ((diary-buffer (get-file-buffer diary-file))
+         (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
+         (split-height-threshold (if diary-window 2 1000)))
+    (if view-calendar-holidays-initially
+        (list-calendar-holidays)))
   (run-hooks 'initial-calendar-window-hook))
 
 (autoload 'view-diary-entries "diary"
@@ -900,6 +1166,56 @@ the date indicated by the cursor position in the displayed three-month
 calendar."
   t)
 
+(autoload 'calendar-sunrise-sunset "solar"
+  "Local time of sunrise and sunset for date under cursor."
+  t)
+
+(autoload 'calendar-phases-of-moon "lunar"
+  "Create a buffer of the phases of the moon for the current calendar window."
+  t)
+
+(autoload 'calendar-print-french-date "cal-french"
+  "Show the French Revolutionary calendar equivalent of the date under the
+cursor."
+  t)
+
+(autoload 'calendar-goto-french-date "cal-french"
+ "Move cursor to French Revolutionary date."
+  t)
+
+(autoload 'calendar-print-mayan-date "cal-mayan"
+  "Show the Mayan long count, Tzolkin, and Haab equivalents of the date
+under the cursor."
+  t)
+
+(autoload 'calendar-goto-mayan-long-count-date "cal-mayan"
+ "Move cursor to Mayan long count date."
+  t)
+
+(autoload 'calendar-next-haab-date "cal-mayan"
+  "Move cursor to next instance of Mayan Haab date."
+  t)
+
+(autoload 'calendar-previous-haab-date "cal-mayan"
+  "Move cursor to previous instance of Mayan Haab date."
+  t)
+
+(autoload 'calendar-next-tzolkin-date "cal-mayan"
+  "Move cursor to next instance of Mayan Tzolkin date."
+  t)
+
+(autoload 'calendar-previous-tzolkin-date "cal-mayan"
+  "Move cursor to previous instance of Mayan Tzolkin date."
+  t)
+
+(autoload 'calendar-next-calendar-round-date "cal-mayan"
+  "Move cursor to next instance of Mayan Haab/Tzoklin combination."
+  t)
+
+(autoload 'calendar-previous-calendar-round-date "cal-mayan"
+  "Move cursor to previous instance of Mayan Haab/Tzoklin combination."
+  t)
+
 (autoload 'show-all-diary-entries "diary"
   "Show all of the diary entries in the diary-file.
 This function gets rid of the selective display of the diary-file so that
@@ -912,60 +1228,60 @@ is created."
 Each entry in diary-file visible in the calendar window is marked."
   t)
 
-(autoload 'insert-diary-entry "diary"
+(autoload 'insert-diary-entry "diary-insert"
   "Insert a diary entry for the date indicated by point."
   t)
 
-(autoload 'insert-weekly-diary-entry "diary"
+(autoload 'insert-weekly-diary-entry "diary-insert"
   "Insert a weekly diary entry for the day of the week indicated by point."
   t)
 
-(autoload 'insert-monthly-diary-entry "diary"
+(autoload 'insert-monthly-diary-entry "diary-insert"
   "Insert a monthly diary entry for the day of the month indicated by point."
   t)
 
-(autoload 'insert-yearly-diary-entry "diary"
+(autoload 'insert-yearly-diary-entry "diary-insert"
   "Insert an annual diary entry for the day of the year indicated by point."
   t)
 
-(autoload 'insert-anniversary-diary-entry "diary"
+(autoload 'insert-anniversary-diary-entry "diary-insert"
   "Insert an anniversary diary entry for the date indicated by point."
   t)
 
-(autoload 'insert-block-diary-entry "diary"
+(autoload 'insert-block-diary-entry "diary-insert"
   "Insert a block diary entry for the dates indicated by point and mark."
   t)
 
-(autoload 'insert-cyclic-diary-entry "diary"
+(autoload 'insert-cyclic-diary-entry "diary-insert"
   "Insert a cyclic diary entry starting at the date indicated by point."
   t)
 
-(autoload 'insert-hebrew-diary-entry "diary"
+(autoload 'insert-hebrew-diary-entry "diary-insert"
   "Insert a diary entry for the Hebrew date corresponding to the date
 indicated by point."
   t)
 
-(autoload 'insert-monthly-hebrew-diary-entry "diary"
+(autoload 'insert-monthly-hebrew-diary-entry "diary-insert"
   "Insert a monthly diary entry for the day of the Hebrew month corresponding
 to the date indicated by point."
   t)
 
-(autoload 'insert-yearly-hebrew-diary-entry "diary"
+(autoload 'insert-yearly-hebrew-diary-entry "diary-insert"
   "Insert an annual diary entry for the day of the Hebrew year corresponding
 to the date indicated by point."
   t)
 
-(autoload 'insert-islamic-diary-entry "diary"
+(autoload 'insert-islamic-diary-entry "diary-insert"
   "Insert a diary entry for the Islamic date corresponding to the date
 indicated by point."
   t)
 
-(autoload 'insert-monthly-islamic-diary-entry "diary"
+(autoload 'insert-monthly-islamic-diary-entry "diary-insert"
   "Insert a monthly diary entry for the day of the Islamic month corresponding
 to the date indicated by point."
   t)
 
-(autoload 'insert-yearly-islamic-diary-entry "diary"
+(autoload 'insert-yearly-islamic-diary-entry "diary-insert"
   "Insert an annual diary entry for the day of the Islamic year corresponding
 to the date indicated by point."
   t)
@@ -984,22 +1300,23 @@ holidays are found, nil if not."
   "Find holidays for the date specified by the cursor in the calendar window."
   t)
 
-(defun regenerate-calendar-window (&optional arg)
-  "Generate the calendar window, offset from the current date by ARG months."
-  (if (not arg) (setq arg 0))
+(defun generate-calendar-window (&optional mon yr)
+  "Generate the calendar window for the current date.
+Or, for optional MON, YR."
   (let* ((buffer-read-only nil)
-         (today-visible (and (<= arg 1) (>= arg -1)))
          (today (calendar-current-date))
          (month (extract-calendar-month today))
          (day (extract-calendar-day today))
          (year (extract-calendar-year today))
+         (today-visible
+          (or (not mon)
+              (let ((offset (calendar-interval mon yr month year)))
+                (and (<= offset 1) (>= offset -1)))))
          (day-in-week (calendar-day-of-week today)))
     (update-calendar-mode-line)
-    (setq current-month month)
-    (setq current-day day)
-    (setq current-year year)
-    (increment-calendar-month month year arg)
-    (generate-calendar month year)
+    (if mon
+        (generate-calendar mon yr)
+        (generate-calendar month year))
     (calendar-cursor-to-visible-date
      (if today-visible today (list displayed-month 1 displayed-year)))
     (set-buffer-modified-p nil)
@@ -1078,9 +1395,7 @@ the inserted text.  Value is always t."
   "Redraw the calendar display."
   (interactive)
   (let ((cursor-date (calendar-cursor-to-date)))
-    (regenerate-calendar-window
-     (calendar-interval current-month current-year
-                        displayed-month displayed-year))
+    (generate-calendar-window displayed-month displayed-year)
     (calendar-cursor-to-visible-date cursor-date)))
 
 (defvar calendar-mode-map nil)
@@ -1106,11 +1421,11 @@ the inserted text.  Value is always t."
   (define-key calendar-mode-map "\C-v"  'scroll-calendar-left-three-months)
   (define-key calendar-mode-map "\C-b"  'calendar-backward-day)
   (define-key calendar-mode-map "\C-p"  'calendar-backward-week)
-  (define-key calendar-mode-map "\e["   'calendar-backward-month)
+  (define-key calendar-mode-map "\e{"   'calendar-backward-month)
   (define-key calendar-mode-map "\C-x[" 'calendar-backward-year)
   (define-key calendar-mode-map "\C-f"  'calendar-forward-day)
   (define-key calendar-mode-map "\C-n"  'calendar-forward-week)
-  (define-key calendar-mode-map "\e]"   'calendar-forward-month)
+  (define-key calendar-mode-map "\e}"   'calendar-forward-month)
   (define-key calendar-mode-map "\C-x]" 'calendar-forward-year)
   (define-key calendar-mode-map "\C-a"  'calendar-beginning-of-week)
   (define-key calendar-mode-map "\C-e"  'calendar-end-of-week)
@@ -1120,44 +1435,57 @@ the inserted text.  Value is always t."
   (define-key calendar-mode-map "\e>"   'calendar-end-of-year)
   (define-key calendar-mode-map "\C-@"  'calendar-set-mark)
   (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
-  (define-key calendar-mode-map "\e="   'calendar-count-days-region)
-  (define-key calendar-mode-map "gd"    'calendar-goto-date)
-  (define-key calendar-mode-map "gJ"    'calendar-goto-julian-date)
-  (define-key calendar-mode-map "gH"    'calendar-goto-hebrew-date)
-  (define-key calendar-mode-map "gI"    'calendar-goto-islamic-date)
-  (define-key calendar-mode-map "gC"    'calendar-goto-iso-date)
-  (define-key calendar-mode-map " "     'scroll-other-window)
+  (define-key calendar-mode-map "\e=" 'calendar-count-days-region)
+  (define-key calendar-mode-map "gd"  'calendar-goto-date)
+  (define-key calendar-mode-map "gj"  'calendar-goto-julian-date)
+  (define-key calendar-mode-map "ga"  'calendar-goto-astro-day-number)
+  (define-key calendar-mode-map "gh"  'calendar-goto-hebrew-date)
+  (define-key calendar-mode-map "gi"  'calendar-goto-islamic-date)
+  (define-key calendar-mode-map "gc"  'calendar-goto-iso-date)
+  (define-key calendar-mode-map "gf"  'calendar-goto-french-date)
+  (define-key calendar-mode-map "gml"  'calendar-goto-mayan-long-count-date)
+  (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
+  (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date)
+  (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date)
+  (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date)
+  (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date)
+  (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date)
+  (define-key calendar-mode-map "S"   'calendar-sunrise-sunset)
+  (define-key calendar-mode-map "M"   'calendar-phases-of-moon)
+  (define-key calendar-mode-map " "   'scroll-other-window)
   (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar)
-  (define-key calendar-mode-map "c"     'calendar-current-month)
-  (define-key calendar-mode-map "o"     'calendar-other-month)
-  (define-key calendar-mode-map "q"     'exit-calendar)
-  (define-key calendar-mode-map "a"     'list-calendar-holidays)
-  (define-key calendar-mode-map "h"     'calendar-cursor-holidays)
-  (define-key calendar-mode-map "x"     'mark-calendar-holidays)
-  (define-key calendar-mode-map "u"     'calendar-unmark)
-  (define-key calendar-mode-map "m"     'mark-diary-entries)
-  (define-key calendar-mode-map "d"     'view-diary-entries)
-  (define-key calendar-mode-map "s"     'show-all-diary-entries)
-  (define-key calendar-mode-map "D"     'cursor-to-calendar-day-of-year)
-  (define-key calendar-mode-map "C"     'cursor-to-iso-calendar-date)
-  (define-key calendar-mode-map "J"     'cursor-to-julian-calendar-date)
-  (define-key calendar-mode-map "H"     'cursor-to-hebrew-calendar-date)
-  (define-key calendar-mode-map "I"     'cursor-to-islamic-calendar-date)
-  (define-key calendar-mode-map "F"     'cursor-to-french-calendar-date)
-  (define-key calendar-mode-map "\C-cd" 'insert-diary-entry)
-  (define-key calendar-mode-map "\C-cw" 'insert-weekly-diary-entry)
-  (define-key calendar-mode-map "\C-cm" 'insert-monthly-diary-entry)
-  (define-key calendar-mode-map "\C-cy" 'insert-yearly-diary-entry)
-  (define-key calendar-mode-map "\C-ca" 'insert-anniversary-diary-entry)
-  (define-key calendar-mode-map "\C-cb" 'insert-block-diary-entry)
-  (define-key calendar-mode-map "\C-cc" 'insert-cyclic-diary-entry)
-  (define-key calendar-mode-map "\C-cHd" 'insert-hebrew-diary-entry)
-  (define-key calendar-mode-map "\C-cHm" 'insert-monthly-hebrew-diary-entry)
-  (define-key calendar-mode-map "\C-cHy" 'insert-yearly-hebrew-diary-entry)
-  (define-key calendar-mode-map "\C-cId" 'insert-islamic-diary-entry)
-  (define-key calendar-mode-map "\C-cIm" 'insert-monthly-islamic-diary-entry)
-  (define-key calendar-mode-map "\C-cIy" 'insert-yearly-islamic-diary-entry)
-  (define-key calendar-mode-map "?"      'describe-calendar-mode))
+  (define-key calendar-mode-map "."   'calendar-current-month)
+  (define-key calendar-mode-map "o"   'calendar-other-month)
+  (define-key calendar-mode-map "q"   'exit-calendar)
+  (define-key calendar-mode-map "a"   'list-calendar-holidays)
+  (define-key calendar-mode-map "h"   'calendar-cursor-holidays)
+  (define-key calendar-mode-map "x"   'mark-calendar-holidays)
+  (define-key calendar-mode-map "u"   'calendar-unmark)
+  (define-key calendar-mode-map "m"   'mark-diary-entries)
+  (define-key calendar-mode-map "d"   'view-diary-entries)
+  (define-key calendar-mode-map "s"   'show-all-diary-entries)
+  (define-key calendar-mode-map "pd"  'calendar-print-day-of-year)
+  (define-key calendar-mode-map "pc"  'calendar-print-iso-date)
+  (define-key calendar-mode-map "pj"  'calendar-print-julian-date)
+  (define-key calendar-mode-map "pa"  'calendar-print-astro-day-number)
+  (define-key calendar-mode-map "ph"  'calendar-print-hebrew-date)
+  (define-key calendar-mode-map "pi"  'calendar-print-islamic-date)
+  (define-key calendar-mode-map "pf"  'calendar-print-french-date)
+  (define-key calendar-mode-map "pm"  'calendar-print-mayan-date)
+  (define-key calendar-mode-map "id"  'insert-diary-entry)
+  (define-key calendar-mode-map "iw"  'insert-weekly-diary-entry)
+  (define-key calendar-mode-map "im"  'insert-monthly-diary-entry)
+  (define-key calendar-mode-map "iy"  'insert-yearly-diary-entry)
+  (define-key calendar-mode-map "ia"  'insert-anniversary-diary-entry)
+  (define-key calendar-mode-map "ib"  'insert-block-diary-entry)
+  (define-key calendar-mode-map "ic"  'insert-cyclic-diary-entry)
+  (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry)
+  (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry)
+  (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry)
+  (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry)
+  (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry)
+  (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry)
+  (define-key calendar-mode-map "?"   'describe-calendar-mode))
 
 (defun describe-calendar-mode ()
   "Create a help buffer with a brief description of the calendar-mode."
@@ -1175,12 +1503,16 @@ the inserted text.  Value is always t."
 (put 'calendar-mode 'mode-class 'special)
 
 (defvar calendar-mode-line-format
-  (substitute-command-keys
-    "\\<calendar-mode-map>\\[scroll-calendar-left]      Calendar    \\[describe-calendar-mode] help/\\[calendar-other-month] other/\\[calendar-current-month] current    %17s       \\[scroll-calendar-right]")
+  (list
+   (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-left]")
+   "Calendar"
+   (substitute-command-keys "\\<calendar-mode-map>\\[describe-calendar-mode] help/\\[calendar-other-month] other/\\[calendar-current-month] current")
+   '(calendar-date-string (calendar-current-date) t)
+   (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-right]"))
   "The mode line of the calendar buffer.")
 
 (defun calendar-mode ()
-  "A major mode for the sliding calendar window and diary.
+  "A major mode for the calendar window.
 
 The commands for cursor movement are:\\<calendar-mode-map>
 
@@ -1191,13 +1523,27 @@ The commands for cursor movement are:\\<calendar-mode-map>
        \\[calendar-beginning-of-week]  beginning of week         \\[calendar-end-of-week]  end of week
        \\[calendar-beginning-of-month]  beginning of month      \\[calendar-end-of-month]  end of month
        \\[calendar-beginning-of-year]  beginning of year       \\[calendar-end-of-year]  end of year
-       \\[calendar-goto-date]  go to date                \\[calendar-goto-julian-date]  go to Julian date
+
+       \\[calendar-goto-date]  go to date
+
+       \\[calendar-goto-julian-date]  go to Julian date         \\[calendar-goto-astro-day-number]  go to astronomical (Julian) day number
        \\[calendar-goto-hebrew-date]  go to Hebrew date         \\[calendar-goto-islamic-date]  go to Islamic date
-       \\[calendar-goto-iso-date]  go to ISO date
+       \\[calendar-goto-iso-date]  go to ISO date            \\[calendar-goto-french-date]  go to French Revolutionary date
+
+       \\[calendar-goto-mayan-long-count-date]  go to Mayan Long Count date
+       \\[calendar-next-haab-date]  go to next occurrence of Mayan Haab date
+       \\[calendar-previous-haab-date]  go to previous occurrence of Mayan Haab date
+       \\[calendar-next-tzolkin-date]  go to next occurrence of Mayan Tzolkin date
+       \\[calendar-previous-tzolkin-date]  go to previous occurrence of Mayan Tzolkin date
+       \\[calendar-next-calendar-round-date]  go to next occurrence of Mayan Calendar Round date
+       \\[calendar-previous-calendar-round-date]  go to previous occurrence of Mayan Calendar Round date
 
 You can mark a date in the calendar and switch the point and mark:
+
        \\[calendar-set-mark]  mark date                 \\[calendar-exchange-point-and-mark]  exchange point and mark
+
 You can determine the number of days (inclusive) between the point and mark by
+
        \\[calendar-count-days-region]  count days in the region
 
 The commands for calendar movement are:
@@ -1292,16 +1638,32 @@ argument; with no prefix argument, the diary entries are marking.
 The day number in the year and the number of days remaining in the year can be
 determined by
 
-       \\[cursor-to-calendar-day-of-year]  show day number and the number of days remaining in the year
+       \\[calendar-print-day-of-year]  show day number and the number of days remaining in the year
+
+Equivalent dates on the ISO commercial, Julian, Hebrew, Islamic, French
+Revolutionary, and Mayan calendars can be determined by
 
-Equivalent dates on the ISO commercial, Julian, Hebrew, Islamic and French
-Revolutionary calendars can be determined by
+       \\[calendar-print-iso-date]  show equivalent date on the ISO commercial calendar
+       \\[calendar-print-julian-date]  show equivalent date on the Julian calendar
+       \\[calendar-print-hebrew-date]  show equivalent date on the Hebrew calendar
+       \\[calendar-print-islamic-date]  show equivalent date on the Islamic calendar
+       \\[calendar-print-french-date]  show equivalent date on the French Revolutionary calendar
+       \\[calendar-print-mayan-date]  show equivalent date on the Mayan calendar
 
-       \\[cursor-to-iso-calendar-date]  show equivalent date on the ISO commercial calendar
-       \\[cursor-to-julian-calendar-date]  show equivalent date on the Julian calendar
-       \\[cursor-to-hebrew-calendar-date]  show equivalent date on the Hebrew calendar
-       \\[cursor-to-islamic-calendar-date]  show equivalent date on the Islamic calendar
-       \\[cursor-to-french-calendar-date]  show equivalent date on the French Revolutionary calendar
+The astromonical (Julian) day number of a date is found with
+
+       \\[calendar-print-astro-day-number]  show equivalent astronomical (Julian) day number
+
+To find the times of sunrise and sunset and lunar phases use
+
+       \\[calendar-sunrise-sunset]  show times of sunrise and sunset
+       \\[calendar-phases-of-moon]  show times of quarters of the moon
+
+The times given will be at latitude `solar-latitude', longitude
+`solar-longitude' in time zone `solar-time-zone'.  These variables, and the
+variables `solar-location-name', `solar-standard-time-zone-name',
+`solar-daylight-time-zone-name', `solar-daylight-savings-starts', and
+`solar-daylight-savings-ends', should be set for your location.
 
 To exit from the calendar use
 
@@ -1321,50 +1683,51 @@ entries will be displayed Monday through Thursday, Friday through Monday's
 entries will be displayed on Friday, while on Saturday only that day's
 entries will be displayed.
 
-The variable `view-calendar-holidays-initially' can be set to t to cause
-the holidays for the current three month period will be displayed on entry
-to the calendar.  The holidays are displayed in another window.
+The variable `view-calendar-holidays-initially' can be set to t to cause the
+holidays for the current three month period will be displayed on entry to the
+calendar.  The holidays are displayed in another window.
 
 The variable `mark-diary-entries-in-calendar' can be set to t to cause any
-dates visible with calendar entries to be marked with the symbol specified
-by the variable `diary-entry-marker', normally a plus sign.
-
-The variable `initial-calendar-window-hook', whose default value is nil,
-is list of functions to be called when the calendar window is first opened.
-The functions invoked are called after the calendar window is opened, but
-once opened is never called again.  Leaving the calendar with the `q' command
-and reentering it will cause these functions to be called again.
-
-The variable `today-visible-calendar-hook', whose default value is nil,
-is the list of functions called after the calendar buffer has been prepared
-with the calendar when the current date is visible in the window.
-This can be used, for example, to replace today's date with asterisks; a
-function calendar-star-date is included for this purpose:
-    (setq today-visible-calendar-hook 'calendar-star-date)
-It could also be used to mark the current date with `*'; a function is also
-provided for this:
-    (setq today-visible-calendar-hook 'calendar-mark-today)
-
-The variable `today-invisible-calendar-hook', whose default value is nil,
-is the list of functions called after the calendar buffer has been prepared
-with the calendar when the current date is not visible in the window.
-
-The variable `diary-display-hook' is the list of functions called
-after the diary buffer is prepared.  The default value simply displays the
-diary file using selective-display to conceal irrelevant diary entries.  An
-alternative function `fancy-diary-display' is provided that, when
-used as the `diary-display-hook', causes a noneditable buffer to be
-prepared with a neatly organized day-by-day listing of relevant diary
-entries, together with any known holidays.  The inclusion of the holidays
-slows this fancy display of the diary; to speed it up, set the variable
-`holidays-in-diary-buffer' to nil.
-
-The variable `print-diary-entries-hook' is the list of functions called
-after a temporary buffer is prepared with the diary entries currently
-visible in the diary buffer.  The default value of this hook adds a heading
-(composed from the diary buffer's mode line), does the printing with the
-command lpr-buffer, and kills the temporary buffer.  Other uses might
-include, for example, rearranging the lines into order by day and time.
+dates visible with calendar entries to be marked with the symbol specified by
+the variable `diary-entry-marker', normally a plus sign.
+
+The variable `calendar-load-hook', whose default value is nil, is list of
+functions to be called when the calendar is first loaded.
+
+The variable `initial-calendar-window-hook', whose default value is nil, is
+list of functions to be called when the calendar window is first opened.  The
+functions invoked are called after the calendar window is opened, but once
+opened is never called again.  Leaving the calendar with the `q' command and
+reentering it will cause these functions to be called again.
+
+The variable `today-visible-calendar-hook', whose default value is nil, is the
+list of functions called after the calendar buffer has been prepared with the
+calendar when the current date is visible in the window.  This can be used,
+for example, to replace today's date with asterisks; a function
+calendar-star-date is included for this purpose: (setq
+today-visible-calendar-hook 'calendar-star-date) It could also be used to mark
+the current date with `*'; a function is also provided for this: (setq
+today-visible-calendar-hook 'calendar-mark-today)
+
+The variable `today-invisible-calendar-hook', whose default value is nil, is
+the list of functions called after the calendar buffer has been prepared with
+the calendar when the current date is not visible in the window.
+
+The variable `diary-display-hook' is the list of functions called after the
+diary buffer is prepared.  The default value simply displays the diary file
+using selective-display to conceal irrelevant diary entries.  An alternative
+function `fancy-diary-display' is provided that, when used as the
+`diary-display-hook', causes a noneditable buffer to be prepared with a neatly
+organized day-by-day listing of relevant diary entries, together with any
+known holidays.  The inclusion of the holidays slows this fancy display of the
+diary; to speed it up, set the variable `holidays-in-diary-buffer' to nil.
+
+The variable `print-diary-entries-hook' is the list of functions called after
+a temporary buffer is prepared with the diary entries currently visible in the
+diary buffer.  The default value of this hook adds a heading (composed from
+the diary buffer's mode line), does the printing with the command lpr-buffer,
+and kills the temporary buffer.  Other uses might include, for example,
+rearranging the lines into order by day and time.
 
 The Gregorian calendar is assumed."
 
@@ -1374,25 +1737,47 @@ The Gregorian calendar is assumed."
   (use-local-map calendar-mode-map)
   (setq buffer-read-only t)
   (setq indent-tabs-mode nil)
+  (update-calendar-mode-line)
   (make-local-variable 'calendar-window-configuration);; Windows on entry.
   (make-local-variable 'calendar-mark-ring)
-  (make-local-variable 'current-month)  ;;  Current month.
-  (make-local-variable 'current-day)    ;;  Current day.
-  (make-local-variable 'current-year)   ;;  Current year.
   (make-local-variable 'displayed-month);;  Month in middle of window.
   (make-local-variable 'displayed-year));;  Year in middle of window.
 
+(defun calendar-string-spread (strings char length)
+  "A list of STRINGS is concatenated separated by copies of CHAR so that it
+fills LENGTH; there must be at least 2 strings.  The effect is like mapconcat
+but the separating pieces are as balanced as possible.  Each item of STRINGS
+is evaluated before concatenation so it can actually be an expression that
+evaluates to a string.  If LENGTH is too short, the STRINGS are just
+concatenated and the result truncated."
+;; The algorithm is based on equation (3.25) on page 85 of Concrete
+;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
+;; Addison-Wesley, Reading, MA, 1989
+  (let* ((strings (mapcar 'eval strings))
+         (n (- length (length (apply 'concat strings))))
+         (m (1- (length strings)))
+         (s (car strings))
+         (strings (cdr strings))
+         (i 0))
+    (while strings
+      (setq s (concat s
+                      (make-string (max 0 (/ (+ n i) m)) char)
+                      (car strings)))
+      (setq i (1+ i))
+      (setq strings (cdr strings)))
+    (substring s 0 length)))
+
 (defun update-calendar-mode-line ()
   "Update the calendar mode line with the current date and date style."
   (if (bufferp (get-buffer calendar-buffer))
       (save-excursion
         (set-buffer calendar-buffer)
         (setq mode-line-format
-              (format calendar-mode-line-format
-                      (calendar-date-string (calendar-current-date) t))))))
+              (calendar-string-spread
+               calendar-mode-line-format ?  (frame-width))))))
 
 (defun exit-calendar ()
-  "Get out of the calendar window and destroy it and related buffers."
+  "Get out of the calendar window and bury it and related buffers."
   (interactive)
   (let ((diary-buffer (get-file-buffer diary-file))
         (d-buffer (get-buffer fancy-diary-buffer))
@@ -1400,26 +1785,26 @@ The Gregorian calendar is assumed."
     (if (not diary-buffer)
         (progn
           (set-window-configuration calendar-window-configuration)
-          (kill-buffer calendar-buffer)
-          (if d-buffer (kill-buffer d-buffer))
-          (if h-buffer (kill-buffer h-buffer)))
+          (bury-buffer calendar-buffer)
+          (if d-buffer (bury-buffer d-buffer))
+          (if h-buffer (bury-buffer h-buffer)))
       (if (or (not (buffer-modified-p diary-buffer))
               (yes-or-no-p "Diary modified; do you really want to exit the calendar? "))
           (progn
             (set-window-configuration calendar-window-configuration)
-            (kill-buffer calendar-buffer)
-            (if d-buffer (kill-buffer d-buffer))
-            (if h-buffer (kill-buffer h-buffer))
+            (bury-buffer calendar-buffer)
+            (if d-buffer (bury-buffer d-buffer))
+            (if h-buffer (bury-buffer h-buffer))
             (set-buffer diary-buffer)
             (set-buffer-modified-p nil)
-            (kill-buffer diary-buffer))))))
+            (bury-buffer diary-buffer))))))
 
 (defun calendar-current-month ()
   "Reposition the calendar window so the current date is visible."
   (interactive)
   (let ((today (calendar-current-date)));; The date might have changed.
     (if (not (calendar-date-is-visible-p today))
-        (regenerate-calendar-window)
+        (generate-calendar-window)
       (update-calendar-mode-line)
       (calendar-cursor-to-visible-date today))))
 
@@ -1471,9 +1856,8 @@ position of the cursor with respect to the calendar as well as possible."
         (today (calendar-current-date)))
     (if (/= arg 0)
         (progn
-          (regenerate-calendar-window
-           (+ arg (calendar-interval current-month current-year
-                                     displayed-month displayed-year)))
+          (increment-calendar-month displayed-month displayed-year arg)
+          (generate-calendar-window displayed-month displayed-year)
           (calendar-cursor-to-visible-date
            (cond
             ((calendar-date-is-visible-p old-date) old-date)
@@ -1520,11 +1904,6 @@ If in the calendar buffer, also sets the current date local variables."
           (string-to-int (substring date (match-beginning 3) (match-end 3))))
          (year
           (string-to-int (substring date (match-beginning 4) (match-end 4)))))
-    (if (equal (current-buffer) (get-buffer calendar-buffer))
-      (progn
-        (setq current-month month)
-        (setq current-day day)
-        (setq current-year year)))
     (list month day year)))
 
 (defun calendar-cursor-to-date ()
@@ -1537,7 +1916,7 @@ Returns nil if the cursor is not on a specific day."
         (forward-char 1)
         (let*
             ((day (string-to-int (buffer-substring (point) (+ 3 (point)))))
-             (day (if (= 0 day) current-day day));; Starred date.
+             (day (if (= 0 day) starred-day day))
              (segment (/ (current-column) 25))
              (month (% (+ displayed-month segment -1) 12))
              (month (if (= 0 month) 12 month))
@@ -1746,15 +2125,15 @@ Gregorian date Sunday, December 31, 1 BC."
           (year (calendar-read
                  "Year (>0): "
                  '(lambda (x) (> x 0))
-                 (int-to-string current-year))))
+                 (int-to-string
+                  (extract-calendar-year (calendar-current-date))))))
      (list month year)))
   (if (and (= month displayed-month)
            (= year displayed-year))
       nil
     (let ((old-date (calendar-cursor-to-date))
           (today (calendar-current-date)))
-      (regenerate-calendar-window
-       (calendar-interval current-month current-year month year))
+      (generate-calendar-window month year)
       (calendar-cursor-to-visible-date
        (cond
         ((calendar-date-is-visible-p old-date) old-date)
@@ -1823,27 +2202,31 @@ is a string to insert in the minibuffer before reading."
       (setq value (read-minibuffer prompt initial-contents)))
     value))
 
+(defun calendar-read-date ()
+  "Prompt for Gregorian date.  Returns a list (month day year)."
+  (let* ((year (calendar-read
+                "Year (>0): "
+                '(lambda (x) (> x 0))
+                (int-to-string (extract-calendar-year
+                                (calendar-current-date)))))
+         (month-array calendar-month-name-array)
+         (completion-ignore-case t)
+         (month (cdr (assoc
+                      (capitalize
+                       (completing-read
+                        "Month name: "
+                        (mapcar 'list (append month-array nil))
+                        nil t))
+                      (calendar-make-alist month-array 1 'capitalize))))
+         (last (calendar-last-day-of-month month year))
+         (day (calendar-read
+               (format "Day (1-%d): " last)
+               '(lambda (x) (and (< 0 x) (<= x last))))))
+    (list month day year)))
+
 (defun calendar-goto-date (date)
   "Move cursor to DATE."
-  (interactive
-   (let* ((year (calendar-read
-                 "Year (>0): "
-                 '(lambda (x) (> x 0))
-                 (int-to-string current-year)))
-          (month-array calendar-month-name-array)
-          (completion-ignore-case t)
-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Month name: "
-                         (mapcar 'list (append month-array nil))
-                         nil t))
-                       (calendar-make-alist month-array 1 'capitalize))))
-          (last (calendar-last-day-of-month month year))
-          (day (calendar-read
-                (format "Day (1-%d): " last)
-                '(lambda (x) (and (< 0 x) (<= x last))))))
-     (list (list month day year))))
+  (interactive (list (calendar-read-date)))
   (let ((month (extract-calendar-month date))
         (year (extract-calendar-year date)))
     (if (not (calendar-date-is-visible-p date))
@@ -1857,14 +2240,15 @@ is a string to insert in the minibuffer before reading."
 (defun calendar-goto-julian-date (date &optional noecho)
   "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
   (interactive
-   (let* ((year (calendar-read
+   (let* ((today (calendar-current-date))
+          (year (calendar-read
                  "Julian calendar year (>0): "
                  '(lambda (x) (> x 0))
                  (int-to-string
                   (extract-calendar-year
                    (calendar-julian-from-absolute
                     (calendar-absolute-from-gregorian
-                     (list current-month 1 current-year)))))))
+                     today))))))
           (month-array calendar-month-name-array)
           (completion-ignore-case t)
           (month (cdr (assoc
@@ -1887,19 +2271,19 @@ is a string to insert in the minibuffer before reading."
      (list (list month day year))))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-julian date)))
-  (or noecho (cursor-to-julian-calendar-date)))
+  (or noecho (calendar-print-julian-date)))
 
 (defun calendar-goto-hebrew-date (date &optional noecho)
   "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t."
   (interactive
-   (let* ((year (calendar-read
+   (let* ((today (calendar-current-date))
+          (year (calendar-read
                  "Hebrew calendar year (>3760): "
                  '(lambda (x) (> x 3760))
                  (int-to-string
                   (extract-calendar-year
                    (calendar-hebrew-from-absolute
-                    (calendar-absolute-from-gregorian
-                     (list current-month 1 current-year)))))))
+                    (calendar-absolute-from-gregorian today))))))
           (month-array (if (hebrew-calendar-leap-year-p year)
                            calendar-hebrew-month-name-array-leap-year
                          calendar-hebrew-month-name-array-common-year))
@@ -1935,19 +2319,19 @@ is a string to insert in the minibuffer before reading."
      (list (list month day year))))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-hebrew date)))
-  (or noecho (cursor-to-hebrew-calendar-date)))
+  (or noecho (calendar-print-hebrew-date)))
 
 (defun calendar-goto-islamic-date (date &optional noecho)
   "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
   (interactive
-   (let* ((year (calendar-read
+   (let* ((today (calendar-current-date))
+          (year (calendar-read
                  "Islamic calendar year (>0): "
                  '(lambda (x) (> x 0))
                  (int-to-string
                   (extract-calendar-year
                    (calendar-islamic-from-absolute
-                    (calendar-absolute-from-gregorian
-                     (list current-month 1 current-year)))))))
+                    (calendar-absolute-from-gregorian today))))))
           (month-array calendar-islamic-month-name-array)
           (completion-ignore-case t)
           (month (cdr (assoc
@@ -1964,15 +2348,16 @@ is a string to insert in the minibuffer before reading."
      (list (list month day year))))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-islamic date)))
-  (or noecho (cursor-to-islamic-calendar-date)))
+  (or noecho (calendar-print-islamic-date)))
 
 (defun calendar-goto-iso-date (date &optional noecho)
   "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
   (interactive
-   (let* ((year (calendar-read
+   (let* ((today (calendar-current-date))
+          (year (calendar-read
                  "ISO calendar year (>0): "
                  '(lambda (x) (> x 0))
-                 (int-to-string current-year)))
+                 (int-to-string (extract-calendar-year today))))
           (no-weeks (extract-calendar-month
                      (calendar-iso-from-absolute
                       (1-
@@ -1988,10 +2373,10 @@ is a string to insert in the minibuffer before reading."
      (list (list week day year))))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-iso date)))
-  (or noecho (cursor-to-iso-calendar-date)))
+  (or noecho (calendar-print-iso-date)))
 
 (defun calendar-interval (mon1 yr1 mon2 yr2)
-  "The number of months difference between the two specified months."
+  "The number of months difference between MON1, YR1 and MON2, YR2."
   (+ (* 12 (- yr2 yr1))
      (- mon2 mon1)))
 
@@ -2095,7 +2480,11 @@ If FILTER is provided, apply it to each item in the list."
 This function can be used with the today-visible-calendar-hook run after the
 calendar window has been prepared."
   (let ((buffer-read-only nil))
+    (make-variable-buffer-local 'starred-day)
     (forward-char 1)
+    (setq starred-day
+          (string-to-int
+           (buffer-substring (point) (- (point) 2))))
     (delete-char -2)
     (insert "**")
     (backward-char 1)
@@ -2125,7 +2514,7 @@ abbreviated to three characters.  An optional parameter NODAYNAME, when t,
 omits the name of the day of the week."
   (let* ((dayname
           (if nodayname
-              ""
+              nil
             (if abbreviate
                 (substring (calendar-day-name date) 0 3)
               (calendar-day-name date))))
@@ -2166,7 +2555,7 @@ the last DAYNAME, -2 is the penultimate DAYNAME, and so on."
           (list month (calendar-last-day-of-month month year) year)))
         (* 7 (1+ n))))))
 
-(defun cursor-to-calendar-day-of-year ()
+(defun calendar-print-day-of-year ()
   "Show the day number in the year and the number of days remaining in the
 year for the date under the cursor."
   (interactive)
@@ -2214,7 +2603,7 @@ date Sunday, December 31, 1 BC."
      (% date 7)
      year)))
 
-(defun cursor-to-iso-calendar-date ()
+(defun calendar-print-iso-date ()
   "Show the equivalent date on the `ISO commercial calendar' for the date
 under the cursor."
   (interactive)
@@ -2269,19 +2658,16 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
        (/ (1- year) 4)
        -2)))
 
-(defun cursor-to-julian-calendar-date ()
+(defun calendar-print-julian-date ()
   "Show the Julian calendar equivalent of the date under the cursor."
   (interactive)
-  (let ((calendar-date-display-form
-         (if european-calendar-style
-             '(day " " monthname " " year)
-           '(monthname " " day ", " year))))
-    (message "Julian date: %s"
-             (calendar-date-string
-              (calendar-julian-from-absolute
-               (calendar-absolute-from-gregorian
-                (or (calendar-cursor-to-date)
-                    (error "Cursor is not on a date!"))))))))
+  (message "Julian date: %s"
+           (calendar-date-string
+            (calendar-julian-from-absolute
+             (calendar-absolute-from-gregorian
+              (or (calendar-cursor-to-date)
+                  (error "Cursor is not on a date!"))))
+            nil t)))
 
 (defun islamic-calendar-leap-year-p (year)
   "Returns t if YEAR is a leap year on the Islamic calendar."
@@ -2353,21 +2739,18 @@ Gregorian date Sunday, December 31, 1 BC."
   ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
    "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"])
 
-(defun cursor-to-islamic-calendar-date ()
+(defun calendar-print-islamic-date ()
   "Show the Islamic calendar equivalent of the date under the cursor."
   (interactive)
-  (let ((calendar-date-display-form
-           (if european-calendar-style
-               '(day " " monthname " " year)
-             '(monthname " " day ", " year)))
-        (calendar-month-name-array calendar-islamic-month-name-array)
+  (let ((calendar-month-name-array calendar-islamic-month-name-array)
         (islamic-date (calendar-islamic-from-absolute
                        (calendar-absolute-from-gregorian
                         (or (calendar-cursor-to-date)
                             (error "Cursor is not on a date!"))))))
     (if (< (extract-calendar-year islamic-date) 1)
         (message "Date is pre-Islamic")
-      (message "Islamic date: %s" (calendar-date-string islamic-date nil t)))))
+      (message "Islamic date (until sunset): %s"
+               (calendar-date-string islamic-date nil t)))))
 
 (defun calendar-hebrew-from-absolute (date)
   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
@@ -2491,14 +2874,10 @@ Gregorian date Sunday, December 31, 1 BC."
   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
 
-(defun cursor-to-hebrew-calendar-date ()
+(defun calendar-print-hebrew-date ()
   "Show the Hebrew calendar equivalent of the date under the cursor."
   (interactive)
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname " " year)
-            '(monthname " " day ", " year)))
-         (hebrew-date (calendar-hebrew-from-absolute
+  (let* ((hebrew-date (calendar-hebrew-from-absolute
                        (calendar-absolute-from-gregorian
                         (or (calendar-cursor-to-date)
                             (error "Cursor is not on a date!")))))
@@ -2506,7 +2885,8 @@ Gregorian date Sunday, December 31, 1 BC."
           (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
               calendar-hebrew-month-name-array-leap-year
             calendar-hebrew-month-name-array-common-year)))
-    (message "Hebrew date: %s" (calendar-date-string hebrew-date nil t))))
+    (message "Hebrew date (until sunset): %s"
+             (calendar-date-string hebrew-date nil t))))
 
 (defun hebrew-calendar-yahrzeit (death-date year)
   "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
@@ -2541,12 +2921,40 @@ Gregorian date Sunday, December 31, 1 BC."
      (t (calendar-absolute-from-hebrew
          (list death-month death-day year))))))
 
+(defun calendar-set-mode-line (str)
+  "Set mode line to STR, centered, surrounded by dashes."
+  (setq mode-line-format
+        (calendar-string-spread (list "" str "") ?- (frame-width))))
+
+;;;###autoload
 (defun list-yahrzeit-dates (death-date start-year end-year)
-  "List of Yahrzeit dates for *Gregorian* DEATH-DATE
-from START-YEAR to END-YEAR.  When called interactively
-the date of death is taken from the cursor in the calendar window."
+  "List of Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to
+END-YEAR.  When called interactively from the calendar window,
+the date of death is taken from the cursor position."
   (interactive
-   (let* ((death-date (calendar-cursor-to-date))
+   (let* ((death-date
+           (if (equal (current-buffer) (get-buffer calendar-buffer))
+               (calendar-cursor-to-date)
+             (let* ((today (calendar-current-date))
+                    (year (calendar-read
+                           "Year of death (>0): "
+                           '(lambda (x) (> x 0))
+                           (int-to-string (extract-calendar-year today))))
+                    (month-array calendar-month-name-array)
+                    (completion-ignore-case t)
+                    (month (cdr (assoc
+                                 (capitalize
+                                  (completing-read
+                                   "Month of death (name): "
+                                   (mapcar 'list (append month-array nil))
+                                   nil t))
+                                 (calendar-make-alist
+                                  month-array 1 'capitalize))))
+                    (last (calendar-last-day-of-month month year))
+                    (day (calendar-read
+                          (format "Day of death (1-%d): " last)
+                          '(lambda (x) (and (< 0 x) (<= x last))))))
+               (list month day year))))
           (death-year (extract-calendar-year death-date))
           (start-year (calendar-read
                        (format "Starting year of Yahrzeit table (>%d): "
@@ -2567,17 +2975,13 @@ the date of death is taken from the cursor in the calendar window."
          (h-year (extract-calendar-year h-date)))
     (set-buffer (get-buffer-create yahrzeit-buffer))
     (setq buffer-read-only nil)
-    (setq mode-line-format
-     (format "------Yahrzeit dates for %s = %s%%-"
+    (calendar-set-mode-line
+     (format "Yahrzeit dates for %s = %s"
              (calendar-date-string death-date)
              (let ((calendar-month-name-array
                     (if (hebrew-calendar-leap-year-p h-year)
                         calendar-hebrew-month-name-array-leap-year
-                      calendar-hebrew-month-name-array-common-year))
-                   (calendar-date-display-form
-                    (if european-calendar-style
-                        '(day " " monthname " " year)
-                      '(monthname " " day ", " year))))
+                      calendar-hebrew-month-name-array-common-year)))
                (calendar-date-string h-date nil t))))
     (erase-buffer)
     (goto-char (point-min))
@@ -2596,113 +3000,27 @@ the date of death is taken from the cursor in the calendar window."
     (display-buffer yahrzeit-buffer)
     (message "Computing yahrzeits...done")))
 
-(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 cursor-to-french-calendar-date ()
-  "Show the French Revolutionary calendar equivalent of the date under the
-cursor."
+(defun calendar-print-astro-day-number ()
+  "Show the astronomical (Julian) day number of afternoon on date
+shown by 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'Annee %d de la Revolution"
-                   (aref french-calendar-special-days-array (1- d))
-                   y)
-        (message "Decade %s, %s de %s de l'Annee %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)))))
-
-(defconst french-calendar-month-name-array
-  ["Vendemiaire" "Brumaire" "Frimaire" "Nivose" "Pluviose" "Ventose" "Germinal"
-   "Floreal" "Prairial" "Messidor" "Thermidor" "Fructidor"])
-;; Very loosely translated as
-;; Slippy, Nippy, Drippy, Freezy, Wheezy, Sneezy,
-;; Showery, Flowery, Bowery, Heaty, Wheaty, Sweety.
-
-(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"])
+  (message
+   "Astromonical (Julian) day number after noon Universal Time: %d"
+   (+ 1721425
+      (calendar-absolute-from-gregorian
+       (or (calendar-cursor-to-date)
+           (error "Cursor is not on a date!"))))))
+
+(defun calendar-goto-astro-day-number (daynumber &optional noecho)
+  "Move cursor to astronomical (Julian) DAYNUMBER.
+Echo astronomical (Julian) day number unless NOECHO is t."
+  (interactive (list (calendar-read
+                      "Astromonical (Julian) day number (>1721425): "
+                      '(lambda (x) (> x 1721425)))))
+  (calendar-goto-date (calendar-gregorian-from-absolute (- daynumber 1721425)))
+  (or noecho (calendar-print-astro-day-number)))
+
+(run-hooks 'calendar-load-hook)
 
 (provide 'calendar)
 
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 8f6aed27dca..5dd4a537cf1 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -1,9 +1,9 @@
 ;;; holidays.el --- holiday functions for the calendar package
 
-;;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
+;;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
+;; Keywords: holidays, calendar
 
 ;; This file is part of GNU Emacs.
 
@@ -36,21 +36,51 @@
 ;; Technical details of all the calendrical calculations can be found in
 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
 ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
-;; pages 899-928.
+;; pages 899-928.  ``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.
+
+;; Hard copies of these two papers can be obtained by sending email to
+;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
+;; the message BODY containing your mailing address (snail).
 
 ;;; Code:
 
 (require 'calendar)
 
-;;;###autoload
-(defun holidays ()
+(autoload 'calendar-holiday-function-solar-equinoxes-solstices "solar"
+  "Date and time of equinoxes and solstices, if visible in the calendar window.
+Requires floating point."
+  t)
+
+(defun holidays (&optional arg)
   "Display the holidays for last month, this month, and next month.
+If called with an optional prefix argument, prompts for month and year.
+
 This function is suitable for execution in a .emacs file."
-  (interactive)
+  (interactive "P")
   (save-excursion
-    (let* ((date (calendar-current-date))
-           (displayed-month (extract-calendar-month date))
-           (displayed-year (extract-calendar-year date)))
+    (let* ((completion-ignore-case t)
+           (date (calendar-current-date))
+           (displayed-month
+            (if arg
+                (cdr (assoc
+                      (capitalize
+                       (completing-read
+                        "Month name: "
+                        (mapcar 'list (append calendar-month-name-array nil))
+                        nil t))
+                      (calendar-make-alist calendar-month-name-array)))
+              (extract-calendar-month date)))
+           (displayed-year
+            (if arg
+                (calendar-read
+                 "Year (>0): "
+                 '(lambda (x) (> x 0))
+                 (int-to-string
+                  (extract-calendar-year (calendar-current-date))))
+              (extract-calendar-year date))))
       (list-calendar-holidays))))
 
 (defun check-calendar-holidays (date)
@@ -79,13 +109,11 @@ The holidays are those in the list calendar-holidays."
          (msg (format "%s:  %s" date-string holiday-string)))
     (if (not holiday-list)
         (message "No holidays known for %s" date-string)
-      (if (<= (length msg) (frame-width))
+      (if (<= (length msg) (screen-width))
           (message msg)
         (set-buffer (get-buffer-create holiday-buffer))
         (setq buffer-read-only nil)
-        (setq mode-line-format
-              (format "--------------------------%s%%-"
-                      date-string))
+        (calendar-set-mode-line date-string)
         (erase-buffer)
         (insert (mapconcat 'identity holiday-list "\n"))
         (goto-char (point-min))
@@ -125,8 +153,8 @@ holidays are found, nil if not."
       (setq buffer-read-only nil)
       (increment-calendar-month m1 y1 -1)
       (increment-calendar-month m2 y2 1)
-      (setq mode-line-format
-            (format "-------------Notable Dates from %s, %d to %s, %d%%-"
+      (calendar-set-mode-line
+            (format "Notable Dates from %s, %d to %s, %d%%-"
                     (calendar-month-name m1) y1 (calendar-month-name m2) y2))
       (erase-buffer)
       (insert
@@ -150,9 +178,14 @@ The holidays are those in the list calendar-holidays."
       (let* ((function-name
               (intern (format "calendar-holiday-function-%s" (car (car p)))))
              (holidays
-              (if (cdr (car p));; optional arguments
-                  (funcall function-name (cdr (car p)))
-                (funcall function-name))))
+              (condition-case nil
+                  (if (cdr (car p));; optional arguments
+                      (funcall function-name (cdr (car p)))
+                    (funcall function-name))
+                (error
+                 (beep)
+                 (message "Bad holiday list item: %s" (car p))
+                 (sleep-for 2)))))
         (if holidays
             (setq holiday-list (append holidays holiday-list))))
       (setq p (cdr p)))
@@ -164,13 +197,13 @@ The holidays are those in the list calendar-holidays."
 ;; including the evaluation of each element in the list that constitutes
 ;; the argument to the function.  If you don't do this evaluation, the
 ;; list calendar-holidays cannot contain expressions (as, for example, in
-;; the entry for the Islamic new year.  Also remember that each function
+;; the entry for the Islamic new year.)  Also remember that each function
 ;; must return a list of items of the form ((month day year) string);
 ;; the date (month day year) should be visible in the calendar window.
 
 (defun calendar-holiday-function-fixed (x)
   "Returns the corresponding Gregorian date, if visible in the window, to
-month, year where month is (car X) and year is (car (cdr X)).  If it is
+(month day) where month is (car X) and day is (car (cdr X)).  If it is
 visible, the value returned is the list (((month day year) string)) where
 string is (car (nthcdr 2 X)).  Returns nil if it is not visible in the
 current calendar window."
@@ -186,9 +219,9 @@ current calendar window."
 (defun calendar-holiday-function-float (x)
   "Returns the corresponding Gregorian date, if visible in the window, to the
 n-th occurrence (negative counts from the end of the month) of dayname in
-month, year where month is (car X), year is (car (cdr X)), n is
-\(car \(nthcdr 2 X\)\).  If it is visible, the value returned is the list
-\(\(\(month day year)\ string\)\) where string is (car (nthcdr 3 X)).
+month where month is (car X), dayname is (car (cdr X)), and n is
+(car (nthcdr 2 X)).  If it is visible, the value returned is the list
+(((month day year) string)) where string is (car (nthcdr 3 X)).
 Returns nil if it is not visible in the current calendar window."
   (let* ((month (eval (car x)))
          (dayname (eval (car (cdr x))))
@@ -202,7 +235,7 @@ Returns nil if it is not visible in the current calendar window."
 
 (defun calendar-holiday-function-julian (x)
   "Returns the corresponding Gregorian date, if visible in the window, to the
-Julian date month, year where month is (car X) and year is (car (cdr X)).
+Julian date (month day) where month is (car X) and day is (car (cdr X)).
 If it is visible, the value returned is the list (((month day year) string))
 where string is (car (nthcdr 2 X)).  Returns nil if it is not visible in the
 current calendar window."
@@ -233,7 +266,7 @@ current calendar window."
 
 (defun calendar-holiday-function-islamic (x)
   "Returns the corresponding Gregorian date, if visible in the window, to the
-Islamic date month, day where month is (car X) and day is (car (cdr X)).
+Islamic date (month day) where month is (car X) and day is (car (cdr X)).
 If it is visible, the value returned is the list (((month day year) string))
 where string is (car (nthcdr 2 X)).  Returns nil if it is not visible in
 the current calendar window."
@@ -257,7 +290,7 @@ the current calendar window."
 
 (defun calendar-holiday-function-hebrew (x)
   "Returns the corresponding Gregorian date, if visible in the window, to the
-Hebrew date month, day where month is (car X) and day is (car (cdr X)).
+Hebrew date (month day) where month is (car X) and day is (car (cdr X)).
 If it is visible, the value returned is the list (((month day year) string))
 where string is (car (nthcdr 2 X)).  Returns nil if it is not visible in
 the current calendar window."
@@ -308,6 +341,21 @@ checked.  If nil, the holiday (car (cdr (cdr X))), if there, is checked."
                 (funcall function-name))))
        holidays))))
 
+(defun calendar-holiday-function-sexp (x)
+  "Sexp holiday for dates in the calendar window.
+The sexp (in `year') is (car X).  If the sexp evals to a date visible in the
+calendar window, the holiday (car (cdr X)) is on that date.  If the sexp evals
+to nil, or if the date is not visible, there is no holiday."
+  (let ((m displayed-month)
+        (y displayed-year))
+    (increment-calendar-month m y -1)
+    (filter-visible-calendar-holidays
+     (append
+      (let ((year y))
+        (list (list (eval (car x)) (eval (car (cdr x))))))
+      (let ((year (1+ y)))
+        (list (list (eval (car x)) (eval (car (cdr x))))))))))
+
 (defun calendar-holiday-function-advent ()
   "Date of Advent, if visible in calendar window."
   (let ((year displayed-year)
@@ -389,6 +437,30 @@ checked.  If nil, the holiday (car (cdr (cdr X))), if there, is checked."
                 output-list)))
      output-list)))
 
+(defun calendar-holiday-function-greek-orthodox-easter ()
+  "Date of Easter according to the rule of the Council of Nicaea, if visible
+in the calendar window."
+  (let ((m displayed-month)
+        (y displayed-year))
+    (increment-calendar-month m y 1)
+    (let* ((julian-year
+            (extract-calendar-year
+             (calendar-julian-from-absolute
+              (calendar-absolute-from-gregorian
+               (list m (calendar-last-day-of-month m y) y)))))
+           (shifted-epact ;; Age of moon for April 5.
+            (% (+ 14
+                  (* 11 (% julian-year 19)))
+               30))
+           (paschal-moon  ;; Day after full moon on or after March 21.
+            (- (calendar-absolute-from-julian (list 4 19 julian-year))
+               shifted-epact))
+           (nicaean-easter;; Sunday following the Paschal moon
+            (calendar-gregorian-from-absolute
+             (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
+      (if (calendar-date-is-visible-p nicaean-easter)
+          (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
+
 (defun calendar-holiday-function-rosh-hashanah-etc ()
   "List of dates related to Rosh Hashanah, as visible in calendar window."
   (if (or (< displayed-month 8)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
new file mode 100644
index 00000000000..904d99ebfca
--- /dev/null
+++ b/lisp/calendar/lunar.el
@@ -0,0 +1,290 @@
+;;; lunar.el --- calendar functions for phases of the moon.
+
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Keywords: moon, lunar phases, 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 lunar phases for calendar.el and
+;; diary.el.
+
+;; Based on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
+;; Willmann-Bell, Inc., 1985.
+;;
+;; WARNING: The calculations will be accurate only to within a few minutes.
+
+;; The author would be delighted to have an astronomically more sophisticated
+;; person rewrite the code for the lunar calculations in this file!
+
+;; 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:
+
+(if (fboundp 'atan)
+    (require 'lisp-float-type)
+  (error "Lunar calculations impossible since floating point is unavailable."))
+
+(require 'solar)
+
+(defun lunar-phase-list (month year)
+  "List of lunar phases for three months starting with Gregorian MONTH, YEAR."
+  (let ((end-month month)
+        (end-year year)
+        (start-month month)
+        (start-year year))
+    (increment-calendar-month end-month end-year 3)
+    (increment-calendar-month start-month start-year -1)
+    (let* ((end-date (list (list end-month 1 end-year)))
+           (start-date (list (list start-month 
+                                   (calendar-last-day-of-month
+                                    start-month start-year)
+                                   start-year)))
+           (index (* 4
+                     (truncate
+                      (* 12.3685
+                         (+ year
+                            ( / (calendar-day-number (list month 1 year))
+                                366.0)
+                            -1900)))))
+           (new-moon (lunar-phase index))
+           (list))
+      (while (calendar-date-compare new-moon end-date)
+        (if (calendar-date-compare start-date new-moon)
+            (setq list (append list (list new-moon))))
+        (setq index (1+ index))
+        (setq new-moon (lunar-phase index)))
+      list)))
+
+(defun lunar-phase (index)
+  "Local date and time of lunar phase INDEX.
+Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900;
+remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
+3 last quarter."
+  (let* ((phase (% index 4))
+         (index (/ index 4.0))
+         (time (/ index 1236.85))
+         (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900))
+                  0.75933
+                  (* 29.53058868 index)
+                  (* 0.0001178 time time)
+                  (* -0.000000155 time time time)
+                  (* 0.00033
+                     (solar-sin-degrees (+ 166.56
+                                           (* 132.87 time)
+                                           (* -0.009173 time time))))))
+         (sun-anomaly (solar-mod
+                       (+ 359.2242
+                          (* 29.105356 index)
+                          (* -0.0000333 time time)
+                          (* -0.00000347 time time time))
+                       360.0))
+         (moon-anomaly (solar-mod
+                        (+ 306.0253
+                           (* 385.81691806 index)
+                           (* 0.0107306 time time)
+                           (* 0.00001236 time time time))
+                        360.0))
+         (moon-lat (solar-mod
+                    (+ 21.2964
+                       (* 390.67050646 index)
+                       (* -0.0016528 time time)
+                       (* -0.00000239 time time time))
+                    360.0))
+         (adjustment
+          (if (memq phase '(0 2))
+              (+ (* (- 0.1734 (* 0.000393 time))
+                    (solar-sin-degrees sun-anomaly))
+                 (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
+                 (* -0.4068 (solar-sin-degrees moon-anomaly))
+                 (* 0.0161 (solar-sin-degrees (* 2 moon-anomaly)))
+                 (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
+                 (* 0.0104 (solar-sin-degrees (* 2 moon-lat)))
+                 (* -0.0051 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
+                 (* -0.0074 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
+                 (* 0.0004 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
+                 (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
+                 (* -0.0006 (solar-sin-degrees
+                             (+ (* 2 moon-lat) moon-anomaly)))
+                 (* 0.0010 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
+                 (* 0.0005 (solar-sin-degrees
+                            (+ (* 2 moon-anomaly) sun-anomaly))))
+            (+ (* (- 0.1721 (* 0.0004 time))
+                  (solar-sin-degrees sun-anomaly))
+               (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
+               (* -0.6280 (solar-sin-degrees moon-anomaly))
+               (* 0.0089 (solar-sin-degrees (* 2 moon-anomaly)))
+               (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
+               (* 0.0079 (solar-sin-degrees (* 2 moon-lat)))
+               (* -0.0119 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
+               (* -0.0047 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
+               (* 0.0003 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
+               (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
+               (* -0.0006 (solar-sin-degrees (+ (* 2 moon-lat) moon-anomaly)))
+               (* 0.0021 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
+               (* 0.0003 (solar-sin-degrees
+                          (+ (* 2 moon-anomaly) sun-anomaly)))
+               (* 0.0004 (solar-sin-degrees
+                          (- sun-anomaly (* 2 moon-anomaly))))
+               (* -0.0003 (solar-sin-degrees
+                          (+ (* 2 sun-anomaly) moon-anomaly))))))
+         (adj (+ 0.0028
+                 (* -0.0004 (solar-cosine-degrees
+                             sun-anomaly))
+                 (* 0.0003 (solar-cosine-degrees
+                            moon-anomaly))))
+         (adjustment (cond ((= phase 1) (+ adjustment adj))
+                           ((= phase 2) (- adjustment adj))
+                           (t adjustment)))
+         (date (+ date adjustment))
+         (calendar-standard-time-zone-name
+          (if calendar-time-zone calendar-standard-time-zone-name "UT"))
+         (calendar-daylight-savings-starts
+          (if calendar-time-zone calendar-daylight-savings-starts))
+         (calendar-daylight-savings-ends
+          (if calendar-time-zone calendar-daylight-savings-ends))
+         (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
+         (year (extract-calendar-year
+                (calendar-gregorian-from-absolute (truncate date))))
+         (dst (and calendar-daylight-savings-starts
+                   calendar-daylight-savings-ends
+                   (<= (calendar-absolute-from-gregorian
+                        (eval calendar-daylight-savings-starts))
+                       date)
+                   (< date
+                      (calendar-absolute-from-gregorian
+                       (eval calendar-daylight-savings-ends)))))
+         (date (+ date 
+                  (/ (+ (if dst 60 0) calendar-time-zone) 60.0 24.0)
+                  (- (/ (solar-ephemeris-correction year) 60.0 24.0))))
+         (time (* 24 (- date (truncate date))))
+         (date (calendar-gregorian-from-absolute (truncate date)))
+         (time-zone calendar-time-zone)
+         (time-zone (if dst
+                        calendar-daylight-time-zone-name
+                        calendar-standard-time-zone-name))
+         (24-hours (truncate time))
+         (12-hours (format "%d" (if (> 24-hours 12)
+                                    (- 24-hours 12)
+                                  (if (= 24-hours 0) 12 24-hours))))
+         (am-pm (if (>= 24-hours 12) "pm" "am"))
+         (minutes (format "%02d" (round (* 60 (- time 24-hours)))))
+         (24-hours (format "%02d" 24-hours))
+         (time (mapconcat 'eval calendar-time-display-form "")))
+    (list date time phase)))
+
+(defun lunar-phase-name (phase)
+  "Name of lunar PHASE.
+0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter."
+  (cond ((= 0 phase) "New Moon")
+        ((= 1 phase) "First Quarter Moon")
+        ((= 2 phase) "Full Moon")
+        ((= 3 phase) "Last Quarter Moon")))
+
+(defun calendar-phases-of-moon ()
+  "Create a buffer with the lunar phases for the current calendar window."
+  (interactive)
+  (message "Computing phases of the moon...")
+  (let ((m1 displayed-month)
+        (y1 displayed-year)
+        (m2 displayed-month)
+        (y2 displayed-year)
+        (lunar-phases-buffer "*Phases of Moon*"))
+    (increment-calendar-month m1 y1 -1)
+    (increment-calendar-month m2 y2 1)
+    (set-buffer (get-buffer-create lunar-phases-buffer))
+    (setq buffer-read-only nil)
+    (calendar-set-mode-line
+          (format "Phases of the moon from %s, %d to %s, %d%%-"
+                  (calendar-month-name m1) y1 (calendar-month-name m2) y2))
+    (erase-buffer)
+    (insert
+     (mapconcat
+      '(lambda (x)
+         (let ((date (car x))
+               (time (car (cdr x)))
+               (phase (car (cdr (cdr x)))))
+           (concat (calendar-date-string date)
+                   ": "
+                   (lunar-phase-name phase)
+                   " "
+                   time)))
+      (lunar-phase-list m1 y1) "\n"))
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (setq buffer-read-only t)
+    (display-buffer lunar-phases-buffer)
+    (message "Computing phases of the moon...done")))
+
+;;;###autoload
+(defun phases-of-moon (&optional arg)
+  "Display the quarters of the moon for last month, this month, and next month.
+If called with an optional prefix argument, prompts for month and year.
+
+This function is suitable for execution in a .emacs file."
+  (interactive "P")
+  (save-excursion
+    (let* ((completion-ignore-case t)
+           (date (calendar-current-date))
+           (displayed-month
+            (if arg
+                (cdr (assoc
+                      (capitalize
+                       (completing-read
+                        "Month name: "
+                        (mapcar 'list (append calendar-month-name-array nil))
+                        nil t))
+                      (calendar-make-alist calendar-month-name-array)))
+              (extract-calendar-month date)))
+           (displayed-year
+            (if arg
+                (calendar-read
+                 "Year (>0): "
+                 '(lambda (x) (> x 0))
+                 (int-to-string
+                  (extract-calendar-year (calendar-current-date))))
+              (extract-calendar-year date))))
+      (calendar-phases-of-moon))))
+
+(defun diary-phases-of-moon ()
+  "Moon phases diary entry."
+  (let* ((index (* 4
+                   (truncate
+                    (* 12.3685
+                       (+ (extract-calendar-year date)
+                          ( / (calendar-day-number date)
+                              366.0)
+                          -1900)))))
+         (phase (lunar-phase index)))
+    (while (calendar-date-compare phase (list date))
+      (setq index (1+ index))
+      (setq phase (lunar-phase index)))
+    (if (calendar-date-equal (car phase) date)
+        (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
+                (car (cdr phase))))))
+
+(provide 'lunar)
+
+;;; lunar.el ends here
diff --git a/lisp/cl.el b/lisp/cl.el
index b675d926fb8..22fda0f4b94 100644
--- a/lisp/cl.el
+++ b/lisp/cl.el
@@ -671,110 +671,55 @@ The forms in BODY should be lists, as non-lists are reserved for new features."
 ;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
 ;;;;       (quiroz@cs.rochester.edu)
 
-(defvar *cl-valid-named-list-accessors*
-    '(first rest second third fourth fifth sixth seventh eighth ninth tenth))
-(defvar *cl-valid-nth-offsets*
-    '((second   . 1)
-      (third    . 2)
-      (fourth   . 3)
-      (fifth    . 4)
-      (sixth    . 5)
-      (seventh  . 6)
-      (eighth   . 7)
-      (ninth    . 8)
-      (tenth    . 9)))
-
-(defun byte-compile-named-list-accessors (form)
-  "Generate code for (<accessor> FORM), where <accessor> is one of the named
-list accessors: first, second, ..., tenth, rest."
-  (let* ((fun       (car form))
-         (arg       (cadr form))
-         (valid     *cl-valid-named-list-accessors*)
-         (offsets   *cl-valid-nth-offsets*))
-    (cond
-
-     ;; Check that it's a form we're prepared to handle.
-     ((not (memq fun valid))
-      (error
-       "cl.el internal bug: `%s' not in {first, ..., tenth, rest}"
-       fun))
-
-     ;; Check the number of arguments.
-     ((not (= (length form) 2))
-      (byte-compile-subr-wrong-args form 1))
-
-     ;; If the result will simply be tossed, don't generate any code for
-     ;; it, and indicate that we have already discarded the value.
-     (for-effect
-      (setq for-effect nil))
-
-     ;; Generate code for the call.
-     ((eq fun 'first)
-      (byte-compile-form arg)
-      (byte-compile-out 'byte-car 0))
-     ((eq fun 'rest)
-      (byte-compile-form arg)
-      (byte-compile-out 'byte-cdr 0))
-     (t                         ;one of the others
-      (byte-compile-constant (cdr (assq fun offsets)))
-      (byte-compile-form arg)
-      (byte-compile-out 'byte-nth 0)))))
+
+
+;;; To make these faster, we define them using defsubst.  This directs the 
+;;; compiler to open-code these functions.
 
 ;;; Synonyms for list functions
-(defun first (x)
+(defsubst first (x)
   "Synonym for `car'"
   (car x))
-(put 'first 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun second (x)
+(defsubst second (x)
   "Return the second element of the list LIST."
   (nth 1 x))
-(put 'second 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun third (x)
+(defsubst third (x)
   "Return the third element of the list LIST."
   (nth 2 x))
-(put 'third 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun fourth (x)
+(defsubst fourth (x)
   "Return the fourth element of the list LIST."
   (nth 3 x))
-(put 'fourth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun fifth (x)
+(defsubst fifth (x)
   "Return the fifth element of the list LIST."
   (nth 4 x))
-(put 'fifth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun sixth (x)
+(defsubst sixth (x)
   "Return the sixth element of the list LIST."
   (nth 5 x))
-(put 'sixth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun seventh (x)
+(defsubst seventh (x)
   "Return the seventh element of the list LIST."
   (nth 6 x))
-(put 'seventh 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun eighth (x)
+(defsubst eighth (x)
   "Return the eighth element of the list LIST."
   (nth 7 x))
-(put 'eighth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun ninth (x)
+(defsubst ninth (x)
   "Return the ninth element of the list LIST."
   (nth 8 x))
-(put 'ninth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun tenth (x)
+(defsubst tenth (x)
   "Return the tenth element of the list LIST."
   (nth 9 x))
-(put 'tenth 'byte-compile 'byte-compile-named-list-accessors)
 
-(defun rest (x)
+(defsubst rest (x)
   "Synonym for `cdr'"
   (cdr x))
-(put 'rest 'byte-compile 'byte-compile-named-list-accessors)
 
 (defun endp (x)
   "t if X is nil, nil if X is a cons; error otherwise."
@@ -845,186 +790,120 @@ SUBLIST must be one of the links in LIST; otherwise the value is LIST itself."
 
 ;;; The popular c[ad]*r functions and other list accessors.
 
-;;; To implement this efficiently, a new byte compile handler is used to
-;;; generate the minimal code, saving one function call.
-
-(defun byte-compile-ca*d*r (form)
-  "Generate code for a (c[ad]+r argument).  This realizes the various
-combinations of car and cdr whose names are supported in this implementation.
-To use this functionality for a given function,just give its name a
-'byte-compile property of 'byte-compile-ca*d*r"
-  (let* ((fun (car form))
-         (arg (cadr form))
-         (seq (mapcar (function (lambda (letter)
-                                  (if (= letter ?a)
-                                      'byte-car 'byte-cdr)))
-                      (cdr (nreverse (cdr (append (symbol-name fun) nil)))))))
-    ;; SEQ is a list of byte-car and byte-cdr in the correct order.
-    (cond
-
-     ;; Is this a function we can handle?
-     ((null seq)
-      (error
-       "cl.el internal bug: `%s' cannot be compiled by byte-compile-ca*d*r"
-       (prin1-to-string form)))
-
-     ;; Are we passing this function the correct number of arguments?
-     ((or (null (cdr form)) (cddr form))
-      (byte-compile-subr-wrong-args form 1))
-
-     ;; Are we evaluating this expression for effect only?
-     (for-effect
-
-      ;; We needn't generate any actual code, as long as we tell the rest 
-      ;; of the compiler that we didn't push anything on the stack.
-      (setq for-effect nil))
-
-     ;; Generate code for the function.
-     (t
-      (byte-compile-form arg)
-      (while seq
-        (byte-compile-out (car seq) 0)
-        (setq seq (cdr seq)))))))
-
-(defun caar (X)
+;;; To implement this efficiently, we define them using defsubst,
+;;; which directs the compiler to open-code these functions.
+
+(defsubst caar (X)
   "Return the car of the car of X."
   (car (car X)))
-(put 'caar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cadr (X)
+(defsubst cadr (X)
   "Return the car of the cdr of X."
   (car (cdr X)))
-(put 'cadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdar (X)
+(defsubst cdar (X)
   "Return the cdr of the car of X."
   (cdr (car X)))
-(put 'cdar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cddr (X)
+(defsubst cddr (X)
   "Return the cdr of the cdr of X."
   (cdr (cdr X)))
-(put 'cddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caaar (X)
+(defsubst caaar (X)
   "Return the car of the car of the car of X."
   (car (car (car X))))
-(put 'caaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caadr (X)
+(defsubst caadr (X)
   "Return the car of the car of the cdr of X."
   (car (car (cdr X))))
-(put 'caadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cadar (X)
+(defsubst cadar (X)
   "Return the car of the cdr of the car of X."
   (car (cdr (car X))))
-(put 'cadar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdaar (X)
+(defsubst cdaar (X)
   "Return the cdr of the car of the car of X."
   (cdr (car (car X))))
-(put 'cdaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caddr (X)
+(defsubst caddr (X)
   "Return the car of the cdr of the cdr of X."
   (car (cdr (cdr X))))
-(put 'caddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdadr (X)
+(defsubst cdadr (X)
   "Return the cdr of the car of the cdr of X."
   (cdr (car (cdr X))))
-(put 'cdadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cddar (X)
+(defsubst cddar (X)
   "Return the cdr of the cdr of the car of X."
   (cdr (cdr (car X))))
-(put 'cddar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdddr (X)
+(defsubst cdddr (X)
   "Return the cdr of the cdr of the cdr of X."
   (cdr (cdr (cdr X))))
-(put 'cdddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caaaar (X)
+(defsubst caaaar (X)
   "Return the car of the car of the car of the car of X."
   (car (car (car (car X)))))
-(put 'caaaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caaadr (X)
+(defsubst caaadr (X)
   "Return the car of the car of the car of the cdr of X."
   (car (car (car (cdr X)))))
-(put 'caaadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caadar (X)
+(defsubst caadar (X)
   "Return the car of the car of the cdr of the car of X."
   (car (car (cdr (car X)))))
-(put 'caadar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cadaar (X)
+(defsubst cadaar (X)
   "Return the car of the cdr of the car of the car of X."
   (car (cdr (car (car X)))))
-(put 'cadaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdaaar (X)
+(defsubst cdaaar (X)
   "Return the cdr of the car of the car of the car of X."
   (cdr (car (car (car X)))))
-(put 'cdaaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caaddr (X)
+(defsubst caaddr (X)
   "Return the car of the car of the cdr of the cdr of X."
   (car (car (cdr (cdr X)))))
-(put 'caaddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cadadr (X)
+(defsubst cadadr (X)
   "Return the car of the cdr of the car of the cdr of X."
   (car (cdr (car (cdr X)))))
-(put 'cadadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdaadr (X)
+(defsubst cdaadr (X)
   "Return the cdr of the car of the car of the cdr of X."
   (cdr (car (car (cdr X)))))
-(put 'cdaadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun caddar (X)
+(defsubst caddar (X)
   "Return the car of the cdr of the cdr of the car of X."
   (car (cdr (cdr (car X)))))
-(put 'caddar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdadar (X)
+(defsubst cdadar (X)
   "Return the cdr of the car of the cdr of the car of X."
   (cdr (car (cdr (car X)))))
-(put 'cdadar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cddaar (X)
+(defsubst cddaar (X)
   "Return the cdr of the cdr of the car of the car of X."
   (cdr (cdr (car (car X)))))
-(put 'cddaar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cadddr (X)
+(defsubst cadddr (X)
   "Return the car of the cdr of the cdr of the cdr of X."
   (car (cdr (cdr (cdr X)))))
-(put 'cadddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cddadr (X)
+(defsubst cddadr (X)
   "Return the cdr of the cdr of the car of the cdr of X."
   (cdr (cdr (car (cdr X)))))
-(put 'cddadr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdaddr (X)
+(defsubst cdaddr (X)
   "Return the cdr of the car of the cdr of the cdr of X."
   (cdr (car (cdr (cdr X)))))
-(put 'cdaddr 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cdddar (X)
+(defsubst cdddar (X)
   "Return the cdr of the cdr of the cdr of the car of X."
   (cdr (cdr (cdr (car X)))))
-(put 'cdddar 'byte-compile 'byte-compile-ca*d*r)
 
-(defun cddddr (X)
+(defsubst cddddr (X)
   "Return the cdr of the cdr of the cdr of the cdr of X."
   (cdr (cdr (cdr (cdr X)))))
-(put 'cddddr 'byte-compile 'byte-compile-ca*d*r)
 
 ;;; some inverses of the accessors are needed for setf purposes
 
diff --git a/lisp/cmulisp.el b/lisp/cmulisp.el
new file mode 100644
index 00000000000..11fc14af064
--- /dev/null
+++ b/lisp/cmulisp.el
@@ -0,0 +1,684 @@
+;;; cmulisp.el --- improved version of standard inferior-lisp mode
+
+;;; Copyright Olin Shivers (1988).
+;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
+;;; notice appearing here to the effect that you may use this code any
+;;; way you like, as long as you don't charge money for it, remove this
+;;; notice, or hold me liable for its results.
+
+;;; This replaces the standard inferior-lisp mode.
+;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
+;;; Please send me bug reports, bug fixes, and extensions, so that I can
+;;; merge them into the master source.
+;;;
+;;; Change log at end of file.
+
+;;; This file defines a a lisp-in-a-buffer package (cmulisp mode) built on top
+;;; of comint mode.  Cmulisp mode is similar to, and intended to replace, its
+;;; counterpart in the standard gnu emacs release. This replacements is more
+;;; featureful, robust, and uniform than the released version.  The key
+;;; bindings are also more compatible with the bindings of Hemlock and Zwei
+;;; (the Lisp Machine emacs).
+
+;;; Since this mode is built on top of the general command-interpreter-in-
+;;; a-buffer mode (comint mode), it shares a common base functionality, 
+;;; and a common set of bindings, with all modes derived from comint mode.
+;;; This makes these modes easier to use.
+
+;;; For documentation on the functionality provided by comint mode, and
+;;; the hooks available for customising it, see the file comint.el.
+;;; For further information on cmulisp mode, see the comments below.
+
+;;; Needs fixin:
+;;; The load-file/compile-file default mechanism could be smarter -- it
+;;; doesn't know about the relationship between filename extensions and
+;;; whether the file is source or executable. If you compile foo.lisp
+;;; with compile-file, then the next load-file should use foo.bin for
+;;; the default, not foo.lisp. This is tricky to do right, particularly
+;;; because the extension for executable files varies so much (.o, .bin,
+;;; .lbin, .mo, .vo, .ao, ...).
+;;;
+;;; It would be nice if cmulisp (and inferior scheme, T, ...) modes
+;;; had a verbose minor mode wherein sending or compiling defuns, etc.
+;;; would be reflected in the transcript with suitable comments, e.g.
+;;; ";;; redefining fact". Several ways to do this. Which is right?
+;;;
+;;; When sending text from a source file to a subprocess, the process-mark can 
+;;; move off the window, so you can lose sight of the process interactions.
+;;; Maybe I should ensure the process mark is in the window when I send
+;;; text to the process? Switch selectable?
+
+(require 'comint)
+;; YOUR .EMACS FILE
+;;=============================================================================
+;; Some suggestions for your .emacs file.
+;;
+;; ; If cmulisp lives in some non-standard directory, you must tell emacs
+;; ; where to get it. This may or may not be necessary.
+;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
+;;
+;; ; Autoload cmulisp from file cmulisp.el
+;; (autoload 'cmulisp "cmulisp"
+;;           "Run an inferior Lisp process."
+;;           t)
+;;
+;; ; Define C-c t to run my favorite command in cmulisp mode:
+;; (setq cmulisp-load-hook
+;;       '((lambda () 
+;;           (define-key cmulisp-mode-map "\C-ct" 'favorite-cmd))))
+
+
+;;; Brief Command Documentation:
+;;;============================================================================
+;;; Comint Mode Commands: (common to cmulisp and all comint-derived modes)
+;;;
+;;; m-p     comint-previous-input           Cycle backwards in input history
+;;; m-n     comint-next-input               Cycle forwards
+;;; m-c-r   comint-previous-input-matching  Search backwards in input history
+;;; return  comint-send-input
+;;; c-a     comint-bol                      Beginning of line; skip prompt.
+;;; c-d     comint-delchar-or-maybe-eof     Delete char unless at end of buff.
+;;; c-c c-u comint-kill-input               ^u
+;;; c-c c-w backward-kill-word              ^w
+;;; c-c c-c comint-interrupt-subjob         ^c
+;;; c-c c-z comint-stop-subjob              ^z
+;;; c-c c-\ comint-quit-subjob              ^\
+;;; c-c c-o comint-kill-output              Delete last batch of process output
+;;; c-c c-r comint-show-output              Show last batch of process output
+;;;         send-invisible                  Read line w/o echo & send to proc
+;;;         comint-continue-subjob          Useful if you accidentally suspend
+;;;                                             top-level job.
+;;; comint-mode-hook is the comint mode hook.
+
+;;; CMU Lisp Mode Commands:
+;;; c-m-x   lisp-send-defun     This binding is a gnu convention.
+;;; c-c c-l lisp-load-file      Prompt for file name; tell Lisp to load it.
+;;; c-c c-k lisp-compile-file   Prompt for file name; tell Lisp to kompile it.
+;;;                             Filename completion is available, of course.
+;;;
+;;; Additionally, these commands are added to the key bindings of Lisp mode:
+;;; c-m-x   lisp-eval-defun         This binding is a gnu convention.
+;;; c-c c-e lisp-eval-defun         Send the current defun to Lisp process.
+;;; c-x c-e lisp-eval-last-sexp     Send the previous sexp to Lisp process.
+;;; c-c c-r lisp-eval-region        Send the current region to Lisp process.
+;;; c-c c-c lisp-compile-defun      Compile the current defun in Lisp process.
+;;; c-c c-z switch-to-lisp          Switch to the Lisp process buffer.
+;;; c-c c-l lisp-load-file          (See above. In a Lisp file buffer, default
+;;; c-c c-k lisp-compile-file        is to load/compile the current file.)
+;;; c-c c-d lisp-describe-sym       Query Lisp for a symbol's description.
+;;; c-c c-a lisp-show-arglist       Query Lisp for function's arglist.
+;;; c-c c-f lisp-show-function-documentation Query Lisp for a function's doc.
+;;; c-c c-v lisp-show-variable-documentation Query Lisp for a variable's doc.
+
+;;; cmulisp                         Fires up the Lisp process.
+;;; lisp-compile-region             Compile all forms in the current region.
+;;;
+;;; CMU Lisp Mode Variables:
+;;; cmulisp-filter-regexp           Match this => don't get saved on input hist
+;;; inferior-lisp-program           Name of Lisp program run-lisp executes
+;;; inferior-lisp-load-command      Customises lisp-load-file
+;;; cmulisp-mode-hook       
+;;; inferior-lisp-prompt            Initialises comint-prompt-regexp.
+;;;                                 Backwards compatibility.
+;;; lisp-source-modes               Anything loaded into a buffer that's in
+;;;                                 one of these modes is considered Lisp 
+;;;                                 source by lisp-load/compile-file.
+
+;;; Read the rest of this file for more information.
+
+(defvar cmulisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
+  "*What not to save on inferior Lisp's input history
+Input matching this regexp is not saved on the input history in cmulisp
+mode. Default is whitespace followed by 0 or 1 single-letter :keyword 
+(as in :a, :c, etc.)")
+
+(defvar cmulisp-mode-map nil)
+(cond ((not cmulisp-mode-map)
+       (setq cmulisp-mode-map
+             (full-copy-sparse-keymap comint-mode-map))
+       (lisp-mode-commands cmulisp-mode-map)
+       (define-key cmulisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
+       (define-key cmulisp-mode-map "\C-c\C-l" 'lisp-load-file)
+       (define-key cmulisp-mode-map "\C-c\C-k" 'lisp-compile-file)
+       (define-key cmulisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
+       (define-key cmulisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
+       (define-key cmulisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
+       (define-key cmulisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)))
+
+;;; These commands augment Lisp mode, so you can process Lisp code in
+;;; the source files.
+(define-key lisp-mode-map "\M-\C-x"  'lisp-eval-defun)     ; Gnu convention
+(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
+(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
+(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
+(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
+(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
+(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
+(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file)  ; "kompile" file
+(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
+(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
+(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
+(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
+
+
+;;; This function exists for backwards compatibility.
+;;; Previous versions of this package bound commands to C-c <letter>
+;;; bindings, which is not allowed by the gnumacs standard.
+
+(defun cmulisp-install-letter-bindings ()
+  "This function binds many cmulisp commands to C-c <letter> bindings,
+where they are more accessible. C-c <letter> bindings are reserved for the
+user, so these bindings are non-standard. If you want them, you should
+have this function called by the cmulisp-load-hook:
+    (setq cmulisp-load-hook '(cmulisp-install-letter-bindings))
+You can modify this function to install just the bindings you want."
+
+  (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
+  (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go)
+  (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go)
+  (define-key lisp-mode-map "\C-cz" 'switch-to-lisp)
+  (define-key lisp-mode-map "\C-cl" 'lisp-load-file)
+  (define-key lisp-mode-map "\C-ck" 'lisp-compile-file)
+  (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist)
+  (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym)
+  (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
+  (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)
+
+  (define-key cmulisp-mode-map "\C-cl" 'lisp-load-file)
+  (define-key cmulisp-mode-map "\C-ck" 'lisp-compile-file)
+  (define-key cmulisp-mode-map "\C-ca" 'lisp-show-arglist)
+  (define-key cmulisp-mode-map "\C-cd" 'lisp-describe-sym)
+  (define-key cmulisp-mode-map "\C-cf" 'lisp-show-function-documentation)
+  (define-key cmulisp-mode-map "\C-cv" 'lisp-show-variable-documentation))
+
+
+(defvar inferior-lisp-program "lisp"
+  "*Program name for invoking an inferior Lisp with `cmulisp'.")
+
+(defvar inferior-lisp-load-command "(load \"%s\")\n"
+  "*Format-string for building a Lisp expression to load a file.
+This format string should use %s to substitute a file name
+and should result in a Lisp expression that will command the inferior Lisp
+to load that file.  The default works acceptably on most Lisps.
+The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\\n\"
+produces cosmetically superior output for this application,
+but it works only in Common Lisp.")
+
+(defvar inferior-lisp-prompt "^[^> ]*>+:? *"
+  "Regexp to recognise prompts in the inferior Lisp.
+Defaults to \"^[^> ]*>+:? *\", which works pretty good for Lucid, kcl,
+and franz. This variable is used to initialise comint-prompt-regexp in the 
+cmulisp buffer.
+
+More precise choices:
+Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
+franz: \"^\\(->\\|<[0-9]*>:\\) *\"
+kcl: \"^>+ *\"
+
+This is a fine thing to set in your .emacs file.")
+
+(defvar cmulisp-mode-hook '()
+  "*Hook for customising cmulisp mode")
+
+(defun cmulisp-mode () 
+  "Major mode for interacting with an inferior Lisp process.  
+Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an
+Emacs buffer.  Variable inferior-lisp-program controls which Lisp interpreter
+is run.  Variables inferior-lisp-prompt, cmulisp-filter-regexp and
+inferior-lisp-load-command can customize this mode for different Lisp
+interpreters.
+
+For information on running multiple processes in multiple buffers, see
+documentation for variable cmulisp-buffer.
+
+\\{cmulisp-mode-map}
+
+Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+cmulisp-mode-hook (in that order).
+
+You can send text to the inferior Lisp process from other buffers containing
+Lisp source.  
+    switch-to-lisp switches the current buffer to the Lisp process buffer.
+    lisp-eval-defun sends the current defun to the Lisp process.
+    lisp-compile-defun compiles the current defun.
+    lisp-eval-region sends the current region to the Lisp process.
+    lisp-compile-region compiles the current region.
+
+    Prefixing the lisp-eval/compile-defun/region commands with
+    a \\[universal-argument] causes a switch to the Lisp process buffer after sending
+    the text.
+
+Commands:
+Return after the end of the process' output sends the text from the 
+    end of process to point.
+Return before the end of the process' output copies the sexp ending at point
+    to the end of the process' output, and sends it.
+Delete converts tabs to spaces as it moves back.
+Tab indents for Lisp; with argument, shifts rest
+    of expression rigidly with the current line.
+C-M-q does Tab on each line starting within following expression.
+Paragraphs are separated only by blank lines.  Semicolons start comments.
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp inferior-lisp-prompt)
+  (setq major-mode 'cmulisp-mode)
+  (setq mode-name "CMU Lisp")
+  (setq mode-line-process '(": %s"))
+  (if (string-match "^18.4" emacs-version) ; hack.
+      (lisp-mode-variables)    ; This is right for 18.49  
+      (lisp-mode-variables t)) ; This is right for 18.50
+  (use-local-map cmulisp-mode-map)    ;c-c c-k for "kompile" file
+  (setq comint-get-old-input (function lisp-get-old-input))
+  (setq comint-input-filter (function lisp-input-filter))
+  (setq comint-input-sentinel 'ignore)
+  (run-hooks 'cmulisp-mode-hook))
+
+(defun lisp-get-old-input ()
+  "Snarf the sexp ending at point"
+  (save-excursion
+    (let ((end (point)))
+      (backward-sexp)
+      (buffer-substring (point) end))))
+
+(defun lisp-input-filter (str)
+  "Don't save anything matching cmulisp-filter-regexp"
+  (not (string-match cmulisp-filter-regexp str)))
+
+(defun cmulisp (cmd)
+  "Run an inferior Lisp process, input and output via buffer *cmulisp*.
+If there is a process already running in *cmulisp*, just switch to that buffer.
+With argument, allows you to edit the command line (default is value
+of inferior-lisp-program).  Runs the hooks from cmulisp-mode-hook (after the
+comint-mode-hook is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+  (interactive (list (if current-prefix-arg
+                         (read-string "Run lisp: " inferior-lisp-program)
+                         inferior-lisp-program)))
+  (if (not (comint-check-proc "*cmulisp*"))
+      (let ((cmdlist (cmulisp-args-to-list cmd)))
+         (set-buffer (apply (function make-comint) "cmulisp" (car cmdlist) nil
+                            (cdr cmdlist)))
+         (cmulisp-mode)))
+  (setq cmulisp-buffer "*cmulisp*")
+  (switch-to-buffer "*cmulisp*"))
+
+;;; Break a string up into a list of arguments.
+;;; This will break if you have an argument with whitespace, as in
+;;; string = "-ab +c -x 'you lose'".
+(defun cmulisp-args-to-list (string)
+  (let ((where (string-match "[ \t]" string)))
+    (cond ((null where) (list string))
+          ((not (= where 0))
+           (cons (substring string 0 where)
+                 (tea-args-to-list (substring string (+ 1 where)
+                                              (length string)))))
+          (t (let ((pos (string-match "[^ \t]" string)))
+               (if (null pos)
+                   nil
+                 (cmulsip-args-to-list (substring string pos
+                                                  (length string)))))))))
+
+(defun lisp-eval-region (start end &optional and-go)
+  "Send the current region to the inferior Lisp process.
+Prefix argument means switch-to-lisp afterwards."
+  (interactive "r\nP")
+  (comint-send-region (cmulisp-proc) start end)
+  (comint-send-string (cmulisp-proc) "\n")
+  (if and-go (switch-to-lisp t)))
+
+(defun lisp-eval-defun (&optional and-go)
+  "Send the current defun to the inferior Lisp process.
+Prefix argument means switch-to-lisp afterwards."
+  (interactive "P")
+  (save-excursion
+    (end-of-defun)
+    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
+    (let ((end (point)))
+      (beginning-of-defun)
+      (lisp-eval-region (point) end)))
+  (if and-go (switch-to-lisp t)))
+
+(defun lisp-eval-last-sexp (&optional and-go)
+  "Send the previous sexp to the inferior Lisp process.
+Prefix argument means switch-to-lisp afterwards."
+  (interactive "P")
+  (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
+
+;;; Common Lisp COMPILE sux. 
+(defun lisp-compile-region (start end &optional and-go)
+  "Compile the current region in the inferior Lisp process.
+Prefix argument means switch-to-lisp afterwards."
+  (interactive "r\nP")
+  (comint-send-string (cmulisp-proc)
+    (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
+            (buffer-substring start end)))
+  (if and-go (switch-to-lisp t)))
+                         
+(defun lisp-compile-defun (&optional and-go)
+  "Compile the current defun in the inferior Lisp process.
+Prefix argument means switch-to-lisp afterwards."
+  (interactive "P")
+  (save-excursion
+    (end-of-defun)
+    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
+    (let ((e (point)))
+      (beginning-of-defun)
+      (lisp-compile-region (point) e)))
+  (if and-go (switch-to-lisp t)))
+
+(defun switch-to-lisp (eob-p)
+  "Switch to the inferior Lisp process buffer.
+With argument, positions cursor at end of buffer."
+  (interactive "P")
+  (if (get-buffer cmulisp-buffer)
+      (pop-to-buffer cmulisp-buffer)
+      (error "No current process buffer. See variable cmulisp-buffer."))
+  (cond (eob-p
+         (push-mark)
+         (goto-char (point-max)))))
+
+
+;;; Now that lisp-compile/eval-defun/region takes an optional prefix arg,
+;;; these commands are redundant. But they are kept around for the user
+;;; to bind if he wishes, for backwards functionality, and because it's
+;;; easier to type C-c e than C-u C-c C-e.
+
+(defun lisp-eval-region-and-go (start end)
+  "Send the current region to the inferior Lisp, 
+and switch to the process buffer."
+  (interactive "r")
+  (lisp-eval-region start end t))
+
+(defun lisp-eval-defun-and-go ()
+  "Send the current defun to the inferior Lisp, 
+and switch to the process buffer."
+  (interactive)
+  (lisp-eval-defun t))
+
+(defun lisp-compile-region-and-go (start end)
+  "Compile the current region in the inferior Lisp, 
+and switch to the process buffer."
+  (interactive "r")
+  (lisp-compile-region start end t))
+
+(defun lisp-compile-defun-and-go ()
+  "Compile the current defun in the inferior Lisp, 
+and switch to the process buffer."
+  (interactive)
+  (lisp-compile-defun t))
+
+;;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
+;(defun lisp-compile-sexp (start end)
+;  "Compile the s-expression bounded by START and END in the inferior lisp.
+;If the sexp isn't a DEFUN form, it is evaluated instead."
+;    (cond ((looking-at "(defun\\s +")
+;          (goto-char (match-end 0))
+;          (let ((name-start (point)))
+;            (forward-sexp 1)
+;            (process-send-string "cmulisp" (format "(compile '%s #'(lambda "
+;                                                (buffer-substring name-start
+;                                                                  (point)))))
+;          (let ((body-start (point)))
+;            (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
+;            (process-send-region "cmulisp" (buffer-substring body-start (point))))
+;          (process-send-string "cmulisp" ")\n"))
+;         (t (lisp-eval-region start end)))))
+;
+;(defun lisp-compile-region (start end)
+;  "Each s-expression in the current region is compiled (if a DEFUN)
+;or evaluated (if not) in the inferior lisp."
+;  (interactive "r")
+;  (save-excursion
+;    (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
+;    (if (< (point) start) (error "region begins in middle of defun"))
+;    (goto-char start)
+;    (let ((s start))
+;      (end-of-defun)
+;      (while (<= (point) end) ; Zip through
+;       (lisp-compile-sexp s (point)) ; compiling up defun-sized chunks.
+;       (setq s (point))
+;       (end-of-defun))
+;      (if (< s end) (lisp-compile-sexp s end)))))
+;;;
+;;; End of HS-style code
+
+
+(defvar lisp-prev-l/c-dir/file nil
+  "Saves the (directory . file) pair used in the last lisp-load-file or
+lisp-compile-file command. Used for determining the default in the 
+next one.")
+
+(defvar lisp-source-modes '(lisp-mode)
+  "*Used to determine if a buffer contains Lisp source code.
+If it's loaded into a buffer that is in one of these major modes, it's
+considered a Lisp source file by lisp-load-file and lisp-compile-file.
+Used by these commands to determine defaults.")
+
+(defun lisp-load-file (file-name)
+  "Load a Lisp file into the inferior Lisp process."
+  (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
+                                  lisp-source-modes nil)) ; NIL because LOAD
+                                                   ; doesn't need an exact name
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
+                                     (file-name-nondirectory file-name)))
+  (comint-send-string (cmulisp-proc)
+                      (format inferior-lisp-load-command file-name))
+  (switch-to-lisp t))
+
+
+(defun lisp-compile-file (file-name)
+  "Compile a Lisp file in the inferior Lisp process."
+  (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
+                                  lisp-source-modes nil)) ; NIL = don't need
+                                                          ; suffix .lisp
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
+                                     (file-name-nondirectory file-name)))
+  (comint-send-string (cmulisp-proc) (concat "(compile-file \""
+                                             file-name
+                                             "\"\)\n"))
+  (switch-to-lisp t))
+
+
+
+;;; Documentation functions: function doc, var doc, arglist, and
+;;; describe symbol.
+;;; ===========================================================================
+
+;;; Command strings
+;;; ===============
+
+(defvar lisp-function-doc-command
+  "(let ((fn '%s))
+     (format t \"Documentation for ~a:~&~a\"
+             fn (documentation fn 'function))
+     (values))\n"
+  "Command to query inferior Lisp for a function's documentation.")
+
+(defvar lisp-var-doc-command
+  "(let ((v '%s))
+     (format t \"Documentation for ~a:~&~a\"
+             v (documentation v 'variable))
+     (values))\n"
+  "Command to query inferior Lisp for a variable's documentation.")
+
+(defvar lisp-arglist-command
+  "(let ((fn '%s))
+     (format t \"Arglist for ~a: ~a\" fn (arglist fn))
+     (values))\n"
+  "Command to query inferior Lisp for a function's arglist.")
+
+(defvar lisp-describe-sym-command
+  "(describe '%s)\n"
+  "Command to query inferior Lisp for a variable's documentation.")
+
+
+;;; Ancillary functions
+;;; ===================
+
+;;; Reads a string from the user.
+(defun lisp-symprompt (prompt default)
+  (list (let* ((prompt (if default
+                           (format "%s (default %s): " prompt default)
+                           (concat prompt ": ")))
+               (ans (read-string prompt)))
+          (if (zerop (length ans)) default ans))))
+
+
+;;; Adapted from function-called-at-point in help.el.
+(defun lisp-fn-called-at-pt ()
+  "Returns the name of the function called in the current call.
+Nil if it can't find one."
+  (condition-case nil
+      (save-excursion
+        (save-restriction
+          (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
+          (backward-up-list 1)
+          (forward-char 1)
+          (let ((obj (read (current-buffer))))
+            (and (symbolp obj) obj))))
+    (error nil)))
+
+
+;;; Adapted from variable-at-point in help.el.
+(defun lisp-var-at-pt ()
+  (condition-case ()
+      (save-excursion
+        (forward-sexp -1)
+        (skip-chars-forward "'")
+        (let ((obj (read (current-buffer))))
+          (and (symbolp obj) obj)))
+    (error nil)))
+
+
+;;; Documentation functions: fn and var doc, arglist, and symbol describe.
+;;; ======================================================================
+
+(defun lisp-show-function-documentation (fn)
+  "Send a command to the inferior Lisp to give documentation for function FN.
+See variable lisp-function-doc-command."
+  (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-function-doc-command fn)))
+
+(defun lisp-show-variable-documentation (var)
+  "Send a command to the inferior Lisp to give documentation for function FN.
+See variable lisp-var-doc-command."
+  (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-var-doc-command var)))
+
+(defun lisp-show-arglist (fn)
+  "Sends an query to the inferior Lisp for the arglist for function FN.
+See variable lisp-arglist-command."
+  (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-arglist-command fn)))
+
+(defun lisp-describe-sym (sym)
+  "Send a command to the inferior Lisp to describe symbol SYM.
+See variable lisp-describe-sym-command."
+  (interactive (lisp-symprompt "Describe" (lisp-var-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-describe-sym-command sym)))
+
+
+(defvar cmulisp-buffer nil "*The current cmulisp process buffer.
+
+MULTIPLE PROCESS SUPPORT
+===========================================================================
+Cmulisp.el supports, in a fairly simple fashion, running multiple Lisp
+processes. To run multiple Lisp processes, you start the first up with
+\\[cmulisp]. It will be in a buffer named *cmulisp*. Rename this buffer
+with \\[rename-buffer]. You may now start up a new process with another
+\\[cmulisp]. It will be in a new buffer, named *cmulisp*. You can
+switch between the different process buffers with \\[switch-to-buffer].
+
+Commands that send text from source buffers to Lisp processes --
+like lisp-eval-defun or lisp-show-arglist -- have to choose a process
+to send to, when you have more than one Lisp process around. This
+is determined by the global variable cmulisp-buffer. Suppose you
+have three inferior lisps running:
+    Buffer      Process
+    foo         cmulisp
+    bar         cmulisp<2>
+    *cmulisp*   cmulisp<3>
+If you do a \\[lisp-eval-defun] command on some Lisp source code, 
+what process do you send it to?
+
+- If you're in a process buffer (foo, bar, or *cmulisp*), 
+  you send it to that process.
+- If you're in some other buffer (e.g., a source file), you
+  send it to the process attached to buffer cmulisp-buffer.
+This process selection is performed by function cmulisp-proc.
+
+Whenever \\[cmulisp] fires up a new process, it resets cmulisp-buffer
+to be the new process's buffer. If you only run one process, this will
+do the right thing. If you run multiple processes, you can change
+cmulisp-buffer to another process buffer with \\[set-variable].
+
+More sophisticated approaches are, of course, possible. If you find youself
+needing to switch back and forth between multiple processes frequently,
+you may wish to consider ilisp.el, a larger, more sophisticated package
+for running inferior Lisp processes. The approach taken here is for a
+minimal, simple implementation. Feel free to extend it.")
+
+(defun cmulisp-proc ()
+  "Returns the current cmulisp process. See variable cmulisp-buffer."
+  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
+                                      (current-buffer)
+                                      cmulisp-buffer))))
+    (or proc
+        (error "No current process. See variable cmulisp-buffer"))))
+
+
+;;; Do the user's customisation...
+;;;===============================
+(defvar cmulisp-load-hook nil
+  "This hook is run when cmulisp is loaded in.
+This is a good place to put keybindings.")
+        
+(run-hooks 'cmulisp-load-hook)
+
+;;; CHANGE LOG
+;;; ===========================================================================
+;;; 5/24/90 Olin
+;;; - Split cmulisp and cmushell modes into separate files. 
+;;;   Not only is this a good idea, it's apparently the way it'll be rel 19.
+;;; - Upgraded process sends to use comint-send-string instead of
+;;;   process-send-string.
+;;; - Explicit references to process "cmulisp" have been replaced with
+;;;   (cmulisp-proc). This allows better handling of multiple process bufs.
+;;; - Added process query and var/function/symbol documentation
+;;;   commands. Based on code written by Douglas Roberts.
+;;; - Added lisp-eval-last-sexp, bound to C-x C-e.
+;;;
+;;; 9/20/90 Olin
+;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix
+;;; reported by Lennart Staflin.
+;;;
+;;; 3/12/90 Olin
+;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp.
+;;;   Tale suggested this.
+;;; - Reversed this decision 7/15/91. You need the visual feedback.
+;;;
+;;; 7/25/91 Olin
+;;; Changed all keybindings of the form C-c <letter>. These are
+;;; supposed to be reserved for the user to bind. This affected
+;;; mainly the compile/eval-defun/region[-and-go] commands.
+;;; This was painful, but necessary to adhere to the gnumacs standard.
+;;; For some backwards compatibility, see the 
+;;;     cmulisp-install-letter-bindings
+;;; function.
+;;;
+;;; 8/2/91 Olin
+;;; - The lisp-compile/eval-defun/region commands now take a prefix arg,
+;;;   which means switch-to-lisp after sending the text to the Lisp process.
+;;;   This obsoletes all the -and-go commands. The -and-go commands are
+;;;   kept around for historical reasons, and because the user can bind
+;;;   them to key sequences shorter than C-u C-c C-<letter>.
+;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to
+;;;   edit the command line.
+
+(provide 'cmulisp)
+
+;;; cmulisp.el ends here
diff --git a/lisp/diary-ins.el b/lisp/diary-ins.el
new file mode 100644
index 00000000000..1ac2c0bfc0c
--- /dev/null
+++ b/lisp/diary-ins.el
@@ -0,0 +1,262 @@
+;;; diary-insert.el --- calendar functions for adding diary entries.
+
+;; Copyright (C) 1990 Free Software Foundation, Inc.
+
+;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Keywords: diary, calendar
+
+;; 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 diary insertion features as
+;; described in calendar.el.
+
+;; 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 'diary)
+
+(defun make-diary-entry (string &optional nonmarking file)
+  "Insert a diary entry STRING which may be NONMARKING in FILE.
+If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
+  (find-file-other-window
+   (substitute-in-file-name (if file file diary-file)))
+  (goto-char (point-max))
+  (insert
+   (if (bolp) "" "\n")
+   (if nonmarking diary-nonmarking-symbol "")
+   string " "))
+
+(defun insert-diary-entry (arg)
+  "Insert a diary entry for the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry
+   (calendar-date-string
+    (or (calendar-cursor-to-date)
+        (error "Cursor is not on a date!"))
+    t t)
+   arg))
+
+(defun insert-weekly-diary-entry (arg)
+  "Insert a weekly diary entry for the day of the week indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry
+   (calendar-day-name
+    (or (calendar-cursor-to-date)
+        (error "Cursor is not on a date!")))
+   arg))
+
+(defun insert-monthly-diary-entry (arg)
+  "Insert a monthly diary entry for the day of the month indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " * ")
+            '("* " day))))
+    (make-diary-entry
+     (calendar-date-string
+      (or (calendar-cursor-to-date)
+          (error "Cursor is not on a date!"))
+      t)
+     arg)))
+
+(defun insert-yearly-diary-entry (arg)
+  "Insert an annual diary entry for the day of the year indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day))))
+    (make-diary-entry
+     (calendar-date-string
+      (or (calendar-cursor-to-date)
+          (error "Cursor is not on a date!"))
+      t)
+     arg)))
+
+(defun insert-anniversary-diary-entry (arg)
+  "Insert an anniversary diary entry for the date given by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry
+   (format "%s(diary-anniversary %s)"
+           sexp-diary-entry-symbol
+           (calendar-date-string
+            (or (calendar-cursor-to-date)
+                (error "Cursor is not on a date!"))
+            nil t))
+   arg))
+
+(defun insert-block-diary-entry (arg)
+  "Insert a block diary entry for the days between the point and marked date.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((cursor (or (calendar-cursor-to-date)
+                     (error "Cursor is not on a date!")))
+         (mark (or (car calendar-mark-ring)
+                   (error "No mark set in this buffer")))
+         (start)
+         (end))
+    (if (< (calendar-absolute-from-gregorian mark)
+           (calendar-absolute-from-gregorian cursor))
+        (setq start mark
+              end cursor)
+      (setq start cursor
+              end mark))
+    (make-diary-entry
+     (format "%s(diary-block %s %s)"
+      sexp-diary-entry-symbol
+      (calendar-date-string start nil t)
+      (calendar-date-string end nil t))
+     arg)))
+
+(defun insert-cyclic-diary-entry (arg)
+  "Insert a cyclic diary entry starting at the date given by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry
+   (format "%s(diary-cyclic %d %s)"
+           sexp-diary-entry-symbol
+           (calendar-read "Repeat every how many days: "
+                          '(lambda (x) (> x 0)))
+           (calendar-date-string
+            (or (calendar-cursor-to-date)
+                (error "Cursor is not on a date!"))
+            nil t))
+   arg))
+
+(defun insert-hebrew-diary-entry (arg)
+  "Insert a diary entry for the Hebrew date corresponding to the date
+indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))
+       nil t))
+     arg)))
+
+(defun insert-monthly-hebrew-diary-entry (arg)
+  "Insert a monthly diary entry for the day of the Hebrew month corresponding
+to the date indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style '(day " * ") '("* " day )))
+         (calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))))
+     arg)))
+
+(defun insert-yearly-hebrew-diary-entry (arg)
+  "Insert an annual diary entry for the day of the Hebrew year corresponding
+to the date indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day)))
+         (calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))))
+     arg)))
+
+(defun insert-islamic-diary-entry (arg)
+  "Insert a diary entry for the Islamic date corresponding to the date
+indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))
+       nil t))
+     arg)))
+
+(defun insert-monthly-islamic-diary-entry (arg)
+  "Insert a monthly diary entry for the day of the Islamic month corresponding
+to the date indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style '(day " * ") '("* " day )))
+         (calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))))
+     arg)))
+
+(defun insert-yearly-islamic-diary-entry (arg)
+  "Insert an annual diary entry for the day of the Islamic year corresponding
+to the date indicated by point.  Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day)))
+         (calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (or (calendar-cursor-to-date)
+             (error "Cursor is not on a date!"))))))
+     arg)))
+
+(provide 'diary-insert)
+
+;;; diary-insert.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 008a9967322..d4789564f5f 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -234,9 +234,9 @@
   (let ((lambda (car form))
         (values (cdr form)))
     (if (compiled-function-p lambda)
-        (setq lambda (list 'lambda (nth 0 form)
-                           (list 'byte-code
-                                 (nth 1 form) (nth 2 form) (nth 3 form)))))
+        (setq lambda (list 'lambda (aref lambda 0)
+                           (list 'byte-code (aref lambda 1)
+                                 (aref lambda 2) (aref lambda 3)))))
     (let ((arglist (nth 1 lambda))
           (body (cdr (cdr lambda)))
           optionalp restp
@@ -913,7 +913,8 @@
                 (eq (car-safe last) 'quote))
             (if (listp (nth 1 last))
                 (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
-                  (nconc (list 'funcall fn) butlast (nth 1 last)))
+                  (nconc (list 'funcall fn) butlast
+                         (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
               (byte-compile-warn
                "last arg to apply can't be a literal atom: %s"
                (prin1-to-string last))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 820ae27389e..5706990ea56 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -142,6 +142,7 @@
 (require 'lisp-mode)
 
 
+;;;###autoload
 (defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
   "*What not to save on inferior Lisp's input history
 Input matching this regexp is not saved on the input history in inferior-lisp
@@ -212,9 +213,11 @@ You can modify this function to install just the bindings you want."
     'lisp-show-variable-documentation))
 
 
+;;;###autoload
 (defvar inferior-lisp-program "lisp"
   "*Program name for invoking an inferior Lisp with `inferior-lisp'.")
 
+;;;###autoload
 (defvar inferior-lisp-load-command "(load \"%s\")\n"
   "*Format-string for building a Lisp expression to load a file.
 This format string should use %s to substitute a file name
@@ -224,6 +227,7 @@ The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\\n\"
 produces cosmetically superior output for this application,
 but it works only in Common Lisp.")
 
+;;;###autoload
 (defvar inferior-lisp-prompt "^[^> ]*>+:? *"
   "Regexp to recognise prompts in the inferior Lisp.
 Defaults to \"^[^> ]*>+:? *\", which works pretty good for Lucid, kcl,
@@ -237,6 +241,7 @@ kcl: \"^>+ *\"
 
 This is a fine thing to set in your .emacs file.")
 
+;;;###autoload
 (defvar inferior-lisp-mode-hook '()
   "*Hook for customising inferior-lisp mode")
 
@@ -304,6 +309,7 @@ to continue it."
   "Don't save anything matching inferior-lisp-filter-regexp"
   (not (string-match inferior-lisp-filter-regexp str)))
 
+;;;###autoload
 (defun inferior-lisp (cmd)
   "Run an inferior Lisp process, input and output via buffer *inferior-lisp*.
 If there is a process already running in *inferior-lisp*, just switch
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 18b0782b92d..02277d796d6 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -29,24 +29,29 @@
 ;; This was a pain.  Now, make-comint should autoload comint.
 ;; (require 'comint)
 
+;;;###autoload
 (defvar tex-shell-file-name nil
   "*If non-nil, is file name to use for the subshell in which TeX is run.")
 
+;;;###autoload
 (defvar tex-directory "."
   "*Directory in which temporary files are left.
 You can make this /tmp if your TEXINPUTS has no relative directories in it
 and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are
 \\input commands with relative directories.")
 
+;;;###autoload
 (defvar tex-offer-save t
   "*If non-nil, ask about saving modified buffers before \\[tex-file] is run.")
 
+;;;###autoload
 (defvar tex-run-command "tex"
   "*Command used to run TeX subjob.
 If this string contains an asterisk (*), it will be replaced by the
 filename; if not, the name of the file, preceded by blank, will be added to
 this string.")
 
+;;;###autoload
 (defvar latex-run-command "latex"
   "*Command used to run LaTeX subjob.
 If this string contains an asterisk (*), it will be replaced by the
@@ -65,28 +70,33 @@ this string.")
         "verbatim"         "verbatim*"        "verse")
   "Standard LaTeX block names.")
 
+;;;###autoload
 (defvar latex-block-names nil
   "*User defined LaTeX block names.
 Combined with `standard-latex-block-names' for minibuffer completion.")
 
+;;;###autoload
 (defvar slitex-run-command "slitex"
   "*Command used to run SliTeX subjob.
 If this string contains an asterisk (*), it will be replaced by the
 filename; if not, the name of the file, preceded by blank, will be added to
 this string.")
 
+;;;###autoload
 (defvar tex-bibtex-command "bibtex"
   "*Command used by `tex-bibtex-file' to gather bibliographic data.
 If this string contains an asterisk (*), it will be replaced by the
 filename; if not, the name of the file, preceded by blank, will be added to
 this string.")
 
+;;;###autoload
 (defvar tex-dvi-print-command "lpr -d"
   "*Command used by \\[tex-print] to print a .dvi file.
 If this string contains an asterisk (*), it will be replaced by the
 filename; if not, the name of the file, preceded by blank, will be added to
 this string.")
 
+;;;###autoload
 (defvar tex-alt-dvi-print-command "lpr -d"
   "*Command used by \\[tex-print] with a prefix arg to print a .dvi file.
 If this string contains an asterisk (*), it will be replaced by the
@@ -103,6 +113,7 @@ for example,
 would tell \\[tex-print] with a prefix argument to ask you which printer to
 use.")
 
+;;;###autoload
 (defvar tex-dvi-view-command nil
   "*Command used by \\[tex-view] to display a .dvi file.
 If this string contains an asterisk (*), it will be replaced by the
@@ -118,19 +129,23 @@ window system being used.  For example,
 would tell \\[tex-view] use xdvi under X windows and to use dvi2tty
 otherwise.")
 
+;;;###autoload
 (defvar tex-show-queue-command "lpq"
   "*Command used by \\[tex-show-print-queue] to show the print queue.
 Should show the queue(s) that \\[tex-print] puts jobs on.")
 
+;;;###autoload
 (defvar tex-default-mode 'plain-tex-mode
   "*Mode to enter for a new file that might be either TeX or LaTeX.
 This variable is used when it can't be determined whether the file
 is plain TeX or LaTeX or what because the file contains no commands.
 Normally set to either 'plain-tex-mode or 'latex-mode.")
 
+;;;###autoload
 (defvar tex-open-quote "``"
   "*String inserted by typing \\[tex-insert-quote] to open a quotation.")
 
+;;;###autoload
 (defvar tex-close-quote "''"
   "*String inserted by typing \\[tex-insert-quote] to close a quotation.")