[gnu.emacs] mail beep

ghh@clarity.princeton.edu (Gilbert Harman) (05/15/89)

Is there a way to get (display-time) or some other process
to beep when mail first arrives, in addition to displaying
"Mail" in the mode-line?

--
		       Gilbert Harman
                       Princeton University Cognitive Science Laboratory
	               221 Nassau Street, Princeton, NJ 08542
			      
		       ghh@princeton.edu
		       HARMAN@PUCC.BITNET

jr@bbn.com (John Robinson) (05/15/89)

In article <GHH.89May15093238@clarity.princeton.edu>, ghh@clarity (Gilbert Harman) writes:
>Is there a way to get (display-time) or some other process
>to beep when mail first arrives, in addition to displaying
>"Mail" in the mode-line?

In time.el, look for the following two lines in the defun of
display-time-filter:

  ;; Install the new time for display.
  (setq display-time-string string)

Just before them, insert:

  (if (and (string-match "Mail" string)
           (not (string-match "Mail" display-time-string)))
      (ding t))

Now execute the defun with ^X^E, or copy it into your .emacs, or
byte-compile all of time.el in your $EMACS/lisp if all your site wants
this change.

Caveats: I haven't tried this.  The ding may be a little disconcerting
if it happens in the middle of your typing away at something.  The
argument to ding prevents its clobbering something you may have been
in the middle of.  This code depends on the behavior of
$EMACS/etc/loadst (that it puts "Mail" in the string when mail is
present) - not a serious problem.  To make this a real change to
time.el it probably needs a config variable, similar to
display-time-day-and-date.
--
/jr
jr@bbn.com or bbn!jr
C'mon big money!

vail@tegra.UUCP (Johnathan Vail) (05/16/89)

If you have a Sun there is a little hack that myself and Mike Jipping,
<jipping@cs.hope.edu> have concocted.  It beeps and changes the icon
when there is new mail.  I can send it to anyone who wants it and it
includes your choice of original Sue Martin Icons.  Either the
traditional mailman or Hank the Hallucination (from Eyebeam comics).

Shar and Enjoy

"Cel-e-brate, the being right, of the doing right, of your heart"
 _____
|     | Johnathan Vail | tegra!N1DXG@ulowell.edu
|Tegra| (508) 663-7435 | N1DXG@145.110-,145.270-,444.2+,448.625-
 -----

jr@bbn.com (John Robinson) (05/16/89)

In article <39946@bbn.COM>, jr@bbn (John Robinson) [that's me!] writes:
>Just before them, insert:
>
>  (if (and (string-match "Mail" string)
>           (not (string-match "Mail" display-time-string)))
>      (ding t))
>
>Caveats: I haven't tried this.

And if I had, maybe I would have noticed that this clobbers
match-data, as Wolfgang Rupprecht pointed out in mail.  If you want to
get it right, protect it using the save-match-data function seen
recently in comp.emacs (or contact me - there, I hope that's pennance
enough :).
--
/jr
jr@bbn.com or bbn!jr
C'mon big money!

jr@bbn.com (John Robinson) (05/19/89)

In article <GHH.89May15093238@clarity.princeton.edu>, ghh@clarity (Gilbert Harman) writes:
>Is there a way to get (display-time) or some other process
>to beep when mail first arrives, in addition to displaying
>"Mail" in the mode-line?

I replied to this once in gnu.emacs, with a buggy suggestion, then
mentioned the bug in comp.emacs, which really confused things.

The solution came from Dave Lawrence and Cesar Quiros in another
context.  First, you want the following macro definition; this is so
useful you should have it around all the time.

    (require 'cl)
    (defmacro save-match-data (&rest body)
      "Execute the BODY forms, restoring the global value of the match data."
      (let ((original (gensym)))
        (list
         'let (list (list original '(match-data)))
         (list 'unwind-protect
               (cons 'progn body)
               (list 'store-match-data original)))))
    (put 'save-match-data 'lisp-indent-hook 0)

Given that, redefine display-time-filter in time.el as follows:

(defun display-time-filter (proc string)
  ;; 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.
  (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)))))
  ;; Append the date if desired.
  (if display-time-day-and-date
      (setq string (concat (substring (current-time-string) 0 11) string)))
  ;; Check if mail just arrived, and ring the bell
  (save-match-data
    (if (and (string-match "Mail" string)
	     (not (string-match "Mail" display-time-string)))
	(ding t)))
  ;; Install the new time for display.
  (setq display-time-string string)
  ;; 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))

This time, I even tried it, and it seems to work.
--

/jr, nee John Robinson	 What a waste it is to lose one's mind--or not
jr@bbn.com or bbn!jr	  to have a mind.  How true that is. -Dan Quayle

jr@bbn.com (John Robinson) (06/03/89)

In article <40158@bbn.COM>, I, jr@bbn (John Robinson) write:
>In article <GHH.89May15093238@clarity.princeton.edu>, ghh@clarity (Gilbert Harman) writes:
>>Is there a way to get (display-time) or some other process
>>to beep when mail first arrives, in addition to displaying
>>"Mail" in the mode-line?
> ...
>(defun display-time-filter (proc string)

... and so forth.  The defun made use of the save-match-data macro,
newly arrived to the list, to protect the (global, sadly) match-data
during this asynchronous function's execution.  I failed to notice
that the distributed code in time.el for display-time-filter already
trashes match-data in the lines prior to my modification.  Here's a
newer defun, with match-data protected properly, and the
save-match-data macro to boot in case you missed it before.
--------
(require 'cl)
(defmacro save-match-data (&rest body)
  "Execute the BODY forms, restoring the global value of the match data."
  (let ((original (gensym)))
    (list
     'let (list (list original '(match-data)))
     (list 'unwind-protect
	   (cons 'progn body)
	   (list 'store-match-data original)))))
(put 'save-match-data 'lisp-indent-hook 0)

(defun display-time-filter (proc string)
  ;; 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.
  (save-match-data
    (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)))))
    ;; Append the date if desired.
    (if display-time-day-and-date
	(setq string (concat (substring (current-time-string) 0 11) string)))
    ;; Check if mail just arrived, and ring the bell
    (if (and (string-match "Mail" string)
	     (not (string-match "Mail" display-time-string)))
	(ding t)))
  ;; Install the new time for display.
  (setq display-time-string string)
  ;; 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))

--
/jr, nee John Robinson   What a waste it is to lose one's mind--or not
jr@bbn.com or bbn!jr      to have a mind.  How true that is. -Dan Quayle

scott@bu-ma (Scott Sutherland) (06/13/89)

In article <40865@bbn.COM>, jr@bbn (John Robinson) writes:
>In article <40158@bbn.COM>, I, jr@bbn (John Robinson) write:
>>In article <GHH.89May15093238@clarity.princeton.edu>, ghh@clarity (Gilbert Harman) writes:
>>>Is there a way to get (display-time) or some other process
>>>to beep when mail first arrives, in addition to displaying
>>>"Mail" in the mode-line?
>> ...
>>(defun display-time-filter (proc string)
>
>... and so forth.  The defun made use of the save-match-data macro,
>newly arrived to the list, to protect the (global, sadly) match-data
>during this asynchronous function's execution.  I failed to notice
>that the distributed code in time.el for display-time-filter already
>trashes match-data in the lines prior to my modification.  Here's a
>newer defun, with match-data protected properly, and the
>save-match-data macro to boot in case you missed it before.
>--------
>   [...Elisp omitted...]
>--
>/jr, nee John Robinson   What a waste it is to lose one's mind--or not
>jr@bbn.com or bbn!jr      to have a mind.  How true that is. -Dan Quayle

I wrote a similar thing some time ago, when there were a flurry of
these in this group.  There was one to beep at new mail, pop up a sun
icon, and one to automatically pop an rmail buffer.  This merges the 3
of them, without rewriting the display-time code.  Instead, I add a
hook using hook.el (also enclosed).  This relys on the fact that
loadst writes Mail in the mode line.  I make no claims about this
being good code, but several of us have been using it for about a year
with no problems.

	Scott Sutherland			
	scott@bu-ma.bu.edu
	Boston University Math Department


;---------------- cut here and save as mail-watch.el ------------------
;
; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
;; Read the GNU COPYING file for the full details.
;; 9/17/87 wolfgang@mgm.mit.edu (was pop-mail.el)
;; 12/8/87 dzzr@lanl.gov (now sun-mail.el)
;; 2/19/88 scott@bu-ma.bu.edu (now mail-watch.el)
;;
(defvar beep-when-mail t "*If t ring the bell when new mail arrives")
(defvar number-beeps-when-mail 2 
  "*number of times to ring the bell when mail arrives" )
(defvar pop-new-mail nil "*If t open an rmail buffer when new mail arrives")
(if (getenv "WINDOW_ME")       ; are we in sunView?
    (defvar sun-icon-when-mail t "*If t pop up mail icon when mail arrives")
  (defvar sun-icon-when-mail nil "*If t pop up mail icon when mail arrives")
)
(setq sun-mail-process nil)
(defvar sun-icon-path "/usr/include/images/mail.icon" 
  "*where to find the sun mail icon")
(defvar sun-icon-command '("shelltool"
			   "-WL" ""
			   "-Wl" "new mail has arrived"
			   "-Wh" "10"
			   "-Ww" "80"
			   "-Wi" "-WI" sun-icon-path
			   "sh" "-c" "stty -nl;mail -H;sleep 99999")
  "*the process and args to run to get an iconic mailbox")
(setq mail-beep-counter 0)


(if (not (boundp 'display-time-process)) ; start the display-time sentinal
    (display-time))                      ; if not already there

(require 'hook)                          ; and add the hook
(add-hook 'display-time-filter '(watch-for-mail-and-do-something))



(defun watch-for-mail-and-do-something ()
  "checks the time-and-load string from display-time, and if Mail is found,
does various things based on the setting of the variables sun-icon-when-mail,
beep-when-mail, and pop-new-mail"

  (setq has-mail-flag (string-match "[Mm]ail" display-time-string))
  (if sun-icon-when-mail (if-mail-pop-sun-icon has-mail-flag))
  (if beep-when-mail (if-mail-beep has-mail-flag))
  (if pop-new-mail   (if-mail-pop-rmail has-mail-flag))
)


(defun if-mail-beep( has-mail-flag )
  "If arg is non-nil, ring the bell number-beeps-when-mail times. "
  (if has-mail-flag
      (progn                                      ;; there is mail
	(if (< mail-beep-counter number-beeps-when-mail)
	    (message "New mail has arrived"))
	(while (< mail-beep-counter number-beeps-when-mail)
	  (ding)
	  (sit-for 1)
	  (setq mail-beep-counter (+ mail-beep-counter 1))
	  ))
    ;; no mail
    (setq mail-beep-counter 0)
    ))

(defun if-mail-pop-sun-icon ( has-mail-flag )
  "If arg is non-nil, start an iconic shelltool with a mail-has-arrived icon.
If nil and shelltool process is running, kill it"
  (if has-mail-flag
      (progn                                      ;; there is mail
	(if (or (not sun-mail-process)
		(not (eq (process-status sun-mail-process) 'run)))
	    (setq sun-mail-process
		  (eval (append (list 
				 'start-process "new" nil)
				 sun-icon-command)))
	  ))
    ;  else, if no more mail, kill the process
    (if (and sun-mail-process
	     (eq (process-status sun-mail-process) 'run))
	(progn
	  (kill-process sun-mail-process)
	  (setq sun-mail-process nil)
	  ))
))

(defun named-buffer-is-visible-p ( buffer-name )
  "return t if the buffer whose name is arg is in a currently visible window"
  (and (get-buffer buffer-name)
       (get-buffer-window (get-buffer buffer-name))))

(defun if-mail-pop-rmail ( has-mail-flag )
  "If arg is non-nil, pop up an rmail buffer unless it is already visible"
  (if (and has-mail-flag                             ; is there mail?
	   (not (named-buffer-is-visible-p "RMAIL"))) ; is RMAIL not visible?
      (progn
	(save-excursion (rmail))
	(display-buffer (get-buffer "RMAIL"))
	))
  )

;---------------- cut here and save as hook.el ------------------------
; From: ciaran@hrc63.co.uk (Ciaran Byrne)
; Newsgroups: comp.emacs
; Subject: hooks in Gnumacs
; Date: 15 Sep 87 09:02:46 GMT
; Organization: GEC Hirst Research Centre, Wembley, England.
; Keywords: emacs,lisp,hooks
; 
; Here is something to help you go on living when you discover that
; the author of your favorite function arrogantly thought that his
; code did everything anyone could possible want, 
; so didn't provide a user hook for you to prove him/her wrong.
; 
; The first command, add-hook, sticks any s-exp onto the end
; of the target function definition,
; the second, make-hook-var, uses add-hook to
; invoke run-hooks on a variable of your choice.
; 
; I personally prefer using just the former for simple extras, since you
; don't need to mess round with function or lambda definitions to 
; provide arguments.
; 
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; module: 	hook.el	
;;;; version: 	1.3
;;;; author: 	Ciaran A Byrne
;;;; date:	20:Aug:87
;;;;
;;;;;;;;;;;;;;;;;;;; hook insertion fns;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;	macros:
;;;;		some c[ad]+r fns
;;;;
;;;;	commands:
;;;;		add-hook		- appends s-exp to function
;;;;		make-hook-var		- adds hook variable to a function
;;;;


;(require 'cl) ;--------------------------------- this stuff is in cl.el-----
(defmacro caar (x) (list 'car (list 'car x)))
(defmacro cadr (x) (list 'car (list 'cdr x)))
(defmacro caadr (x) (list 'car (list 'car (list 'cdr x))))
(defmacro caddr (x) (list 'car (list 'cdr (list 'cdr x))))
(defmacro cadar (x) (list 'car (list 'cdr (list 'car x))))
;
(defmacro cdar (x) (list 'cdr (list 'car x)))
(defmacro cddr (l) "" (list 'cdr (list 'cdr l)))
(defmacro cdadr (x) (list 'cdr (list 'car (list 'cdr x))))
;---------------------------------------------------------------------------

(defun add-hook (target-function extrafn) 
"Redefines FUNCTION so that SEXP is evaluated (apparently!) after the 
function has completed.

e.g. (add-hook 'next-line '(what-line))

The original return value is preserved.
Does not work with subr's.
"

;Even if it did attempt to put a wrapper around a subr,
;it would be only partially effective, 
;since subrs get called from other 'C'-coded fns.

    (interactive "aTarget function: 
xs-exp: ")

;	OLD FORM	    ==>		NEW FORM
;
;  (defun foo (args) "bar"	(defun foo (args) "bar"
;	(interactive "s")	     (interactive "s")
;	(s1)			     (prog1
;	(s2))				(progn 
;					    (s1)
;					    (s2))  ; old result
;					extrafn)   ; new action
;
  (if (subrp (symbol-function target-function))
      	 (message "No can do; %s is a subr" target-function)

    (let* (  (fval (symbol-function target-function))
	      (args (cadr fval))
	      (body (cddr fval))
	      (doc  (car body))
	      (newfn (list 'lambda args)) )
	
	(if (or (numberp doc) (stringp doc))	; move body past doc 
	    (setq newfn (append newfn (list doc))
		  body (cdr body)))

	(if (eq 'interactive (caar body)) ; move body past (interactive ..)
	    (setq newfn (append newfn (list (car body)))
		  body (cdr body)))

	(fset target-function
	    (append newfn
		(list 
		    (list 'prog1
			(append '(progn) body)
			extrafn))
	    )
	)
    ) ; let
  )
)

(defun make-hook-var (hook-name target-function) "Causes the functions (if any)
in  VARIABLE to be run at the completion of FUNCTION.
e.g.

(make-hook-var compilation-sentinel-hook-var compilation-sentinel)
; adds hook var to compilation-sentinel
; eg:
(setq compilation-sentinel-hook-var '(next-error))

use this instead of add-hook (qv) when you need to be able to change
the hook functions without reloading.
"
    (interactive "SNew hook var name : 
aFunction : ")
    (add-hook target-function
	(list 'run-hooks
	    (list 'quote hook-name))))

(provide 'hook)
;
;
; comments/suggestions to ...!seismo!mcvax!ukc!gec-rl-hrc!ciaran
;
; When you said ``HEAVILY FORESTED'' it reminded me of an overdue
; CLEANING BILL..  Don't you SEE?  O'Grogan SWALLOWED a VALUABLE
; COIN COLLECTION and HAD to murder the ONLY MAN who KNEW!!