summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/bell.n13
-rw-r--r--generic/tkCmds.c41
-rw-r--r--tests/bell.test24
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
} {}