home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / reportmail.el < prev    next >
Encoding:
Text File  |  1991-03-20  |  21.6 KB  |  596 lines
  1. ; Path: utkcs2!emory!samsung!cs.utexas.edu!tut.cis.ohio-state.edu!pt.cs.cmu.edu!PROOF.ERGO.CS.CMU.EDU!bcp
  2. ; >From: bcp@CS.CMU.EDU (Benjamin Pierce)
  3. ; Newsgroups: gnu.emacs
  4. ; Subject: Reportmail (was: Mail alert in mode line?)
  5. ; Date: 21 Jul 90 03:25:07 GMT
  6. ; Organization: Carnegie Mellon University
  7. ; 
  8. ; 
  9. ; Dave Plaut, Mark Leone, and I wrote a bit of code to report incoming
  10. ; mail in the mode line.  Installation instructions are included below.
  11. ; 
  12. ;     Benli
  13. ; 
  14. ; 
  15. ; 
  16. ; 
  17. ;; REPORTMAIL: Display time and load in mode line of Emacs.
  18. ;; Originally time.el in the emacs distribution.
  19. ;; Mods by BCP and DCP to display incoming mail.
  20. ;;
  21. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  22.  
  23. ;; This file is part of GNU Emacs.
  24.  
  25. ;; GNU Emacs is distributed in the hope that it will be useful,
  26. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  27. ;; accepts responsibility to anyone for the consequences of using it
  28. ;; or for whether it serves any particular purpose or works at all,
  29. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  30. ;; License for full details.
  31.  
  32. ;; Everyone is granted permission to copy, modify and redistribute
  33. ;; GNU Emacs, but only under the conditions described in the
  34. ;; GNU Emacs General Public License.   A copy of this license is
  35. ;; supposed to have been given to you along with GNU Emacs so you
  36. ;; can know your rights and responsibilities.  It should be in a
  37. ;; file named COPYING.  Among other things, the copyright notice
  38. ;; and this notice must be preserved on all copies.
  39.  
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41. ;
  42. ; To use reportmail, add the following to your .emacs file:
  43. ;
  44. ;    (load-library "reportmail")
  45. ;
  46. ;    ;; Edit this list as appropriate
  47. ;    (setq display-time-my-addresses
  48. ;     '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "\"Benjamin C. Pierce"))
  49. ; 
  50. ;    ;; By default, mail arrival is reported with a message but no beep  
  51. ;    (setq display-time-mail-ring-bell t)
  52. ; 
  53. ;    (display-time)
  54. ; 
  55. ;
  56. ; In the CMU SCS environment, messages waiting to be read are kept in a 
  57. ; file called /usr/spool/mail/<userid>, separated by control-Cs.
  58. ; If your environment differs, you will want to modify the values of
  59. ; the variables 
  60. ;             display-time-incoming-mail-file 
  61. ; and/or      display-time-message-separator.
  62. ;
  63. ;
  64. ; The reportmail package has a notion of "junk mail," which can be used to
  65. ; reduce the frequency of irritating interruptions by reporting only the
  66. ; arrival of messages that seem to be interesting.  If you're on a lot
  67. ; of high-volume mailing lists, this can be quite convenient.  To use
  68. ; this facility, add something like the following to your .emacs file:
  69. ; 
  70. ;   ;; The value of this variable is a list of lists, where the first
  71. ;   ;; element in each list is the name of a header field and the
  72. ;   ;; remaining elements are various prefixes of the value of this
  73. ;   ;; header field that signal the junkiness of a message.  
  74. ;   (setq display-time-junk-mail-checklist
  75. ;     '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
  76. ;               "Mail Delivery Subsystem" "network" "daemon@bartok")
  77. ;       ("To" "sml-request" "sml-redistribution-request" 
  78. ;        "scheme" "TeXhax-Distribution-list")
  79. ;       ("Resent-From" "Benjamin.Pierce")
  80. ;       ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
  81. ;   
  82. ;
  83. ; If you normally keep your emacs window iconified, reportmail can 
  84. ; maintain an xbiff display as well.  The xbiff window will only be 
  85. ; highlighted when non-junk mail is waiting to be read.  For example:
  86. ;
  87. ;    (if window-system-version
  88. ;        (setq display-time-use-xbiff t))
  89. ;    (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
  90. ;
  91. ;
  92. ; There are several other user-customization variables that you may wish
  93. ; to modify.  These are documented below.
  94.  
  95.  
  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97. ;
  98. ; HISTORY
  99. ;
  100. ; 19 Jul 90     Benjamin Pierce (bcp@cs.cmu.edu)
  101. ;       Improved user documentation and eliminated known CMU dependencies.
  102. ;
  103. ; 13 Jul 90    Mark Leone (mleone@cs.cmu.edu)
  104. ;    Added display-time-use-xbiff option.  Various layout changes.
  105. ;
  106. ; 20 May 90     Benjamin Pierce (bcp@cs.cmu.edu)
  107. ;       Fixed a bug that occasionally caused fields to be extracted
  108. ;       from the wrong buffer.
  109. ;
  110. ; 14 May 90     Benjamin Pierce (bcp@cs.cmu.edu)
  111. ;       Added concept of junk mail and ability to display message
  112. ;       recipient in addition to sender and subject.  (Major internal
  113. ;       reorganization was needed to implement this cleanly.)
  114. ;
  115. ; 18 Nov 89     Benjamin Pierce (bcp@cs.cmu.edu)
  116. ;       Fixed to work when display-time is called with 
  117. ;       global-mode-string not a list
  118. ;
  119. ; 15 Jan 89    David Plaut (dcp@cs.cmu.edu)
  120. ;    Added ability to discard load from displayed string
  121. ;
  122. ;    To use:    (setq display-time-load nil)
  123. ;
  124. ;    Added facility for reporting incoming mail (modeled after gosmacs
  125. ;    reportmail.ml package written by Benjamin Pierce).
  126.  
  127.  
  128. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  129. ;;;                       User Variables                          ;;;
  130. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  131.  
  132. (defvar display-time-announce-mail t
  133.   "*Toggles whether name of mail sender is displayed in mode line.")
  134.  
  135. (defvar display-time-announce-junk-mail-too nil
  136.   "*When non-NIL, announce incoming junk mail as well as interesting mail")
  137.  
  138. (defvar display-time-time t
  139.   "*Toggles whether the time is displayed.")
  140.  
  141. (defvar display-time-load nil
  142.   "*Toggles whether machine load is displayed.")
  143.  
  144. (defvar display-time-day-and-date nil
  145.   "*Toggles whether day and date are displayed.")
  146.  
  147. (defvar display-time-mail-ring-bell nil
  148.   "*Toggles whether bell is rung on mail arrival.")
  149.  
  150. (defvar display-time-my-addresses 
  151.   (list (user-full-name) (user-login-name))
  152.   "*Report the addressee of incoming mail, unless it appears in this list")
  153. ;; For example:
  154. ;; (setq display-time-my-addresses
  155. ;;  '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "\"Benjamin C. Pierce"))
  156.  
  157. (defvar display-time-junk-mail-checklist nil
  158.   "*A list of lists of strings.  In each sublist, the first component is the
  159. name of a message field and the rest are values that flag a piece of
  160. junk mail.")
  161. ;; For example:
  162. ;; (setq display-time-junk-mail-checklist
  163. ;;  '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
  164. ;;            "Mail Delivery Subsystem" "network" "daemon@bartok")
  165. ;;    ("To" "sml-request" "sml-redistribution-request" "computermusic" 
  166. ;;     "scheme" "TeXhax-Distribution-list")
  167. ;;    ("Resent-From" "Benjamin.Pierce")
  168. ;;    ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
  169.  
  170. (defvar display-time-max-from-length 35
  171.   "*Truncate sender name to this length in mail announcements")
  172.  
  173. (defvar display-time-max-to-length 11
  174.   "*Truncate addressee name to this length in mail announcements")
  175.  
  176. (defvar display-time-interval 30
  177.   "*Seconds between updates of time in the mode line.  Also used
  178. as interval for checking incoming mail.")
  179.  
  180. (defvar display-time-incoming-mail-file
  181.   (let ((spool-name (getenv "MAIL")))
  182.     (if (or (null spool-name) (not (file-exists-p spool-name)))
  183.     (let ((user-name (getenv "USER")))
  184.       (setq spool-name (concat "/usr/spool/mail/" user-name))
  185.       (if (or (null user-name) (not (file-exists-p spool-name)))
  186.           (setq spool-name ""))))
  187.     spool-name)
  188.   "User's incoming mail file.  Default is value of environment variable MAIL,
  189. if set;  otherwise /usr/spool/mail/$USER is used.")
  190.  
  191. (defvar display-time-message-separator "\C-c")
  192.  
  193. (defvar display-time-use-xbiff nil
  194.   "If set, display-time uses xbiff to announce new mail.")
  195.  
  196. (defvar display-time-xbiff-arg-list nil
  197.   "List of arguments passed to xbiff.  Useful for setting geometry, etc.")
  198. ;;; For example: 
  199. ;;; (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
  200.  
  201. (defvar display-time-mail-arrived-file
  202.   (concat "/usr/" (getenv "USER") "/.mail-arrived")
  203.   "New mail announcements saved in this file if xbiff used.  Deleted when 
  204. mail is read.  Xbiff used to monitor existence of this file.")
  205.  
  206. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  207. ;;;                       Internal Variables                      ;;;
  208. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  209.  
  210. (defvar display-time-loadst-process nil
  211.   "The process providing time, load, and mail info.")
  212.  
  213. (defvar display-time-xbiff-process nil
  214.   "The xbiff process used to announce incoming mail.")
  215.  
  216. (defvar display-time-string nil
  217.   "Time displayed in mode line")
  218.  
  219. (defvar display-time-mail-buffer-name "*Mail*"
  220.   "Name of buffer used for announcing mail.")
  221.  
  222. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  223. ;;;                       Macros                                  ;;;
  224. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  225.  
  226. (defmacro when (condition &rest body)
  227.   (append (list 'if (list 'not condition) '()) body))
  228.  
  229. (defmacro unless (condition &rest body)
  230.   (append (list 'if condition '()) body))
  231.  
  232. (defmacro del-file (filename)
  233.   (list 'if (list 'file-exists-p filename) (list 'delete-file filename)))
  234.  
  235. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  236. ;;;                       Time Display                            ;;;
  237. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  238.  
  239. (defun display-time-kill ()
  240.   "Kill all display-time processes.  Done automatically if display-time
  241. is re-invoked."
  242.   (interactive)
  243.   (if display-time-loadst-process (delete-process display-time-loadst-process))
  244.   (if display-time-xbiff-process (delete-process display-time-xbiff-process))
  245. )
  246.  
  247.  
  248. (defun display-time ()
  249.   "Displays current time, date, load level, and incoming mail status in 
  250. mode line of each buffer (if corresponding user variables are set)."
  251.   (interactive)
  252.   (let ((process-connection-type nil))  ; UIUCDCS mod
  253.     (save-excursion
  254.       (display-time-kill)
  255.       (if (or (string-equal "" display-time-incoming-mail-file)
  256.           (not (file-exists-p display-time-incoming-mail-file)))
  257.       (error "Display-time-incoming-mail-file not found!"))
  258.       
  259.       (if (not global-mode-string) (setq global-mode-string '("")))
  260.       (if (not (listp global-mode-string))
  261.       (setq global-mode-string (list global-mode-string "  ")))
  262.       (if (not (memq 'display-time-string global-mode-string))
  263.       (setq global-mode-string
  264.         (append global-mode-string '(display-time-string))))
  265.       (setq display-time-string "time and load")
  266.       
  267.       (setq display-time-loadst-process
  268.         (start-process "display-time-loadst" nil
  269.                "loadst" 
  270.                "-n" (int-to-string display-time-interval)))
  271.       (process-kill-without-query display-time-loadst-process)
  272.       (set-process-sentinel display-time-loadst-process 
  273.                 'display-time-sentinel)
  274.       (set-process-filter display-time-loadst-process 'display-time-filter)
  275.       
  276.       (if display-time-use-xbiff
  277.       (progn
  278.         (del-file display-time-mail-arrived-file)
  279.         (setq display-time-xbiff-process
  280.           (apply 'start-process "display-time-xbiff" nil
  281.              "xbiff" "-file" display-time-mail-arrived-file
  282.              display-time-xbiff-arg-list))
  283.         (process-kill-without-query display-time-xbiff-process)
  284.         (sit-for 1)            ; Need time to see if xbiff fails.
  285.         (if (/= 0 (process-exit-status display-time-xbiff-process))
  286.         (error "Display time: xbiff failed.  Check xbiff-arg-list"))))))
  287.   (display-time-reset-mail-processing))
  288.  
  289.  
  290. (defun display-time-sentinel (proc reason)
  291.   (or (eq (process-status proc) 'run)
  292.       (setq display-time-string ""))
  293.   ;; Force mode-line updates
  294.   (save-excursion (set-buffer (other-buffer)))
  295.   (set-buffer-modified-p (buffer-modified-p))
  296.   (sit-for 0))
  297.  
  298.  
  299. (defun display-time-filter (proc string)
  300.   ;; Desired data can't need more than the last 30 chars,
  301.   ;; so save time by flushing the rest.
  302.   ;; This way, if we have many different times all collected at once,
  303.   ;; we can discard all but the last few very fast.
  304.   (if (> (length string) 30) (setq string (substring string -30)))
  305.   ;; Now discard all but the very last one.
  306.   (while (and (> (length string) 4)
  307.           (string-match "[0-9]+:[0-9][0-9].." string 4))
  308.     (setq string (substring string (match-beginning 0))))
  309.   (if (string-match "[^0-9][0-9]+:" string)
  310.       (setq string (substring string 0 (1+ (match-beginning 0)))))
  311.   ;; If we're announcing mail and mail has come, process any new messages
  312.   (when display-time-announce-mail
  313.     (if (string-match "Mail" string)
  314.         (display-time-process-new-mail)
  315.         (display-time-reset-mail-processing)))
  316.   ;; Format the mode line time display
  317.   (let ((time-string (if (string-match "Mail" string)
  318.              (if display-time-announce-mail 
  319.                  display-time-mail-modeline
  320.                  "Mail "))))
  321.     (if (and display-time-time (string-match "[0-9]+:[0-9][0-9].." string))
  322.     (setq time-string 
  323.           (concat time-string
  324.               (substring string (match-beginning 0) (match-end 0))
  325.               " ")))
  326.     (if display-time-day-and-date
  327.     (setq time-string
  328.           (concat time-string
  329.               (substring (current-time-string) 0 11))))
  330.     (if (and display-time-load (string-match "[0-9]+\\.[0-9][0-9]" string))
  331.     (setq time-string
  332.           (concat time-string
  333.               (substring string (match-beginning 0) (match-end 0))
  334.               " ")))
  335.     ;; Install the new time for display.
  336.     (setq display-time-string time-string)
  337.     ;; Force redisplay of all buffers' mode lines to be considered.
  338.     (save-excursion (set-buffer (other-buffer)))
  339.     (set-buffer-modified-p (buffer-modified-p))
  340.     ;; Do redisplay right now, if no input pending.
  341.     (sit-for 0)))
  342.  
  343.  
  344. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  345. ;;;                       Mail processing                         ;;;
  346. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  347.  
  348. (defvar display-time-mail-who-from ""
  349.   "Short-form name of sender of last piece of interesting unread mail")
  350.  
  351. (defvar display-time-mail-modeline ""
  352.   "Terse mail announcement (displayed in modeline)")
  353.  
  354. (defvar display-time-previous-mail-buffer-max 1
  355.   "The length of the mail buffer the last time we looked at it")
  356.  
  357. (defvar display-time-msg-count 0
  358.   "How many interesting messages have arrived")
  359.  
  360. (defvar display-time-junk-msg-count 0
  361.   "How many junk messages have arrived")
  362.  
  363.  
  364. ;; A test procedure for trying out new display-time features
  365. (defun display-time-test ()
  366.   (interactive)
  367.   (display-time-reset-mail-processing)
  368.   (display-time-process-new-mail))
  369.  
  370. (defun display-time-reset-mail-processing ()
  371.   (let ((mail-buffer (get-buffer display-time-mail-buffer-name)))
  372.     (if mail-buffer (kill-buffer mail-buffer)))
  373.   (if display-time-use-xbiff
  374.       ;; This function is only called when no mail is in the spool.
  375.       ;; Hence we should delete the mail-arrived file.
  376.       (del-file display-time-mail-arrived-file))
  377.   (display-time-reset-mail-processing-vars))
  378.  
  379. (defun display-time-reset-mail-processing-vars ()
  380.   (setq display-time-msg-count 0)
  381.   (setq display-time-junk-msg-count 0)
  382.   (setq display-time-mail-who-from "Junk mail")
  383.   (setq display-time-previous-mail-buffer-max 1))
  384.  
  385. (defun display-time-process-new-mail ()
  386.   (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
  387.     start)
  388.     (unless (and mail-buffer (verify-visited-file-modtime mail-buffer))
  389.       (save-window-excursion
  390.     (if mail-buffer (kill-buffer mail-buffer))
  391.     ;; Change to pop-to-buffer when we're debugging:
  392.     (set-buffer (find-file-noselect display-time-incoming-mail-file))
  393.     (rename-buffer display-time-mail-buffer-name)
  394.     (if (< display-time-previous-mail-buffer-max (point-max))
  395.         (progn
  396.           (goto-char display-time-previous-mail-buffer-max)
  397.           (if (not (looking-at display-time-message-separator))
  398.           (display-time-reset-mail-processing-vars)))
  399.         (display-time-reset-mail-processing-vars))
  400.     (goto-char display-time-previous-mail-buffer-max)
  401.     (if (not (eobp))
  402.         (forward-char 1))
  403.     (while (not (eobp))
  404.       (setq start (point))
  405.       (if (not (search-forward display-time-message-separator nil t))
  406.           (goto-char (point-max)))
  407.       (narrow-to-region start (point))
  408.       (display-time-process-this-message)
  409.       (goto-char (point-max))
  410.       (widen))
  411.     (setq display-time-previous-mail-buffer-max (point-max))))))
  412.  
  413. (defun display-time-process-this-message ()
  414.   ;; Here's where we should check to see whether it's junk mail
  415.   (if (display-time-junk-message)
  416.       (display-time-process-junk-message)  
  417.       (display-time-process-good-message))
  418.   
  419.   ;; Update mode line contents
  420.   (setq display-time-mail-modeline 
  421.     (concat "[" (display-time-format-msg-count) 
  422.         display-time-mail-who-from
  423.         "] "))
  424.   ;; (stop-here (concat "New mode line: " display-time-mail-modeline))
  425.   )
  426.  
  427. (defun display-time-junk-message ()
  428.   "Check to see whether this message is interesting"
  429.   (let ((checklist display-time-junk-mail-checklist)
  430.     (junk nil))
  431.     (while (and checklist (not junk))
  432.       (if (display-time-member 
  433.        (display-time-get-field (car (car checklist)))
  434.        (cdr (car checklist)))
  435.       (setq junk t)
  436.       (setq checklist (cdr checklist))))
  437.     junk))
  438.  
  439. (defun display-time-process-good-message ()
  440.   ;; Update the message counter
  441.   (setq display-time-msg-count (+ display-time-msg-count 1))
  442.  
  443.   ;; Format components of announcement
  444.   (let* ((subject (display-time-get-field "Subject" ""))
  445.      (from (display-time-get-field "From" ""))
  446.      (to (display-time-get-field "To" ""))
  447.          (print-subject (if (string= subject "")
  448.                 ""
  449.                 (concat " (" subject ")")))
  450.      (print-from (display-time-truncate from display-time-max-from-length))
  451.      (short-from (display-time-truncate 
  452.               (display-time-extract-short-addr from) 25))
  453.      (print-to (if (display-time-member to display-time-my-addresses)
  454.                ""
  455.                (display-time-truncate 
  456.             (display-time-extract-short-addr to)
  457.             display-time-max-to-length))))
  458.  
  459.     ;; Announce message
  460.     (let ((msg (concat 
  461.            (display-time-format-msg-count)
  462.            "Mail " 
  463.            (if (string= print-to "") "" 
  464.                (concat "to " print-to " "))
  465.            "from " print-from 
  466.            print-subject)))
  467.       (if display-time-use-xbiff
  468.       (save-excursion
  469.         (let ((tmp-buf (generate-new-buffer "*Tmp*")))
  470.           (set-buffer tmp-buf)
  471.           (insert msg)
  472.           (newline)
  473.           (append-to-file (point-min) (point-max) 
  474.                   display-time-mail-arrived-file)
  475.           (kill-buffer tmp-buf))))
  476.       (message "%s" msg))
  477.  
  478.     (if display-time-mail-ring-bell (ding))
  479.     (sit-for 2)
  480.     
  481.     ;; Update mode line information
  482.     (setq display-time-mail-who-from short-from)))
  483.  
  484. (defun display-time-process-junk-message ()
  485.   ;; Update the message counter
  486.   (setq display-time-junk-msg-count (+ display-time-junk-msg-count 1))
  487.  
  488.   ;; Format components of announcement
  489.   (let* ((subject (display-time-get-field "Subject" ""))
  490.      (from (display-time-get-field "From" ""))
  491.      (to (display-time-get-field "To" ""))
  492.          (print-subject (if (string= subject "")
  493.                 ""
  494.                 (concat " (" subject ")")))
  495.      (print-from (display-time-truncate from display-time-max-from-length))
  496.      (short-from (display-time-truncate 
  497.               (display-time-extract-short-addr from) 25))
  498.      (print-to (if (display-time-member to display-time-my-addresses)
  499.                ""
  500.                (display-time-truncate 
  501.             (display-time-extract-short-addr to)
  502.             display-time-max-to-length))))
  503.  
  504.     ;; Announce message
  505.     (when display-time-announce-junk-mail-too
  506.       (let ((msg (concat 
  507.               (display-time-format-msg-count)
  508.               "Junk Mail " 
  509.               (if (string= print-to "") "" 
  510.             (concat "to " print-to " "))
  511.               "from " print-from 
  512.               print-subject)))
  513.         (if display-time-use-xbiff
  514.         (save-excursion
  515.           (let ((tmp-buf (generate-new-buffer "*Tmp*")))
  516.             (set-buffer tmp-buf)
  517.             (insert msg)
  518.             (newline)
  519.             (append-to-file (point-min) (point-max) 
  520.                     display-time-mail-arrived-file)
  521.             (kill-buffer tmp-buf))))
  522.         (message "%s" msg)
  523.         (if display-time-mail-ring-bell (ding))
  524.         (sit-for 2)))))
  525.  
  526. (defun display-time-format-msg-count ()
  527.    (if (> (+ display-time-msg-count display-time-junk-msg-count) 1) 
  528.        (concat 
  529.     (int-to-string display-time-msg-count) 
  530.     (if (> display-time-junk-msg-count 0)
  531.         (concat "(" (int-to-string display-time-junk-msg-count) ")"))
  532.     ": ")
  533.        ""))
  534.  
  535. (defun display-time-get-field (field &optional default)
  536.   (when (not (equal (buffer-name) display-time-mail-buffer-name))
  537.     (beep)
  538.     (message "bcp-time bug: processing buffer %s, not %s"
  539.          (buffer-name)
  540.          display-time-mail-buffer-name)
  541.     (sit-for 2))
  542.   (goto-char (point-min))
  543.   (if (re-search-forward (concat "^" field ":[ |\C-i]*") nil t)
  544.     (let ((start (point)))
  545.       (end-of-line)
  546.       (buffer-substring start (point)))
  547.     (or default "<unknown>")))
  548.  
  549. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  550. ;;;                       Auxilliary Functions                    ;;;
  551. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  552.  
  553. (defun display-time-member (e l)
  554.   "Is string E and element of list L?"
  555.   (let ((done nil)
  556.     (result nil))
  557.     (while (not done)
  558.       (cond 
  559.        ((null l) (setq done t))
  560.        ((display-time-is-prefix (car l) e) (setq result l) (setq done t))
  561.        (t (setq l (cdr l)))))
  562.     result))
  563.  
  564. (defun display-time-truncate (s max)
  565.   (if (and s (>= (length s) max))
  566.       (concat (substring s 0 max) "...")
  567.       s))
  568.  
  569. (defun display-time-is-prefix (pstr1 str2) 
  570.   "Is PSTR1 a prefix of STR2?"
  571.   (and (<= (length pstr1) (length str2))
  572.       (equal pstr1 (substring str2 0 (length pstr1)))))
  573.  
  574. (defun display-time-extract-short-addr (long-addr)
  575.   (let ((name "\\([A-Za-z0-9-_+\\. ]+\\)"))
  576.     (if (or 
  577.      ;; David Plaut <dcp@CS.CMU.EDU>     -> David Plaut
  578.      (string-match (concat name "[ |    ]+<.+>") long-addr)
  579.     
  580.      ;; anything (David Plaut) anything     -> David Plaut
  581.      (string-match ".+(\\(.+\\)).*" long-addr)
  582.      
  583.      ;; plaut%address.bitnet@vma.cc.cmu.edu -> plaut
  584.      (string-match (concat name "%.+@.+") long-addr)
  585.  
  586.      ;; random!uucp!addresses!dcp@uu.relay.net -> dcp
  587.      (string-match (concat ".*!" name "@.+") long-addr)
  588.  
  589.      ;; David.Plaut@CS.CMU.EDU         -> David.Plaut
  590.      (string-match (concat name "@.+") long-addr)
  591.      )
  592.     (substring long-addr (match-beginning 1) (match-end 1))
  593.     long-addr)))
  594.  
  595.  
  596.