From fbf586402577f13e441c029a81077d8eb592292f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sun, 21 Apr 1991 23:45:05 +0000 Subject: [PATCH] Added "Slave GC Alarm" variable (default :MESSAGE) which controls how obnoxious the slave GC notification is. Other values are like for "Input Wait Alarm", :LOUD-MESSAGE and NIL. --- hemlock/eval-server.lisp | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/hemlock/eval-server.lisp b/hemlock/eval-server.lisp index c9f2d5a53..f91dac1aa 100644 --- a/hemlock/eval-server.lisp +++ b/hemlock/eval-server.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.1.1.6 1991/03/21 14:48:50 chiles Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.1.1.7 1991/04/21 23:45:05 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -119,6 +119,12 @@ :value t) +(defhvar "Slave GC Alarm" + "Determines that is done when the slave notifies that it is GCing. + :MESSAGE prints a message in the echo area, :LOUD-MESSAGE beeps as well. + NIL does nothing." + :value :message) + ;;;; Slave destruction. @@ -639,13 +645,18 @@ (defun slave-gc-notify-before (remote-ts message) (let ((ts (wire:remote-object-value remote-ts))) (ts-buffer-output-string ts message t) - (message "~A is GC'ing." (buffer-name (ts-data-buffer ts))) - (system:beep))) + (when (value slave-gc-alarm) + (message "~A is GC'ing." (buffer-name (ts-data-buffer ts))) + (when (eq (value slave-gc-alarm) :loud-message) + (beep))))) + (defun slave-gc-notify-after (remote-ts message) (let ((ts (wire:remote-object-value remote-ts))) (ts-buffer-output-string ts message t) - (message "~A is done GC'ing." (buffer-name (ts-data-buffer ts))) - (system:beep))) + (when (value slave-gc-alarm) + (message "~A is done GC'ing." (buffer-name (ts-data-buffer ts))) + (when (eq (value slave-gc-alarm) :loud-message) + (beep))))) ;;; EDITOR-DIED -- internal ;;; -- GitLab