xemacs-beta: lisp/packages/reportmail.el comparison

comparison lisp/packages/reportmail.el @ 100:4be1180a9e89 r20-1b2

Import from CVS: tag r20-1b2

author	cvs
date	Mon, 13 Aug 2007 09:15:11 +0200
parents	131b0175ea99
children

comparison

equal deleted inserted replaced

-:2d83cbd90d8d
+:4be1180a9e89
 ;; GNU Emacs General Public License.   A copy of this license is
 ;; supposed to have been given to you along with GNU Emacs so you
 ;; can know your rights and responsibilities.  It should be in a
 ;; file named COPYING.  Among other things, the copyright notice
 ;; and this notice must be preserved on all copies.
-;;; Synched up with: Not in FSF.
-;;; #### Appears to duplicate time.el.  Perhaps should be nuked.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;
 ; Installation
 ; ------------
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;
 ; 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)
 ;	Improvements to message display code.
 ;
 ; 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)
 ;	Added facility for regular-expression matching of junk-mail
 ;	checklist.  Set inhibit-local-variables to t inside of
 ;	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
 ;	this code can safely be dumped with emacs.  Also, it now notices
 ;	when it's at CMU, and defaults to something reasonable.  Removed
 ;	display-time-wait-hard, because I learned how to make echo-area
 ;	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.
 ;	Made the junk-mail checklist use a member-search rather than a
 ;	prefix-search.
 ;	To use: (setq display-time-load nil)
 ;
 ;	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                          ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defmacro display-time-debug (mesg &rest args)
 (list
 'if 'display-time-debugging
 (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
 (setq display-time-incoming-mail-file
 (if (not (memq 'display-time-string global-mode-string))
 	  (setq global-mode-string
 		(append global-mode-string '(display-time-string))))
 (setq display-time-string "time and load")
-(let ((old (get-itimer "display-time")))
+(if (featurep 'itimer)
-	(if old (delete-itimer old))
+	  (let ((old (get-itimer "display-time")))
-	(start-itimer "display-time" 'display-time-timer-function
+	    (if old (delete-itimer old))
-		      display-time-interval display-time-interval)
+	    (start-itimer "display-time" 'display-time-timer-function
-	(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)
 	    (setq display-time-xbiff-process
 		  (apply 'start-process "display-time-xbiff" nil
 	    (sit-for 1)			; Need time to see if xbiff fails.
 	    (if (/= 0 (process-exit-status display-time-xbiff-process))
 		(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
+(defun display-time-sentinel (proc reason)
-;; but we're not supporting version 18 here and I'm trimming excess
+(display-time-save-match-data
-(save-match-data
+;; notice if the process has died an untimely death...
-(display-time-debug "display-time-timer-function")
+(display-time-debug "display-time-sentinel")
-(if display-time-flush-echo-area
+(cond ((memq (process-status proc) '(stop exit closed signal))
-	(progn
+	 (if (and (stringp reason) (string-match "\n?\n*\\'" reason))
-	  (display-time-debug "flush echo area")
+	     (setq reason (substring reason 0 (match-beginning 0))))
-	  (display-time-message "")))
+	 (beep)
-(let ((mailp (and (file-exists-p display-time-incoming-mail-file)
+	 (setq display-time-string (format "%s" reason))
-		      (not (eq 0 (nth 7 (file-attributes
+	 (display-time-message "")
-					 display-time-incoming-mail-file)))))))
+	 (message "process %s: %s (%s)" proc reason (process-status proc))))
-(if display-time-announce-mail
+(display-time-force-redisplay)))
-	  (if mailp
-	      (display-time-process-new-mail)
+(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
+			   (if display-time-announce-mail
-				 display-time-mail-modeline
+			       display-time-mail-modeline
 			       "Mail "))))
-	(if display-time-time
+(if display-time-time
-	    (let* ((time (current-time-string))
+	  (let* ((time (current-time-string))
-		   (hour (read (substring time 11 13)))
+		 (hour (read (substring time 11 13)))
-		   (pm (>= hour 12)))
+		 (pm (>= hour 12)))
-	      (if (> hour 12) (setq hour (- hour 12)))
+	    (if (> hour 12) (setq hour (- hour 12)))
-	      (if (= hour 0) (setq 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
-			  (substring (current-time-string) 0 11))))
+			  (format "%d" hour) (substring time 13 16)
-	(if display-time-load
+			  (if pm "pm " "am ")))))
-	    (setq time-string
+(if display-time-day-and-date
-		  (concat time-string
+	  (setq time-string
-			  (condition-case ()
+		(concat time-string
-			      (let* ((la (car (load-average)))
+			(substring (current-time-string) 0 11))))
-				     (load (if (zerop la)
+(if display-time-load
-					       nil
+	  (setq time-string
-					     (format "%03d" la))))
+	      (concat time-string
-				(if load
+		      (condition-case ()
-				    (concat (substring load 0 -2)
+(let* ((la (car (load-average)))
-					    "." (substring load -2))
+(load (if (zerop la)
-				  ""))
+nil
-			    (error "load-error"))
+(format "%03d" la))))
-			  " ")))
+(if load
-	;; Install the new time for display.
+(concat (substring load 0 -2)
-	(setq display-time-string time-string)
+"." (substring load -2))
-	(force-mode-line-update t)))))
+			      ""))
+(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                         ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq display-time-mail-who-from "Junk mail")
 (setq display-time-mail-modeline "")
 (setq display-time-previous-mail-buffer-max 1)
 (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))
 	(inhibit-local-variables t)
 	    (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
-;; XEmacs version fix
+(if (and (string= str "") (string-match "^19" emacs-version))
-(if (and (string= str "") (not (string-match "^18" emacs-version)))
 	  (message nil)
 	(message "%s" str)))))
 (defun display-time-process-good-message ()
 (display-time-debug "Formatting message announcement (good message)")
 	 (to (display-time-get-field "To" ""))
 	 (print-subject (if (string= subject "")
 			    ""
 			    (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
 			(display-time-extract-short-addr to)
 			display-time-max-to-length))))
 (defvar display-time-debugging-messages nil
 "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)
 	(sit-for 1)
 	))

Mercurial > hg > xemacs-beta

comparison lisp/packages/reportmail.el @ 100:4be1180a9e89 r20-1b2