--- a/lisp/packages/reportmail.el	Mon Aug 13 08:50:31 2007 +0200
+++ b/lisp/packages/reportmail.el	Mon Aug 13 08:51:03 2007 +0200
@@ -21,9 +21,6 @@
 ;; file named COPYING.  Among other things, the copyright notice
 ;; and this notice must be preserved on all copies.
 
-;;; Synched up with: Not in FSF.
-;;; #### Appears to duplicate time.el.  Perhaps should be nuked.
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;
 ; Installation
@@ -121,20 +118,20 @@
 ;
 ; HISTORY
 ;
-; 19 dec 93	Jamie Zawinski <jwz@netscape.com>
+; 19 dec 93	Jamie Zawinski <jwz@lucid.com>
 ;	Protected it from edits of the *reportmail* buffer; made the process
 ;	filters not interfere with the match data.
 ;
-; 15 dec 93	Jamie Zawinski <jwz@netscape.com>
+; 15 dec 93	Jamie Zawinski <jwz@lucid.com>
 ;	Kyle renamed timer.el to itimer.el; made this use the new names.
 ;
-; 27 aug 93	Jamie Zawinski <jwz@netscape.com>
+; 27 aug 93	Jamie Zawinski <jwz@lucid.com>
 ;	Use mail-extr to parse addresses if it is loadable.
 ;
 ; 15 oct 92	Benjamin Pierce (bcp@cs.cmu.edu)
 ;	Merged recent changes
 ;
-; 14 oct 92	Jamie Zawinski <jwz@netscape.com>
+; 14 oct 92	Jamie Zawinski <jwz@lucid.com>
 ;	Added support for xbiff++.
 ;
 ; 17 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
@@ -143,16 +140,16 @@
 ; 15 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
 ;	Minor bug fixes.
 ;
-; 1 may 92	Jamie Zawinski <jwz@netscape.com>
+; 1 may 92	Jamie Zawinski <jwz@lucid.com>
 ;	Converted to work with Kyle Jones' timer.el package.
 ;
-; 3 may 91	Jamie Zawinski <jwz@netscape.com>
+; 3 may 91	Jamie Zawinski <jwz@lucid.com>
 ;	Made the display-time-sentinel make a fuss when the process dies.
 ;
-; 26 mar 91	Jamie Zawinski <jwz@netscape.com>
+; 26 mar 91	Jamie Zawinski <jwz@lucid.com>
 ;	Merged with BCP's latest posted version
 ;
-;  5 mar 91	Jamie Zawinski <jwz@netscape.com>
+;  5 mar 91	Jamie Zawinski <jwz@lucid.com>
 ;	Added compatibility with Emacs 18.57.
 ;
 ; 25 Jan 91	Benjamin Pierce (bcp@cs.cmu.edu)
@@ -161,7 +158,7 @@
 ;	display-time-process-new-mail to prevent letterbombs 
 ;	(suggested by jwz).
 ;
-; 15 feb 91	Jamie Zawinski <jwz@netscape.com>
+; 15 feb 91	Jamie Zawinski <jwz@lucid.com>
 ;	Made the values of display-time-message-separator and 
 ;	display-time-incoming-mail-file be initialized when this code
 ;	starts, instead of forcing the user to do it.  This means that
@@ -171,7 +168,7 @@
 ;	messages be persistent (not go away at the first key).  I wish
 ;	GC messages didn't destroy it, though...
 ;
-; 20 Dec 90	Jamie Zawinski <jwz@netscape.com>
+; 20 Dec 90	Jamie Zawinski <jwz@lucid.com>
 ;	Added new variables: display-time-no-file-means-no-mail, 
 ;	display-time-wait-hard, and display-time-junk-mail-ring-bell.
 ;	Made display-time-message-separator be compared case-insensitively.
@@ -208,8 +205,13 @@
 ;	Added facility for reporting incoming mail (modeled after gosmacs
 ;	reportmail.ml package written by Benjamin Pierce).
 
-(require 'itimer)		; this is xemacs, so why conditionalize?
-(require 'mail-extr)
+
+(if (string-match "XEmacs" emacs-version)
+    (require 'itimer))
+
+(condition-case ()
+    (require 'mail-extr)
+  (error nil))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;                       User Variables                          ;;;
@@ -357,6 +359,15 @@
          (list 'display-time-debug-mesg
 	       (append (list 'format mesg) args))))
 
+(defmacro display-time-save-match-data (&rest body)
+  ;; Execute the BODY forms, restoring the global value of the match data.
+  ;; We need this because it's antisocial for process filters to change
+  ;; the regexp match registers.
+  (list 'let '((_match_data_ (match-data)))
+	(list 'unwind-protect
+	      (cons 'progn body)
+	      '(store-match-data _match_data_))))
+
 (defun display-time-init ()
   ;; If the mail-file isn't set, figure it out.
   (or display-time-incoming-mail-file
@@ -425,12 +436,29 @@
 		(append global-mode-string '(display-time-string))))
       (setq display-time-string "time and load")
       
-      (let ((old (get-itimer "display-time")))
-	(if old (delete-itimer old))
-	(start-itimer "display-time" 'display-time-timer-function
-		      display-time-interval display-time-interval)
-	(display-time-timer-function))
-
+      (if (featurep 'itimer)
+	  (let ((old (get-itimer "display-time")))
+	    (if old (delete-itimer old))
+	    (start-itimer "display-time" 'display-time-timer-function
+			  display-time-interval display-time-interval)
+	    (display-time-timer-function))
+	;; if we don't have timers, then use one of the process mechanisms.
+	(setq display-time-loadst-process
+	      (if (string-match "18\\.5[0-5]" (emacs-version))
+		  (start-process "display-time-loadst" nil
+				 "loadst" 
+				 "-n" (int-to-string display-time-interval))
+		(start-process "display-time-wakeup" nil
+			       (concat exec-directory "wakeup")
+			       (int-to-string display-time-interval))))
+	(process-kill-without-query display-time-loadst-process)
+	(set-process-sentinel display-time-loadst-process 
+			      'display-time-sentinel)
+	(set-process-filter display-time-loadst-process
+			    (if (string-match "^18\\.5[0-5]" (emacs-version))
+				'display-time-filter-18-55
+			      'display-time-filter-18-57)))
+      
       (if display-time-use-xbiff
 	  (progn
 	    (display-time-del-file display-time-mail-arrived-file)
@@ -445,58 +473,124 @@
 		(error "Display time: xbiff failed.  Check xbiff-arg-list"))))))
   (display-time-total-reset))
 
-(defun display-time-timer-function ()
-  ;; was: (defun display-time-filter-18-57 (proc string) ; args are ignored
-  ;; but we're not supporting version 18 here and I'm trimming excess
-  (save-match-data
-    (display-time-debug "display-time-timer-function")
-    (if display-time-flush-echo-area
-	(progn
-	  (display-time-debug "flush echo area")
-	  (display-time-message "")))
-    (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
-		      (not (eq 0 (nth 7 (file-attributes
-					 display-time-incoming-mail-file)))))))
-      (if display-time-announce-mail
-	  (if mailp
-	      (display-time-process-new-mail)
+
+(defun display-time-sentinel (proc reason)
+ (display-time-save-match-data
+  ;; notice if the process has died an untimely death...
+  (display-time-debug "display-time-sentinel")
+  (cond ((memq (process-status proc) '(stop exit closed signal))
+	 (if (and (stringp reason) (string-match "\n?\n*\\'" reason))
+	     (setq reason (substring reason 0 (match-beginning 0))))
+	 (beep)
+	 (setq display-time-string (format "%s" reason))
+	 (display-time-message "")
+	 (message "process %s: %s (%s)" proc reason (process-status proc))))
+  (display-time-force-redisplay)))
+
+(defun display-time-filter-18-55 (proc string)
+ (display-time-save-match-data
+  (if display-time-flush-echo-area (display-time-message ""))
+  ;; Desired data can't need more than the last 30 chars,
+  ;; so save time by flushing the rest.
+  ;; This way, if we have many different times all collected at once,
+  ;; we can discard all but the last few very fast.
+  (display-time-debug "display-time-filter-18-55")
+  (if (> (length string) 30) (setq string (substring string -30)))
+  ;; Now discard all but the very last one.
+  (while (and (> (length string) 4)
+	      (string-match "[0-9]+:[0-9][0-9].." string 4))
+    (setq string (substring string (match-beginning 0))))
+  (if (string-match "[^0-9][0-9]+:" string)
+      (setq string (substring string 0 (1+ (match-beginning 0)))))
+  ;; If we're announcing mail and mail has come, process any new messages
+  (if display-time-announce-mail
+      (if (string-match "Mail" string)
+	  (display-time-process-new-mail)
+	  (display-time-total-reset)))
+  ;; Format the mode line time display
+  (let ((time-string (if (string-match "Mail" string)
+			 (if display-time-announce-mail 
+			     display-time-mail-modeline
+			     "Mail "))))
+    (if (and display-time-time (string-match "[0-9]+:[0-9][0-9].." string))
+	(setq time-string 
+	      (concat time-string
+		      (substring string (match-beginning 0) (match-end 0))
+		      " ")))
+    (if display-time-day-and-date
+	(setq time-string
+	      (concat time-string
+		      (substring (current-time-string) 0 11))))
+    (if (and display-time-load (string-match "[0-9]+\\.[0-9][0-9]" string))
+	(setq time-string
+	      (concat time-string
+		      (substring string (match-beginning 0) (match-end 0))
+		      " ")))
+    ;; Install the new time for display.
+    (setq display-time-string time-string)
+    (display-time-force-redisplay))))
+
+(defun display-time-filter-18-57 (proc string) ; args are ignored
+ (display-time-save-match-data
+  (display-time-debug "display-time-filter-18-57")
+  (if display-time-flush-echo-area
+      (progn
+	(display-time-debug "flush echo area")
+	(display-time-message "")))
+  (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
+		    (not (eq 0 (nth 7 (file-attributes
+				       display-time-incoming-mail-file)))))))
+    (if display-time-announce-mail
+	(if mailp
+	    (display-time-process-new-mail)
 	    (display-time-total-reset)))
-      ;; Format the mode line time display
-      (let ((time-string (if mailp
-			     (if display-time-announce-mail
-				 display-time-mail-modeline
+    ;; Format the mode line time display
+    (let ((time-string (if mailp
+			   (if display-time-announce-mail
+			       display-time-mail-modeline
 			       "Mail "))))
-	(if display-time-time
-	    (let* ((time (current-time-string))
-		   (hour (read (substring time 11 13)))
-		   (pm (>= hour 12)))
-	      (if (> hour 12) (setq hour (- hour 12)))
-	      (if (= hour 0) (setq hour 12))
-	      (setq time-string
-		    (concat time-string
-			    (format "%d" hour) (substring time 13 16)
-			    (if pm "pm " "am ")))))
-	(if display-time-day-and-date
+      (if display-time-time
+	  (let* ((time (current-time-string))
+		 (hour (read (substring time 11 13)))
+		 (pm (>= hour 12)))
+	    (if (> hour 12) (setq hour (- hour 12)))
+	    (if (= hour 0) (setq hour 12))
 	    (setq time-string
 		  (concat time-string
-			  (substring (current-time-string) 0 11))))
-	(if display-time-load
-	    (setq time-string
-		  (concat time-string
-			  (condition-case ()
-			      (let* ((la (car (load-average)))
-				     (load (if (zerop la)
-					       nil
-					     (format "%03d" la))))
-				(if load
-				    (concat (substring load 0 -2)
-					    "." (substring load -2))
-				  ""))
-			    (error "load-error"))
-			  " ")))
-	;; Install the new time for display.
-	(setq display-time-string time-string)
-	(force-mode-line-update t)))))
+			  (format "%d" hour) (substring time 13 16)
+			  (if pm "pm " "am ")))))
+      (if display-time-day-and-date
+	  (setq time-string
+		(concat time-string
+			(substring (current-time-string) 0 11))))
+      (if display-time-load
+	  (setq time-string
+	      (concat time-string
+		      (condition-case ()
+                          (let* ((la (car (load-average)))
+                                 (load (if (zerop la)
+                                           nil
+                                         (format "%03d" la))))
+                            (if load
+                                (concat (substring load 0 -2)
+                                        "." (substring load -2))
+			      ""))
+                        (error "load-error"))
+		      " ")))
+      ;; Install the new time for display.
+      (setq display-time-string time-string)
+
+      (display-time-force-redisplay)))))
+
+(defun display-time-timer-function ()
+  (display-time-filter-18-57 nil nil))
+
+(defun display-time-force-redisplay ()
+  "Force redisplay of all buffers' mode lines to be considered."
+  (save-excursion (set-buffer (other-buffer)))
+  (set-buffer-modified-p (buffer-modified-p))
+  ;; Do redisplay right now, if no input pending.
+  (sit-for 0))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;                       Mail processing                         ;;;
@@ -563,6 +657,9 @@
   (display-time-message "") ; clear the echo-area.
   )
 
+(or (fboundp 'buffer-disable-undo)
+    (fset 'buffer-disable-undo 'buffer-flush-undo))
+
 (defun display-time-process-new-mail ()
   (setq display-time-may-need-to-reset t)
   (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
@@ -693,8 +790,7 @@
     ;; clear the thing, like, don't bother, that's annoying.
     (if (and in-echo-area-already (string= "" str))
 	nil
-      ;; XEmacs version fix
-      (if (and (string= str "") (not (string-match "^18" emacs-version)))
+      (if (and (string= str "") (string-match "^19" emacs-version))
 	  (message nil)
 	(message "%s" str)))))
 
@@ -761,6 +857,8 @@
 			    ""
 			    (concat " (" subject ")")))
 	 (print-from (display-time-truncate from display-time-max-from-length))
+	 (short-from (display-time-truncate 
+		      (display-time-extract-short-addr from) 25))
 	 (print-to (if (display-time-member to display-time-my-addresses)
 		       ""
 		       (display-time-truncate 
@@ -873,7 +971,7 @@
   "When non-NIL, reportmail displays status messages in real time.")
 
 (defun display-time-debug-mesg (mesg)
- (save-match-data
+ (display-time-save-match-data
   (if display-time-debugging-messages
       (progn 
 	(message "Reportmail: %s" mesg)