* doc/bell.n:

	* tests/bell.test:
	* generic/tkCmds.c (Tk_BellObjCmd): added -nice option to
	optionally avoid resetting screen saver [Bug: 4279]

3 files changed, 52 insertions, 26 deletions

diff --git a/doc/bell.n b/doc/bell.n
index c3e0561..d981a60 100644
--- a/doc/bell.n
+++ b/doc/bell.n
@@ -1,20 +1,21 @@
 '\"
 '\" Copyright (c) 1994 The Regents of the University of California.
 '\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: bell.n,v 1.2 1998/09/14 18:22:54 stanton Exp $
+'\" RCS: @(#) $Id: bell.n,v 1.3 2000/05/17 22:44:09 hobbs Exp $
 '\" 
 .so man.macros
-.TH bell n 4.0 Tk "Tk Built-In Commands"
+.TH bell n 8.4 Tk "Tk Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
 bell \- Ring a display's bell
 .SH SYNOPSIS
-\fBbell \fR?\fB\-displayof \fIwindow\fR?
+\fBbell \fR?\fB\-displayof \fIwindow\fR? \fR?\fB\-nice\fR?
 .BE
 
 .SH DESCRIPTION
@@ -26,9 +27,9 @@ application's main window is used by default.
 The command uses the current bell-related settings for the display, which
 may be modified with programs such as \fBxset\fR.
 .PP
-This command also resets the screen saver for the screen.  Some
-screen savers will ignore this, but others will reset so that the
-screen becomes visible again.
+If \fB\-nice\fR is not specified, this command also resets the screen saver
+for the screen.  Some screen savers will ignore this, but others will reset
+so that the screen becomes visible again.
 
 .SH KEYWORDS
 beep, bell, ring
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index 9bbfba3..7c98aa6 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -6,11 +6,12 @@
  *
  * Copyright (c) 1990-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Scriptics Corporation.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkCmds.c,v 1.13 2000/04/19 23:11:23 ericm Exp $
+ * RCS: @(#) $Id: tkCmds.c,v 1.14 2000/05/17 22:44:09 hobbs Exp $
  */
 
 #include "tkPort.h"
@@ -62,30 +63,42 @@ Tk_BellObjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    static char *bellOptions[] = {"-displayof", (char *) NULL};
+    static char *bellOptions[] = {"-displayof", "-nice", (char *) NULL};
+    enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
     Tk_Window tkwin = (Tk_Window) clientData;
-    char *displayName;
-    int index;
+    int i, index, nice = 0;
 
-    if ((objc != 1) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");
+    if (objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
 	return TCL_ERROR;
     }
 
-    if (objc == 3) {
-	if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0,
+    for (i = 1; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0,
 		&index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
-	
-	tkwin = Tk_NameToWindow(interp, displayName, tkwin);
-	if (tkwin == NULL) {
-	    return TCL_ERROR;
+	switch ((enum options) index) {
+	    case TK_BELL_DISPLAYOF:
+		if (++i >= objc) {
+		    Tcl_WrongNumArgs(interp, 1, objv,
+			    "?-displayof window? ?-nice?");
+		    return TCL_ERROR;
+		}
+		tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+		if (tkwin == NULL) {
+		    return TCL_ERROR;
+		}
+		break;
+	    case TK_BELL_NICE:
+		nice = 1;
+		break;
 	}
     }
     XBell(Tk_Display(tkwin), 0);
-    XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+    if (!nice) {
+	XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+    }
     XFlush(Tk_Display(tkwin));
     return TCL_OK;
 }
diff --git a/tests/bell.test b/tests/bell.test
index e8c2040..96b7a74 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -2,10 +2,10 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bell.test,v 1.4 1999/04/16 01:51:33 stanton Exp $
+# RCS: @(#) $Id: bell.test,v 1.5 2000/05/17 22:44:10 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -13,20 +13,32 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 test bell-1.1 {bell command} {
     list [catch {bell a} msg] $msg
-} {1 {wrong # args: should be "bell ?-displayof window?"}}
+} {1 {bad option "a": must be -displayof or -nice}}
 test bell-1.2 {bell command} {
     list [catch {bell a b} msg] $msg
-} {1 {bad option "a": must be -displayof}}
+} {1 {bad option "a": must be -displayof or -nice}}
 test bell-1.3 {bell command} {
     list [catch {bell -displayof gorp} msg] $msg
 } {1 {bad window path name "gorp"}}
 test bell-1.4 {bell command} {
+    list [catch {bell -nice -displayof} msg] $msg
+} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
+test bell-1.5 {bell command} {
+    list [catch {bell -nice -nice -nice} msg] $msg
+} {0 {}}
+test bell-1.6 {bell command} {
+    list [catch {bell -displayof . -nice} msg] $msg
+} {0 {}}
+test bell-1.7 {bell command} {
+    list [catch {bell -nice -displayof . -nice} msg] $msg
+} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
+test bell-1.8 {bell command} {
     puts "Bell should ring now ..."
     flush stdout
-    after 500
+    after 200
     bell -displayof .
     after 200
-    bell
+    bell -nice
     after 200
     bell
 } {}