diff options
| -rw-r--r-- | doc/bell.n | 13 | ||||
| -rw-r--r-- | generic/tkCmds.c | 41 | ||||
| -rw-r--r-- | tests/bell.test | 24 |
3 files changed, 52 insertions, 26 deletions
@@ -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 } {} |