Commits

Anonymous committed 6e3f85b

sync with Emacs 21.4

Comments (0)

Files changed (23)

 MAINTAINER = Jeff Miller <jeff.miller@xemacs.org>
 PACKAGE = calendar
 PKG_TYPE = regular
-REQUIRES = xemacs-base
+REQUIRES = xemacs-base ibuffer fsf-compat
 CATEGORY = standard
 
 include ../../Local.rules.inc
 ELCS = appt.elc cal-dst.elc cal-french.elc cal-mayan.elc cal-x.elc \
 	cal-xemacs.elc calendar.elc diary-lib.elc holidays.elc cal-tex.elc \
 	cal-hebrew.elc cal-islam.elc cal-iso.elc cal-move.elc cal-persia.elc\
-	cal-china.elc cal-coptic.elc cal-julian.elc lunar.elc solar.elc
-
+	cal-china.elc cal-coptic.elc cal-julian.elc lunar.elc solar.elc \
+        todo-mode.elc timeclock.elc
 
 ifeq ($(BUILD_WITHOUT_MULE),)
 ELCS += cal-japanese.elc
-;;; appt.el --- appointment notification functions.
+;;; appt.el --- appointment notification functions
 ;; Keywords: calendar
 
 ;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; 29-nov-89	created by Neil Mager <neilm@juliet.ll.mit.edu>.
-;;; 23-feb-91	hacked upon by Jamie Zawinski <jwz@lucid.com>.
-;;;  1-apr-91	some more.
-;;; 12-jul-95   updated for XEmacs 19.12 by Greg Veres 
-;;;             <gveres@cgl.uwaterloo.ca>
-;;; 21-mar-97   better support for fancy diary display by Tomasz J. Cholewo 
-;;;             <t.cholewo@ieee.org>
-;;;
 ;;; Commentary:
 
 ;;
 ;; appt.el - visible and/or audible notification of
 ;;           appointments from ~/diary file.
 ;;
-;; Version 2.1
-;;
-;; Comments, corrections, and improvements should be sent to
-;; Neil M. Mager
-;; Net                     <neilm@juliet.ll.mit.edu>
-;; Voice                   (617) 981-4803
 ;;;
 ;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
 ;;; And to many others for bug fixes and suggestions.
 ;;; This functions in this file will alert the user of a 
 ;;; pending appointment based on their diary file.
 ;;;
-;;; ******* It is necessary to invoke 'display-time' and ********
-;;; ******* 'appt-initialize' for this to work properly. ********
+;;; ******* It is necessary to invoke 'appt-initialize' for this 
+;;; ******* to work properly. 
 ;;; 
 ;;; A message will be displayed in the mode line of the Emacs buffer 
 ;;; and (if you request) the terminal will beep and display a message 
 ;;; .emacs file:
 ;;;
 ;;;    (require 'appt)
-;;;    (display-time)
 ;;;    (appt-initialize)
 ;;;
 ;;; If you wish to see a list of appointments, or a full calendar, when emacs
   :type 'boolean
   :group 'appt)
 
-(defcustom appt-msg-countdown-list '(20 15 10 5 3 1)
-  "*A list of the intervals in minutes before the appointment when
- the warnings will be given.  That is, if this were the list '(5 3 1),
- then a notification would be given five minutes, three minutes, and
- one minute before the appointment."
-  :type '(repeat integer)
+;;;###autoload
+(defcustom appt-message-warning-time 12
+  "*Time in minutes before an appointment that the warning begins."
+  :type 'integer
   :group 'appt)
 
-(defcustom appt-check-time-syntax nil
-  "*Whether all diary entries are intended to begin with time specifications.
-Appt will beep and issue a warning message when encountering unparsable 
-lines."
+;;;###autoload
+(defcustom appt-audible t
+  "*Non-nil means beep to indicate appointment."
   :type 'boolean
   :group 'appt)
-
+  
+;;;###autoload
+(defcustom appt-visible t
+  "*Non-nil means display appointment message in echo area."
+  :type 'boolean
+  :group 'appt)
+  
 ;;;###autoload
 (defcustom appt-audible t
   "*Controls whether appointment announcements should beep.
   :group 'appt)
 
 ;;;###autoload
+(defcustom appt-msg-window t
+  "*Non-nil means display appointment message in another window."
+:type 'boolean
+:group 'appt)
+
+;;;###autoload
 (defcustom appt-display-duration 10
-  "*The number of seconds an appointment message is displayed in its own 
- window if appt-announce-method is 'appt-window-announce."
+  "*The number of seconds an appointment message is displayed."
   :type 'integer
   :group 'appt)
 
+;;;###autoload
+(defcustom 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."
+:type 'boolean
+:group 'appt)
+
 (defcustom appt-announce-method 'appt-window-announce
   "*The name of the function used to notify the user of an impending 
 appointment.  This is called with two arguments, the number of minutes
 
 (defconst appt-max-time 1439
   "11:59pm in minutes - number of minutes in a day minus 1.")
-
-(defconst appt-check-tick -1)
-
-(defvar appt-disp-frame nil
-  "If non-nil, frame to display appointments in.")
-(defvaralias 'appt-disp-screen 'appt-disp-frame)
   
 
 ;;; Announcement methods
       (message "%s" str))
     ))
 
+(defcustom appt-display-interval 3
+  "*Number of minutes to wait between checking the appointment list."
+:type 'integer
+:group 'appt)
+ 
 (defvar appt-buffer-name " *appt-buf*"
   "Name of the appointments buffer.")
 
-(defvar appt-frame-defaults nil)
-(defvaralias 'appt-screen-defaults 'appt-frame-defaults)
-
 (defun appt-frame-announce (min-to-app appt)
   "Set appt-announce-method to the name of this function to cause appointment 
 notifications to be given via messages in a pop-up frame."
         (sleep-for 2))))
   (goto-char (point-min)))
 
-(defun appt-initialize ()
-  "Read your `diary-file' and remember today's appointments.  Call this from 
- your .emacs file, or any time you want your .diary file re-read (this happens 
- automatically at midnight to notice the next day's appointments).
- 
- The time must be at the beginning of a line for it to be put in the 
- appointments list.
-               02/23/89
-                  12:00pm    lunch
-                Wednesday
-                  10:00am    group meeting"
-  (install-display-time-hook)
-  (let ((n (length (appt-diary-entries))))
-    (cond ((= n 0) (message "no appointments today."))
-	  ((= n 1) (message "1 appointment today."))
-	  (t (message "%d appointments today." n)))))
-
-
 (defun appt-beep (&optional final-p)
   (cond ((null appt-audible) nil)
 	((numberp appt-audible)
 	     (setq i (1- i)))))
 	(t (beep))))
 
+(defvar appt-disp-window-function 'appt-disp-window
+  "Function called to display appointment window.")
 
+(defvar appt-delete-window-function 'appt-delete-window
+  "Function called to remove appointment window and buffer.")
+
+(defvar appt-mode-string nil
+  "String being displayed in the mode line saying you have an appointment.
+The actual string includes the amount of time till the appointment.")
+
+(defvar appt-prev-comp-time nil
+  "Time of day (mins since midnight) at which we last checked appointments.")
+
+(defvar appt-now-displayed nil
+  "Non-nil when we have started notifying about a appointment that is near.")
+
+(defvar appt-display-count nil)
+ 
 (defun appt-check ()
   "Check for an appointment and update the mode line and minibuffer if
  desired.
 
               Thursday
                 11:45am Lunch meeting.
-  
+
+Appointments are checked every `appt-display-interval' minutes.
 The following variables control appointment notification:
  
 `appt-issue-message'
        If t, the diary buffer is checked for appointments.
 
+`appt-message-warning-time'
+       Variable used to determine if appointment message
+       should be displayed.
+
 `appt-audible'
        Variable used to determine if appointment is audible.
        Default is t.
 
+`appt-visible'
+       Variable used to determine if appointment message should be
+       displayed in the mini-buffer.  Default is t.
+
+`appt-msg-window'
+       Variable used to determine if appointment message
+       should temporarily appear in another window.  Mutually exclusive
+       to `appt-visible'.
+
 `appt-display-duration'
        The number of seconds an appointment message
        is displayed in another window.
 
+`appt-disp-window-function'
+       Function called to display appointment window.  You can customize
+       appt.el by setting this variable to a function different from the
+       one provided with this package.
+  
+`appt-delete-window-function'
+       Function called to remove appointment window and buffer.  You can
+       customize appt.el by setting this variable to a function different
+       from the one provided with this package.
+ 
+
  appt-msg-countdown-list	Specifies how much warning you want before 
 				appointments.
  appt-display-mode-line		Whether to display a countdown to the next 
 				'appt-window-announce to do it in a pop-up
 				window, 'appt-message-announce or 
 				'appt-persistent-message-announce to do it 
-				in the echo-area.
+				in the echo-area."
 
- This function is run from the `loadst' or `wakeup' process for display-time.
- Therefore, you need to have `(display-time)' in your .emacs file."
-  (if appt-issue-message
-   (let ((min-to-app -1))
-     ;; Get the current time and convert it to minutes
-     ;; from midnight. i.e., 12:01am = 1, midnight = 0.
+  (let* ((min-to-app -1) 
+ 	 (new-time "")
+ 	 (prev-appt-mode-string appt-mode-string)
+ 	 (prev-appt-display-count (or appt-display-count 0))
+         ;; Non-nil means do a full check for pending appointments
+         ;; and display in whatever ways the user has selected.
+         ;; When no appointment is being displayed,
+         ;; we always do a full check.
+         (full-check
+          (or (not appt-now-displayed)
+              ;; This is true every appt-display-interval minutes.
+              (= 0 (mod prev-appt-display-count appt-display-interval))))
+         ;; Non-nil means only update the interval displayed in the mode line.
+         (mode-line-only
+          (and (not full-check) appt-now-displayed)))
 
-     (let* ((now (decode-time))
-		 (cur-hour (nth 2 now))
-		 (cur-min (nth 1 now))
-		 (cur-comp-time (+ (* cur-hour 60) cur-min))
+    (when (or full-check mode-line-only)
+      (save-excursion
 
-	       ;; At the first check in any given day, update our 
-	       ;; appointments to today's list.
+	;; Get the current time and convert it to minutes
+	;; from midnight. ie. 12:01am = 1, midnight = 0.
 
-	    ;; If the current time is the same as the tick, just return.
-	    ;; This means that this function has been called more than once
-	    ;; in the current minute, which is not useful.
-	    (shut-up-this-time (= cur-comp-time appt-check-tick))
-	    (turnover-p (> appt-check-tick cur-comp-time)))
-       (setq appt-check-tick cur-comp-time)
-       ;;
-       ;; If it is now the next day (we have crossed midnight since the last
-       ;; time this was called) then we should update our appointments to
-       ;; today's list.  Show the diary entries (tjc).
-       (if turnover-p (progn (appt-diary-entries) (diary 1)))
-       ;;
+	(let* ((now (decode-time))
+	       (cur-hour (nth 2 now))
+	       (cur-min (nth 1 now))
+	       (cur-comp-time (+ (* cur-hour 60) cur-min)))
+
+	  ;; At the first check in any given day, update our 
+	  ;; appointments to today's list.
+
+          (if (or (null appt-prev-comp-time)
+                  (< cur-comp-time appt-prev-comp-time))
+              (condition-case nil
+                  (progn
+                    (if (and view-diary-entries-initially appt-display-diary)
+                        (diary)
+                      (let ((diary-display-hook 'appt-make-list))
+                        (diary))))
+                (error nil)))
+          (setq appt-prev-comp-time cur-comp-time)
+
+          (setq appt-mode-string nil)
+          (setq appt-display-count nil)
+
 	  ;; If there are entries in the list, and the
 	  ;; user wants a message issued,
 	  ;; get the first time off of the list 
 	  ;; and calculate the number of minutes until the appointment.
 
-       (if (and appt-issue-message appt-time-msg-list)
-	   (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
-	     (setq min-to-app (- appt-comp-time cur-comp-time))
-	
-	     (while (and appt-time-msg-list 
-			 (< appt-comp-time cur-comp-time))
-	       (setq appt-time-msg-list (cdr appt-time-msg-list)) 
-	       (if appt-time-msg-list
-		   (setq appt-comp-time 
-			 (car (car (car appt-time-msg-list))))))
-	     ;;
+	  (if (and appt-issue-message appt-time-msg-list)
+	      (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
+		(setq min-to-app (- appt-comp-time cur-comp-time))
+
+		(while (and appt-time-msg-list 
+			    (< appt-comp-time cur-comp-time))
+		  (setq appt-time-msg-list (cdr appt-time-msg-list)) 
+		  (if appt-time-msg-list
+		      (setq appt-comp-time 
+			    (car (car (car appt-time-msg-list))))))
+	     
 		;; If we have an appointment between midnight and
-		;; warning-time minutes after midnight, we must begin
-		;; to issue a message before midnight.  Midnight is
-		;; considered 0 minutes and 11:59pm is 1439
-		;; minutes. Therefore we must recalculate the minutes
-		;; to appointment variable. It is equal to the number
-		;; of minutes before midnight plus the number of
+		;; 'appt-message-warning-time' minutes after midnight,
+		;; we must begin to issue a message before midnight.
+		;; Midnight is considered 0 minutes and 11:59pm is
+		;; 1439 minutes. Therefore we must recalculate the minutes
+		;; to appointment variable. It is equal to the number of 
+		;; minutes before midnight plus the number of 
 		;; minutes after midnight our appointment is.
-		;;
-		;; ## I don't think this does anything -- it would if
-		;; it were (for example) a 12:01am appt on the list at
-		;; 11:55pm, but that can't ever happen, because the
-		;; applicable 12:01am appt is for tomorrow, not today,
-		;; and we only have today's diary list.  It's not
-		;; simply a matter of concatenating two days together,
-		;; either, because then tuesday's appts would be
-		;; signalled on monday.  We have to do a real one-day
-		;; lookahead -- keep a list of tomorrow's appts, and
-		;; check it when near midnight.
-		;;
-		(if (and (< appt-comp-time 
-			    (apply 'max appt-msg-countdown-list))
-			 (> (+ cur-comp-time 
-			       (apply 'max appt-msg-countdown-list))
+	     
+		(if (and (< appt-comp-time appt-message-warning-time)
+			 (> (+ cur-comp-time appt-message-warning-time)
 			    appt-max-time))
-		    (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time)
-					appt-comp-time)))
-	     ;;
-	     ;; issue warning if the appointment time is within warning-time
-	     (cond
-	       ;; if there should not be any notifications in the mode-line,
-	       ;; clear it.
-	       ((> min-to-app (apply 'max appt-msg-countdown-list))
-		(appt-display-mode-line nil))
-	       ;; do nothing if this is the second time this minute we've
-	       ;; gotten here, of if we shouldn't be notifying right now.
-	       ((or shut-up-this-time
-		    (and (not (= min-to-app 0))
-			 (not (memq min-to-app appt-msg-countdown-list))))
-		nil)
+		    (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
+			  appt-comp-time))
+	     
+		;; issue warning if the appointment time is 
+		;; within appt-message-warning time
 
-	       ((and (= min-to-app 0)
-		     (string-match "%%(" (nth 1 (car appt-time-msg-list))))
-		;;
-		;; If this is a magic evaluating-notification, evaluate it.
-		;; these kinds of notifications aren't subject to the
-		;; appt-msg-countdown-list.
-		;;
-		(let* ((list-string (substring (nth 1 (car appt-time-msg-list))
-					       (1- (match-end 0))))
-		       (form (condition-case ()
-				 (read list-string)
-			       (error
-				 (ding)
-				 (message "Appt: error reading from \"%s\""
-					  (nth 1 (car appt-time-msg-list)))
-				 (sit-for 2)
-				 nil))))
-		  (eval form)))
-                 ;; issue warning if the appointment time is 
-                 ;; within appt-message-warning time
-	       ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
-		     (>= min-to-app 0))
-		;;
-		;; produce a notification.
-		(appt-beep (= min-to-app 0))
-		(funcall appt-announce-method min-to-app
-			 (car appt-time-msg-list))
-		;; update mode line and expire if necessary
-		(appt-display-mode-line min-to-app)
+		(when (and (<= min-to-app appt-message-warning-time)
+			   (>= min-to-app 0))
+		  (setq appt-now-displayed t)
+		  (setq appt-display-count
+			(1+ prev-appt-display-count))
+		  (unless mode-line-only
+		    (if appt-msg-window
+			(progn
+			  (setq new-time (format-time-string "%a %b %e "
+							     (current-time)))
+			  (funcall
+			   appt-disp-window-function
+			   (number-to-string min-to-app) new-time
+			   (car (cdr (car appt-time-msg-list))))
+		       
+			  (run-at-time
+			   (format "%d sec" appt-display-duration)
+			   nil
+  			   appt-delete-window-function))
+                             ;;; else
+		   
+		      (if appt-visible
+			  (message "%s" 
+				   (car (cdr (car appt-time-msg-list)))))
+		   
+		      (if appt-audible
+			  (beep 1))))
+	       
+		  (when appt-display-mode-line
+		    (setq appt-mode-string
+			  (concat  " App't in "
+				   (number-to-string min-to-app)
+				   " min. ")))
+	       
 		  ;; When an appointment is reached,
 		  ;; delete it from the list.
 		  ;; Reset the count to 0 in case we display another
 		  ;; appointment on the next cycle.
-		(if (= min-to-app 0)
-		    (setq appt-time-msg-list 
+		  (if (= min-to-app 0)
+		      (setq appt-time-msg-list 
 			    (cdr appt-time-msg-list)
-			    )))
-	       (t
-		;; else we're not near any appointment, or there are no
-		;; apointments; make sure mode line is clear.
-		(appt-display-mode-line nil))))
-	   (appt-display-mode-line nil))))))
+			    appt-display-count nil)))))
+       
+	  ;; If we have changed the mode line string,
+	  ;; redisplay all mode lines.
+	  (and appt-display-mode-line
+	       (not (equal appt-mode-string
+			   prev-appt-mode-string))
+	       (progn
+		 (force-mode-line-update t)
+		 ;; If the string now has a notification,
+		 ;; redisplay right now.
+		 (if appt-mode-string
+		     (sit-for 0)))))))))
 
-(defun appt-window-announce (min-to-app appt)
-  "Set appt-announce-method to the name of this function to cause appointment 
-notifications to be given via messages in a pop-up window.  The variable
-appt-display-duration controls how long this window should be left up."
+;;(defun appt-window-announce (min-to-app appt)
+;;  "Set appt-announce-method to the name of this function to cause appointment 
+;;notifications to be given via messages in a pop-up window.  The variable
+;;appt-display-duration controls how long this window should be left up."
+
+(defun  appt-disp-window (min-to-app new-time appt-msg)
+  "Display appointment message APPT-MSG in a separate buffer."
   (require 'electric)
-  (save-excursion
-   (save-window-excursion
+  
+  ;; Make sure we're not in the minibuffer
+  ;; before splitting the window.
+  
+  (if (equal (selected-window) (minibuffer-window))
+      (if (other-window 1) 
+	  (select-window (other-window 1))
+	(if (display-multi-frame-p)
+	    (select-frame (other-frame 1)))))
+  
+  (let* ((this-buffer (current-buffer))
+	 (this-window (selected-window))
+	 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
 
-    ;; Make sure we're not in the minibuffer
-    ;; before splitting the window.
-     (if (window-minibuffer-p (selected-window))
-	 nil
-       (select-window (frame-lowest-window))
-       (split-window))
-    (let (appt-disp-buf)
-      (unwind-protect
-	   (progn
-	     (setq appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))
-	     ;; set the mode-line of the pop-up window
-	     (setq modeline-format 
-	       (concat "-------------------- Appointment "
-		 (if (eq min-to-app 0)
-		     "NOW"
-		   (concat "in " (format "%s" min-to-app)
-		     (if (eq min-to-app 1) " minute" " minutes")))
-		 ". ("
-		 (let ((h (string-to-int
-			    (substring (current-time-string) 11 13))))
-		   (concat (if (> h 12) (format "%s" (- h 12))
-			     (format "%s" h)) ":"
-			   (substring (current-time-string) 14 16)
-	 		   (if (< h 12) "am" "pm")))
-		 ") %-"))
-	     (pop-to-buffer appt-disp-buf)
-	     (insert (car (cdr appt)))
-	      (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf))
-	     (set-buffer-modified-p nil)
-	     (sit-for appt-display-duration))
-	(and appt-disp-buf (kill-buffer appt-disp-buf)))))))
+    (if (cdr (assq 'unsplittable (frame-parameters)))
+	;; In an unsplittable frame, use something somewhere else.
+	(display-buffer appt-disp-buf)
+    ;;  (unless (or (special-display-p (buffer-name appt-disp-buf))
+    ;;		  (same-window-p (buffer-name appt-disp-buf)))
+	;; By default, split the bottom window and use the lower part.
+	(appt-select-lowest-window)
+	(split-window)
+    ;;)
+      (pop-to-buffer appt-disp-buf))
+    (setq mode-line-format 
+	  (concat "-------------------- Appointment in "
+		  min-to-app " minutes. " new-time " %-"))
+    (erase-buffer)
+    (insert-string appt-msg)
+    (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
+    (set-buffer-modified-p nil)
+    (raise-frame (selected-frame))
+    (select-window this-window)
+    (if appt-audible
+	(beep 1))))
+  
+(defun appt-delete-window ()
+  "Function called to undisplay appointment messages.
+Usually just deletes the appointment buffer."
+  (let ((window (get-buffer-window appt-buffer-name t)))
+    (and window
+        (or (eq window (frame-root-window (window-frame window)))
+            (delete-window window))))
+  (kill-buffer appt-buffer-name)
+  (if appt-audible
+      (beep 1)))
 
-
-;;; Interactively adding and deleting appointments
+(defun appt-select-lowest-window ()
+"Select the lowest window on the frame."
+  (let ((lowest-window (selected-window))
+       (bottom-edge (nth 3 (window-pixel-edges))))
+    (walk-windows (lambda (w)
+                   (let ((next-bottom-edge (nth 3 (window-pixel-edges w))))
+                     (when (< bottom-edge next-bottom-edge)
+                       (setq bottom-edge next-bottom-edge
+                             lowest-window w)))))
+    (select-window lowest-window)))
+
 ;;;###autoload
 (defun appt-add (new-appt-time new-appt-msg)
-  "Add an appointment for the day at TIME and issue MESSAGE.
+  "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
 The time should be in either 24 hour format or am/pm format."
  
   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
          (appt-time (list (appt-convert-time new-appt-time)))
          (time-msg (cons appt-time (list appt-time-string))))
-    (setq appt-time-msg-list (append appt-time-msg-list
-                                     (list time-msg)))
+    (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
 
 ;;;###autoload
     (while tmp-msg-list
       (let* ((element (car tmp-msg-list))
              (prompt-string (concat "Delete " 
-                                    (prin1-to-string (car (cdr element))) 
+				    ;; We want to quote any doublequotes
+				    ;; in the string, as well as put
+				    ;; doublequotes around it.
+                                    (prin1-to-string
+				     (substring-no-properties
+				      (car (cdr element)) 0)) 				    
                                     " from list? "))
              (test-input (y-or-n-p prompt-string)))
         (setq tmp-msg-list (cdr tmp-msg-list))
         (if test-input
             (setq appt-time-msg-list (delq element appt-time-msg-list)))))
+    (appt-check)
     (message "")))
 
 
-;; Create the appointments list from todays diary buffer.
-;; The time must be at the beginning of a line for it to be
-;; put in the appointments list.
-;;                02/23/89
-;;                  12:00pm lunch
-;;                 Wednesday
-;;                   10:00am group meeting
-;; We assume that the variables DATE and NUMBER
-;; hold the arguments that list-diary-entries received.
-;; They specify the range of dates that the diary is being processed for.
-
+(eval-when-compile (defvar number)
+                  (defvar original-date)
+                  (defvar diary-entries-list))
 ;;;###autoload
 (defun appt-make-list ()
-  "Don't call this directly; call appt-initialize or appt-diary-entries."
-  ;; Clear the appointments list, then fill it in from the diary.
-  (if diary-entries-list
+  "Create the appointments list from todays diary buffer.
+The time must be at the beginning of a line for it to be
+put in the appointments list.
+  02/23/89
+    12:00pm lunch
+   Wednesday
+     10:00am group meeting
+We assume that the variables DATE and NUMBER
+hold the arguments that `list-diary-entries' received.
+They specify the range of dates that the diary is being processed for."
 
-           ;; Cycle through the entry-list (diary-entries-list)
-           ;; looking for entries beginning with a time. If 
-           ;; the entry begins with a time, add it to the
-           ;; appt-time-msg-list. Then sort the list.
+  ;; We have something to do if the range of dates that the diary is
+  ;; considering includes the current date.
+  (if (and (not (calendar-date-compare
+		 (list (calendar-current-date))
+		 (list original-date)))
+	   (calendar-date-compare
+	    (list (calendar-current-date))
+            (list (calendar-gregorian-from-absolute
+		   (+ (calendar-absolute-from-gregorian original-date)
+		      number)))))
+      (save-excursion
+	;; Clear the appointments list, then fill it in from the diary.
+	(setq appt-time-msg-list nil)
+	(if diary-entries-list
 
-      (let ((entry-list diary-entries-list)
-	    (new-appts '())
-	    (new-time-string ""))
-	;; Skip diary entries for dates before today.
-	(while (and entry-list
-		    (calendar-date-compare
-		     (car entry-list) (list (calendar-current-date))))
-	  (setq entry-list (cdr entry-list)))
-	;; Parse the entries for today.
-	(while (and entry-list
-		    (calendar-date-equal
-		      (calendar-current-date) (car (car entry-list))))
-	  (let ((time-string (car (cdr (car entry-list)))))
-	    (while (string-match
-		    "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
-		     time-string)
-	      (let* ((eol (match-end 0))
-		     (appt-time-string (substring time-string 
-						  (match-beginning 1)
-						  (match-end 1)))
-		     (appt-msg-string
-		      (substring time-string (match-end 1) eol))
-		     (appt-time (list (appt-convert-time appt-time-string))))
-		(setq time-string (substring time-string eol)
-		      new-appts (cons (cons appt-time
-					    (list (concat appt-time-string ":"
-							  appt-msg-string)))
-				      new-appts))))
-	    (if appt-check-time-syntax
-		(while (string-match "\n*\\([^\n]+\\)$" time-string)
-		  (beep)
-		  (message "Unparsable time: %s"
-			   (substring time-string (match-beginning 1)
-				      (match-end 1)))
-		  (sit-for 3)
-		  (setq time-string (substring time-string (match-end 0)))))
-					       
-	    )
-	  (setq entry-list (cdr entry-list)))
-	(setq appt-time-msg-list ; seems we can't nconc this list...
-	      (append (nreverse new-appts) appt-time-msg-list))))
-  (run-hooks 'appt-make-list-hook)
-  (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
+	    ;; Cycle through the entry-list (diary-entries-list)
+	    ;; looking for entries beginning with a time. If 
+	    ;; the entry begins with a time, add it to the
+	    ;; appt-time-msg-list. Then sort the list.
 
-        ;; Get the current time and convert it to minutes 
-        ;; from midnight, i.e., 12:01am = 1, midnight = 0, 
-        ;; so that the elements in the list 
-        ;; that are earlier than the present time can 
-        ;; be removed.
+	    (let ((entry-list diary-entries-list)
+		  (new-time-string ""))
+	      ;; Skip diary entries for dates before today.
+	      (while (and entry-list
+			  (calendar-date-compare
+			   (car entry-list) (list (calendar-current-date))))
+		(setq entry-list (cdr entry-list)))
+	      ;; Parse the entries for today.
+	      (while (and entry-list 
+			  (calendar-date-equal 
+			   (calendar-current-date) (car (car entry-list))))
+               (let ((time-string (cadr (car entry-list))))
+		  (while (string-match
+                         "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
+			  time-string)
+                  (let* ((beg (match-beginning 0))
+                         ;; Get just the time for this appointment.
+                         (only-time (match-string 1 time-string))
+                         ;; Find the end of this appointment
+                         ;; (the start of the next).
+                         (end (string-match
+                               "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
+                               time-string
+                               (match-end 0)))
+                         ;; Get the whole string for this appointment.
+                         (appt-time-string
+                          (substring time-string beg (if end (1- end)))))
 
-  (let* ((now (decode-time))
+                    ;; Add this appointment to appt-time-msg-list.
+                    (let* ((appt-time (list (appt-convert-time only-time)))
+                           (time-msg (list appt-time appt-time-string)))
+                      (setq appt-time-msg-list
+                            (nconc appt-time-msg-list (list time-msg))))
+
+                     ;; Discard this appointment from the string.
+                     (setq time-string
+                           (if end (substring time-string end) "")))))
+                (setq entry-list (cdr entry-list)))))
+	(run-hooks 'appt-make-list-hook)
+        (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
+	;; Get the current time and convert it to minutes
+	;; from midnight. ie. 12:01am = 1, midnight = 0,
+ 	;; so that the elements in the list
+	;; that are earlier than the present time can
+	;; be removed.
+	(let* ((now (decode-time))
 	       (cur-hour (nth 2 now))
 	       (cur-min (nth 1 now))
 	       (cur-comp-time (+ (* cur-hour 60) cur-min))
 	       (appt-comp-time (car (car (car appt-time-msg-list)))))
 
-    (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
-      (setq appt-time-msg-list (cdr appt-time-msg-list)) 
-      (if appt-time-msg-list
-          (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
-  appt-time-msg-list)
+	  (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
+	    (setq appt-time-msg-list (cdr appt-time-msg-list)) 
+	    (if appt-time-msg-list
+		(setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
+  
 
-;;Simple sort to put the appointments list in order.
-;;Scan the list for the smallest element left in the list.
-;;Append the smallest element left into the new list, and remove
-;;it from the original list.
 (defun appt-sort-list (appt-list)
+  "Simple sort to put the appointments list APPT-LIST in order.
+Scan the list for the smallest element left in the list.
+Append the smallest element left into the new list, and remove
+it from the original list."
   (let ((order-list nil))
     (while appt-list
       (let* ((element (car appt-list))
             (setq element (car tmp-list))
             (setq element-time (car (car element))))
           (setq tmp-list (cdr tmp-list)))
-        (setq order-list (append order-list (list element)))
+        (setq order-list (nconc order-list (list element)))
         (setq appt-list (delq element appt-list))))
     order-list))
 
 
 (defun appt-convert-time (time2conv)
   "Convert hour:min[am/pm] format to minutes from midnight."
-  (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
-	 0)
-	((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
-	 (* 12 60))
-	(t
-         (let ((conv-time 0)
-	       (hr 0)
-               (min 0))
-           (or (string-match
-                 "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ 
-\t]*\\(am\\|pm\\)?"
-                 time2conv)
-               (error "unparsable time \"%s\"" time2conv))
-           (setq hr (string-to-int
-                      (substring time2conv
-                                 (match-beginning 1) (match-end 1))))
-           (if (match-beginning 3)
-               (setq min (string-to-int 
-                           (substring time2conv 
-                                      (match-beginning 3) (match-end 3)))))
-           ;; convert the time appointment time into 24 hour time
-           (if (match-beginning 4)
-               (progn
-                 (if (or (= hr 0) (> hr 12))
-                     (error "mixing 12hr and 24 hr time!  %s" time2conv))
-                 (if (string-match "am"
-                                   (substring time2conv (match-beginning 4)))
-                     (if (= hr 12) (setq hr 0))
-                   (if (< hr 12) (setq hr (+ 12 hr))))))
-           (if (> min 59) (error "minutes outa bounds - %s" time2conv))
-           (+ (* hr 60) min)))))
+
+  (let ((conv-time 0)
+        (hr 0)
+        (min 0))
+
+    (string-match ":\\([0-9][0-9]\\)" time2conv)
+    (setq min (string-to-int 
+               (match-string 1 time2conv)))
+  
+    (string-match "[0-9]?[0-9]:" time2conv)
+    (setq hr (string-to-int 
+              (match-string 0 time2conv)))
+  
+    ;; convert the time appointment time into 24 hour time
+  
+    (cond ((and (string-match "pm" time2conv) (< hr 12))
+	   (setq hr (+ 12 hr)))
+	  ((and (string-match "am" time2conv) (= hr 12))
+           (setq hr 0)))
+  
+    ;; convert the actual time
+    ;; into minutes for comparison
+    ;; against the actual time.
+  
+    (setq conv-time (+ (* hr 60) min))
+    conv-time))
+
+
 
 (defvar display-time-hook-installed nil)
 
      (setq display-time-hook (cons appt-check display-time-hook)))
    ))
 
-;defvar appt-timer nil
-;  "Timer used for diary appointment notifications (`appt-check').")
 
-;(unless appt-timer
-;  (progn
-;    (setq appt-timer (make-itimer))
-;    (set-itimer-fun
+(defvar appt-timer nil
+  "Timer used for diary appointment notifications (`appt-check').")
+
+(defun appt-initialize ()
+  "Read your `diary-file' and remember today's appointments.  Call this from 
+ your .emacs file, or any time you want your .diary file re-read (this happens 
+ automatically at midnight to notice the next day's appointments).
  
+ The time must be at the beginning of a line for it to be put in the 
+ appointments list.
+               02/23/89
+                  12:00pm    lunch
+                Wednesday
+                  10:00am    group meeting"
+
+  (unless appt-timer
+    (setq appt-timer (run-at-time t 60 'appt-check)))
+  
+  (or global-mode-string (setq global-mode-string '("")))
+  (or (memq 'appt-mode-string global-mode-string)
+      (setq global-mode-string
+	    (append global-mode-string '(appt-mode-string))))
+
+  (let ((n (length (appt-diary-entries))))
+    (cond ((= n 0) (message "no appointments today."))
+	  ((= n 1) (message "1 appointment today."))
+	  (t (message "%d appointments today." n))))
+  )
 
 ;;; appt.el ends here
 
-;;; cal-china.el --- calendar functions for the Chinese calendar.
+;;; cal-china.el --- calendar functions for the Chinese calendar
 
 ;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars.
+;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
 
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;; Keywords: calendar
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-dst.el --- calendar functions for daylight savings rules.
+;;; cal-dst.el --- calendar functions for daylight savings rules
 
 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
+;;; cal-french.el --- calendar functions for the French Revolutionary calendar
 
 ;; Copyright (C) 1988, 89, 92, 94, 95, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 ;;; Commentary:
 
 ;; This collection of functions implements the features of calendar.el and
 
 (defun french-calendar-accents ()
   "True if diacritical marks are available."
-  (if (not (featurep 'xemacs) )
-      (and (or window-system
-	       (terminal-coding-system))
-	   (or enable-multibyte-characters
-	       (and (char-table-p standard-display-table)
-		    (equal (aref standard-display-table 161) [161])))))
+  (and (or window-system
+	   (terminal-coding-system))
+       (not (featurep 'xemacs)
+	    (or enable-multibyte-characters
+		(and (char-table-p standard-display-table)
+		     (equal (aref standard-display-table 161) [161])))))
   t)
 
 (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
    "Octidi" "Nonidi" "Decadi"])
 
 (defconst french-calendar-multibyte-special-days-array
-  ["de la Vertu" "du G�nie" "du Labour" "de la Raison" "de la R�compense"
+  ["de la Vertu" "du G�nie" "du Travail" "de la Raison" "des R�compenses"
    "de la R�volution"])
 
 (defconst french-calendar-special-days-array
-  ["de la Vertu" "du Ge'nie" "du Labour" "de la Raison" "de la Re'compense"
+  ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses"
    "de la Re'volution"])
 
 (defun french-calendar-month-name-array ()
 			     y))
      (t (format 
 	 (if (french-calendar-accents)
-	     "D�cade %s, %s de %s de l'Ann�e %d de la R�volution"
-	   "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution")
-	 (make-string (1+ (/ (1- d) 10)) ?I)
-	 (aref (french-calendar-day-name-array) (% (1- d) 10))
+             "%d %s an %d de la R�volution"
+           "%d %s an %d de la Re'volution")
+         d
          (aref (french-calendar-month-name-array) (1- m))
 	 y)))))
 
                          month-list
                          nil t)
 			(calendar-make-alist month-list 1 'car))))
-          (decade (if (> month 12)
-                      1
-                    (calendar-read
-		     (if accents
-                     "D�cade (1-3): "
-		     "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)))))
+                  "Jour (1-30): "
+                   '(lambda (x) (and (<= 1 x) (<= x 30))))))
+           (month (if (> month 12) 13 month)))
+      (list (list month day year)))))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-french date)))
   (or noecho (calendar-print-french-date)))
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
+;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
 
 ;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
          (week (/ omer 7))
          (day (% omer 7)))
     (if (and (> omer 0) (< omer 50))
-        (format "Day %d%s of the omer (until sunset)"
-                omer
-                (if (zerop week)
-                    ""
-                  (format ", that is, %d week%s%s"
-                          week
-                          (if (= week 1) "" "s")
-                          (if (zerop day)
-                              ""
-                            (format " and %d day%s"
-                                    day (if (= day 1) "" "s")))))))))
+	(format "Day %d%s of the omer (until sunset)"
+		omer
+		(if (zerop week)
+		    ""
+		  (format ", that is, %d week%s%s"
+			  week
+			  (if (= week 1) "" "s")
+			  (if (zerop day)
+			      ""
+			    (format " and %d day%s"
+				    day (if (= day 1) "" "s")))))))))
 
 (defun diary-yahrzeit (death-month death-day death-year)
   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
          (diff (- yr h-year))
          (y (hebrew-calendar-yahrzeit h-date yr)))
     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
-        (format "Yahrzeit of %s%s: %d%s anniversary"
-                entry
-                (if (= y d) "" " (evening)")
-                diff
-                (cond ((= (% diff 10) 1) "st")
-                      ((= (% diff 10) 2) "nd")
-                      ((= (% diff 10) 3) "rd")
-                      (t "th"))))))
+	      (format "Yahrzeit of %s%s: %d%s anniversary"
+		      entry
+		      (if (= y d) "" " (evening)")
+		      diff
+		      (cond ((= (% diff 10) 1) "st")
+			    ((= (% diff 10) 2) "nd")
+			    ((= (% diff 10) 3) "rd")
+			    (t "th"))))))
 
 (defun diary-rosh-hodesh ()
   "Rosh Hodesh diary entry.
          (h-yesterday (extract-calendar-day
                        (calendar-hebrew-from-absolute (1- d)))))
     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
-        (format
-         "Rosh Hodesh %s"
-         (if (= h-day 30)
-             (format
-              "%s (first day)"
-              ;; next month must be in the same year since this
-              ;; month can't be the last month of the year since
-              ;; it has 30 days
-              (aref h-month-names h-month))
-           (if (= h-yesterday 30)
-               (format "%s (second day)" this-month)
-             this-month)))
+	      (format
+	       "Rosh Hodesh %s"
+	       (if (= h-day 30)
+		   (format
+		    "%s (first day)"
+		    ;; next month must be in the same year since this
+		    ;; month can't be the last month of the year since
+		    ;; it has 30 days
+		    (aref h-month-names h-month))
+		 (if (= h-yesterday 30)
+		     (format "%s (second day)" this-month)
+		   this-month)))
       (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
-          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s)"
-                         (aref h-month-names
-                               (if (= h-month
-                                      (hebrew-calendar-last-month-of-year
-                                       h-year))
-                                   0 h-month))
-                         (aref calendar-day-name-array (- 29 h-day))))
-                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s-%s)"
-                         (aref h-month-names h-month)
-                         (if (= h-day 29)
-                             "tomorrow"
-                           (aref calendar-day-name-array (- 29 h-day)))
-                         (aref calendar-day-name-array
-                               (% (- 30 h-day) 7)))))
-        (if (and (= h-day 29) (/= h-month 6))
-            (format "Erev Rosh Hodesh %s"
-                    (aref h-month-names
-                          (if (= h-month
-                                 (hebrew-calendar-last-month-of-year
-                                  h-year))
-                              0 h-month))))))))
+		(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
+		       (format "Mevarhim Rosh Hodesh %s (%s)"
+			       (aref h-month-names
+				     (if (= h-month
+					    (hebrew-calendar-last-month-of-year
+					     h-year))
+					 0 h-month))
+			       (aref calendar-day-name-array (- 29 h-day))))
+		      ((and (< h-day 30) (> h-day 22) (= 30 last-day))
+		       (format "Mevarhim Rosh Hodesh %s (%s-%s)"
+			       (aref h-month-names h-month)
+			       (if (= h-day 29)
+				   "tomorrow"
+				 (aref calendar-day-name-array (- 29 h-day)))
+			       (aref calendar-day-name-array
+				     (% (- 30 h-day) 7)))))
+	(if (and (= h-day 29) (/= h-month 6))
+		  (format "Erev Rosh Hodesh %s"
+			  (aref h-month-names
+				(if (= h-month
+				       (hebrew-calendar-last-month-of-year
+					h-year))
+				    0 h-month))))))))
 
 (defun diary-parasha ()
   "Parasha diary entry--entry applies if date is a Saturday."
               (/ (- d first-saturday) 7))
              (parasha (aref year-format saturday)))
           (if parasha
-              (format
-               "Parashat %s"
-               (if (listp parasha);; Israel differs from diaspora
-                   (if (car parasha)
-                       (format "%s (diaspora), %s (Israel)"
-                               (hebrew-calendar-parasha-name (car parasha))
-                               (hebrew-calendar-parasha-name (cdr parasha)))
-                     (format "%s (Israel)"
-                             (hebrew-calendar-parasha-name (cdr parasha))))
-                 (hebrew-calendar-parasha-name parasha))))))))
+		    (format
+		     "Parashat %s"
+		     (if (listp parasha);; Israel differs from diaspora
+			 (if (car parasha)
+			     (format "%s (diaspora), %s (Israel)"
+				     (hebrew-calendar-parasha-name (car parasha))
+				     (hebrew-calendar-parasha-name (cdr parasha)))
+			   (format "%s (Israel)"
+				   (hebrew-calendar-parasha-name (cdr parasha))))
+		       (hebrew-calendar-parasha-name parasha))))))))
 
 (defvar hebrew-calendar-parashiot-names
 ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
-;;; cal-islam.el --- calendar functions for the Islamic calendar.
+;;; cal-islam.el --- calendar functions for the Islamic calendar
 
 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-iso.el --- calendar functions for the ISO calendar.
+;;; cal-iso.el --- calendar functions for the ISO calendar
 
 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-julian.el --- calendar functions for the Julian calendar.
+;;; cal-julian.el --- calendar functions for the Julian calendar
 
 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-mayan.el --- calendar functions for the Mayan calendars.
+;;; cal-mayan.el --- calendar functions for the Mayan calendars
 
 ;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
     (if (not (calendar-date-is-visible-p today))
         (generate-calendar-window)
       (update-calendar-mode-line)
-      (calendar-cursor-to-visible-date today))))
+      (calendar-cursor-to-visible-date today)))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-forward-month (arg)
   "Move the cursor forward ARG months.
     (let ((new-cursor-date (list month day year)))
       (if (not (calendar-date-is-visible-p new-cursor-date))
           (calendar-other-month month year))
-      (calendar-cursor-to-visible-date new-cursor-date))))
+      (calendar-cursor-to-visible-date new-cursor-date)))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-forward-year (arg)
   "Move the cursor forward by ARG years.
   (interactive "p")
   (calendar-forward-month (* -12 arg)))
 
-(defun scroll-calendar-left (arg)
+(defun scroll-calendar-left (&optional arg)
   "Scroll the displayed calendar left by ARG months.
 If ARG is negative the calendar is scrolled right.  Maintains the relative
 position of the cursor with respect to the calendar as well as possible."
   (interactive "p")
+  (unless arg (setq arg 1))
   (calendar-cursor-to-nearest-date)
   (let ((old-date (calendar-cursor-to-date))
         (today (calendar-current-date)))
            (cond
             ((calendar-date-is-visible-p old-date) old-date)
             ((calendar-date-is-visible-p today) today)
-            (t (list month 1 year))))))))
+            (t (list month 1 year)))))))
+  (run-hooks 'calendar-move-hook))
 
-(defun scroll-calendar-right (arg)
+(defun scroll-calendar-right (&optional arg)
   "Scroll the displayed calendar window right by ARG months.
 If ARG is negative the calendar is scrolled left.  Maintains the relative
 position of the cursor with respect to the calendar as well as possible."
   (interactive "p")
-  (scroll-calendar-left (- arg)))
+  (scroll-calendar-left (- (or arg 1))))
 
 (defun scroll-calendar-left-three-months (arg)
   "Scroll the displayed calendar window left by 3*ARG months.
         ;; Put the new month on the screen, if needed, and go to the new date.
         (if (not (calendar-date-is-visible-p new-cursor-date))
             (calendar-other-month new-display-month new-display-year))
-        (calendar-cursor-to-visible-date new-cursor-date))))
+        (calendar-cursor-to-visible-date new-cursor-date)))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-backward-day (arg)
   "Move the cursor back ARG days.
                      year)))
       (if (not (calendar-date-is-visible-p last-day))
           (calendar-other-month month year)
-      (calendar-cursor-to-visible-date last-day)))))
+      (calendar-cursor-to-visible-date last-day))))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-beginning-of-year (arg)
   "Move the cursor backward ARG year beginnings."
          (month (extract-calendar-month date))
          (day (extract-calendar-day date))
          (year (extract-calendar-year date))
-         (jan-first (list 1 1 year)))
+         (jan-first (list 1 1 year))
+	 (calendar-move-hook nil))
     (if (and (= day 1) (= 1 month))
         (calendar-backward-month (* 12 arg))
       (if (and (= arg 1)
                (calendar-date-is-visible-p jan-first))
           (calendar-cursor-to-visible-date jan-first)
-        (calendar-other-month 1 (- year (1- arg)))))))
+        (calendar-other-month 1 (- year (1- arg))))))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-end-of-year (arg)
   "Move the cursor forward ARG year beginnings."
          (month (extract-calendar-month date))
          (day (extract-calendar-day date))
          (year (extract-calendar-year date))
-         (dec-31 (list 12 31 year)))
+         (dec-31 (list 12 31 year))
+	 (calendar-move-hook nil))
     (if (and (= day 31) (= 12 month))
         (calendar-forward-month (* 12 arg))
       (if (and (= arg 1)
                (calendar-date-is-visible-p dec-31))
           (calendar-cursor-to-visible-date dec-31)
         (calendar-other-month 12 (- year (1- arg)))
-        (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
+        (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))
+  (run-hooks 'calendar-move-hook))
 
 (defun calendar-cursor-to-visible-date (date)
   "Move the cursor to DATE that is on the screen."
              2
            month)
          year)))
-  (calendar-cursor-to-visible-date date))
+  (calendar-cursor-to-visible-date date)
+  (run-hooks 'calendar-move-hook))
 
 (provide 'cal-move)
 
-;;; cal-persia.el --- calendar functions for the Persian calendar.
+;;; cal-persia.el --- calendar functions for the Persian calendar
 
 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX.
+;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
 
 ;; Copyright (C) 1995 Free Software Foundation, Inc.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
 
 ;;; Commentary:
 
   :type 'boolean
   :group 'calendar-tex)
 
+(defcustom cal-tex-rules nil
+  "*If t, pages will be ruled in some styles."
+:type 'boolean
+:group 'calendar-tex)
+
 (defcustom cal-tex-daily-string
   '(let* ((year (extract-calendar-year date))
           (day  (calendar-day-number date))
        (cal-tex-noindent)
        (cal-tex-nl)
        (calendar-for-loop i from 1 to 12 do
-          (insert (cal-tex-mini-calendar i year
-                                         (calendar-month-name i)
-                                         "1in" ".9in" "tiny" "0.6mm")))
-       (insert
+			  (insert (cal-tex-mini-calendar i year
+							 (calendar-month-name i)
+							 "1in" ".9in" "tiny" "0.6mm")))
+		       (insert
 "\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\
 \\noindent\\fbox{\\April}\\fbox{\\May}\\fbox{\\June}\\\\
 \\noindent\\fbox{\\July}\\fbox{\\August}\\fbox{\\September}\\\\
   (calendar-for-loop i from 0 to 6 do
      (if (memq i cal-tex-which-days)
          (insert (format cal-tex-day-name-format 
-                         (aref calendar-day-name-array 
-                               (mod (+ calendar-week-start-day i) 7)))))
+			  (aref calendar-day-name-array 
+				(mod (+ calendar-week-start-day i) 7)))))
      (cal-tex-comment)))
 
 (defun cal-tex-insert-month-header (n month year end-month end-year)
   "Create a title for a calendar.
 A title is inserted for a calendar with N months starting with 
 MONTH YEAR and ending with END-MONTH END-YEAR."
-  (let ( (month-name (calendar-month-name  month))
+  (let ((month-name (calendar-month-name  month))
          (end-month-name (calendar-month-name  end-month)))
     (if (= 1 n)
         (insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}"
     (if (not weekend)
 	(progn
 	  (calendar-for-loop i from 8 to 12 do
-	     (insert (format "{\\large\\sf %d}\\\\\n" i)))
+              (insert (format "{\\large\\sf %d}\\\\\n" i)))
 	  (calendar-for-loop i from 1 to 5 do
-	     (insert (format "{\\large\\sf %d}\\\\\n" i)))))
+	      (insert (format "{\\large\\sf %d}\\\\\n" 
+              (if cal-tex-24 (+ i 12) i))))))
     (cal-tex-nl ".5cm")
     (if weekend
 	(progn
           (if (= (extract-calendar-month date)
                  (extract-calendar-month d))
               (format "%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
+		      (calendar-month-name
+		       (extract-calendar-month date))
                       (extract-calendar-year date))
             (if (=  (extract-calendar-year date)
                     (extract-calendar-year d))
                 (format "%s---%s %s"
-                        (calendar-month-name
-                         (extract-calendar-month date))
+			(calendar-month-name
+			 (extract-calendar-month date))
                         (calendar-month-name
                          (extract-calendar-month d))
                         (extract-calendar-year date))
               (format "%s %s---%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
+		      (calendar-month-name
+		       (extract-calendar-month date))
                       (extract-calendar-year date)
                       (calendar-month-name (extract-calendar-month d))
                       (extract-calendar-year d))))))
   "Day-per-page Filofax style calendar for week indicated by cursor.
 Optional prefix argument specifies number of weeks.  Weeks start on Monday. 
 Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t."
+Holidays are included if `cal-tex-holidays' is t.
+Pages are ruled if `cal-tex-rules' is t."
   (interactive "P")
   (let* ((n (if arg arg 1))
          (date (calendar-gregorian-from-absolute
 \\long\\def\\rightday#1#2#3{%
    \\rule{\\textwidth}{0.3pt}\\\\%
    \\hbox to \\textwidth{%
-     \\vbox to 1.85in{%
+     \\vbox {%
           \\vspace*{2pt}%
           \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
           \\hbox to \\textwidth{\\vbox {\\raggedleft \\em #2}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+          \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
 \\long\\def\\weekend#1#2#3{%
    \\rule{\\textwidth}{0.3pt}\\\\%
    \\hbox to \\textwidth{%
-     \\vbox to 2in{%
+     \\vbox {%
           \\vspace*{2pt}%
           \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
           \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+          \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
 \\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
 \\long\\def\\leftday#1#2#3{%
    \\rule{\\textwidth}{0.3pt}\\\\%
    \\hbox to \\textwidth{%
-     \\vbox to 1.85in{%
+     \\vbox {%
           \\vspace*{2pt}%
           \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
           \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+          \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
+\\newbox\\LineBox
+\\setbox\\LineBox=\\hbox to\\textwidth{%
+\\vrule height.2in width0pt\\leaders\\hrule\\hfill}
+\\def\\linesfill{\\par\\leaders\\copy\\LineBox\\vfill}
 ")
     (cal-tex-b-document)
     (cal-tex-cmd "\\pagestyle{empty}")
        (insert "%\n")
        (insert (if odd "\\rightday"  "\\leftday")))
           (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
+          (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
           (cal-tex-arg (eval cal-tex-daily-string))
           (insert "%\n")
-          (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+	  (if cal-tex-rules
+	      (insert "\\linesfill\n")
+	    (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
           (cal-tex-newpage)
           (setq date (cal-tex-incr-date date)))
        (insert "%\n")
           (cal-tex-arg (calendar-date-string date))
           (insert "\\weekend")
           (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
+          (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
           (cal-tex-arg (eval cal-tex-daily-string))
           (insert "%\n")
-          (insert "\\vfill")
+          (if cal-tex-rules
+              (insert "\\linesfill\n")
+            (insert "\\vfill"))
           (setq date (cal-tex-incr-date date)))
-       (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+       (if (not cal-tex-rules)
+	   (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
        (if (/= i n)
            (progn
              (run-hooks 'cal-tex-week-hook)
   (calendar-gregorian-from-absolute
    (+ (if n n 1) (calendar-absolute-from-gregorian date))))
 
-(defun cal-tex-latexify-list (date-list date &optional separator)
+(defun cal-tex-latexify-list (date-list date &optional separator final-separator)
   "Return string with concatenated, LaTeXified entries in DATE_LIST for DATE.
-Use double backslash as a separator unless optional SEPARATOR is given."
-  (mapconcat '(lambda (x) (cal-tex-LaTeXify-string  x))
-             (let ((result)
-                   (p date-list))
-               (while p
-                 (and (car (car p))
-                      (calendar-date-equal date (car (car p)))
-                      (setq result (cons (car (cdr (car p))) result)))
-                 (setq p (cdr p)))
-               (reverse result))
-             (if separator separator "\\\\")))
+Use double backslash as a separator unless optional SEPARATOR is given.
+If resulting string is not empty, put separator at end if optional
+FINAL-SEPARATOR is t."
+  (let* ((sep (if separator separator "\\\\"))
+         (result
+	  (mapconcat '(lambda (x) (cal-tex-LaTeXify-string  x))
+		     (let ((result)
+			   (p date-list))
+		       (while p
+			 (and (car (car p))
+			      (calendar-date-equal date (car (car p)))
+			      (setq result (cons (car (cdr (car p))) result)))
+			 (setq p (cdr p)))
+		       (reverse result))
+		     sep)))
+    (if (and final-separator (not (string-equal result "")))
+	(concat result sep)
+      result)))
 
 (defun cal-tex-previous-month (date)
   "Return the date of the first day in the month previous to DATE."
 ;;      Edward M. Reingold <reingold@cs.uiuc.edu>
 ;; Modified for XEmacs by:  Chuck Thompson <cthomp@cs.uiuc.edu>
 ;; Keywords: calendar
-;; Human-Keywords: calendar, dedicated frames, x-windows
+;; Human-Keywords: calendar, dedicated frames, X Window System
 
 ;; This file is part of GNU Emacs.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with (Mostly): FSF 20.5
+;;; Synched up with (Mostly): FSF 21.4
 
 ;;; Commentary:
 
-;; This collection of functions implements dedicated frames in x-windows for
+;; This collection of functions implements dedicated frames in X for
 ;; calendar.el.
 
 ;; Comments, corrections, and improvements should be sent to
 
 (defun calendar-one-frame-setup (&optional arg)
   "Start calendar and display it in a dedicated frame together with the diary."
-  (if (calendar-not-using-window-system-p)
+  (if (not (display-multi-frame-p))
       (calendar-basic-setup arg)
     (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
     (if (frame-live-p diary-frame) (delete-frame diary-frame))
 
 (defun calendar-only-one-frame-setup (&optional arg)
   "Start calendar and display it in a dedicated frame."
-  (if (calendar-not-using-window-system-p)
+  (if (not (display-multi-frame-p))
       (calendar-basic-setup arg)
     (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
     (let ((special-display-buffer-names nil)
 
 (defun calendar-two-frame-setup (&optional arg)
   "Start calendar and diary in separate, dedicated frames."
-  (if (calendar-not-using-window-system-p)
+  (if (not (display-multi-frame-p))
       (calendar-basic-setup arg)
     (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
     (if (frame-live-p diary-frame) (delete-frame diary-frame))
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
  
-;;; Synched up with: cal-menu.el in Emacs 20.3
+;;; Synched up with: cal-menu.el in Emacs 21.4
 
 ;;; Commentary:
 
 
 (eval-when-compile (require 'calendar))
 (require 'easymenu)
+
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-popup-menus-p)
+  (defun display-popup-menus-p (&optional display)
+    "Return non-nil if popup menus are supported on DISPLAY.
+DISPLAY can be a frame, a device, a console, or nil (meaning the selected
+frame).  Support for popup menus requires that the mouse be available."
+    (and
+     (memq (framep-on-display display) '(x ns gtk mswindows))
+     (display-mouse-p display)))
+  )
+
  
 (defconst calendar-popup-menu-3
   '("Calendar"
 
 (define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)
 
-
 (defun cal-tex-mouse-filofax (e) 
   "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date."
   (interactive "e")
 	(add-submenu '("Calendar") calendar-diary-menu))
     (if (not (assoc "Moon" current-menubar))
 	(add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))
-
+ 
 (defun cal-menu-list-holidays-year ()
   "Display a list of the holidays of the selected date's year."
   (interactive)
-;;; calendar.el --- Calendar functions.
-
-;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997 
-;;       Free Software Foundation, Inc.
+;;; calendar.el --- calendar functions
+
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
+;;       2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;; Keywords: calendar
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with (Mostly): FSF 20.5
+;;; Synched up with (Mostly): FSF 21.4
 
 ;;; Commentary:
 
 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
 ;;                                   Urbana, Illinois 61801
 
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-multi-frame-p)
+  (defun display-multi-frame-p ()
+    (not (null (memq (device-type) '(x mswindows gtk))))
+    ))
+
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-color-p)
+  (defun display-color-p ()
+    (eq  'color (device-class))
+    ))
+
+;; XEmacs change
+;; only available in MULE
+(unless (featurep 'mule)
+  (setq enable-multibyte-characters nil))
+
+; propertize appeared in XEmacs subr.el r21-5-7: 1.26
+(unless (fboundp 'propertize)
+;; `propertize' is a builtin in GNU Emacs 21.
+  (defun propertize (string &rest properties)
+    "Return a copy of STRING with text properties added.
+First argument is the string to copy.
+Remaining arguments form a sequence of PROPERTY VALUE pairs for text
+properties to add to the result."
+    (let ((str (copy-sequence string)))
+      (add-text-properties 0 (length str)
+                           properties
+                           str)
+      str))
+  )
+
 ;;; Code:
 
+(eval-when-compile 
+  (defvar displayed-month)
+  (defvar displayed-year)
+  (defvar calendar-month-name-array)
+  (defvar calendar-starred-day))
+
+(require 'ibuffer)
+
 (defun calendar-version ()
   (interactive)
   (message "Version 6, October 12, 1995"))
 ;;;###autoload
 (defcustom 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,
+This variable affects the diary display when the command \\[diary] is used,
 or if the value of the variable `view-diary-entries-initially' is t.  For
 example, if the default value 1 is used, then only the current day's diary
 entries will be displayed.  If the value 2 is used, then both the current
   :type 'boolean
   :group 'diary)
 
+;;;###autoload
+(defcustom calendar-remove-frame-by-deleting nil
+  "*Determine how the calendar mode removes a frame no longer needed.
+If nil, make an icon of the frame.  If non-nil, delete the frame."
+:type 'boolean
+:group 'view)
+
+(defface diary-face
+  '((((class color) (background light))
+     (:foreground "red"))
+    (((class color) (background dark))
+     (:foreground "yellow"))
+    (t
+     (:weight bold t)))
+  "Face for highlighting diary entries."
+:group 'diary)
+
+(defface calendar-today-face
+  '((t (:underline t)))
+  "Face for indicating today's date."
+:group 'diary)
+
+(defface holiday-face
+  '((((class color) (background light))
+     (:background "pink"))
+    (((class color) (background dark))
+     (:background "chocolate4"))
+    (t
+     (:inverse-video t)))
+  "Face for indicating dates that have holidays."
+:group 'diary)
+
 (defcustom diary-entry-marker
-  (progn
-    (make-face 'diary-face)
-    (cond ((face-differs-from-default-p 'diary-face) nil)
-	  (t (set-face-foreground 'diary-face "red" 'global '(x color))
-	     (set-face-highlight-p 'diary-face t 'global 'tty)
-	     ;; avoid a weird problem when byte-compiling appt.el
-	     ;; in batch mode.
-	     (if (and (not noninteractive) (fboundp 'x-make-font-bold))
-		 (let ((bfont (x-make-font-bold
-			       (face-font-instance 'default)))
-		       (mono-tag (list 'x 'mono))
-		       (gray-tag (list 'x 'grayscale)))
-		   (if bfont
-		       (progn
-			 (set-face-font 'diary-face bfont 'global mono-tag)
-			 (set-face-font 'diary-face bfont 'global
-					gray-tag)))))))
+  (if (not (display-color-p))
+      "+"
     'diary-face)
   "*How to mark dates that have diary entries.
 The value can be either a single-character string or a face."
   :type '(choice string face)
   :group 'diary)
 
+(eval-after-load "facemenu"
+  '(progn
+    (add-to-list 'facemenu-unlisted-faces 'diary-face)
+    (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
+    (add-to-list 'facemenu-unlisted-faces 'holiday-face)))
+
 (defcustom calendar-today-marker
-  (progn
-    (make-face 'calendar-today-face)
-    (if (not (face-differs-from-default-p 'calendar-today-face))
-	(set-face-underline-p 'calendar-today-face t))
+  (if (not (display-color-p))
+      "="
     'calendar-today-face)
   "*How to mark today's date in the calendar.
 The value can be either a single-character string or a face.
   :group 'calendar)
 
 (defcustom calendar-holiday-marker
-  (progn
-    (make-face 'holiday-face)
-    (cond ((face-differs-from-default-p 'holiday-face) nil)
-	  (t (let ((color-tag (list 'x 'color))
-		   (mono-tag (list 'x 'mono))
-		   (gray-tag (list 'x 'grayscale)))
-	       (set-face-background 'holiday-face [default foreground] 'global
-				    mono-tag)
-	       (set-face-foreground 'holiday-face [default background] 'global
-				    mono-tag)
-	       (set-face-background 'holiday-face [default foreground] 'global
-				    gray-tag)
-	       (set-face-foreground 'holiday-face [default background] 'global
-				    gray-tag)
-	       (set-face-background 'holiday-face "pink" 'global color-tag)
-	       (set-face-reverse-p 'holiday-face t 'global 'tty))))
+  (if (not (display-color-p))
+      "*"
     'holiday-face)
   "*How to mark notable dates in the calendar.
 The value can be either a single-character string or a face."
   :group 'calendar-hooks)
 
 ;;;###autoload
+(defcustom calendar-move-hook nil
+  "*List of functions called whenever the cursor moves in the calendar.
+
+For example, 
+
+  (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
+
+redisplays the diary for whatever date the cursor is moved to."
+:type 'hook
+:group 'calendar-hooks)
+
+;;;###autoload
 (defcustom diary-file "~/diary"
   "*Name of the file in which one's personal diary of dates is kept.
 
 
 ;;;###autoload
 (defcustom sexp-diary-entry-symbol "%%"
-  "*The string used to indicate a sexp diary entry in diary-file.
+  "*The string used to indicate a sexp diary entry in `diary-file'.
 See the documentation for the function `list-sexp-diary-entries'."
   :type 'string
   :group 'diary)
   "*List of pseudo-patterns describing the American patterns of date used.
 See the documentation of `diary-date-forms' for an explanation."
   :type '(repeat (choice (cons :tag "Backup"
+			       :value (backup . nil)
 			       (const backup)
 			       (repeat (list :inline t :format "%v"
 					     (symbol :tag "Keyword")
 (defcustom european-date-diary-pattern
   '((day "/" month "[^/0-9]")
     (day "/" month "/" year "[^0-9]")
-    (backup day " *" monthname "\\W+\\<[^*0-9]")
+    (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
     (day " *" monthname " *" year "[^0-9]")
     (dayname "\\W"))
   "*List of pseudo-patterns describing the European patterns of date used.
 See the documentation of `diary-date-forms' for an explanation."
   :type '(repeat (choice (cons :tag "Backup"
+			       :value (backup . nil)
 			       (const backup)
 			       (repeat (list :inline t :format "%v"
 					     (symbol :tag "Keyword")
       european-date-diary-pattern
     american-date-diary-pattern)
   "*List of pseudo-patterns describing the forms of date used in the diary.
-The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match
+The patterns on the list must be MUTUALLY EXCLUSIVE and must not match
 any portion of the diary entry itself, just the date component.
 
 A pseudo-pattern is a list of regular expressions and the keywords `month',
 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."
   :type '(repeat (choice (cons :tag "Backup"
+			       :value (backup . nil)
 			       (const backup)
 			       (repeat (list :inline t :format "%v"
 					     (symbol :tag "Keyword")
 (defcustom european-calendar-display-form
   '((if dayname (concat dayname ", ")) day " " monthname " " year)
   "*Pseudo-pattern governing the way a date appears in the European style.
-See the documentation of calendar-date-display-form for an explanation."
+See the documentation of `calendar-date-display-form' for an explanation."
   :type 'sexp
   :group 'calendar)
 
   "*List of functions called after marking diary entries in the calendar.
 
 A function `mark-included-diary-files' is also provided for use as the
-mark-diary-entries-hook; it enables you to use shared diary files together
+`mark-diary-entries-hook'; it enables you to use shared diary files together
 with your own.  The files included are specified in the diary file by lines
 of the form
         #include \"filename\"
   (append general-holidays local-holidays other-holidays
           christian-holidays hebrew-holidays islamic-holidays
           oriental-holidays solar-holidays)
-  "*List of notable days for the command M-x holidays.
+  "*List of notable days for the command \\[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
 (defmacro increment-calendar-month (mon yr n)
   "Move the variables MON and YR to the month and year by N months.
 Forward if N is positive or backward if N is negative."
-  (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
-       (setq (, mon) (1+ (% macro-y 12) ))
-       (setq (, yr) (/ macro-y 12)))))
+  `(let ((macro-y (+ (* ,yr 12) ,mon -1 ,n)))
+    (setq ,mon (1+ (% macro-y 12)))
+    (setq ,yr (/ macro-y 12))))
 
 (defmacro calendar-for-loop (var from init to final do &rest body)
   "Execute a for loop."
-  (` (let (( (, var) (1- (, init)) ))
-       (while (>= (, final) (setq (, var) (1+ (, var))))
-         (,@ body)))))
+  `(let ((,var (1- ,init)))
+    (while (>= ,final (setq ,var (1+ ,var)))
+      ,@body)))
 
 (defmacro calendar-sum (index initial condition expression)
   "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
-  (` (let (( (, index) (, initial))
+  `(let ((,index ,initial)
              (sum 0))
-       (while (, condition)
-         (setq sum (+ sum (, expression) ))
-         (setq (, index) (1+ (, index))))
-       sum)))
+    (while ,condition
+      (setq sum (+ sum ,expression))
+      (setq ,index (1+ ,index)))
+    sum))
 
 ;; The following are in-line for speed; they can be called thousands of times
 ;; when looking up holidays or processing the diary.  Here, for example, are
   (car (cdr (cdr date))))
 
 (defsubst calendar-leap-year-p (year)
-  "Returns t if YEAR is a Gregorian leap year."
+  "Return t if YEAR is a Gregorian leap year."
   (and (zerop (% year 4))
        (or (not (zerop (% year 100)))
            (zerop (% year 400)))))
   "Move cursor to DATE."
   t)
 
+(autoload 'calendar-only-one-frame-setup "cal-x"
+  "Start calendar and display it in a dedicated frame.")
+
 (autoload 'calendar-one-frame-setup "cal-x"
   "Start calendar and display it in a dedicated frame together with the diary.")
 
 ;;;###autoload
 (defun calendar (&optional arg)
   "Choose between the one frame, two frame, or basic calendar displays.
-The original function `calendar' has been renamed `calendar-basic-setup'."
+If called with an optional prefix argument, prompts for month and year.
+
+The original function `calendar' has been renamed `calendar-basic-setup'.
+See the documentation of that function for more information."
   (interactive "P")
   (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
         ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
 `number-of-diary-entries' controls the number of days of diary entries
 displayed upon initial display of the calendar.
 
-An optional prefix argument ARG causes the calendar displayed to be ARG
-months in the future if ARG is positive or in the past if ARG is negative;
-in this case the cursor goes on the first day of the month.
-
 Once in the calendar window, future or past months can be moved into view.
 Arbitrary months can be displayed, or the calendar can be scrolled forward
 or backward.
 
 Diary entries can be marked on the calendar or displayed in another window.
 
-Use M-x describe-mode for details of the key bindings in the calendar window.
+Use \\[describe-mode] for details of the key bindings in the calendar window.
 
 The Gregorian calendar is assumed.
 
   "String of astronomical (Julian) day number of Gregorian date."
   t)
 
-(autoload 'calendar-goto-astro-date "cal-julian"
+(autoload 'calendar-goto-astro-day-number "cal-julian"
    "Move cursor to astronomical (Julian) day number."
    t)
 
+(autoload 'calendar-print-astro-day-number "cal-julian"
+   "Show the astro date equivalents of date."
+   t)
+
 (autoload 'calendar-julian-from-absolute "cal-julian"
   "Compute the Julian (month day year) corresponding to the absolute DATE.
 The absolute date is the number of days elapsed since the (imaginary)
   "String of ISO date of Gregorian date."
   t)
 
+(autoload 'calendar-goto-islamic-date "cal-islam"
+  "Move cursor to Islamic date."
+  t)
+
 (autoload 'calendar-print-islamic-date "cal-islam"
   "Show the Islamic date equivalents of date."
   t)
     (calendar-cursor-to-visible-date
      (if today-visible today (list displayed-month 1 displayed-year)))
     (set-buffer-modified-p nil)
-    (or (one-window-p t)
-        (/= (frame-width) (window-width))
-        (shrink-window (- (window-height) 9)))
+    (if (or (one-window-p t) (/= (frame-width) (window-width)))
+	;; Don't mess with the window size, but ensure that the first
+	;; line is fully visible
+	(if (fboundp 'set-window-vscroll)
+	    (set-window-vscroll nil 0))
+      ;; Adjust the window to exactly fit the displayed calendar
+      (ibuffer-shrink-to-fit ))
     (sit-for 0)
     (and mark-holidays-in-calendar
          (mark-calendar-holidays)
 (defun generate-calendar (month year)
   "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
   (if (< (+ month (* 12 (1- year))) 2)
-      (error "Months before February, 1 AD are not available."))
+      (error "Months before February, 1 AD are not available"))
   (setq displayed-month month)
   (setq displayed-year year)
   (erase-buffer)
    (goto-char (point-min))
    (calendar-insert-indented
     (calendar-string-spread
+     ;; XEmacs change - primarily for cal-japanese
      (list (format "%s %s"
 		   (calendar-month-name month)
 		   (calendar-year-name year month 1))) ?  20)
    ;; Put in the days of the month
    (calendar-for-loop i from 1 to last do
       (insert (format "%2d " i))
-      (put-text-property (- (point) (if (< i 10) 2 3)) (1- (point))
-			 'highlight t)
+      (add-text-properties (- (point) (if (< i 10) 2 3)) (1- (point))
+			 '(mouse-face highlight 
+			   help-echo "mouse-2:menu of operations for this date"))
       (and (zerop (mod (+ i blank-days) 7))
            (/= i last)
            (calendar-insert-indented "" 0 t)    ;; Force onto following line
       (setq l (cdr l))))
   (define-key calendar-mode-map "-"     'negative-argument)
   (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right)
-  (define-key calendar-mode-map '[prior] 'scroll-calendar-right-three-months)
-  (define-key calendar-mode-map "\M-v"   'scroll-calendar-right-three-months)
+  (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months)
+  (define-key calendar-mode-map "\ev"   'scroll-calendar-right-three-months)
   (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left)
-  (define-key calendar-mode-map '[next]  'scroll-calendar-left-three-months)
+  (define-key calendar-mode-map [next]  'scroll-calendar-left-three-months)
   (define-key calendar-mode-map "\C-v"  'scroll-calendar-left-three-months)
   (define-key calendar-mode-map "\C-b"  'calendar-backward-day)