diff lisp/packages/reportmail.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
line wrap: on
line diff
--- a/lisp/packages/reportmail.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/packages/reportmail.el	Mon Aug 13 09:02:59 2007 +0200
@@ -21,6 +21,9 @@
 ;; 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
@@ -118,20 +121,20 @@
 ;
 ; HISTORY
 ;
-; 19 dec 93	Jamie Zawinski <jwz@lucid.com>
+; 19 dec 93	Jamie Zawinski <jwz@netscape.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@lucid.com>
+; 15 dec 93	Jamie Zawinski <jwz@netscape.com>
 ;	Kyle renamed timer.el to itimer.el; made this use the new names.
 ;
-; 27 aug 93	Jamie Zawinski <jwz@lucid.com>
+; 27 aug 93	Jamie Zawinski <jwz@netscape.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@lucid.com>
+; 14 oct 92	Jamie Zawinski <jwz@netscape.com>
 ;	Added support for xbiff++.
 ;
 ; 17 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
@@ -140,16 +143,16 @@
 ; 15 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
 ;	Minor bug fixes.
 ;
-; 1 may 92	Jamie Zawinski <jwz@lucid.com>
+; 1 may 92	Jamie Zawinski <jwz@netscape.com>
 ;	Converted to work with Kyle Jones' timer.el package.
 ;
-; 3 may 91	Jamie Zawinski <jwz@lucid.com>
+; 3 may 91	Jamie Zawinski <jwz@netscape.com>
 ;	Made the display-time-sentinel make a fuss when the process dies.
 ;
-; 26 mar 91	Jamie Zawinski <jwz@lucid.com>
+; 26 mar 91	Jamie Zawinski <jwz@netscape.com>
 ;	Merged with BCP's latest posted version
 ;
-;  5 mar 91	Jamie Zawinski <jwz@lucid.com>
+;  5 mar 91	Jamie Zawinski <jwz@netscape.com>
 ;	Added compatibility with Emacs 18.57.
 ;
 ; 25 Jan 91	Benjamin Pierce (bcp@cs.cmu.edu)
@@ -158,7 +161,7 @@
 ;	display-time-process-new-mail to prevent letterbombs 
 ;	(suggested by jwz).
 ;
-; 15 feb 91	Jamie Zawinski <jwz@lucid.com>
+; 15 feb 91	Jamie Zawinski <jwz@netscape.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
@@ -168,7 +171,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@lucid.com>
+; 20 Dec 90	Jamie Zawinski <jwz@netscape.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.
@@ -205,13 +208,8 @@
 ;	Added facility for reporting incoming mail (modeled after gosmacs
 ;	reportmail.ml package written by Benjamin Pierce).
 
-
-(if (string-match "XEmacs" emacs-version)
-    (require 'itimer))
-
-(condition-case ()
-    (require 'mail-extr)
-  (error nil))
+(require 'itimer)		; this is xemacs, so why conditionalize?
+(require 'mail-extr)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;                       User Variables                          ;;;
@@ -359,15 +357,6 @@
          (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
@@ -436,29 +425,12 @@
 		(append global-mode-string '(display-time-string))))
       (setq display-time-string "time and load")
       
-      (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)))
-      
+      (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 display-time-use-xbiff
 	  (progn
 	    (display-time-del-file display-time-mail-arrived-file)
@@ -473,124 +445,58 @@
 		(error "Display time: xbiff failed.  Check xbiff-arg-list"))))))
   (display-time-total-reset))
 
-
-(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)
+(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)
 	    (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))
+	(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
 	    (setq time-string
 		  (concat time-string
-			  (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))
+			  (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)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;                       Mail processing                         ;;;
@@ -657,9 +563,6 @@
   (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))
@@ -790,7 +693,8 @@
     ;; clear the thing, like, don't bother, that's annoying.
     (if (and in-echo-area-already (string= "" str))
 	nil
-      (if (and (string= str "") (string-match "^19" emacs-version))
+      ;; XEmacs version fix
+      (if (and (string= str "") (not (string-match "^18" emacs-version)))
 	  (message nil)
 	(message "%s" str)))))
 
@@ -857,8 +761,6 @@
 			    ""
 			    (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 
@@ -971,7 +873,7 @@
   "When non-NIL, reportmail displays status messages in real time.")
 
 (defun display-time-debug-mesg (mesg)
- (display-time-save-match-data
+ (save-match-data
   (if display-time-debugging-messages
       (progn 
 	(message "Reportmail: %s" mesg)