Commits

Anonymous committed a8e353a

let's really commit the changes this time.

Comments (0)

Files changed (27)

 	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 \
-        todo-mode.elc timeclock.elc
+        todo-mode.elc timeclock.elc cal-bahai.elc icalendar.elc cal-compat.elc
 
 ifeq ($(BUILD_WITHOUT_MULE),)
 ELCS += cal-japanese.elc
 ;;; appt.el --- appointment notification functions
+
+;; Copyright (C) 1989, 1990, 1994, 1998, 2001, 2002, 2003, 2004, 2005,
+;;   2006  Free Software Foundation, Inc.
+
+;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 
-;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
-
-;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
-;; Maintainer: FSF
-;; Keywords: calendar
- 
 ;; This file is part of XEmacs.
 
 ;; XEmacs is free software; you can redistribute it and/or modify
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Synched up with: FSF Emacs 22.1 CVS 2006-09-15
 
 ;;; Commentary:
 
 ;;
 ;; appt.el - visible and/or audible notification of
-;;           appointments from ~/diary file.
+;;           appointments from diary file.
 ;;
 ;;;
-;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
+;;; 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.
+;;; This functions in this file will alert the user of a
+;;; pending appointment based on his/her diary file.  This package
+;;; is documented in the Emacs manual.
 ;;;
-;;; ******* 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 
-;;; from the diary in the mini-buffer, or you can choose to 
-;;; have a message displayed in a new buffer.
+;;; To activate this package, simply use (appt-activate 1).
+;;; A `diary-file' with appointments of the format described in the
+;;; documentation of the function `appt-check' is required.
+;;; Relevant customizable variables are also listed in the
+;;; documentation of that function.
 ;;;
-;;; Variables of note:
+;;; Today's appointment list is initialized from the diary when this
+;;; package is activated. Additionally, the appointments list is
+;;; recreated automatically at 12:01am for those who do not logout
+;;; every day or are programming late. It is also updated when the
+;;; `diary-file' is saved. Calling `appt-check' with an argument forces
+;;; a re-initialization at any time.
 ;;;
-;;; appt-issue-message		If this variable is nil, then the code in this
-;;;				file does nothing.
-;;; appt-msg-countdown-list	Specifies how much warning you want before 
-;;;				appointments.
-;;; appt-audible		Whether to beep when it's notification-time.
-;;; appt-display-mode-line	Whether to display a countdown to the next 
-;;;				appointment in the mode-line.
-;;; appt-announce-method	The function used to do the notifications.
-;;;	'appt-window-announce		   do it in a pop-up window.
-;;;     'appt-frame-announce		   do it in a pop-up frame (v19 only)
-;;;	'appt-message-announce		   do it in the echo area.
-;;;	'appt-persistent-message-announce  do it in the echo area, but make the
-;;;				    messages not go away at the next keystroke.
-;;; appt-display-duration	If appt-announce-method is set to the function
-;;;				'appt-window-announce, this specifies how many
-;;;				seconds the pop-up window should stick around.
+;;; In order to add or delete items from today's list, without
+;;; changing the diary file, use `appt-add' and `appt-delete'.
 ;;;
-;;; In order to use this, create a diary file, and add the following to your
-;;; .emacs file:
-;;;
-;;;    (require 'appt)
-;;;    (appt-initialize)
-;;;
-;;; If you wish to see a list of appointments, or a full calendar, when emacs
-;;; starts up, you can add a call to (diary) or (calendar) after this.
-;;;
-;;;  This is an example of what can be in your diary file:
-;;;	 Monday
-;;;	   9:30am Coffee break
-;;;	  12:00pm Lunch
-;;; 
-;;; Based upon the above lines in your .emacs and diary files, 
-;;; the calendar and diary will be displayed when you enter
-;;; Emacs and your appointments list will automatically be created.  
-;;; You will then be reminded at 9:20am about your coffee break 
-;;; and at 11:50am to go to lunch.
-;;;
-;;; In order to interactively add or delete items from today's list, use 
-;;; Meta-x appt-add and Meta-x appt-delete.  (This does not modify your 
-;;; diary file, so these will be forgotten when you exit emacs.)
-;;;
-;;;  Additionally, the appointments list is recreated automatically 
-;;;  at 12:01am for those who do not logout every day or are programming 
-;;;  late.
-;;;
-;;; You can have special appointments which execute arbitrary code rather than
-;;; simply notifying you -- sort of like the unix "cron" facility.  The syntax
-;;; for this is borrowed from the Calendar's special-date format.  If you have
-;;; a diary entry like
-;;;
-;;;  Monday
-;;;    3:00am	%%(save-all-modified-buffers)
-;;;
-;;; then on monday at 3AM, the function `save-all-modified-buffers' will be
-;;; invoked.  (Presumably this function is defined in your .emacs file.)
-;;; There will be no notification that these "special" appointments are being
-;;; triggered, unless the form evaluated produces a notification.
-;;;
-;;; It is necessary for the entire list after the "%%" to be on one line in 
-;;; your .diary file -- there may not be embedded newlines in it.  This is a
-;;; bit of a misfeature.
-;;;
-;;; This also interacts correctly with Benjamin Pierce's reportmail.el package.
-;;;
+
 ;;; Brief internal description - Skip this if you are not interested!
 ;;;
-;;; The function appt-initialize invokes 'diary' to get a list of today's
-;;; appointments, and parses the lines beginning with date descriptions.
-;;; This list is cached away.  'diary' is invoked in such a way so as to
-;;; not pop up a window displaying the diary buffer.
+;;; The function `appt-make-list' creates the appointments list which
+;;; `appt-check' reads.
 ;;;
-;;; The function appt-check is run from the 'loadst' process (or the 'wakeup'
-;;; process in emacs 18.57 or newer) which is started by invoking display-time.
-;;; It checks this cached list, and announces as appropriate.  At midnight,
-;;; appt-initialize is called again to rebuild this list.
+;;; You can change the way the appointment window is created/deleted by
+;;; setting the variables
 ;;;
-;;; display-time-filter is modified to invoke appt-check.
+;;;	     appt-disp-window-function
+;;; and
+;;; 	     appt-delete-window-function
 ;;;
-;;; TO DO:
+;;; For instance, these variables could be set to functions that display
+;;; appointments in pop-up frames, which are lowered or iconified after
+;;; `appt-display-interval' minutes.
 ;;;
-;;;  o  multiple adjacent appointments are not handled gracefully.  If there 
-;;;     is an appointment at 3:30 and another at 3:35, and you have set things
-;;;     up so that you get a notification twenty minutes before each appt,
-;;;     then a notification should come at 3:10 for the first appt, and at
-;;;     3:15 for the second.  Currently, no notifications are generated for an
-;;;     appointment until all preceding appointments have completely expired.
-;;;
-;;;  o  If there are two appointments at the same time, all but the first are
-;;;     ignored (not announced.)
-;;;
-;;;  o  Appointments which are early enough in the morning that their 
-;;;     announcements should begin before midnight are not announced until
-;;;     midnight.
-;;;
-;;;  o  There should be some way to mark certain appointments as "important,"
-;;;     so that you will be harassed about them even after they have expired.
 
 ;;; Code:
 
 ;; Make sure calendar is loaded when we compile this.
 (require 'calendar)
 
-(provide 'appt)
+;; XEmacs - this helps quiet the byte-compiler
+(eval-when-compile
+  (require 'diary-lib))
+
+(defvar diary-selective-display)
 
 ;;;###autoload
 (defcustom 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."
+To be detected, the diary entry must have the format described in the
+documentation of the function `appt-check'."
   :type 'boolean
   :group 'appt)
 
+;; XEmacs - only use the 2 arg form. 
+(make-obsolete-variable 'appt-issue-message
+                        "use the function `appt-activate', and the \
+variable `appt-display-format' instead.")
+
 ;;;###autoload
 (defcustom appt-message-warning-time 12
   "*Time in minutes before an appointment that the warning begins."
   "*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."
+  "*Non-nil means display appointment message in echo area.
+This variable is only relevant if `appt-msg-window' is nil."
   :type 'boolean
   :group 'appt)
-  
+
+;; XEmacs - only use the 2 arg form. 
+(make-obsolete-variable 'appt-visible 'appt-display-format)
+
 ;;;###autoload
-(defcustom appt-audible t
-  "*Controls whether appointment announcements should beep.
-Appt uses two sound-types for beeps: `appt' and `appt-final'.
-If this is a number, then that many beeps will occur.
-If this is a cons, the car is how many beeps, and the cdr is the
-  delay between them (a float, fraction of a second to sleep.)
-See also the variable `appt-msg-countdown-list'"
+(defcustom appt-msg-window t
+  "*Non-nil means display appointment message in another window.
+If non-nil, this variable overrides `appt-visible'."
+  :type 'boolean
+  :group 'appt)
+
+;; XEmacs - only use the 2 arg form. 
+(make-obsolete-variable 'appt-msg-window 'appt-display-format)
+
+
+;;;###autoload
+;(defcustom appt-audible t
+;  "*Controls whether appointment announcements should beep.
+;Appt uses two sound-types for beeps: `appt' and `appt-final'.
+;If this is a number, then that many beeps will occur.
+;If this is a cons, the car is how many beeps, and the cdr is the
+;  delay between them (a float, fraction of a second to sleep.)
+;See also the variable `appt-msg-countdown-list'"
+;  :type 'boolean
+;  :group 'appt)
+
+;; TODO - add popup.
+(defcustom appt-display-format 'ignore
+  "How appointment reminders should be displayed.
+The options are:
+   window - use a separate window
+   echo   - use the echo area
+   nil    - no visible reminder.
+See also `appt-audible' and `appt-display-mode-line'.
+
+The default value is 'ignore, which means to fall back on the value
+of the (obsolete) variables `appt-msg-window' and `appt-visible'."
+  :type '(choice
+          (const :tag "Separate window" window)
+          (const :tag "Echo-area" echo)
+          (const :tag "No visible display" nil)
+          (const :tag "Backwards compatibility setting - choose another value"
+                 ignore))
+  :group 'appt
+  :version "22.1")
+
+;;;###autoload
+(defcustom appt-display-mode-line t
+  "*Non-nil means display minutes to appointment and time on the mode line.
+This is in addition to any other display of appointment messages."
   :type 'boolean
   :group 'appt)
 
 ;;;###autoload
-(defcustom appt-display-mode-line t
-  "*Non-nil means display minutes to appointment and time on the mode line."
-  :type 'boolean
-  :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."
+  "*The number of seconds an appointment message is displayed.
+Only relevant if reminders are to be displayed in their own window."
   :type 'integer
   :group 'appt)
 
 ;;;###autoload
 (defcustom appt-display-diary t
-  "*Non-nil means to display the next days diary on the screen. 
+  "*Non-nil displays the diary when the appointment list is first initialized.
 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
-until the appointment, and the appointment description list.
-
-Reasonable values for this variable are 'appt-window-announce,
-'appt-message-announce, or 'appt-persistent-message-announce."
-  :type 'function
+  :type 'boolean
   :group 'appt)
 
 (defcustom appt-make-list-hook nil
 :type 'hook
 :group 'appt)
 
-(defvar appt-time-msg-list nil
-  "The list of appointments for today.  
-Use `appt-add' and `appt-delete' to add and delete appointments from list.
-The original list is generated from the today's `diary-entries-list'. 
-The number before each time/message is the time in minutes from midnight.")
 
-(defconst appt-max-time 1439
-  "11:59pm in minutes - number of minutes in a day minus 1.")
-  
-
+
 ;;; Announcement methods
 
-(defun appt-message-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 the minibuffer."
-  (message (if (eq min-to-app 0) "App't NOW."
-	       (format "App't in %d minute%s -- %s"
-		       min-to-app
-		       (if (eq 1 min-to-app) "" "s")
-		       (car (cdr appt))))))
+;(defun appt-message-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 the minibuffer."
+;  (message (if (eq min-to-app 0) "App't NOW."
+;	       (format "App't in %d minute%s -- %s"
+;		       min-to-app
+;		       (if (eq 1 min-to-app) "" "s")
+;		       (car (cdr appt))))))
 
-(defun appt-persistent-message-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 the minibuffer, but have those 
-messages stay around even if you type something (unlike normal messages)."
-  (let ((str (if (eq min-to-app 0)
-		 (format "App't NOW -- %s" (car (cdr appt)))
-		 (format "App't in %d minute%s -- %s"
-			 min-to-app
-			 (if (eq 1 min-to-app) "" "s")
-			 (car (cdr appt)))))
-	(in-echo-area-already (eq (selected-window) (minibuffer-window))))
-    (if (not in-echo-area-already)
-	;; don't stomp the echo-area-buffer if reading from the minibuffer now.
-	(save-excursion
-	  (save-window-excursion
-	    (select-window (minibuffer-window))
-	    (delete-region (point-min) (point-max))
-	    (insert str))))
-    ;; if we're reading from the echo-area, and all we were going to do is
-    ;; clear the thing, like, don't bother, that's annoying.
-    (if (and in-echo-area-already (string= "" str))
-	nil
-      (message "%s" str))
-    ))
+;(defun appt-persistent-message-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 the minibuffer, but have those 
+;messages stay around even if you type something (unlike normal messages)."
+;  (let ((str (if (eq min-to-app 0)
+;		 (format "App't NOW -- %s" (car (cdr appt)))
+;		 (format "App't in %d minute%s -- %s"
+;			 min-to-app
+;			 (if (eq 1 min-to-app) "" "s")
+;			 (car (cdr appt)))))
+;	(in-echo-area-already (eq (selected-window) (minibuffer-window))))
+;    (if (not in-echo-area-already)
+;	;; don't stomp the echo-area-buffer if reading from the minibuffer now.
+;	(save-excursion
+;	  (save-window-excursion
+;	    (select-window (minibuffer-window))
+;	    (delete-region (point-min) (point-max))
+;	    (insert str))))
+;    ;; if we're reading from the echo-area, and all we were going to do is
+;    ;; clear the thing, like, don't bother, that's annoying.
+;    (if (and in-echo-area-already (string= "" str))
+;	nil
+;      (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*"
+  :type 'integer
+  :group 'appt)
+
+(defcustom appt-disp-window-function 'appt-disp-window
+  "Function called to display appointment window.
+Only relevant if reminders are being displayed in a window."
+  :type '(choice (const appt-disp-window)
+                 function)
+  :group 'appt)
+
+(defcustom appt-delete-window-function 'appt-delete-window
+  "Function called to remove appointment window and buffer.
+Only relevant if reminders are being displayed in a window."
+  :type '(choice (const appt-delete-window)
+                 function)
+  :group 'appt)
+
+
+;;; Internal variables below this point.
+
+(defconst appt-buffer-name " *appt-buf*"
   "Name of the appointments buffer.")
 
-(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."
-  (let ()
-    (save-excursion
-      (set-buffer (get-buffer-create appt-buffer-name))
-      (erase-buffer)
-      ;; 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")))
-		    ") %-"))
-      (insert (car (cdr appt)))
-      (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
-						      (point-max)))))))
-        ;; If we already have a frame constructed, use it. If not, or it has
-        ;; been deleted, then make a new one
-	(if (and appt-disp-frame (frame-live-p appt-disp-frame))
-	    (let ((s (selected-frame)))
-	      (select-frame appt-disp-frame)
-	      (make-frame-visible appt-disp-frame)
-	      (set-frame-height appt-disp-frame height)
-	      (sit-for 0)
-	      (select-frame s))
-          (progn
-            (setq appt-disp-frame (make-frame))
-            (set-frame-height appt-disp-frame height)
-            )
-          )
-	;; make the buffer visible in the frame 
-	;; and make the frame visible
-	(let ((pop-up-windows nil))
-	  (pop-to-buffer (get-buffer appt-buffer-name) 
-			 nil 
-			 appt-disp-frame)
-	  (make-frame-visible appt-disp-frame))
-        )
-      )
-    )
-  )
+(defvar appt-time-msg-list nil
+  "The list of appointments for today.
+Use `appt-add' and `appt-delete' to add and delete appointments.
+The original list is generated from today's `diary-entries-list', and
+can be regenerated using the function `appt-check'.
+Each element of the generated list has the form (MINUTES STRING [FLAG]); where
+MINUTES is the time in minutes of the appointment after midnight, and
+STRING is the description of the appointment.
+FLAG, if non-nil, says that the element was made with `appt-add'
+so calling `appt-make-list' again should preserve it.")
+
+;(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."
+;  (let ()
+;    (save-excursion
+;      (set-buffer (get-buffer-create appt-buffer-name))
+;      (erase-buffer)
+;      ;; 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")))
+;		    ") %-"))
+;      (insert (car (cdr appt)))
+;      (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
+;						      (point-max)))))))
+;        ;; If we already have a frame constructed, use it. If not, or it has
+;        ;; been deleted, then make a new one
+;	(if (and appt-disp-frame (frame-live-p appt-disp-frame))
+;	    (let ((s (selected-frame)))
+;	      (select-frame appt-disp-frame)
+;	      (make-frame-visible appt-disp-frame)
+;	      (set-frame-height appt-disp-frame height)
+;	      (sit-for 0)
+;	      (select-frame s))
+;          (progn
+;            (setq appt-disp-frame (make-frame))
+;            (set-frame-height appt-disp-frame height)
+;            )
+;          )
+;	;; make the buffer visible in the frame 
+;	;; and make the frame visible
+;	(let ((pop-up-windows nil))
+;	  (pop-to-buffer (get-buffer appt-buffer-name) 
+;			 nil 
+;			 appt-disp-frame)
+;	  (make-frame-visible appt-disp-frame))
+;        )
+;      )
+;    )
+;  )
 (defalias 'appt-screen-announce 'appt-frame-announce)
 
 ;;; To display stuff in the mode line, we use a new variable instead of
   :type 'string
   :group 'appt)
 
-(defun appt-display-mode-line (min-to-app)
-  "Add an appointment annotation to the mode line."
-  (setq appt-mode-line-string
-	(if (and appt-display-mode-line min-to-app)
-	    (if (eq 0 min-to-app)
-		"App't NOW "
-		(concat "App't in " (format "%s" min-to-app)
-			(if (eq 1 min-to-app) " minute  " " minutes ")))
-	    ""))
-  ;; make sure our variable is visible in global-mode-string.
-  (cond ((not appt-display-mode-line) nil)
-	((null global-mode-string)
-	 (setq global-mode-string (list "" 'appt-mode-line-string)))
-	((stringp global-mode-string)
-	 (setq global-mode-string
-	       (list global-mode-string 'appt-mode-line-string)))
-	((not (memq 'appt-mode-line-string global-mode-string))
-	 (setq global-mode-string
-	       (append global-mode-string (list 'appt-mode-line-string)))))
-  ;; force mode line updates - from time.el
-  (save-excursion (set-buffer (other-buffer)))
-  (set-buffer-modified-p (buffer-modified-p))
-  (sit-for 0))
+;(defun appt-display-mode-line (min-to-app)
+;  "Add an appointment annotation to the mode line."
+;  (setq appt-mode-line-string
+;	(if (and appt-display-mode-line min-to-app)
+;	    (if (eq 0 min-to-app)
+;		"App't NOW "
+;		(concat "App't in " (format "%s" min-to-app)
+;			(if (eq 1 min-to-app) " minute  " " minutes ")))
+;	    ""))
+;  ;; make sure our variable is visible in global-mode-string.
+;  (cond ((not appt-display-mode-line) nil)
+;	((null global-mode-string)
+;	 (setq global-mode-string (list "" 'appt-mode-line-string)))
+;	((stringp global-mode-string)
+;	 (setq global-mode-string
+;	       (list global-mode-string 'appt-mode-line-string)))
+;	((not (memq 'appt-mode-line-string global-mode-string))
+;	 (setq global-mode-string
+;	       (append global-mode-string (list 'appt-mode-line-string)))))
+;  ;; force mode line updates - from time.el
+;  (save-excursion (set-buffer (other-buffer)))
+;  (set-buffer-modified-p (buffer-modified-p))
+;  (sit-for 0))
 
 
 ;;; Internal stuff
 	     (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.")
+(defconst appt-max-time (1- (* 24 60))
+  "11:59pm in minutes - number of minutes in a day minus 1.")
 
 (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.")
+The actual string includes the amount of time till the appointment.
+Only used if `appt-display-mode-line' is non-nil.")
 
 (defvar appt-prev-comp-time nil
-  "Time of day (mins since midnight) at which we last checked appointments.")
+  "Time of day (mins since midnight) at which we last checked appointments.
+A nil value forces the diary file to be (re-)checked for 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.
-Note: the time must be the first thing in the line in the diary 
- for a warning to be issued.
+(defvar appt-display-count nil
+  "Internal variable used to count number of consecutive reminders.")
 
-The format of the time can be either 24 hour or am/pm.
-Example: 
-  
-               02/23/89
-                 18:00 Dinner
+(defvar appt-timer nil
+  "Timer used for diary appointment notifications (`appt-check').
+If this is non-nil, appointment checking is active.")
+
+
+;;; Functions.
+
+(defun appt-display-message (string mins)
+  "Display a reminder about an appointment.
+The string STRING describes the appointment, due in integer MINS minutes.
+The format of the visible reminder is controlled by `appt-display-format'.
+The variable `appt-audible' controls the audible reminder."
+  ;; let binding for backwards compatability. Remove when obsolete
+  ;; vars appt-msg-window and appt-visible are dropped.
+  (let ((appt-display-format
+         (if (eq appt-display-format 'ignore)
+             (cond (appt-msg-window 'window)
+                   (appt-visible 'echo))
+           appt-display-format)))
+    (cond ((eq appt-display-format 'window)
+           (funcall appt-disp-window-function
+                    (number-to-string mins)
+                    ;; TODO - use calendar-month-abbrev-array rather
+                    ;; than %b?
+                    (format-time-string "%a %b %e " (current-time))
+                    string)
+           (run-at-time (format "%d sec" appt-display-duration)
+                        nil
+                        appt-delete-window-function))
+          ((eq appt-display-format 'echo)
+           (message "%s" string)))
+    (if appt-audible (beep 1))))
+
+
+(defun appt-check (&optional force)
+  "Check for an appointment and update any reminder display.
+If optional argument FORCE is non-nil, reparse the diary file for
+appointments.  Otherwise the diary file is only parsed once per day,
+and when saved.
+
+Note: the time must be the first thing in the line in the diary
+for a warning to be issued.  The format of the time can be either
+24 hour or am/pm.  For example:
+
+              02/23/89
+                18:00 Dinner
 
               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-display-format'
+        Controls the format in which reminders are displayed.
+
+`appt-audible'
+	Variable used to determine if reminder is audible.
+	Default is t.
 
 `appt-message-warning-time'
-       Variable used to determine if appointment message
-       should be displayed.
+	Variable used to determine when appointment message
+	should first be displayed.
 
-`appt-audible'
-       Variable used to determine if appointment is audible.
-       Default is t.
+`appt-display-mode-line'
+        If non-nil, a generic message giving the time remaining
+        is shown in the mode-line when an appointment is due.
 
-`appt-visible'
-       Variable used to determine if appointment message should be
-       displayed in the mini-buffer.  Default is t.
+`appt-display-interval'
+        Interval in minutes at which to check for pending appointments.
 
-`appt-msg-window'
-       Variable used to determine if appointment message
-       should temporarily appear in another window.  Mutually exclusive
-       to `appt-visible'.
+`appt-display-diary'
+        Display the diary buffer when the appointment list is
+        initialized for the first time in a day.
+
+The following variables are only relevant if reminders are being
+displayed in a window:
 
 `appt-display-duration'
-       The number of seconds an appointment message
-       is displayed in another window.
+	The number of seconds an appointment message is displayed.
 
 `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.
-  
+    	Function called to display appointment window.
+
 `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.
- 
+    	Function called to remove appointment window and buffer."
 
- appt-msg-countdown-list	Specifies how much warning you want before 
-				appointments.
- appt-display-mode-line		Whether to display a countdown to the next 
-				appointment in the mode-line.
- appt-announce-method   	The function used to do the notifications.
-				'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."
-
-  (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* ((min-to-app -1)
+	 (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.
+	      (zerop (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)))
 
     (when (or full-check mode-line-only)
       (save-excursion
 	       (cur-min (nth 1 now))
 	       (cur-comp-time (+ (* cur-hour 60) cur-min)))
 
-	  ;; At the first check in any given day, update our 
+	  ;; 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)
+	  (if (or force                 ; eg initialize, diary save
+                  (null appt-prev-comp-time)             ; first check
+		  (< cur-comp-time appt-prev-comp-time)) ; new day
+	      (condition-case nil
+                  (if appt-display-diary
+                      (let ((diary-hook
+                             (if (assoc 'appt-make-list diary-hook)
+                                 diary-hook
+                               (cons 'appt-make-list diary-hook))))
+                        (diary))
+                    (let* ((diary-display-hook 'appt-make-list)
+                           (d-buff (find-buffer-visiting
+                                    (substitute-in-file-name diary-file)))
+                           (selective
+                            (if d-buff        ; Diary buffer exists.
+                                (with-current-buffer d-buff
+                                  diary-selective-display))))
+                      (diary)
+                      ;; If the diary buffer existed before this command,
+                      ;; restore its display state. Otherwise, kill it.
+                      (if d-buff
+                          ;; Displays the diary buffer.
+                          (or selective (diary-show-all-entries))
+                        (and
+                         (setq d-buff (find-buffer-visiting
+                                       (substitute-in-file-name diary-file)))
+                         (kill-buffer d-buff)))))
+		(error nil)))
 
-          (setq appt-mode-string nil)
-          (setq appt-display-count nil)
+	  (setq appt-prev-comp-time cur-comp-time
+                appt-mode-string nil
+                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 
+	  ;; 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 
+		(while (and appt-time-msg-list
 			    (< appt-comp-time cur-comp-time))
-		  (setq appt-time-msg-list (cdr appt-time-msg-list)) 
+		  (setq appt-time-msg-list (cdr appt-time-msg-list))
 		  (if appt-time-msg-list
-		      (setq appt-comp-time 
+		      (setq appt-comp-time
 			    (car (car (car appt-time-msg-list))))))
-	     
+
 		;; If we have an appointment between midnight and
 		;; '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 
+		;; to appointment variable. It is equal to the number of
+		;; minutes before midnight plus the number of
 		;; minutes after midnight our appointment is.
-	     
+
 		(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 
+		    (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
 
 		(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))
+		  (setq appt-now-displayed t
+                        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))))
-	       
+                    (appt-display-message (cadr (car appt-time-msg-list))
+                                          min-to-app))
 		  (when appt-display-mode-line
 		    (setq appt-mode-string
-			  (concat  " App't in "
-				   (number-to-string min-to-app)
-				   " min. ")))
-	       
+                          (format " App't in %s min." min-to-app)))
+
 		  ;; 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 
-			    (cdr appt-time-msg-list)
+		  (if (zerop min-to-app)
+		      (setq appt-time-msg-list (cdr appt-time-msg-list)
 			    appt-display-count nil)))))
-       
+
 	  ;; If we have changed the mode line string,
 	  ;; redisplay all mode lines.
 	  (and appt-display-mode-line
 ;;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."
+(defun appt-disp-window (min-to-app new-time appt-msg)
+  "Display appointment message APPT-MSG in a separate buffer.
+The appointment is due in MIN-TO-APP (a string) minutes.
+NEW-TIME is a string giving the date."
   (require 'electric)
-  
+
   ;; Make sure we're not in the minibuffer
   ;; before splitting the window.
-  
+
   (if (equal (selected-window) (minibuffer-window))
-      (if (other-window 1) 
+      (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))))
+
+  (let ((this-window (selected-window))
+        (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
 
     (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)))
+      ;; XEmacs, we don't have either of these functions
+      ;;  (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 " %-"))
+        (select-window (split-window)))
+      (switch-to-buffer appt-disp-buf)
+      ;;)
+    (calendar-set-mode-line
+     (format " Appointment in %s minutes. %s " min-to-app new-time))
     (erase-buffer)
     (insert 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))))
-  
+    (select-window this-window)))
+
 (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))))
+	 (or (eq window (frame-root-window (window-frame window)))
+	     (delete-window window))))
   (kill-buffer appt-buffer-name)
   (if appt-audible
       (beep 1)))
 (defun appt-select-lowest-window ()
 "Select the lowest window on the frame."
   (let ((lowest-window (selected-window))
+        ;; XEmacs change, we don't have window-edges
        (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)))))
+		    (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)))
 
+(defconst appt-time-regexp
+  "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?")
+
 ;;;###autoload
 (defun appt-add (new-appt-time new-appt-msg)
-  "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
+  "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG.
 The time should be in either 24 hour format or am/pm format."
- 
   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
-  (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
-      nil
+  (unless (string-match appt-time-regexp new-appt-time)
     (error "Unacceptable time-string"))
-  
-  (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 (nconc appt-time-msg-list (list time-msg)))
-    (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
+  (let ((time-msg (list (list (appt-convert-time new-appt-time))
+                        (concat new-appt-time " " new-appt-msg) t)))
+    (unless (member time-msg appt-time-msg-list)
+      (setq appt-time-msg-list
+            (appt-sort-list (nconc appt-time-msg-list (list time-msg)))))))
 
 ;;;###autoload
 (defun appt-delete ()
   "Delete an appointment from the list of appointments."
   (interactive)
-  (let* ((tmp-msg-list appt-time-msg-list))
+  (let ((tmp-msg-list appt-time-msg-list))
     (while tmp-msg-list
       (let* ((element (car tmp-msg-list))
-             (prompt-string (concat "Delete " 
+             (prompt-string (concat "Delete "
 				    ;; 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)) 				    
+				      (car (cdr element)) 0))
                                     " from list? "))
              (test-input (y-or-n-p prompt-string)))
         (setq tmp-msg-list (cdr tmp-msg-list))
     (appt-check)
     (message "")))
 
-
+
 (eval-when-compile (defvar number)
-                  (defvar original-date)
-                  (defvar diary-entries-list))
+		   (defvar original-date)
+		   (defvar diary-entries-list))
 ;;;###autoload
 (defun appt-make-list ()
-  "Create the appointments list from todays diary buffer.
+  "Update the appointments list from today's 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."
+put in the appointments list (see examples in documentation of
+the function `appt-check').  We assume that the variables DATE and
+NUMBER hold the arguments that `diary-list-entries' received.
+They specify the range of dates that the diary is being processed for.
 
-  ;; 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
+Any appointments made with `appt-add' are not affected by this
+function.
 
-	    ;; 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.
+For backwards compatibility, this function activates the
+appointment package (if it is not already active)."
+  ;; See comments above appt-activate defun.
+  (if (not appt-timer)
+      (appt-activate 1)
+    ;; 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.
+          (dolist (elt appt-time-msg-list)
+            ;; Delete any entries that were not made with appt-add.
+            (unless (nth 2 elt)
+              (setq appt-time-msg-list
+                    (delq elt appt-time-msg-list))))
+          (if diary-entries-list
 
-	    (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)))))
+              ;; 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.
 
-                    ;; 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))))
+              (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 appt-time-regexp time-string)
+                      (let* ((beg (match-beginning 0))
+                             ;; Get just the time for this appointment.
+                             (only-time (match-string 0 time-string))
+                             ;; Find the end of this appointment
+                             ;; (the start of the next).
+                             (end (string-match
+                                   (concat "\n[ \t]*" appt-time-regexp)
+                                   time-string
+                                   (match-end 0)))
+                             ;; Get the whole string for this appointment.
+                             (appt-time-string
+                              (substring time-string beg (if end (1- end)))))
 
-                     ;; 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)))))
+                        ;; 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))))
 
-	  (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))))))))))
-  
+                        ;; Discard this appointment from the string.
+                        (setq time-string
+                              (if end (substring time-string end) "")))))
+                  (setq entry-list (cdr entry-list)))))
+          ;; XEmacs change
+          (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 (caar 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 (caar appt-time-msg-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))
-             (element-time (car (car element)))
-             (tmp-list (cdr appt-list)))
-        (while tmp-list
-          (if (< element-time (car (car (car tmp-list))))
-              nil
-            (setq element (car tmp-list))
-            (setq element-time (car (car element))))
-          (setq tmp-list (cdr tmp-list)))
-        (setq order-list (nconc order-list (list element)))
-        (setq appt-list (delq element appt-list))))
-    order-list))
+  "Sort an appointment list, putting earlier items at the front.
+APPT-LIST is a list of the same format as `appt-time-msg-list'."
+(sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
 
 
 (defun appt-convert-time (time2conv)
-  "Convert hour:min[am/pm] format to minutes from midnight."
+  "Convert hour:min[am/pm] format to minutes from midnight.
+A period (.) can be used instead of a colon (:) to separate the
+hour and minute parts."
+  ;; Formats that should be accepted:
+  ;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am
+  (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv)
+                 (string-to-number (match-string 1 time2conv))
+               0))
+        (hr (if (string-match "[0-9]*[0-9]" time2conv)
+                (string-to-number (match-string 0 time2conv))
+              0)))
 
-  (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))
 
+    ;; convert the actual time into minutes.
+    (+ (* hr 60) min)))
 
 
-(defvar display-time-hook-installed nil)
+(defun appt-update-list ()
+  "If the current buffer is visiting the diary, update appointments.
+This function is intended for use with `write-file-functions'."
+  (and (string-equal buffer-file-name (expand-file-name diary-file))
+       appt-timer
+       (let ((appt-display-diary nil))
+         (appt-check t)))
+  nil)
 
-(defun install-display-time-hook ()
- (unless display-time-hook-installed	; only do this stuff once!
-   (unless (boundp 'display-time-hook)	; Need to wrapper it.
-     (defvar display-time-hook nil
-       "*List of functions to be called when the time is updated on the mode line.")
-     (let ((old-fn (if (or (featurep 'reportmail)
-			   ;; old reportmail without a provide statement
-			   (and (fboundp 'display-time-filter-18-55)
-				(fboundp 'display-time-filter-18-57)))
-		       (if (and (featurep 'itimer)  ; XEmacs reportmail.el
-				(fboundp 'display-time-timer-function))
-			   'display-time-timer-function
-			 ;; older reportmail, or no timer.el.
-			 (if (string-match "18\\.5[0-5]" (emacs-version))
-			     'display-time-filter-18-55
-			   'display-time-filter-18-57))
-		     ;; othewise, time.el
-		     (if (and (featurep 'itimer)
-			      (fboundp 'display-time-function)) ; XEmacs
-			 'display-time-function
-		       'display-time-filter))))
-    ;; we're about to redefine it...
-       (fset 'old-display-time-filter (symbol-function old-fn))
-       (fset old-fn
-	     (lambda (&rest args)  ;; ...here's the revised definition
-	       "Revised version of the original function: this version calls a hook."
-	       (apply 'old-display-time-filter args)
-	       (run-hooks 'display-time-hook)))))
-   (setq display-time-hook-installed t)
-   (if (fboundp 'add-hook)
-       (add-hook 'display-time-hook 'appt-check)
-     (setq display-time-hook (cons appt-check display-time-hook)))
-   ))
 
+;; In Emacs-21.3, the manual documented the following procedure to
+;; activate this package:
+;;     (display-time)
+;;     (add-hook 'diary-hook 'appt-make-list)
+;;     (diary 0)
+;; The display-time call was not necessary, AFAICS.
+;; What was really needed was to add the hook and load this file.
+;; Calling (diary 0) once the hook had been added was in some sense a
+;; roundabout way of loading this file. This file used to have code at
+;; the top-level that set up the appt-timer and global-mode-string.
+;; One way to maintain backwards compatibility would be to call
+;; (appt-activate 1) at top-level. However, this goes against the
+;; convention that just loading an Emacs package should not activate
+;; it. Instead, we make appt-make-list activate the package (after a
+;; suggestion from rms). This means that one has to call diary in
+;; order to get it to work, but that is in line with the old (weird,
+;; IMO) documented behavior for activating the package.
+;; Actually, since (diary 0) does not run diary-hook, I don't think
+;; the documented behavior in Emacs-21.3 would ever have worked.
+;; Oh well, at least with the changes to appt-make-list it will now
+;; work as well as it ever did.
+;; The new method is just to use (appt-activate 1).
+;; -- gmorris
 
-(defvar appt-timer nil
-  "Timer used for diary appointment notifications (`appt-check').")
+;;;###autoload
+(defun appt-activate (&optional arg)
+"Toggle checking of appointments.
+With optional numeric argument ARG, turn appointment checking on if
+ARG is positive, otherwise off."
+  (interactive "P")
+  (let ((appt-active appt-timer))
+    (setq appt-active (if arg (> (prefix-numeric-value arg) 0)
+                        (not appt-active)))
+    ;; XEmacs - we use write-file-hooks
+    (remove-hook 'write-file-hooks 'appt-update-list)
+    (or global-mode-string (setq global-mode-string '("")))
+    (delq 'appt-mode-string global-mode-string)
+    (when appt-timer
+      ;; XEmacs - really uses itimer
+      (appt-cancel-timer appt-timer)
+      (setq appt-timer nil))
+    (when appt-active
+      ;; XEmacs - we use write-file-hooks
+      (add-hook 'write-file-hooks 'appt-update-list)
+      (setq appt-timer (run-at-time t 60 'appt-check)
+            global-mode-string
+            (append global-mode-string '(appt-mode-string)))
+      (appt-check t))))
 
-(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"
+;; This is needed for backwards compatibility. Feh.
+;; Not for XEmacs, we don't activate appt when the package is loaded.
+;;(appt-activate 1)
 
-  (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))))
+(defalias 'appt-initialize 'appt-activate)
+(provide 'appt)
 
-  (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))))
-  )
-
+;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347
 ;;; appt.el ends here
-
+;;; cal-bahai.el --- calendar functions for the Baha'i calendar.
+
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006
+;;   Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@gnu.org>
+;; Keywords: calendar
+;; Human-Keywords: Baha'i calendar, Baha'i, Bahai, calendar, diary
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Synched up with: FSF Emacs 22.1 CVS 2006-09-15
+
+;;; Commentary:
+
+;; This collection of functions implements the features of calendar.el
+;; and diary.el that deal with the Baha'i calendar.
+
+;; The Baha'i (http://www.bahai.org) calendar system is based on a
+;; solar cycle of 19 months with 19 days each.  The four remaining
+;; "intercalary" days are called the Ayyam-i-Ha (days of Ha), and are
+;; placed between the 18th and 19th months.  They are meant as a time
+;; of festivals preceding the 19th month, which is the month of
+;; fasting.  In Gregorian leap years, there are 5 of these days (Ha
+;; has the numerical value of 5 in the arabic abjad, or
+;; letter-to-number, reckoning).
+
+;; Each month is named after an attribute of God, as are the 19 days
+;; -- which have the same names as the months.  There is also a name
+;; for each year in every 19 year cycle.  These cycles are called
+;; Vahids.  A cycle of 19 Vahids (361 years) is called a Kullu-Shay,
+;; which means "all things".
+
+;; The calendar was named the "Badi calendar" by its author, the Bab.
+;; It uses a week of seven days, corresponding to the Gregorian week,
+;; each of which has its own name, again patterned after the
+;; attributes of God.
+
+;; Note: The days of Ayyam-i-Ha are encoded as zero and negative
+;; offsets from the first day of the final month.  So, (19 -3 157) is
+;; the first day of Ayyam-i-Ha, in the year 157 BE.
+
+;;; Code:
+
+(defvar date)
+(defvar displayed-month)
+(defvar displayed-year)
+(defvar number)
+(defvar original-date)
+
+(eval-when-compile
+  (require 'diary-lib))
+
+(require 'cal-julian)
+
+(defvar bahai-calendar-month-name-array
+  ["Baha" "Jalal" "Jamal" "`Azamat" "Nur" "Rahmat" "Kalimat" "Kamal"
+   "Asma" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masa'il"
+   "Sharaf" "Sultan" "Mulk" "`Ala"])
+
+(defvar calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
+  "Absolute date of start of Baha'i calendar = March 19, 622 A.D. (Julian).")
+
+(defun bahai-calendar-leap-year-p (year)
+  "True if YEAR is a leap year on the Baha'i calendar."
+  (calendar-leap-year-p (+ year 1844)))
+
+(defvar bahai-calendar-leap-base
+  (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)))
+
+(defun calendar-absolute-from-bahai (date)
+  "Compute absolute date from Baha'i date 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))
+	 (prior-years (+ (1- year) 1844))
+	 (leap-days (- (+ (/ prior-years 4) ; Leap days in prior years.
+			  (- (/ prior-years 100))
+			  (/ prior-years 400))
+		       bahai-calendar-leap-base)))
+    (+ (1- calendar-bahai-epoch)	; Days before epoch
+       (* 365 (1- year))		; Days in prior years.
+       leap-days
+       (calendar-sum m 1 (< m month) 19)
+       (if (= month 19) 4 0)
+       day)))				; Days so far this month.
+
+(defun calendar-bahai-from-absolute (date)
+  "Baha'i year corresponding to the absolute DATE."
+  (if (< date calendar-bahai-epoch)
+      (list 0 0 0) ;; pre-Baha'i date
+    (let* ((greg (calendar-gregorian-from-absolute date))
+	   (year (+ (- (extract-calendar-year greg) 1844)
+		    (if (or (> (extract-calendar-month greg) 3)
+			    (and (= (extract-calendar-month greg) 3)
+				 (>= (extract-calendar-day greg) 21)))
+			1 0)))
+           (month ;; Search forward from Baha.
+            (1+ (calendar-sum m 1
+			      (> date
+				 (calendar-absolute-from-bahai
+				  (list m 19 year)))
+			      1)))
+           (day	;; Calculate the day by subtraction.
+            (- date
+               (1- (calendar-absolute-from-bahai (list month 1 year))))))
+      (list month day year))))
+
+(defun calendar-bahai-date-string (&optional date)
+  "String of Baha'i date of Gregorian DATE.
+Defaults to today's date if DATE is not given."
+  (let* ((bahai-date (calendar-bahai-from-absolute
+                       (calendar-absolute-from-gregorian
+                        (or date (calendar-current-date)))))
+         (y (extract-calendar-year bahai-date))
+         (m (extract-calendar-month bahai-date))
+         (d (extract-calendar-day bahai-date)))
+    (let ((monthname
+	   (if (and (= m 19)
+		    (<= d 0))
+	       "Ayyam-i-Ha"
+	     (aref bahai-calendar-month-name-array (1- m))))
+	  (day (int-to-string
+		(if (<= d 0)
+		    (if (bahai-calendar-leap-year-p y)
+			(+ d 5)
+		      (+ d 4))
+		  d)))
+	  (dayname nil)
+	  (month (int-to-string m))
+	  (year (int-to-string y)))
+      (mapconcat 'eval calendar-date-display-form ""))))
+
+(defun calendar-print-bahai-date ()
+  "Show the Baha'i calendar equivalent of the selected date."
+  (interactive)
+  (message "Baha'i date: %s"
+           (calendar-bahai-date-string (calendar-cursor-to-date t))))
+
+(defun calendar-goto-bahai-date (date &optional noecho)
+  "Move cursor to Baha'i date DATE.
+Echo Baha'i date unless NOECHO is t."
+  (interactive (bahai-prompt-for-date))
+  (calendar-goto-date (calendar-gregorian-from-absolute
+                       (calendar-absolute-from-bahai date)))
+  (or noecho (calendar-print-bahai-date)))
+
+(defun bahai-prompt-for-date ()
+  "Ask for a Baha'i date."
+  (let* ((today (calendar-current-date))
+         (year (calendar-read
+                "Baha'i calendar year (not 0): "
+                '(lambda (x) (/= x 0))
+                (int-to-string
+                 (extract-calendar-year
+                  (calendar-bahai-from-absolute
+                   (calendar-absolute-from-gregorian today))))))
+         (completion-ignore-case t)
+         (month (cdr (assoc
+                       (completing-read
+                        "Baha'i calendar month name: "
+                        (mapcar 'list
+                                (append bahai-calendar-month-name-array nil))
+                        nil t)
+                      (calendar-make-alist bahai-calendar-month-name-array
+                                           1))))
+         (day (calendar-read "Baha'i calendar day (1-19): "
+			     '(lambda (x) (and (< 0 x) (<= x 19))))))
+    (list (list month day year))))
+
+(defun diary-bahai-date ()
+  "Baha'i calendar equivalent of date diary entry."
+  (format "Baha'i date: %s" (calendar-bahai-date-string date)))
+
+(defun holiday-bahai (month day string)
+  "Holiday on MONTH, DAY (Baha'i) called STRING.
+If MONTH, DAY (Baha'i) is visible, the value returned is corresponding
+Gregorian date in the form of the list (((month day year) STRING)).  Returns
+nil if it is not visible in the current calendar window."
+  (let* ((bahai-date (calendar-bahai-from-absolute
+		      (calendar-absolute-from-gregorian
+		       (list displayed-month 15 displayed-year))))
+         (m (extract-calendar-month bahai-date))
+         (y (extract-calendar-year bahai-date))
+	 (date))
+    (if (< m 1)
+        nil ;;   Baha'i calendar doesn't apply.
+      (increment-calendar-month m y (- 10 month))
+      (if (> m 7) ;;  Baha'i date might be visible
+          (let ((date (calendar-gregorian-from-absolute
+                       (calendar-absolute-from-bahai (list month day y)))))
+            (if (calendar-date-is-visible-p date)
+                (list (list date string))))))))
+
+(defun list-bahai-diary-entries ()
+  "Add any Baha'i date entries from the diary file to `diary-entries-list'.
+Baha'i date diary entries must be prefaced by an
+`bahai-diary-entry-symbol' (normally a `B').  The same diary date
+forms govern the style of the Baha'i calendar entries, except that the
+Baha'i month names must be given numerically.  The Baha'i months are
+numbered from 1 to 19 with Baha being 1 and 19 being `Ala.  If a
+Baha'i date diary entry begins with a `diary-nonmarking-symbol', the
+entry will appear in the diary listing, but will not be marked in the
+calendar.  This function is provided for use with the
+`nongregorian-diary-listing-hook'."
+  (if (< 0 number)
+      (let ((buffer-read-only nil)
+            (diary-modified (buffer-modified-p))
+            (gdate original-date)
+            (mark (regexp-quote diary-nonmarking-symbol)))
+        (calendar-for-loop i from 1 to number do
+           (let* ((d diary-date-forms)
+                  (bdate (calendar-bahai-from-absolute
+                          (calendar-absolute-from-gregorian gdate)))
+                  (month (extract-calendar-month bdate))
+                  (day (extract-calendar-day bdate))
+                  (year (extract-calendar-year bdate)))
+             (while d
+               (let*
+                   ((date-form (if (equal (car (car d)) 'backup)
+                                   (cdr (car d))
+                                 (car d)))
+                    (backup (equal (car (car d)) 'backup))
+                    (dayname
+                     (concat
+                      (calendar-day-name gdate) "\\|"
+                      (substring (calendar-day-name gdate) 0 3) ".?"))
+                    (calendar-month-name-array
+                     bahai-calendar-month-name-array)
+                    (monthname
+                     (concat
+                      "\\*\\|"
+                      (calendar-month-name month)))
+                    (month (concat "\\*\\|0*" (int-to-string month)))
+                    (day (concat "\\*\\|0*" (int-to-string day)))
+                    (year
+                     (concat
+                      "\\*\\|0*" (int-to-string year)
+                      (if abbreviated-calendar-year
+                          (concat "\\|" (int-to-string (% year 100)))
+                        "")))
+                    (regexp
+                     (concat
+                      "\\(\\`\\|\^M\\|\n\\)" mark "?"
+                      (regexp-quote bahai-diary-entry-symbol)
+                      "\\("
+                      (mapconcat 'eval date-form "\\)\\(")
+                      "\\)"))
+                    (case-fold-search t))
+                 (goto-char (point-min))
+                 (while (re-search-forward regexp nil t)
+                   (if backup (re-search-backward "\\<" nil t))
+                   (if (and (or (char-equal (preceding-char) ?\^M)
+                                (char-equal (preceding-char) ?\n))
+                            (not (looking-at " \\|\^I")))
+                       ;;  Diary entry that consists only of date.
+                       (backward-char 1)
+                     ;;  Found a nonempty diary entry--make it visible and
+                     ;;  add it to the list.
+                     (let ((entry-start (point))
+                           (date-start))
+                       (re-search-backward "\^M\\|\n\\|\\`")
+                       (setq date-start (point))
+                       (re-search-forward "\^M\\|\n" nil t 2)
+                       (while (looking-at " \\|\^I")
+                         (re-search-forward "\^M\\|\n" nil t))
+                       (backward-char 1)
+                       (subst-char-in-region date-start (point) ?\^M ?\n t)
+                       (add-to-diary-list
+                        gdate
+                        (buffer-substring-no-properties entry-start (point))
+                        (buffer-substring-no-properties
+                         (1+ date-start) (1- entry-start)))))))
+               (setq d (cdr d))))
+           (setq gdate
+                 (calendar-gregorian-from-absolute
+                  (1+ (calendar-absolute-from-gregorian gdate)))))
+           (set-buffer-modified-p diary-modified))
+        (goto-char (point-min))))
+
+(defun mark-bahai-diary-entries ()
+  "Mark days in the calendar window that have Baha'i date diary entries.
+Each entry in diary-file (or included files) visible in the calendar
+window is marked.  Baha'i date entries are prefaced by a
+bahai-diary-entry-symbol \(normally a B`I').  The same
+diary-date-forms govern the style of the Baha'i calendar entries,
+except that the Baha'i month names must be spelled in full.  The
+Baha'i months are numbered from 1 to 12 with Baha being 1 and 12 being
+`Ala.  Baha'i date diary entries that begin with a
+diary-nonmarking-symbol will not be marked in the calendar.  This
+function is provided for use as part of the
+nongregorian-diary-marking-hook."
+  (let ((d diary-date-forms))
+    (while d
+      (let*
+          ((date-form (if (equal (car (car d)) 'backup)
+                          (cdr (car d))
+                        (car d)));; ignore 'backup directive
+           (dayname (diary-name-pattern calendar-day-name-array))
+           (monthname
+            (concat
+             (diary-name-pattern bahai-calendar-month-name-array t)
+             "\\|\\*"))
+           (month "[0-9]+\\|\\*")
+           (day "[0-9]+\\|\\*")
+           (year "[0-9]+\\|\\*")
+           (l (length date-form))
+           (d-name-pos (- l (length (memq 'dayname date-form))))
+           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
+           (m-name-pos (- l (length (memq 'monthname date-form))))
+           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
+           (d-pos (- l (length (memq 'day date-form))))
+           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
+           (m-pos (- l (length (memq 'month date-form))))
+           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
+           (y-pos (- l (length (memq 'year date-form))))
+           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
+           (regexp
+            (concat
+             "\\(\\`\\|\^M\\|\n\\)"
+             (regexp-quote bahai-diary-entry-symbol)
+             "\\("
+             (mapconcat 'eval date-form "\\)\\(")
+             "\\)"))
+           (case-fold-search t))
+        (goto-char (point-min))
+        (while (re-search-forward regexp nil t)
+          (let* ((dd-name
+                  (if d-name-pos
+                      (buffer-substring
+                       (match-beginning d-name-pos)
+                       (match-end d-name-pos))))
+                 (mm-name
+                  (if m-name-pos
+                      (buffer-substring
+                       (match-beginning m-name-pos)
+                       (match-end m-name-pos))))
+                 (mm (string-to-number
+                      (if m-pos
+                          (buffer-substring
+                           (match-beginning m-pos)
+                           (match-end m-pos))
+                        "")))
+                 (dd (string-to-number
+                      (if d-pos
+                          (buffer-substring
+                           (match-beginning d-pos)
+                           (match-end d-pos))
+                        "")))
+                 (y-str (if y-pos
+                            (buffer-substring
+                             (match-beginning y-pos)
+                             (match-end y-pos))))
+                 (yy (if (not y-str)
+                         0
+                       (if (and (= (length y-str) 2)
+                                abbreviated-calendar-year)
+                           (let* ((current-y
+                                   (extract-calendar-year
+                                    (calendar-bahai-from-absolute
+                                     (calendar-absolute-from-gregorian
+                                      (calendar-current-date)))))
+                                  (y (+ (string-to-number y-str)
+                                        (* 100 (/ current-y 100)))))
+                             (if (> (- y current-y) 50)
+                                 (- y 100)
+                               (if (> (- current-y y) 50)
+                                   (+ y 100)
+                                 y)))
+                         (string-to-number y-str)))))
+            (if dd-name
+                (mark-calendar-days-named
+                 ;; XEmacs change, we don't have assoc-string
+                 (cdr (cal-assoc-string (substring dd-name 0 3)
+                                    (calendar-make-alist
+                                     calendar-day-name-array
+                                     0
+                                     '(lambda (x) (substring x 0 3)))
+                                    t)))
+              (if mm-name
+                  (if (string-equal mm-name "*")
+                      (setq mm 0)
+                    (setq mm
+                          ;; XEmacs change, we don't have assoc-string
+                          (cdr (cal-assoc-string
+                                mm-name
+                                (calendar-make-alist
+                                  bahai-calendar-month-name-array)
+                                t)))))
+              (mark-bahai-calendar-date-pattern mm dd yy)))))
+      (setq d (cdr d)))))
+
+(defun mark-bahai-calendar-date-pattern (month day year)
+  "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.
+A value of 0 in any position is a wildcard."
+  (save-excursion
+    (set-buffer calendar-buffer)
+    (if (and (/= 0 month) (/= 0 day))
+        (if (/= 0 year)
+            ;; Fully specified Baha'i date.
+            (let ((date (calendar-gregorian-from-absolute
+                         (calendar-absolute-from-bahai
+                          (list month day year)))))
+              (if (calendar-date-is-visible-p date)
+                  (mark-visible-calendar-date date)))
+          ;; Month and day in any year--this taken from the holiday stuff.
+          (let* ((bahai-date (calendar-bahai-from-absolute
+                                (calendar-absolute-from-gregorian
+                                 (list displayed-month 15 displayed-year))))
+                 (m (extract-calendar-month bahai-date))
+                 (y (extract-calendar-year bahai-date))
+                 (date))
+            (if (< m 1)
+                nil;;   Baha'i calendar doesn't apply.
+              (increment-calendar-month m y (- 10 month))
+              (if (> m 7);;  Baha'i date might be visible
+                  (let ((date (calendar-gregorian-from-absolute
+                               (calendar-absolute-from-bahai
+                                (list month day y)))))
+                    (if (calendar-date-is-visible-p date)
+                        (mark-visible-calendar-date date)))))))
+      ;; Not one of the simple cases--check all visible dates for match.
+      ;; Actually, the following code takes care of ALL of the cases, but
+      ;; it's much too slow to be used for the simple (common) cases.
+      (let ((m displayed-month)
+            (y displayed-year)
+            (first-date)
+            (last-date))
+        (increment-calendar-month m y -1)
+        (setq first-date
+              (calendar-absolute-from-gregorian
+               (list m 1 y)))
+        (increment-calendar-month m y 2)
+        (setq last-date
+              (calendar-absolute-from-gregorian
+               (list m (calendar-last-day-of-month m y) y)))
+        (calendar-for-loop date from first-date to last-date do
+          (let* ((b-date (calendar-bahai-from-absolute date))
+                 (i-month (extract-calendar-month b-date))
+                 (i-day (extract-calendar-day b-date))
+                 (i-year (extract-calendar-year b-date)))
+            (and (or (zerop month)
+                     (= month i-month))
+                 (or (zerop day)
+                     (= day i-day))
+                 (or (zerop year)
+                     (= year i-year))
+                 (mark-visible-calendar-date
+                  (calendar-gregorian-from-absolute date)))))))))
+
+(defun insert-bahai-diary-entry (arg)
+  "Insert a diary entry.
+For the Baha'i date corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-month-name-array bahai-calendar-month-name-array))
+    (make-diary-entry
+     (concat
+      bahai-diary-entry-symbol
+      (calendar-date-string
+       (calendar-bahai-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))
+       nil t))
+     arg)))
+
+(defun insert-monthly-bahai-diary-entry (arg)
+  "Insert a monthly diary entry.
+For the day of the Baha'i 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 bahai-calendar-month-name-array))
+    (make-diary-entry
+     (concat
+      bahai-diary-entry-symbol
+      (calendar-date-string
+       (calendar-bahai-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(defun insert-yearly-bahai-diary-entry (arg)
+  "Insert an annual diary entry.
+For the day of the Baha'i 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 bahai-calendar-month-name-array))
+    (make-diary-entry
+     (concat
+      bahai-diary-entry-symbol
+      (calendar-date-string
+       (calendar-bahai-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(provide 'cal-bahai)
+
+;;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14
+;;; cal-bahai.el ends here
 ;;; cal-china.el --- calendar functions for the Chinese calendar
 
-;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006
+;;   Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; Human-Keywords: Chinese calendar, calendar, holidays, diary
 
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
-;;; Synched up with: FSF 21.4
+;;; Synched up with: FSF Emacs 22.1 CVS 2006-09-15
 
 ;;; Commentary:
 
 ;; The date of Chinese New Year is correct from 1644-2051.
 
 ;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
-;; Cambridge University Press (1997).
+;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
+;; and Nachum Dershowitz, Cambridge University Press (2001).
 
 ;; Comments, corrections, and improvements should be sent to
 ;;  Edward M. Reingold               Department of Computer Science
 
 ;;; Code:
 
+(defvar date)
+(defvar displayed-month)
+(defvar displayed-year)
+
 (require 'lunar)
 
 (defvar chinese-calendar-celestial-stem
 (defvar chinese-calendar-terrestrial-branch
   ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
 
-(defcustom chinese-calendar-time-zone 
+(defcustom chinese-calendar-time-zone
   '(if (< year 1928)
        (+ 465 (/ 40.0 60.0))
      480)
 
 (provide 'cal-china)
 
+;;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
 ;;; cal-china.el ends here
+;;; cal-compat.el --- calendar compatibility functions
+
+;; Author: Jeff Miller <jmiller@xemacs.org>
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; Provide functional equivalents to code present only in Emacs or
+;; currently only found in XEmacs betas.
+
+;; XEmacs change
+(if (featurep 'xemacs)
+    (defalias 'appt-cancel-timer 'delete-itimer)
+  (defalias 'appt-cancel-timer 'cancel-timer))
+
+;; XEmacs change
+;;;###autoload
+(eval-and-compile
+  (unless (fboundp 'line-beginning-position)
+    (defalias 'line-beginning-position 'point-at-bol))
+  (unless (fboundp 'line-end-position)
+    (defalias 'line-end-position 'point-at-eol)))
+
+;; XEmacs change, mimic button.el from Emacs 22
+;;;###autoload
+(defun make-button (beg end &rest properties)
+  "Make a button from BEG to END in the current buffer.
+The remaining arguments form a sequence of PROPERTY VALUE pairs,
+
+This function is included with calendar for compatability with Emacs."
+  (let ((extent  (make-extent beg end))
+        (map (make-sparse-keymap)))
+
+    (define-key map [button2] 'diary-goto-entry)
+    ;;    (define-key map [return] 'diary-goto-entry)
+    (set-extent-keymap extent map)
+
+    (set-extent-mouse-face extent 'highlight)
+    (set-extent-property extent 'button extent)
+    (set-extent-face extent 'diary-button)
+    ;; set the properties from the calling function
+    (set-extent-properties extent  properties )
+
+    extent ))
+
+;; XEmacs change, mimic button.el from Emacs 22
+;;;###autoload
+(defun insert-button (label &rest properties)
+  "Insert a button with the label LABEL.
+The remaining arguments form a sequence of PROPERTY VALUE pairs.
+
+This function is included with calendar for compatability with Emacs."
+  (apply #'make-button (prog1 (point) (insert label))
+         (point)
+         properties))
+
+;; XEmacs change, this shows up in XEmacs 21.5
+;;;###autoload
+(unless (fboundp 'match-string-no-properties)
+  (defun match-string-no-properties (num &optional string)
+    "Return string of text matched by last search, without text properties.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+    (if (match-beginning num)
+        (if string
+            (let ((result
+                   (substring string (match-beginning num) (match-end num))))
+              (set-text-properties 0 (length result) nil result)
+              result)
+          (buffer-substring-no-properties (match-beginning num)
+                                          (match-end num))))))
+
+;; XEmacs change, this shows up in XEmacs 21.5
+;;;###autoload
+(unless (fboundp 'add-to-invisibility-spec)
+  (defun add-to-invisibility-spec (arg)
+    "Add elements to `buffer-invisibility-spec'.
+See documentation for `buffer-invisibility-spec' for the kind of elements
+that can be added."
+    (if (eq buffer-invisibility-spec t)
+        (setq buffer-invisibility-spec (list t)))
+    (setq buffer-invisibility-spec
+          (cons arg buffer-invisibility-spec))))
+
+;;;###autoload
+(if (fboundp 'assoc-string)
+    (defalias 'cal-assoc-string 'assoc-string)
+  (defun cal-assoc-string (key list case-fold)
+    (if case-fold
+        (assoc-ignore-case key list)
+      (assoc key list)))  
+  )
+
+;; XEmacs change
+;; not available until 21.5
+  ;;;###autoload
+(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
+;;;###autoload
+(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
+;;;###autoload
+(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))
+  )
+
+;; XEmacs change
+;; fit-window-to-buffer is only available in Emacs.
+;; shamelessly taken from ibuffer
+;;;###autoload
+(unless (fboundp 'fit-window-to-buffer)
+  (defun cal-fit-window-to-buffer (&optional owin)
+    "Make window the right size to display its contents exactly."
+    (interactive)
+    (if owin
+	(delete-other-windows))
+    (when (> (length (window-list nil 'nomini)) 1)
+      (let* ((window (selected-window))
+	     (buf (window-buffer window))
+	     (height (window-displayed-height (selected-window)))
+	     (new-height (with-current-buffer buf
+			   (count-lines (point-min) (point-max))))
+	     (diff (- new-height height)))
+	(unless (zerop diff)
+	  (enlarge-window diff))
+	(let ((end (with-current-buffer buf (point-max))))
+	  (while (and (> (length (window-list nil 'nomini)) 1)
+		      (not (pos-visible-in-window-p end)))
+	    (enlarge-window 1)))))))
+
+;; XEmacs change. Mimic remove-overlays from Emacs, but for extents
+;;;###autoload
+(defun cal-remove-extents (&optional beg end name val)   
+  "Clear BEG and END of overlays whose property NAME has value VAL.
+Extents might be moved and or split. "
+  (interactive)
+  ;; Stolen from planner as planner-remove-overlays
+  (if (< end beg)
+      (setq beg (prog1 end (setq end beg))))
+  (save-excursion
+      (dolist (e (extent-list nil  beg end))
+        (when (eq (extent-property e name) val)
+          ;; Either push this overlay outside beg...end
+          ;; or split it to exclude beg...end
+          ;; or delete it entirely (if it is contained in beg...end).
+          (if (< (extent-start-position e) beg)
+              (if (> (extent-end-position e) end)
+                  (progn
+                    (let ((e1  (copy-extent e))
+                          (props (extent-properties e)))
+                      (set-extent-endpoints e1
+                                            (extent-start-position e) beg)
+                      (set-extent-endpoints e end (extent-end-position e))
+                      (while props
+                        (set-extent-property e1 (pop props) (pop props)))))
+                (set-extent-endpoints e (extent-start-position e) beg))
+