Path: utzoo!utgpu!jarvis.csri.toronto.edu!rutgers!apple!bloom-beacon!bu-cs!bu-ma!scott From: scott@bu-ma (Scott Sutherland) Newsgroups: gnu.emacs Subject: Re: mail beep (take 3) Message-ID: <613692482.18880@bu-ma.bu.edu> Date: 12 Jun 89 22:08:02 GMT References: <40158@bbn.COM> <40865@bbn.COM> Reply-To: scott@bu-ma (Scott Sutherland) Organization: Boston University Mathematics Department Lines: 272 In-reply-to: jr@bbn.com (John Robinson) In article <40865@bbn.COM>, jr@bbn (John Robinson) writes: >In article <40158@bbn.COM>, I, jr@bbn (John Robinson) write: >>In article , 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!!