Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
18 ;; GNU Emacs General Public License. A copy of this license is 18 ;; GNU Emacs General Public License. A copy of this license is
19 ;; supposed to have been given to you along with GNU Emacs so you 19 ;; supposed to have been given to you along with GNU Emacs so you
20 ;; can know your rights and responsibilities. It should be in a 20 ;; can know your rights and responsibilities. It should be in a
21 ;; file named COPYING. Among other things, the copyright notice 21 ;; file named COPYING. Among other things, the copyright notice
22 ;; and this notice must be preserved on all copies. 22 ;; and this notice must be preserved on all copies.
23
24 ;;; Synched up with: Not in FSF.
25 ;;; #### Appears to duplicate time.el. Perhaps should be nuked.
23 26
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ; 28 ;
26 ; Installation 29 ; Installation
27 ; ------------ 30 ; ------------
116 119
117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118 ; 121 ;
119 ; HISTORY 122 ; HISTORY
120 ; 123 ;
121 ; 19 dec 93 Jamie Zawinski <jwz@lucid.com> 124 ; 19 dec 93 Jamie Zawinski <jwz@netscape.com>
122 ; Protected it from edits of the *reportmail* buffer; made the process 125 ; Protected it from edits of the *reportmail* buffer; made the process
123 ; filters not interfere with the match data. 126 ; filters not interfere with the match data.
124 ; 127 ;
125 ; 15 dec 93 Jamie Zawinski <jwz@lucid.com> 128 ; 15 dec 93 Jamie Zawinski <jwz@netscape.com>
126 ; Kyle renamed timer.el to itimer.el; made this use the new names. 129 ; Kyle renamed timer.el to itimer.el; made this use the new names.
127 ; 130 ;
128 ; 27 aug 93 Jamie Zawinski <jwz@lucid.com> 131 ; 27 aug 93 Jamie Zawinski <jwz@netscape.com>
129 ; Use mail-extr to parse addresses if it is loadable. 132 ; Use mail-extr to parse addresses if it is loadable.
130 ; 133 ;
131 ; 15 oct 92 Benjamin Pierce (bcp@cs.cmu.edu) 134 ; 15 oct 92 Benjamin Pierce (bcp@cs.cmu.edu)
132 ; Merged recent changes 135 ; Merged recent changes
133 ; 136 ;
134 ; 14 oct 92 Jamie Zawinski <jwz@lucid.com> 137 ; 14 oct 92 Jamie Zawinski <jwz@netscape.com>
135 ; Added support for xbiff++. 138 ; Added support for xbiff++.
136 ; 139 ;
137 ; 17 sep 92 Benjamin Pierce (bcp@cs.cmu.edu) 140 ; 17 sep 92 Benjamin Pierce (bcp@cs.cmu.edu)
138 ; Improvements to message display code. 141 ; Improvements to message display code.
139 ; 142 ;
140 ; 15 sep 92 Benjamin Pierce (bcp@cs.cmu.edu) 143 ; 15 sep 92 Benjamin Pierce (bcp@cs.cmu.edu)
141 ; Minor bug fixes. 144 ; Minor bug fixes.
142 ; 145 ;
143 ; 1 may 92 Jamie Zawinski <jwz@lucid.com> 146 ; 1 may 92 Jamie Zawinski <jwz@netscape.com>
144 ; Converted to work with Kyle Jones' timer.el package. 147 ; Converted to work with Kyle Jones' timer.el package.
145 ; 148 ;
146 ; 3 may 91 Jamie Zawinski <jwz@lucid.com> 149 ; 3 may 91 Jamie Zawinski <jwz@netscape.com>
147 ; Made the display-time-sentinel make a fuss when the process dies. 150 ; Made the display-time-sentinel make a fuss when the process dies.
148 ; 151 ;
149 ; 26 mar 91 Jamie Zawinski <jwz@lucid.com> 152 ; 26 mar 91 Jamie Zawinski <jwz@netscape.com>
150 ; Merged with BCP's latest posted version 153 ; Merged with BCP's latest posted version
151 ; 154 ;
152 ; 5 mar 91 Jamie Zawinski <jwz@lucid.com> 155 ; 5 mar 91 Jamie Zawinski <jwz@netscape.com>
153 ; Added compatibility with Emacs 18.57. 156 ; Added compatibility with Emacs 18.57.
154 ; 157 ;
155 ; 25 Jan 91 Benjamin Pierce (bcp@cs.cmu.edu) 158 ; 25 Jan 91 Benjamin Pierce (bcp@cs.cmu.edu)
156 ; Added facility for regular-expression matching of junk-mail 159 ; Added facility for regular-expression matching of junk-mail
157 ; checklist. Set inhibit-local-variables to t inside of 160 ; checklist. Set inhibit-local-variables to t inside of
158 ; display-time-process-new-mail to prevent letterbombs 161 ; display-time-process-new-mail to prevent letterbombs
159 ; (suggested by jwz). 162 ; (suggested by jwz).
160 ; 163 ;
161 ; 15 feb 91 Jamie Zawinski <jwz@lucid.com> 164 ; 15 feb 91 Jamie Zawinski <jwz@netscape.com>
162 ; Made the values of display-time-message-separator and 165 ; Made the values of display-time-message-separator and
163 ; display-time-incoming-mail-file be initialized when this code 166 ; display-time-incoming-mail-file be initialized when this code
164 ; starts, instead of forcing the user to do it. This means that 167 ; starts, instead of forcing the user to do it. This means that
165 ; this code can safely be dumped with emacs. Also, it now notices 168 ; this code can safely be dumped with emacs. Also, it now notices
166 ; when it's at CMU, and defaults to something reasonable. Removed 169 ; when it's at CMU, and defaults to something reasonable. Removed
167 ; display-time-wait-hard, because I learned how to make echo-area 170 ; display-time-wait-hard, because I learned how to make echo-area
168 ; messages be persistent (not go away at the first key). I wish 171 ; messages be persistent (not go away at the first key). I wish
169 ; GC messages didn't destroy it, though... 172 ; GC messages didn't destroy it, though...
170 ; 173 ;
171 ; 20 Dec 90 Jamie Zawinski <jwz@lucid.com> 174 ; 20 Dec 90 Jamie Zawinski <jwz@netscape.com>
172 ; Added new variables: display-time-no-file-means-no-mail, 175 ; Added new variables: display-time-no-file-means-no-mail,
173 ; display-time-wait-hard, and display-time-junk-mail-ring-bell. 176 ; display-time-wait-hard, and display-time-junk-mail-ring-bell.
174 ; Made display-time-message-separator be compared case-insensitively. 177 ; Made display-time-message-separator be compared case-insensitively.
175 ; Made the junk-mail checklist use a member-search rather than a 178 ; Made the junk-mail checklist use a member-search rather than a
176 ; prefix-search. 179 ; prefix-search.
203 ; To use: (setq display-time-load nil) 206 ; To use: (setq display-time-load nil)
204 ; 207 ;
205 ; Added facility for reporting incoming mail (modeled after gosmacs 208 ; Added facility for reporting incoming mail (modeled after gosmacs
206 ; reportmail.ml package written by Benjamin Pierce). 209 ; reportmail.ml package written by Benjamin Pierce).
207 210
208 211 (require 'itimer) ; this is xemacs, so why conditionalize?
209 (if (string-match "XEmacs" emacs-version) 212 (require 'mail-extr)
210 (require 'itimer))
211
212 (condition-case ()
213 (require 'mail-extr)
214 (error nil))
215 213
216 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
217 ;;; User Variables ;;; 215 ;;; User Variables ;;;
218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 216 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
219 217
356 (defmacro display-time-debug (mesg &rest args) 354 (defmacro display-time-debug (mesg &rest args)
357 (list 355 (list
358 'if 'display-time-debugging 356 'if 'display-time-debugging
359 (list 'display-time-debug-mesg 357 (list 'display-time-debug-mesg
360 (append (list 'format mesg) args)))) 358 (append (list 'format mesg) args))))
361
362 (defmacro display-time-save-match-data (&rest body)
363 ;; Execute the BODY forms, restoring the global value of the match data.
364 ;; We need this because it's antisocial for process filters to change
365 ;; the regexp match registers.
366 (list 'let '((_match_data_ (match-data)))
367 (list 'unwind-protect
368 (cons 'progn body)
369 '(store-match-data _match_data_))))
370 359
371 (defun display-time-init () 360 (defun display-time-init ()
372 ;; If the mail-file isn't set, figure it out. 361 ;; If the mail-file isn't set, figure it out.
373 (or display-time-incoming-mail-file 362 (or display-time-incoming-mail-file
374 (setq display-time-incoming-mail-file 363 (setq display-time-incoming-mail-file
434 (if (not (memq 'display-time-string global-mode-string)) 423 (if (not (memq 'display-time-string global-mode-string))
435 (setq global-mode-string 424 (setq global-mode-string
436 (append global-mode-string '(display-time-string)))) 425 (append global-mode-string '(display-time-string))))
437 (setq display-time-string "time and load") 426 (setq display-time-string "time and load")
438 427
439 (if (featurep 'itimer) 428 (let ((old (get-itimer "display-time")))
440 (let ((old (get-itimer "display-time"))) 429 (if old (delete-itimer old))
441 (if old (delete-itimer old)) 430 (start-itimer "display-time" 'display-time-timer-function
442 (start-itimer "display-time" 'display-time-timer-function 431 display-time-interval display-time-interval)
443 display-time-interval display-time-interval) 432 (display-time-timer-function))
444 (display-time-timer-function)) 433
445 ;; if we don't have timers, then use one of the process mechanisms.
446 (setq display-time-loadst-process
447 (if (string-match "18\\.5[0-5]" (emacs-version))
448 (start-process "display-time-loadst" nil
449 "loadst"
450 "-n" (int-to-string display-time-interval))
451 (start-process "display-time-wakeup" nil
452 (concat exec-directory "wakeup")
453 (int-to-string display-time-interval))))
454 (process-kill-without-query display-time-loadst-process)
455 (set-process-sentinel display-time-loadst-process
456 'display-time-sentinel)
457 (set-process-filter display-time-loadst-process
458 (if (string-match "^18\\.5[0-5]" (emacs-version))
459 'display-time-filter-18-55
460 'display-time-filter-18-57)))
461
462 (if display-time-use-xbiff 434 (if display-time-use-xbiff
463 (progn 435 (progn
464 (display-time-del-file display-time-mail-arrived-file) 436 (display-time-del-file display-time-mail-arrived-file)
465 (setq display-time-xbiff-process 437 (setq display-time-xbiff-process
466 (apply 'start-process "display-time-xbiff" nil 438 (apply 'start-process "display-time-xbiff" nil
471 (sit-for 1) ; Need time to see if xbiff fails. 443 (sit-for 1) ; Need time to see if xbiff fails.
472 (if (/= 0 (process-exit-status display-time-xbiff-process)) 444 (if (/= 0 (process-exit-status display-time-xbiff-process))
473 (error "Display time: xbiff failed. Check xbiff-arg-list")))))) 445 (error "Display time: xbiff failed. Check xbiff-arg-list"))))))
474 (display-time-total-reset)) 446 (display-time-total-reset))
475 447
476 448 (defun display-time-timer-function ()
477 (defun display-time-sentinel (proc reason) 449 ;; was: (defun display-time-filter-18-57 (proc string) ; args are ignored
478 (display-time-save-match-data 450 ;; but we're not supporting version 18 here and I'm trimming excess
479 ;; notice if the process has died an untimely death... 451 (save-match-data
480 (display-time-debug "display-time-sentinel") 452 (display-time-debug "display-time-timer-function")
481 (cond ((memq (process-status proc) '(stop exit closed signal)) 453 (if display-time-flush-echo-area
482 (if (and (stringp reason) (string-match "\n?\n*\\'" reason)) 454 (progn
483 (setq reason (substring reason 0 (match-beginning 0)))) 455 (display-time-debug "flush echo area")
484 (beep) 456 (display-time-message "")))
485 (setq display-time-string (format "%s" reason)) 457 (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
486 (display-time-message "") 458 (not (eq 0 (nth 7 (file-attributes
487 (message "process %s: %s (%s)" proc reason (process-status proc)))) 459 display-time-incoming-mail-file)))))))
488 (display-time-force-redisplay))) 460 (if display-time-announce-mail
489 461 (if mailp
490 (defun display-time-filter-18-55 (proc string) 462 (display-time-process-new-mail)
491 (display-time-save-match-data
492 (if display-time-flush-echo-area (display-time-message ""))
493 ;; Desired data can't need more than the last 30 chars,
494 ;; so save time by flushing the rest.
495 ;; This way, if we have many different times all collected at once,
496 ;; we can discard all but the last few very fast.
497 (display-time-debug "display-time-filter-18-55")
498 (if (> (length string) 30) (setq string (substring string -30)))
499 ;; Now discard all but the very last one.
500 (while (and (> (length string) 4)
501 (string-match "[0-9]+:[0-9][0-9].." string 4))
502 (setq string (substring string (match-beginning 0))))
503 (if (string-match "[^0-9][0-9]+:" string)
504 (setq string (substring string 0 (1+ (match-beginning 0)))))
505 ;; If we're announcing mail and mail has come, process any new messages
506 (if display-time-announce-mail
507 (if (string-match "Mail" string)
508 (display-time-process-new-mail)
509 (display-time-total-reset)))
510 ;; Format the mode line time display
511 (let ((time-string (if (string-match "Mail" string)
512 (if display-time-announce-mail
513 display-time-mail-modeline
514 "Mail "))))
515 (if (and display-time-time (string-match "[0-9]+:[0-9][0-9].." string))
516 (setq time-string
517 (concat time-string
518 (substring string (match-beginning 0) (match-end 0))
519 " ")))
520 (if display-time-day-and-date
521 (setq time-string
522 (concat time-string
523 (substring (current-time-string) 0 11))))
524 (if (and display-time-load (string-match "[0-9]+\\.[0-9][0-9]" string))
525 (setq time-string
526 (concat time-string
527 (substring string (match-beginning 0) (match-end 0))
528 " ")))
529 ;; Install the new time for display.
530 (setq display-time-string time-string)
531 (display-time-force-redisplay))))
532
533 (defun display-time-filter-18-57 (proc string) ; args are ignored
534 (display-time-save-match-data
535 (display-time-debug "display-time-filter-18-57")
536 (if display-time-flush-echo-area
537 (progn
538 (display-time-debug "flush echo area")
539 (display-time-message "")))
540 (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
541 (not (eq 0 (nth 7 (file-attributes
542 display-time-incoming-mail-file)))))))
543 (if display-time-announce-mail
544 (if mailp
545 (display-time-process-new-mail)
546 (display-time-total-reset))) 463 (display-time-total-reset)))
547 ;; Format the mode line time display 464 ;; Format the mode line time display
548 (let ((time-string (if mailp 465 (let ((time-string (if mailp
549 (if display-time-announce-mail 466 (if display-time-announce-mail
550 display-time-mail-modeline 467 display-time-mail-modeline
551 "Mail ")))) 468 "Mail "))))
552 (if display-time-time 469 (if display-time-time
553 (let* ((time (current-time-string)) 470 (let* ((time (current-time-string))
554 (hour (read (substring time 11 13))) 471 (hour (read (substring time 11 13)))
555 (pm (>= hour 12))) 472 (pm (>= hour 12)))
556 (if (> hour 12) (setq hour (- hour 12))) 473 (if (> hour 12) (setq hour (- hour 12)))
557 (if (= hour 0) (setq hour 12)) 474 (if (= hour 0) (setq hour 12))
475 (setq time-string
476 (concat time-string
477 (format "%d" hour) (substring time 13 16)
478 (if pm "pm " "am ")))))
479 (if display-time-day-and-date
558 (setq time-string 480 (setq time-string
559 (concat time-string 481 (concat time-string
560 (format "%d" hour) (substring time 13 16) 482 (substring (current-time-string) 0 11))))
561 (if pm "pm " "am "))))) 483 (if display-time-load
562 (if display-time-day-and-date 484 (setq time-string
563 (setq time-string 485 (concat time-string
564 (concat time-string 486 (condition-case ()
565 (substring (current-time-string) 0 11)))) 487 (let* ((la (car (load-average)))
566 (if display-time-load 488 (load (if (zerop la)
567 (setq time-string 489 nil
568 (concat time-string 490 (format "%03d" la))))
569 (condition-case () 491 (if load
570 (let* ((la (car (load-average))) 492 (concat (substring load 0 -2)
571 (load (if (zerop la) 493 "." (substring load -2))
572 nil 494 ""))
573 (format "%03d" la)))) 495 (error "load-error"))
574 (if load 496 " ")))
575 (concat (substring load 0 -2) 497 ;; Install the new time for display.
576 "." (substring load -2)) 498 (setq display-time-string time-string)
577 "")) 499 (force-mode-line-update t)))))
578 (error "load-error"))
579 " ")))
580 ;; Install the new time for display.
581 (setq display-time-string time-string)
582
583 (display-time-force-redisplay)))))
584
585 (defun display-time-timer-function ()
586 (display-time-filter-18-57 nil nil))
587
588 (defun display-time-force-redisplay ()
589 "Force redisplay of all buffers' mode lines to be considered."
590 (save-excursion (set-buffer (other-buffer)))
591 (set-buffer-modified-p (buffer-modified-p))
592 ;; Do redisplay right now, if no input pending.
593 (sit-for 0))
594 500
595 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 501 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
596 ;;; Mail processing ;;; 502 ;;; Mail processing ;;;
597 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 503 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
598 504
654 (setq display-time-mail-who-from "Junk mail") 560 (setq display-time-mail-who-from "Junk mail")
655 (setq display-time-mail-modeline "") 561 (setq display-time-mail-modeline "")
656 (setq display-time-previous-mail-buffer-max 1) 562 (setq display-time-previous-mail-buffer-max 1)
657 (display-time-message "") ; clear the echo-area. 563 (display-time-message "") ; clear the echo-area.
658 ) 564 )
659
660 (or (fboundp 'buffer-disable-undo)
661 (fset 'buffer-disable-undo 'buffer-flush-undo))
662 565
663 (defun display-time-process-new-mail () 566 (defun display-time-process-new-mail ()
664 (setq display-time-may-need-to-reset t) 567 (setq display-time-may-need-to-reset t)
665 (let ((mail-buffer (get-buffer display-time-mail-buffer-name)) 568 (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
666 (inhibit-local-variables t) 569 (inhibit-local-variables t)
788 (insert str)))) 691 (insert str))))
789 ;; if we're reading from the echo-area, and all we were going to do is 692 ;; if we're reading from the echo-area, and all we were going to do is
790 ;; clear the thing, like, don't bother, that's annoying. 693 ;; clear the thing, like, don't bother, that's annoying.
791 (if (and in-echo-area-already (string= "" str)) 694 (if (and in-echo-area-already (string= "" str))
792 nil 695 nil
793 (if (and (string= str "") (string-match "^19" emacs-version)) 696 ;; XEmacs version fix
697 (if (and (string= str "") (not (string-match "^18" emacs-version)))
794 (message nil) 698 (message nil)
795 (message "%s" str))))) 699 (message "%s" str)))))
796 700
797 (defun display-time-process-good-message () 701 (defun display-time-process-good-message ()
798 (display-time-debug "Formatting message announcement (good message)") 702 (display-time-debug "Formatting message announcement (good message)")
855 (to (display-time-get-field "To" "")) 759 (to (display-time-get-field "To" ""))
856 (print-subject (if (string= subject "") 760 (print-subject (if (string= subject "")
857 "" 761 ""
858 (concat " (" subject ")"))) 762 (concat " (" subject ")")))
859 (print-from (display-time-truncate from display-time-max-from-length)) 763 (print-from (display-time-truncate from display-time-max-from-length))
860 (short-from (display-time-truncate
861 (display-time-extract-short-addr from) 25))
862 (print-to (if (display-time-member to display-time-my-addresses) 764 (print-to (if (display-time-member to display-time-my-addresses)
863 "" 765 ""
864 (display-time-truncate 766 (display-time-truncate
865 (display-time-extract-short-addr to) 767 (display-time-extract-short-addr to)
866 display-time-max-to-length)))) 768 display-time-max-to-length))))
969 871
970 (defvar display-time-debugging-messages nil 872 (defvar display-time-debugging-messages nil
971 "When non-NIL, reportmail displays status messages in real time.") 873 "When non-NIL, reportmail displays status messages in real time.")
972 874
973 (defun display-time-debug-mesg (mesg) 875 (defun display-time-debug-mesg (mesg)
974 (display-time-save-match-data 876 (save-match-data
975 (if display-time-debugging-messages 877 (if display-time-debugging-messages
976 (progn 878 (progn
977 (message "Reportmail: %s" mesg) 879 (message "Reportmail: %s" mesg)
978 (sit-for 1) 880 (sit-for 1)
979 )) 881 ))