From 98ea3cb2214b51432f38f6ea50c1c429397281cc Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 1 Aug 2001 16:21:11 +0000 Subject: Merged changes from feature branch dgp-privates-into-namespace, implementing TIP 44. All Tk commands and variables matching tk[A-Z]* are now in the ::tk namespace. --- ChangeLog | 145 +++++++++++++++ doc/console.n | 6 +- doc/menu.n | 12 +- doc/text.n | 28 ++- doc/tkvars.n | 16 +- generic/tkBind.c | 14 +- generic/tkMenu.c | 6 +- library/bgerror.tcl | 10 +- library/button.tcl | 290 ++++++++++++++--------------- library/choosedir.tcl | 26 +-- library/clrpick.tcl | 260 +++++++++++++------------- library/comdlg.tcl | 110 +++++------ library/console.tcl | 124 ++++++------- library/dialog.tcl | 21 ++- library/entry.tcl | 230 ++++++++++++----------- library/focus.tcl | 24 +-- library/listbox.tcl | 156 ++++++++-------- library/menu.tcl | 474 ++++++++++++++++++++++++------------------------ library/msgbox.tcl | 21 ++- library/optMenu.tcl | 6 +- library/palette.tcl | 31 ++-- library/scale.tcl | 122 ++++++------- library/scrlbar.tcl | 204 ++++++++++----------- library/spinbox.tcl | 147 ++++++++------- library/tclIndex | 447 ++++++++++++++++++++++++--------------------- library/tearoff.tcl | 14 +- library/text.tcl | 335 +++++++++++++++++----------------- library/tk.tcl | 116 ++++++------ library/tkfbox.tcl | 404 ++++++++++++++++++++--------------------- library/unsupported.tcl | 286 +++++++++++++++++++++++++++++ library/xmfbox.tcl | 235 ++++++++++++------------ mac/tkMacMenu.c | 4 +- tests/clrpick.test | 10 +- tests/filebox.test | 4 +- tests/macMenu.test | 122 ++++++------- tests/menu.test | 16 +- tests/menuDraw.test | 62 +++---- tests/msgbox.test | 4 +- tests/text.test | 6 +- tests/unixMenu.test | 110 +++++------ tests/winMenu.test | 100 +++++----- tests/xmfbox.test | 50 ++--- unix/mkLinks | 20 +- unix/tkUnixDialog.c | 14 +- 44 files changed, 2679 insertions(+), 2163 deletions(-) create mode 100644 library/unsupported.tcl diff --git a/ChangeLog b/ChangeLog index 9541657..fddcd92 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,70 @@ +2001-08-01 Don Porter + + * doc/console.n: + * doc/menu.n: + * doc/text.n: + * doc/tkvars.n: + * generic/tkBind.c: + * generic/tkMenu.c: + * library/bgerror.tcl: + * library/button.tcl: + * library/choosedir.tcl: + * library/clrpick.tcl: + * library/comdlg.tcl: + * library/console.tcl: + * library/dialog.tcl: + * library/entry.tcl: + * library/focus.tcl: + * library/listbox.tcl: + * library/menu.tcl: + * library/msgbox.tcl: + * library/optMenu.tcl: + * library/palette.tcl: + * library/scale.tcl: + * library/scrlbar.tcl: + * library/spinbox.tcl: + * library/tclIndex: + * library/tearoff.tcl: + * library/text.tcl: + * library/tk.tcl: + * library/tkfbox.tcl: + * library/unsupported.tcl: + * library/xmfbox.tcl: + * mac/tkMacMenu.c: + * tests/clrpick.test: + * tests/filebox.test: + * tests/macMenu.test: + * tests/menu.test: + * tests/menuDraw.test: + * tests/msgbox.test: + * tests/text.test: + * tests/unixMenu.test: + * tests/winMenu.test: + * tests/xmfbox.test: + * unix/mkLinks: + * unix/tkUnixDialog.c: Merged changes from feature branch + dgp-privates-into-namespace, implementing TIP 44. All + Tk commands and variables matching tk[A-Z]* are now in the + ::tk namespace. See "BRANCH: dgp-privates-into-namespace" + entries below for details. [FR 220936] + 2001-07-24 Mo DeJong * generic/default.h: Include tkWinDefault.h when built with Cygwin or Mingw. +2001-07-18 Don Porter + + BRANCH dgp-privates-into-namespace: + * doc/console.n: Updated names of private console commands. + +2001-07-16 Don Porter + + BRANCH dgp-privates-into-namespace: + * library/console.tcl: + * library/unsupported.tcl: Renamed tk::histNum to tk::HistNum + as directed by the Tcl Style Guide. + 2001-07-10 Mo DeJong * unix/Makefile.in: Add AR and STLIB_LD variables. @@ -454,6 +516,89 @@ * tests/unixWm.test (unixWm-50.4): Replaced all [load {} tk] in Tk test suite with [load {} Tk]. [Bug 220940, Patch 411952] +2001-03-12 Don Porter + + BRANCH dgp-privates-into-namespace: + * doc/menu.n: + * unix/mkLinks: Added documentation for [tk_menuSetFocus]. + +2001-03-12 Don Porter + + BRANCH dgp-privates-into-namespace: + * doc/text.n: + * doc/tkvars.n: + * unix/mkLinks: Added documentation for commands and variables + matching tk_text*. + +2001-03-08 Don Porter + + BRANCH dgp-privates-into-namespace: + * generic/tkTextDisp.c: + * library/unsupported.tcl: + * tests/textDisp.test: Restored the global variables tk_textRedraw + and tk_textRelayout. Since they match tk_*, they should remain + publicly available until at least Tk 9. + +2001-03-01 Don Porter + + BRANCH dgp-privates-into-namespace: + * library/unsupported.tcl: New file for Tk's unsupported + interfaces. Contains [tk::unsupported::ExposePrivateCommand] + and [tk::unsupported::ExposePrivateVariable] that restore the + availability of an old public name of one of Tk's private + commands and variables, respectively, for those applications + and extensions that depend on the old names against advice. + +2001-02-28 Don Porter + + BRANCH dgp-privates-into-namespace: Feature branch to move all + of Tk's private commands and variable into the ::tk namespace + and its children. + + * doc/tkvars.n: Documented private variable tkPriv renamed tk::Priv. + + * generic/tkBind.c: + * generic/tkMenu.c: + * generic/tkTextDisp.c: + * library/bgerror.tcl: + * library/button.tcl: + * library/choosedir.tcl: + * library/clrpick.tcl: + * library/comdlg.tcl: + * library/console.tcl: + * library/dialog.tcl: + * library/entry.tcl: + * library/focus.tcl: + * library/listbox.tcl: + * library/menu.tcl: + * library/msgbox.tcl: + * library/optMenu.tcl: + * library/palette.tcl: + * library/scale.tcl: + * library/scrlbar.tcl: + * library/spinbox.tcl: + * library/tclIndex: + * library/tearoff.tcl: + * library/text.tcl: + * library/tk.tcl: + * library/tkfbox.tcl: + * library/xmfbox.tcl: + * mac/tkMacMenu.c: + * tests/clrpick.test: + * tests/filebox.test: + * tests/macMenu.test: + * tests/menu.test: + * tests/menuDraw.test: + * tests/msgbox.test: + * tests/text.test: + * tests/textDisp.test: + * tests/unixMenu.test: + * tests/winMenu.test: + * tests/xmfbox.test: + * unix/tkUnixDialog.c: All Tk commands matching ::tk[A-Z]* and + all Tk private variables in the global namespace were renamed to + live in the namespace ::tk or one of its children. + 2001-02-13 Eric Melski * doc/photo.n: [Bug 132213] Added clarification on interpretation diff --git a/doc/console.n b/doc/console.n index e910f1e..7aabd6e 100644 --- a/doc/console.n +++ b/doc/console.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: console.n,v 1.1 2001/05/16 12:39:18 dkf Exp $ +'\" RCS: @(#) $Id: console.n,v 1.2 2001/08/01 16:21:11 dgp Exp $ '\" .so man.macros .TH console n 8.4 Tk "Tcl Built-In Commands" @@ -78,14 +78,14 @@ the internal implementation of the console and are likely to change or be modified without warning.\fR .PP Output to the console from the main interpreter via the stdout and -stderr channels is handled by invoking the \fBtkConsoleOutput\fR +stderr channels is handled by invoking the \fBtk::ConsoleOutput\fR command in the console interpreter with two arguments. The first argument is the name of the channel being written to, and the second argument is the string being written to the channel (after encoding and end-of-line translation processing has been performed.) .PP When the \fB.\fR window of the main interpreter is destroyed, the -\fBtkConsoleExit\fR command in the console interpreter is called +\fBtk::ConsoleExit\fR command in the console interpreter is called (assuming the console interpreter has not already been deleted itself, that is.) diff --git a/doc/menu.n b/doc/menu.n index b3be142..352dbc4 100644 --- a/doc/menu.n +++ b/doc/menu.n @@ -5,16 +5,18 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: menu.n,v 1.4 2000/08/25 06:58:32 ericm Exp $ +'\" RCS: @(#) $Id: menu.n,v 1.5 2001/08/01 16:21:11 dgp Exp $ '\" .so man.macros .TH menu n 4.1 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -menu \- Create and manipulate menu widgets +menu, tk_menuSetFocus \- Create and manipulate menu widgets .SH SYNOPSIS +.nf \fBmenu\fR \fIpathName \fR?\fIoptions\fR? +\fBtk_menuSetFocus\fR \fIpathName\fR .SO \-activebackground \-borderwidth \-foreground \-activeborderwidth \-cursor \-relief @@ -752,6 +754,12 @@ next menubutton to the right is posted. Disabled menu entries are non-responsive: they don't activate and they ignore mouse button presses and releases. .PP +.VS 8.4 +Several of the bindings make use of the command \fBtk_menuSetFocus\fR. +It saves the current focus and sets the focus to its \fIpathName\fR +argument, which is a menu widget. +.VE +.PP The behavior of menus can be changed by defining new bindings for individual widgets or by redefining the class bindings. diff --git a/doc/text.n b/doc/text.n index f8d60dc..bd67d57 100644 --- a/doc/text.n +++ b/doc/text.n @@ -5,16 +5,22 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: text.n,v 1.8 2000/08/25 06:58:33 ericm Exp $ +'\" RCS: @(#) $Id: text.n,v 1.9 2001/08/01 16:21:11 dgp Exp $ '\" .so man.macros .TH text n 4.0 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -text \- Create and manipulate text widgets +text, tk_textCopy, tk_textCut, tk_textPaste \- Create and manipulate text widgets .SH SYNOPSIS +.nf \fBtext\fR \fIpathName \fR?\fIoptions\fR? +.VS 8.4 +\fBtk_textCopy\fR \fIpathName\fR +\fBtk_textCut\fR \fIpathName\fR +\fBtk_textPaste\fR \fIpathName\fR +.VE .SO \-background \-highlightthickness \-relief \-borderwidth \-insertbackground \-selectbackground @@ -772,6 +778,13 @@ There is a single debugging switch shared by all text widgets: turning debugging on or off in any widget turns it on or off for all widgets. For widgets with large amounts of text, the consistency checks may cause a noticeable slow-down. +.PP +.VS 8.4 +When debugging is turned on, the drawing routines of the text widget +set the global variables \fBtk_textRedraw\fR and \fBtk_textRelayout\fR +to the lists of indices that are redrawn. The values of these variables +are tested by Tk's test suite. +.VE .TP \fIpathName \fBdelete \fIindex1 \fR?\fIindex2\fR? Delete a range of characters from the text. @@ -1554,15 +1567,24 @@ Control-\e clears any selection in the widget. .IP [20] The F16 key (labelled Copy on many Sun workstations) or Meta-w copies the selection in the widget to the clipboard, if there is a selection. +.VS 8.4 +This action is carried out by the command \fBtk_textCopy\fR. +.VE .IP [21] The F20 key (labelled Cut on many Sun workstations) or Control-w copies the selection in the widget to the clipboard and deletes the selection. +.VS 8.4 +This action is carried out by the command \fBtk_textCut\fR. +.VE If there is no selection in the widget then these keys have no effect. .IP [22] The F18 key (labelled Paste on many Sun workstations) or Control-y inserts the contents of the clipboard at the position of the insertion cursor. +.VS 8.4 +This action is carried out by the command \fBtk_textPaste\fR. +.VE .IP [23] The Delete key deletes the selection, if there is one in the widget. If there is no selection, it deletes the character to the right of @@ -1634,4 +1656,4 @@ The display line with the insert cursor is redrawn each time the cursor blinks, which causes a steady stream of graphics traffic. Set the \fBinsertOffTime\fP attribute to 0 avoid this. .SH KEYWORDS -text, widget +text, widget, tkvars diff --git a/doc/tkvars.n b/doc/tkvars.n index f2e9a73..4c6451d 100644 --- a/doc/tkvars.n +++ b/doc/tkvars.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tkvars.n,v 1.2 1998/09/14 18:23:00 stanton Exp $ +'\" RCS: @(#) $Id: tkvars.n,v 1.3 2001/08/01 16:21:11 dgp Exp $ '\" .so man.macros .TH tkvars n 4.1 Tk "Tk Built-In Commands" @@ -44,9 +44,9 @@ Contains a decimal integer giving the current patch level for Tk. The patch level is incremented for each new release or patch, and it uniquely identifies an official version of Tk. .TP -\fBtkPriv\fR +\fBtk::Priv\fR This variable is an array containing several pieces of information -that are private to Tk. The elements of \fBtkPriv\fR are used by +that are private to Tk. The elements of \fBtk::Priv\fR are used by Tk library procedures and default bindings. They should not be accessed by any code outside Tk. .TP @@ -56,6 +56,14 @@ If an application sets it to one, then Tk attempts to adhere as closely as possible to Motif look-and-feel standards. For example, active elements such as buttons and scrollbar sliders will not change color when the pointer passes over them. +.TP +\fBtk_textRedraw\fR +.TP +\fBtk_textRelayout\fR +These variables are set by text widgets when they have debugging +turned on. The values written to these variables can be used to +test or debug text widget operations. These variables are mostly +used by Tk's test suite. .TP 15 \fBtk_version\fR Tk sets this variable in the interpreter for each application. @@ -69,4 +77,4 @@ each new release of Tk, except that it resets to zero whenever the major version number changes. .SH KEYWORDS -variables, version +variables, version, text diff --git a/generic/tkBind.c b/generic/tkBind.c index d06d246..f0627de 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBind.c,v 1.15 2001/03/30 21:52:28 hobbs Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.16 2001/08/01 16:21:11 dgp Exp $ */ #include "tkPort.h" @@ -293,7 +293,7 @@ typedef struct PhysicalsOwned { * One of the following structures exists for each interpreter. This * structure keeps track of the current display and screen in the * interpreter, so that a script can be invoked whenever the display/screen - * changes (the script does things like point tkPriv at a display-specific + * changes (the script does things like point tk::Priv at a display-specific * structure). */ @@ -2545,16 +2545,16 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) * * This procedure is invoked whenever the current screen changes * in an application. It invokes a Tcl procedure named - * "tkScreenChanged", passing it the screen name as argument. - * tkScreenChanged does things like making the tkPriv variable + * "tk::ScreenChanged", passing it the screen name as argument. + * tk::ScreenChanged does things like making the tk::Priv variable * point to an array for the current display. * * Results: * None. * * Side effects: - * Depends on what tkScreenChanged does. If an error occurs - * them tkError will be invoked. + * Depends on what tk::ScreenChanged does. If an error occurs + * them bgerror will be invoked. * *---------------------------------------------------------------------- */ @@ -2571,7 +2571,7 @@ ChangeScreen(interp, dispName, screenIndex) char screen[TCL_INTEGER_SPACE]; Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16); + Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18); Tcl_DStringAppend(&cmd, dispName, -1); sprintf(screen, ".%d", screenIndex); Tcl_DStringAppend(&cmd, screen, -1); diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 3661fa7..a4cc86c 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenu.c,v 1.10 2001/04/03 06:54:33 hobbs Exp $ + * RCS: @(#) $Id: tkMenu.c,v 1.11 2001/08/01 16:21:11 dgp Exp $ */ /* @@ -1070,7 +1070,7 @@ TkInvokeMenu(interp, menuPtr, index) if (mePtr->type == TEAROFF_ENTRY) { Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1); + Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1); Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1); result = Tcl_Eval(interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); @@ -2644,7 +2644,7 @@ CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) } } - menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1); + menuDupCommandArray[0] = Tcl_NewStringObj("tk::MenuDup", -1); menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); menuDupCommandArray[2] = newMenuNamePtr; if (newMenuTypePtr == NULL) { diff --git a/library/bgerror.tcl b/library/bgerror.tcl index 9586518..13b0389 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,8 +9,8 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: bgerror.tcl,v 1.15 2001/06/14 10:56:58 dkf Exp $ -# $Id: bgerror.tcl,v 1.15 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.16 2001/08/01 16:21:11 dgp Exp $ +# $Id: bgerror.tcl,v 1.16 2001/08/01 16:21:11 dgp Exp $ option add *ErrorDialog.function.text [::msgcat::mc "Save To Log"] \ widgetDefault @@ -73,7 +73,7 @@ proc ::tk::dialog::error::Destroy {w} { } } -# bgerror -- +# ::bgerror -- # This is the default version of bgerror. # It tries to execute tkerror, if that fails it posts a dialog box containing # the error message and gives the user a chance to ask to see a stack @@ -81,7 +81,7 @@ proc ::tk::dialog::error::Destroy {w} { # Arguments: # err - The error message. -proc bgerror err { +proc ::bgerror err { global errorInfo tcl_platform set butvar ::tk::dialog::error::button @@ -262,7 +262,7 @@ proc bgerror err { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - tkwait variable $butvar + vwait $butvar set button $::tk::dialog::error::button; # Save a copy... catch {focus $oldFocus} catch {destroy .bgerrorDialog} diff --git a/library/button.tcl b/library/button.tcl index 457b545..763c67e 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -4,7 +4,7 @@ # checkbutton, and radiobutton widgets and provides procedures # that help in implementing those bindings. # -# RCS: @(#) $Id: button.tcl,v 1.10 2000/05/25 17:19:57 ericm Exp $ +# RCS: @(#) $Id: button.tcl,v 1.11 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -19,111 +19,111 @@ if {[string match "macintosh" $tcl_platform(platform)]} { bind Radiobutton { - tkButtonEnter %W + tk::ButtonEnter %W } bind Radiobutton <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Radiobutton { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton { - tkButtonEnter %W + tk::ButtonEnter %W } bind Checkbutton <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Checkbutton { - tkButtonUp %W + tk::ButtonUp %W } } if {[string match "windows" $tcl_platform(platform)]} { bind Checkbutton { - tkCheckRadioInvoke %W select + tk::CheckRadioInvoke %W select } bind Checkbutton { - tkCheckRadioInvoke %W select + tk::CheckRadioInvoke %W select } bind Checkbutton { - tkCheckRadioInvoke %W deselect + tk::CheckRadioInvoke %W deselect } bind Checkbutton <1> { - tkCheckRadioDown %W + tk::CheckRadioDown %W } bind Checkbutton { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton { - tkCheckRadioEnter %W + tk::CheckRadioEnter %W } bind Radiobutton <1> { - tkCheckRadioDown %W + tk::CheckRadioDown %W } bind Radiobutton { - tkButtonUp %W + tk::ButtonUp %W } bind Radiobutton { - tkCheckRadioEnter %W + tk::CheckRadioEnter %W } } if {[string match "unix" $tcl_platform(platform)]} { bind Checkbutton { if {!$tk_strictMotif} { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } } bind Radiobutton { if {!$tk_strictMotif} { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } } bind Checkbutton <1> { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Radiobutton <1> { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Checkbutton { - tkButtonEnter %W + tk::ButtonEnter %W } bind Radiobutton { - tkButtonEnter %W + tk::ButtonEnter %W } } bind Button { - tkButtonInvoke %W + tk::ButtonInvoke %W } bind Checkbutton { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Radiobutton { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Button {} bind Button { - tkButtonEnter %W + tk::ButtonEnter %W } bind Button { - tkButtonLeave %W + tk::ButtonLeave %W } bind Button <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Button { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton {} bind Checkbutton { - tkButtonLeave %W + tk::ButtonLeave %W } bind Radiobutton {} bind Radiobutton { - tkButtonLeave %W + tk::ButtonLeave %W } if {[string match "windows" $tcl_platform(platform)]} { @@ -132,7 +132,7 @@ if {[string match "windows" $tcl_platform(platform)]} { # Windows implementation ######################### -# tkButtonEnter -- +# ::tk::ButtonEnter -- # The procedure below is invoked when the mouse pointer enters a # button widget. It records the button we're in and changes the # state of the button to active unless the button is disabled. @@ -140,35 +140,35 @@ if {[string match "windows" $tcl_platform(platform)]} { # Arguments: # w - The name of the widget. -proc tkButtonEnter w { - global tkPriv +proc ::tk::ButtonEnter w { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"] } { # If the mouse button is down, set the relief to sunken on entry. # Overwise, if there's an -overrelief value, set the relief to that. - if {[string equal $tkPriv(buttonWindow) $w]} { + if {[string equal $Priv(buttonWindow) $w]} { $w configure -state active -relief sunken } elseif { [string compare [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] $w configure -relief [$w cget -overrelief] } } - set tkPriv(window) $w + set Priv(window) $w } -# tkButtonLeave -- +# ::tk::ButtonLeave -- # The procedure below is invoked when the mouse pointer leaves a # button widget. It changes the state of the button back to # inactive. If we're leaving the button window with a mouse button -# pressed (tkPriv(buttonWindow) == $w), restore the relief of the +# pressed (Priv(buttonWindow) == $w), restore the relief of the # button too. # # Arguments: # w - The name of the widget. -proc tkButtonLeave w { - global tkPriv +proc ::tk::ButtonLeave w { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { $w configure -state normal } @@ -176,15 +176,15 @@ proc tkButtonLeave w { # Restore the original button relief if the mouse button is down # or there is an -overrelief value. - if {[string equal $tkPriv(buttonWindow) $w] || \ + if {[string equal $Priv(buttonWindow) $w] || \ [string compare [$w cget -overrelief] ""] } { - $w configure -relief $tkPriv(relief) + $w configure -relief $Priv(relief) } - set tkPriv(window) "" + set Priv(window) "" } -# tkCheckRadioEnter -- +# ::tk::CheckRadioEnter -- # The procedure below is invoked when the mouse pointer enters a # checkbutton or radiobutton widget. It records the button we're in # and changes the state of the button to active unless the button is @@ -193,21 +193,21 @@ proc tkButtonLeave w { # Arguments: # w - The name of the widget. -proc tkCheckRadioEnter w { - global tkPriv +proc ::tk::CheckRadioEnter w { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { - if {[string equal $tkPriv(buttonWindow) $w]} { + if {[string equal $Priv(buttonWindow) $w]} { $w configure -state active } if { [string compare [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] $w configure -relief [$w cget -overrelief] } } - set tkPriv(window) $w + set Priv(window) $w } -# tkButtonDown -- +# ::tk::ButtonDown -- # The procedure below is invoked when the mouse button is pressed in # a button widget. It records the fact that the mouse is in the button, # saves the button's relief so it can be restored later, and changes @@ -216,31 +216,31 @@ proc tkCheckRadioEnter w { # Arguments: # w - The name of the widget. -proc tkButtonDown w { - global tkPriv +proc ::tk::ButtonDown w { + variable ::tk::Priv # Only save the button's relief if it has no -overrelief value. If there - # is an overrelief setting, tkPriv(relief) will already have been set, and + # is an overrelief setting, Priv(relief) will already have been set, and # the current value of the -relief option will be incorrect. if { [string equal [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] } if {[string compare [$w cget -state] "disabled"]} { - set tkPriv(buttonWindow) $w + set Priv(buttonWindow) $w $w configure -relief sunken -state active # If this button has a repeatdelay set up, get it going with an after - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) set delay [$w cget -repeatdelay] - set tkPriv(repeated) 0 + set Priv(repeated) 0 if {$delay > 0} { - set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]] + set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]] } } } -# tkCheckRadioDown -- +# ::tk::CheckRadioDown -- # The procedure below is invoked when the mouse button is pressed in # a button widget. It records the fact that the mouse is in the button, # saves the button's relief so it can be restored later, and changes @@ -249,19 +249,19 @@ proc tkButtonDown w { # Arguments: # w - The name of the widget. -proc tkCheckRadioDown w { - global tkPriv +proc ::tk::CheckRadioDown w { + variable ::tk::Priv if { [string equal [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] } if {[string compare [$w cget -state] "disabled"]} { - set tkPriv(buttonWindow) $w - set tkPriv(repeated) 0 + set Priv(buttonWindow) $w + set Priv(repeated) 0 $w configure -state active } } -# tkButtonUp -- +# ::tk::ButtonUp -- # The procedure below is invoked when the mouse button is released # in a button widget. It restores the button's relief and invokes # the command as long as the mouse hasn't left the button. @@ -269,10 +269,10 @@ proc tkCheckRadioDown w { # Arguments: # w - The name of the widget. -proc tkButtonUp w { - global tkPriv - if {[string equal $tkPriv(buttonWindow) $w]} { - set tkPriv(buttonWindow) "" +proc ::tk::ButtonUp w { + variable ::tk::Priv + if {[string equal $Priv(buttonWindow) $w]} { + set Priv(buttonWindow) "" # Restore the button's relief. If there is no overrelief, the # button relief goes back to its original value. If there is an # overrelief, the relief goes to the overrelief (since the cursor is @@ -280,21 +280,21 @@ proc tkButtonUp w { set relief [$w cget -overrelief] if { [string equal $relief ""] } { - set relief $tkPriv(relief) + set relief $Priv(relief) } $w configure -relief $relief # Clean up the after event from the auto-repeater - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) - if {[string equal $tkPriv(window) $w] + if {[string equal $Priv(window) $w] && [string compare [$w cget -state] "disabled"]} { $w configure -state normal # Only invoke the command if it wasn't already invoked by the # auto-repeater functionality - if { $tkPriv(repeated) == 0 } { + if { $Priv(repeated) == 0 } { uplevel #0 [list $w invoke] } } @@ -309,7 +309,7 @@ if {[string match "unix" $tcl_platform(platform)]} { # Unix implementation ##################### -# tkButtonEnter -- +# ::tk::ButtonEnter -- # The procedure below is invoked when the mouse pointer enters a # button widget. It records the button we're in and changes the # state of the button to active unless the button is disabled. @@ -317,37 +317,37 @@ if {[string match "unix" $tcl_platform(platform)]} { # Arguments: # w - The name of the widget. -proc tkButtonEnter {w} { - global tkPriv +proc ::tk::ButtonEnter {w} { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { $w configure -state active # If the mouse button is down, set the relief to sunken on entry. # Overwise, if there's an -overrelief value, set the relief to that. - if {[string equal $tkPriv(buttonWindow) $w]} { + if {[string equal $Priv(buttonWindow) $w]} { $w configure -state active -relief sunken } elseif { [string compare [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] $w configure -relief [$w cget -overrelief] } } - set tkPriv(window) $w + set Priv(window) $w } -# tkButtonLeave -- +# ::tk::ButtonLeave -- # The procedure below is invoked when the mouse pointer leaves a # button widget. It changes the state of the button back to # inactive. If we're leaving the button window with a mouse button -# pressed (tkPriv(buttonWindow) == $w), restore the relief of the +# pressed (Priv(buttonWindow) == $w), restore the relief of the # button too. # # Arguments: # w - The name of the widget. -proc tkButtonLeave w { - global tkPriv +proc ::tk::ButtonLeave w { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { $w configure -state normal } @@ -355,15 +355,15 @@ proc tkButtonLeave w { # Restore the original button relief if the mouse button is down # or there is an -overrelief value. - if {[string equal $tkPriv(buttonWindow) $w] || \ + if {[string equal $Priv(buttonWindow) $w] || \ [string compare [$w cget -overrelief] ""] } { - $w configure -relief $tkPriv(relief) + $w configure -relief $Priv(relief) } - set tkPriv(window) "" + set Priv(window) "" } -# tkButtonDown -- +# ::tk::ButtonDown -- # The procedure below is invoked when the mouse button is pressed in # a button widget. It records the fact that the mouse is in the button, # saves the button's relief so it can be restored later, and changes @@ -372,32 +372,32 @@ proc tkButtonLeave w { # Arguments: # w - The name of the widget. -proc tkButtonDown w { - global tkPriv +proc ::tk::ButtonDown w { + variable ::tk::Priv # Only save the button's relief if it has no -overrelief value. If there - # is an overrelief setting, tkPriv(relief) will already have been set, and + # is an overrelief setting, Priv(relief) will already have been set, and # the current value of the -relief option will be incorrect. if { [string equal [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] } if {[string compare [$w cget -state] "disabled"]} { - set tkPriv(buttonWindow) $w + set Priv(buttonWindow) $w $w configure -relief sunken # If this button has a repeatdelay set up, get it going with an after - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) set delay [$w cget -repeatdelay] - set tkPriv(repeated) 0 + set Priv(repeated) 0 if {$delay > 0} { - set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]] + set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]] } } } -# tkButtonUp -- +# ::tk::ButtonUp -- # The procedure below is invoked when the mouse button is released # in a button widget. It restores the button's relief and invokes # the command as long as the mouse hasn't left the button. @@ -405,10 +405,10 @@ proc tkButtonDown w { # Arguments: # w - The name of the widget. -proc tkButtonUp w { - global tkPriv - if {[string equal $w $tkPriv(buttonWindow)]} { - set tkPriv(buttonWindow) "" +proc ::tk::ButtonUp w { + variable ::tk::Priv + if {[string equal $w $Priv(buttonWindow)]} { + set Priv(buttonWindow) "" # Restore the button's relief. If there is no overrelief, the # button relief goes back to its original value. If there is an @@ -417,19 +417,19 @@ proc tkButtonUp w { set relief [$w cget -overrelief] if { [string equal $relief ""] } { - set relief $tkPriv(relief) + set relief $Priv(relief) } $w configure -relief $relief # Clean up the after event from the auto-repeater - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) - if {[string equal $w $tkPriv(window)] \ + if {[string equal $w $Priv(window)] \ && [string compare [$w cget -state] "disabled"]} { # Only invoke the command if it wasn't already invoked by the # auto-repeater functionality - if { $tkPriv(repeated) == 0 } { + if { $Priv(repeated) == 0 } { uplevel #0 [list $w invoke] } } @@ -444,7 +444,7 @@ if {[string match "macintosh" $tcl_platform(platform)]} { # Mac implementation #################### -# tkButtonEnter -- +# ::tk::ButtonEnter -- # The procedure below is invoked when the mouse pointer enters a # button widget. It records the button we're in and changes the # state of the button to active unless the button is disabled. @@ -452,41 +452,41 @@ if {[string match "macintosh" $tcl_platform(platform)]} { # Arguments: # w - The name of the widget. -proc tkButtonEnter {w} { - global tkPriv +proc ::tk::ButtonEnter {w} { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { - if {[string equal $w $tkPriv(buttonWindow)]} { + if {[string equal $w $Priv(buttonWindow)]} { $w configure -state active } elseif { [string compare [$w cget -overrelief] ""] } { - set tkPriv(relief) [$w cget -relief] + set Priv(relief) [$w cget -relief] $w configure -relief [$w cget -overrelief] } } - set tkPriv(window) $w + set Priv(window) $w } -# tkButtonLeave -- +# ::tk::ButtonLeave -- # The procedure below is invoked when the mouse pointer leaves a # button widget. It changes the state of the button back to # inactive. If we're leaving the button window with a mouse button -# pressed (tkPriv(buttonWindow) == $w), restore the relief of the +# pressed (Priv(buttonWindow) == $w), restore the relief of the # button too. # # Arguments: # w - The name of the widget. -proc tkButtonLeave w { - global tkPriv - if {[string equal $w $tkPriv(buttonWindow)]} { +proc ::tk::ButtonLeave w { + variable ::tk::Priv + if {[string equal $w $Priv(buttonWindow)]} { $w configure -state normal } if { [string compare [$w cget -overrelief] ""] } { - $w configure -relief $tkPriv(relief) + $w configure -relief $Priv(relief) } - set tkPriv(window) "" + set Priv(window) "" } -# tkButtonDown -- +# ::tk::ButtonDown -- # The procedure below is invoked when the mouse button is pressed in # a button widget. It records the fact that the mouse is in the button, # saves the button's relief so it can be restored later, and changes @@ -495,26 +495,26 @@ proc tkButtonLeave w { # Arguments: # w - The name of the widget. -proc tkButtonDown w { - global tkPriv +proc ::tk::ButtonDown w { + variable ::tk::Priv if {[string compare [$w cget -state] "disabled"]} { - set tkPriv(buttonWindow) $w + set Priv(buttonWindow) $w $w configure -state active # If this button has a repeatdelay set up, get it going with an after - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) if { ![catch {$w cget -repeatdelay} delay] } { set delay [$w cget -repeatdelay] - set tkPriv(repeated) 0 + set Priv(repeated) 0 if {$delay > 0} { - set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]] + set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]] } } } } -# tkButtonUp -- +# ::tk::ButtonUp -- # The procedure below is invoked when the mouse button is released # in a button widget. It restores the button's relief and invokes # the command as long as the mouse hasn't left the button. @@ -522,24 +522,24 @@ proc tkButtonDown w { # Arguments: # w - The name of the widget. -proc tkButtonUp w { - global tkPriv - if {[string equal $w $tkPriv(buttonWindow)]} { +proc ::tk::ButtonUp w { + variable ::tk::Priv + if {[string equal $w $Priv(buttonWindow)]} { $w configure -state normal - set tkPriv(buttonWindow) "" + set Priv(buttonWindow) "" if { [string compare [$w cget -overrelief] ""] } { $w configure -relief [$w cget -overrelief] } # Clean up the after event from the auto-repeater - after cancel $tkPriv(afterId) + after cancel $Priv(afterId) - if {[string equal $w $tkPriv(window)] + if {[string equal $w $Priv(window)] && [string compare [$w cget -state] "disabled"]} { # Only invoke the command if it wasn't already invoked by the # auto-repeater functionality - if { $tkPriv(repeated) == 0 } { + if { $Priv(repeated) == 0 } { uplevel #0 [list $w invoke] } } @@ -552,14 +552,14 @@ proc tkButtonUp w { # Shared routines ################## -# tkButtonInvoke -- +# ::tk::ButtonInvoke -- # The procedure below is called when a button is invoked through # the keyboard. It simulate a press of the button via the mouse. # # Arguments: # w - The name of the widget. -proc tkButtonInvoke w { +proc ::tk::ButtonInvoke w { if {[string compare [$w cget -state] "disabled"]} { set oldRelief [$w cget -relief] set oldState [$w cget -state] @@ -571,7 +571,7 @@ proc tkButtonInvoke w { } } -# tkButtonAutoInvoke -- +# ::tk::ButtonAutoInvoke -- # # Invoke an auto-repeating button, and set it up to continue to repeat. # @@ -582,22 +582,22 @@ proc tkButtonInvoke w { # None. # # Side effects: -# May create an after event to call tkButtonAutoInvoke. +# May create an after event to call ::tk::ButtonAutoInvoke. -proc tkButtonAutoInvoke {w} { - global tkPriv - after cancel $tkPriv(afterId) +proc ::tk::ButtonAutoInvoke {w} { + variable ::tk::Priv + after cancel $Priv(afterId) set delay [$w cget -repeatinterval] - if { [string equal $tkPriv(window) $w] } { - incr tkPriv(repeated) + if { [string equal $Priv(window) $w] } { + incr Priv(repeated) uplevel #0 [list $w invoke] } if {$delay > 0} { - set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]] + set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]] } } -# tkCheckRadioInvoke -- +# ::tk::CheckRadioInvoke -- # The procedure below is invoked when the mouse button is pressed in # a checkbutton or radiobutton widget, or when the widget is invoked # through the keyboard. It invokes the widget if it @@ -607,7 +607,7 @@ proc tkButtonAutoInvoke {w} { # w - The name of the widget. # cmd - The subcommand to invoke (one of invoke, select, or deselect). -proc tkCheckRadioInvoke {w {cmd invoke}} { +proc ::tk::CheckRadioInvoke {w {cmd invoke}} { if {[string compare [$w cget -state] "disabled"]} { uplevel #0 [list $w $cmd] } diff --git a/library/choosedir.tcl b/library/choosedir.tcl index d9aa79d..ee4dfb1 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -5,7 +5,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.tcl,v 1.9 2000/06/30 06:38:38 ericm Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.10 2001/08/01 16:21:11 dgp Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -15,15 +15,15 @@ namespace eval ::tk::dialog::file {} namespace eval ::tk::dialog::file::chooseDir { } -# ::tk::dialog::file::tkChooseDirectory -- +# ::tk::dialog::file::chooseDir:: -- # # Implements the TK directory selection dialog. # # Arguments: # args Options parsed by the procedure. # -proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} { - global tkPriv +proc ::tk::dialog::file::chooseDir:: {args} { + variable ::tk::Priv set dataName __tk_choosedir upvar ::tk::dialog::file::$dataName data ::tk::dialog::file::chooseDir::Config $dataName $args @@ -81,7 +81,7 @@ proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - tkwait variable tkPriv(selectFilePath) + vwait ::tk::Priv(selectFilePath) ::tk::RestoreFocusGrab $w $data(ent) withdraw @@ -96,7 +96,7 @@ proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} { # Return value to user # - return $tkPriv(selectFilePath) + return $Priv(selectFilePath) } # ::tk::dialog::file::chooseDir::Config -- @@ -182,9 +182,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 4b. If the value is different from the current directory, change to # that directory. - set selection [tkIconList_Curselection $data(icons)] + set selection [tk::IconList_Curselection $data(icons)] if { [llength $selection] != 0 } { - set iconText [tkIconList_Get $data(icons) [lindex $selection 0]] + set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] ::tk::dialog::file::chooseDir::Done $w $iconText } else { @@ -220,9 +220,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data - set selection [tkIconList_Curselection $data(icons)] + set selection [tk::IconList_Curselection $data(icons)] if { [llength $selection] != 0 } { - set text [tkIconList_Get $data(icons) [lindex $selection 0]] + set text [tk::IconList_Get $data(icons) [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w $text @@ -250,13 +250,13 @@ proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { # # Gets called when user has input a valid filename. Pops up a # dialog box to confirm selection when necessary. Sets the -# tkPriv(selectFilePath) variable, which will break the "tkwait" +# Priv(selectFilePath) variable, which will break the "vwait" # loop in tk_chooseDirectory and return the selected filename to the # script that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data - global tkPriv + variable ::tk::Priv if {[string equal $selectFilePath ""]} { set selectFilePath $data(selectPath) @@ -267,5 +267,5 @@ proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { return } } - set tkPriv(selectFilePath) $selectFilePath + set Priv(selectFilePath) $selectFilePath } diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 2cc74f1..bb3d6b2 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -3,7 +3,7 @@ # Color selection dialog for platforms that do not support a # standard color selection dialog. # -# RCS: @(#) $Id: clrpick.tcl,v 1.12 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.13 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -17,16 +17,22 @@ # (2): Implement HSV color selection. # -# tkColorDialog -- +# Make sure namespaces exist +namespace eval ::tk {} +namespace eval ::tk::dialog {} +namespace eval ::tk::dialog::color {} + +# ::tk::dialog::color:: -- # # Create a color dialog and let the user choose a color. This function # should not be called directly. It is called by the tk_chooseColor # function when a native color selector widget does not exist # -proc tkColorDialog {args} { - global tkPriv - set w .__tk__color - upvar #0 $w data +proc ::tk::dialog::color:: {args} { + variable ::tk::Priv + set dataName __tk__color + upvar ::tk::dialog::color::$dataName data + set w .$dataName # The lines variables track the start and end indices of the line # elements in the colorbar canvases. @@ -56,8 +62,8 @@ proc tkColorDialog {args} { # selection rectangle at the bottom of the color bar. No restrictions. set data(PLGN_WIDTH) 10 - tkColorDialog_Config $w $args - tkColorDialog_InitValues $w + Config $dataName $args + InitValues $dataName set sc [winfo screen $data(-parent)] set winExists [winfo exists $w] @@ -65,8 +71,8 @@ proc tkColorDialog {args} { if {$winExists} { destroy $w } - toplevel $w -class tkColorDialog -screen $sc - tkColorDialog_BuildDialog $w + toplevel $w -class TkColorDialog -screen $sc + BuildDialog $w } wm transient $w $data(-parent) @@ -88,19 +94,19 @@ proc tkColorDialog {args} { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - vwait tkPriv(selectColor) + vwait ::tk::Priv(selectColor) ::tk::RestoreFocusGrab $w $data(okBtn) unset data - return $tkPriv(selectColor) + return $Priv(selectColor) } -# tkColorDialog_InitValues -- +# ::tk::dialog::color::InitValues -- # # Get called during initialization or when user resets NUM_COLORBARS # -proc tkColorDialog_InitValues {w} { - upvar #0 $w data +proc ::tk::dialog::color::InitValues {dataName} { + upvar ::tk::dialog::color::$dataName data # IntensityIncr is the difference in color intensity between a colorbar # and its neighbors. @@ -144,19 +150,19 @@ proc tkColorDialog_InitValues {w} { set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}] } -# tkColorDialog_Config -- +# ::tk::dialog::color::Config -- # # Parses the command line arguments to tk_chooseColor # -proc tkColorDialog_Config {w argList} { - global tkPriv - upvar #0 $w data +proc ::tk::dialog::color::Config {dataName argList} { + variable ::tk::Priv + upvar ::tk::dialog::color::$dataName data # 1: the configuration specs # - if {[info exists tkPriv(selectColor)] && \ - [string compare $tkPriv(selectColor) ""]} { - set defaultColor $tkPriv(selectColor) + if {[info exists Priv(selectColor)] && \ + [string compare $Priv(selectColor) ""]} { + set defaultColor $Priv(selectColor) } else { set defaultColor [. cget -background] } @@ -169,7 +175,7 @@ proc tkColorDialog_Config {w argList} { # 2: parse the arguments # - tclParseConfigSpec $w $specs "" $argList + tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList if {[string equal $data(-title) ""]} { set data(-title) " " @@ -183,12 +189,12 @@ proc tkColorDialog_Config {w argList} { } } -# tkColorDialog_BuildDialog -- +# ::tk::dialog::color::BuildDialog -- # # Build the dialog. # -proc tkColorDialog_BuildDialog {w} { - upvar #0 $w data +proc ::tk::dialog::color::BuildDialog {w} { + upvar ::tk::dialog::color::[winfo name $w] data # TopFrame contains the color strips and the color selection # @@ -212,8 +218,9 @@ proc tkColorDialog_BuildDialog {w} { set box [frame $f.box] label $box.label -text $l: -width $maxWidth -under 0 -anchor ne - entry $box.entry -textvariable [format %s $w]($color,intensity) \ - -width 4 + entry $box.entry -textvariable \ + ::tk::dialog::color::[winfo name $w]($color,intensity) \ + -width 4 pack $box.label -side left -fill y -padx 2 -pady 3 pack $box.entry -side left -anchor n -pady 0 pack $box -side left -fill both @@ -236,18 +243,18 @@ proc tkColorDialog_BuildDialog {w} { set data($color,sel) $f.sel bind $data($color,col) \ - [list tkColorDialog_DrawColorScale $w $color 1] + [list tk::dialog::color::DrawColorScale $w $color 1] bind $data($color,col) \ - [list tkColorDialog_EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,col) \ - [list tkColorDialog_LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] bind $data($color,sel) \ - [list tkColorDialog_EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,sel) \ - [list tkColorDialog_LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] - bind $box.entry [list tkColorDialog_HandleRGBEntry $w] + bind $box.entry [list tk::dialog::color::HandleRGBEntry $w] } pack $stripsFrame -side left -fill both -padx 4 -pady 10 @@ -258,7 +265,8 @@ proc tkColorDialog_BuildDialog {w} { set selFrame [frame $topFrame.sel] set lab [label $selFrame.lab -text [::msgcat::mc "Selection:"] \ -under 0 -anchor sw] - set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \ + set ent [entry $selFrame.ent \ + -textvariable ::tk::dialog::color::[winfo name $w](selection) \ -width 16] set f1 [frame $selFrame.f1 -relief sunken -bd 2] set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] @@ -267,7 +275,7 @@ proc tkColorDialog_BuildDialog {w} { pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10 pack $data(finalCanvas) -expand yes -fill both - bind $ent [list tkColorDialog_HandleSelEntry $w] + bind $ent [list tk::dialog::color::HandleSelEntry $w] pack $selFrame -side left -fill none -anchor nw pack $topFrame -side top -expand yes -fill both -anchor nw @@ -279,10 +287,10 @@ proc tkColorDialog_BuildDialog {w} { set maxWidth [expr {$maxWidth<8?8:$maxWidth}] button $botFrame.ok -text [::msgcat::mc "OK"] \ -width $maxWidth -under 0 \ - -command [list tkColorDialog_OkCmd $w] + -command [list tk::dialog::color::OkCmd $w] button $botFrame.cancel -text [::msgcat::mc "Cancel"] \ -width $maxWidth -under 0 \ - -command [list tkColorDialog_CancelCmd $w] + -command [list tk::dialog::color::CancelCmd $w] set data(okBtn) $botFrame.ok set data(cancelBtn) $botFrame.cancel @@ -298,62 +306,61 @@ proc tkColorDialog_BuildDialog {w} { bind $w [list focus $data(green,entry)] bind $w [list focus $data(blue,entry)] bind $w [list focus $ent] - bind $w [list tkButtonInvoke $data(cancelBtn)] - bind $w [list tkButtonInvoke $data(cancelBtn)] - bind $w [list tkButtonInvoke $data(okBtn)] + bind $w [list tk::ButtonInvoke $data(cancelBtn)] + bind $w [list tk::ButtonInvoke $data(cancelBtn)] + bind $w [list tk::ButtonInvoke $data(okBtn)] - wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w] + wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w] } -# tkColorDialog_SetRGBValue -- +# ::tk::dialog::color::SetRGBValue -- # # Sets the current selection of the dialog box # -proc tkColorDialog_SetRGBValue {w color} { - upvar #0 $w data +proc ::tk::dialog::color::SetRGBValue {w color} { + upvar ::tk::dialog::color::[winfo name $w] data set data(red,intensity) [lindex $color 0] set data(green,intensity) [lindex $color 1] set data(blue,intensity) [lindex $color 2] - tkColorDialog_RedrawColorBars $w all + RedrawColorBars $w all # Now compute the new x value of each colorbars pointer polygon foreach color [list red green blue ] { - set x [tkColorDialog_RgbToX $w $data($color,intensity)] - tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0 + set x [RgbToX $w $data($color,intensity)] + MoveSelector $w $data($color,sel) $color $x 0 } } -# tkColorDialog_XToRgb -- +# ::tk::dialog::color::XToRgb -- # # Converts a screen coordinate to intensity # -proc tkColorDialog_XToRgb {w x} { - upvar #0 $w data +proc ::tk::dialog::color::XToRgb {w x} { + upvar ::tk::dialog::color::[winfo name $w] data return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] } -# tkColorDialog_RgbToX +# ::tk::dialog::color::RgbToX # # Converts an intensity to screen coordinate. # -proc tkColorDialog_RgbToX {w color} { - upvar #0 $w data +proc ::tk::dialog::color::RgbToX {w color} { + upvar ::tk::dialog::color::[winfo name $w] data return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] } -# tkColorDialog_DrawColorScale -- +# ::tk::dialog::color::DrawColorScale -- # # Draw color scale is called whenever the size of one of the color # scale canvases is changed. # -proc tkColorDialog_DrawColorScale {w c {create 0}} { - global lines - upvar #0 $w data +proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { + upvar ::tk::dialog::color::[winfo name $w] data # col: color bar canvas # sel: selector canvas @@ -375,13 +382,13 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { } # Draw the selection polygons - tkColorDialog_CreateSelector $w $sel $c + CreateSelector $w $sel $c $sel bind $data($c,index) \ - [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1] + [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1] $sel bind $data($c,index) \ - [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)] + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] $sel bind $data($c,index) \ - [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)] + [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)] set height [winfo height $col] # Create an invisible region under the colorstrip to catch mouse clicks @@ -390,18 +397,18 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { $data(canvasWidth) $height -fill {} -outline {}] bind $col \ - [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)] + [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] bind $col \ - [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)] + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)] bind $col \ - [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)] + [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)] $sel bind $data($c,clickRegion) \ - [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)] + [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)] $sel bind $data($c,clickRegion) \ - [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)] + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] $sel bind $data($c,clickRegion) \ - [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)] + [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)] } else { # l is the canvas index of the first colorbar. set l $data(lines,$c,start) @@ -446,30 +453,30 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}] } - tkColorDialog_RedrawFinalColor $w + RedrawFinalColor $w } -# tkColorDialog_CreateSelector -- +# ::tk::dialog::color::CreateSelector -- # # Creates and draws the selector polygon at the position # $data($c,intensity). # -proc tkColorDialog_CreateSelector {w sel c } { - upvar #0 $w data +proc ::tk::dialog::color::CreateSelector {w sel c } { + upvar ::tk::dialog::color::[winfo name $w] data set data($c,index) [$sel create polygon \ 0 $data(PLGN_HEIGHT) \ $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ $data(indent) 0] - set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)] + set data($c,x) [RgbToX $w $data($c,intensity)] $sel move $data($c,index) $data($c,x) 0 } -# tkColorDialog_RedrawFinalColor +# ::tk::dialog::color::RedrawFinalColor # # Combines the intensities of the three colors into the final color # -proc tkColorDialog_RedrawFinalColor {w} { - upvar #0 $w data +proc ::tk::dialog::color::RedrawFinalColor {w} { + upvar ::tk::dialog::color::[winfo name $w] data set color [format "#%02x%02x%02x" $data(red,intensity) \ $data(green,intensity) $data(blue,intensity)] @@ -483,42 +490,42 @@ proc tkColorDialog_RedrawFinalColor {w} { $data(blue,intensity)] } -# tkColorDialog_RedrawColorBars -- +# ::tk::dialog::color::RedrawColorBars -- # # Only redraws the colors on the color strips that were not manipulated. # Params: color of colorstrip that changed. If color is not [red|green|blue] # Then all colorstrips will be updated # -proc tkColorDialog_RedrawColorBars {w colorChanged} { - upvar #0 $w data +proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { + upvar ::tk::dialog::color::[winfo name $w] data switch $colorChanged { red { - tkColorDialog_DrawColorScale $w green - tkColorDialog_DrawColorScale $w blue + DrawColorScale $w green + DrawColorScale $w blue } green { - tkColorDialog_DrawColorScale $w red - tkColorDialog_DrawColorScale $w blue + DrawColorScale $w red + DrawColorScale $w blue } blue { - tkColorDialog_DrawColorScale $w red - tkColorDialog_DrawColorScale $w green + DrawColorScale $w red + DrawColorScale $w green } default { - tkColorDialog_DrawColorScale $w red - tkColorDialog_DrawColorScale $w green - tkColorDialog_DrawColorScale $w blue + DrawColorScale $w red + DrawColorScale $w green + DrawColorScale $w blue } } - tkColorDialog_RedrawFinalColor $w + RedrawFinalColor $w } #---------------------------------------------------------------------- # Event handlers #---------------------------------------------------------------------- -# tkColorDialog_StartMove -- +# ::tk::dialog::color::StartMove -- # # Handles a mousedown button event over the selector polygon. # Adds the bindings for moving the mouse while the button is @@ -526,15 +533,15 @@ proc tkColorDialog_RedrawColorBars {w colorChanged} { # # Params: sel is the selector canvas window, color is the color of the strip. # -proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} { - upvar #0 $w data +proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { + upvar ::tk::dialog::color::[winfo name $w] data if {!$dontMove} { - tkColorDialog_MoveSelector $w $sel $color $x $delta + MoveSelector $w $sel $color $x $delta } } -# tkColorDialog_MoveSelector -- +# ::tk::dialog::color::MoveSelector -- # # Moves the polygon selector so that its middle point has the same # x value as the specified x. If x is outside the bounds [0,255], @@ -543,8 +550,8 @@ proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} { # Params: sel is the selector canvas, c is [red|green|blue] # x is a x-coordinate. # -proc tkColorDialog_MoveSelector {w sel color x delta} { - upvar #0 $w data +proc ::tk::dialog::color::MoveSelector {w sel color x delta} { + upvar ::tk::dialog::color::[winfo name $w] data incr x -$delta @@ -561,49 +568,49 @@ proc tkColorDialog_MoveSelector {w sel color x delta} { return $x } -# tkColorDialog_ReleaseMouse +# ::tk::dialog::color::ReleaseMouse # # Removes mouse tracking bindings, updates the colorbars. # # Params: sel is the selector canvas, color is the color of the strip, # x is the x-coord of the mouse. # -proc tkColorDialog_ReleaseMouse {w sel color x delta} { - upvar #0 $w data +proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { + upvar ::tk::dialog::color::[winfo name $w] data - set x [tkColorDialog_MoveSelector $w $sel $color $x $delta] + set x [MoveSelector $w $sel $color $x $delta] # Determine exactly what color we are looking at. - set data($color,intensity) [tkColorDialog_XToRgb $w $x] + set data($color,intensity) [XToRgb $w $x] - tkColorDialog_RedrawColorBars $w $color + RedrawColorBars $w $color } -# tkColorDialog_ResizeColorbars -- +# ::tk::dialog::color::ResizeColorbars -- # # Completely redraws the colorbars, including resizing the # colorstrips # -proc tkColorDialog_ResizeColorBars {w} { - upvar #0 $w data +proc ::tk::dialog::color::ResizeColorBars {w} { + upvar ::tk::dialog::color::[winfo name $w] data if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} { set data(BARS_WIDTH) $data(NUM_COLORBARS) } - tkColorDialog_InitValues $w + InitValues [winfo name $w] foreach color [list red green blue ] { $data($color,col) configure -width $data(canvasWidth) - tkColorDialog_DrawColorScale $w $color 1 + DrawColorScale $w $color 1 } } -# tkColorDialog_HandleSelEntry -- +# ::tk::dialog::color::HandleSelEntry -- # # Handles the return keypress event in the "Selection:" entry # -proc tkColorDialog_HandleSelEntry {w} { - upvar #0 $w data +proc ::tk::dialog::color::HandleSelEntry {w} { + upvar ::tk::dialog::color::[winfo name $w] data set text [string trim $data(selection)] # Check to make sure that the color is valid @@ -616,16 +623,16 @@ proc tkColorDialog_HandleSelEntry {w} { set G [expr {[lindex $color 1]/0x100}] set B [expr {[lindex $color 2]/0x100}] - tkColorDialog_SetRGBValue $w "$R $G $B" + SetRGBValue $w "$R $G $B" set data(selection) $text } -# tkColorDialog_HandleRGBEntry -- +# ::tk::dialog::color::HandleRGBEntry -- # # Handles the return keypress event in the R, G or B entry # -proc tkColorDialog_HandleRGBEntry {w} { - upvar #0 $w data +proc ::tk::dialog::color::HandleRGBEntry {w} { + upvar ::tk::dialog::color::[winfo name $w] data foreach c [list red green blue] { if {[catch { @@ -642,40 +649,39 @@ proc tkColorDialog_HandleRGBEntry {w} { } } - tkColorDialog_SetRGBValue $w "$data(red,intensity) \ + SetRGBValue $w "$data(red,intensity) \ $data(green,intensity) $data(blue,intensity)" } # mouse cursor enters a color bar # -proc tkColorDialog_EnterColorBar {w color} { - upvar #0 $w data +proc ::tk::dialog::color::EnterColorBar {w color} { + upvar ::tk::dialog::color::[winfo name $w] data $data($color,sel) itemconfig $data($color,index) -fill red } # mouse leaves enters a color bar # -proc tkColorDialog_LeaveColorBar {w color} { - upvar #0 $w data +proc ::tk::dialog::color::LeaveColorBar {w color} { + upvar ::tk::dialog::color::[winfo name $w] data $data($color,sel) itemconfig $data($color,index) -fill black } # user hits OK button # -proc tkColorDialog_OkCmd {w} { - global tkPriv - upvar #0 $w data +proc ::tk::dialog::color::OkCmd {w} { + variable ::tk::Priv + upvar ::tk::dialog::color::[winfo name $w] data - set tkPriv(selectColor) $data(finalColor) + set Priv(selectColor) $data(finalColor) } # user hits Cancel button # -proc tkColorDialog_CancelCmd {w} { - global tkPriv - - set tkPriv(selectColor) "" +proc ::tk::dialog::color::CancelCmd {w} { + variable ::tk::Priv + set Priv(selectColor) "" } diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 1ba0769..cb2af18 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -3,7 +3,7 @@ # Some functions needed for the common dialog boxes. Probably need to go # in a different file. # -# RCS: @(#) $Id: comdlg.tcl,v 1.7 2000/04/08 06:59:28 hobbs Exp $ +# RCS: @(#) $Id: comdlg.tcl,v 1.8 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -112,94 +112,99 @@ proc tclListValidFlags {v} { #---------------------------------------------------------------------- -# tkFocusGroup_Create -- +# ::tk::FocusGroup_Create -- # # Create a focus group. All the widgets in a focus group must be # within the same focus toplevel. Each toplevel can have only # one focus group, which is identified by the name of the # toplevel widget. # -proc tkFocusGroup_Create {t} { - global tkPriv +proc ::tk::FocusGroup_Create {t} { + variable ::tk::Priv if {[string compare [winfo toplevel $t] $t]} { error "$t is not a toplevel window" } - if {![info exists tkPriv(fg,$t)]} { - set tkPriv(fg,$t) 1 - set tkPriv(focus,$t) "" - bind $t [list tkFocusGroup_In $t %W %d] - bind $t [list tkFocusGroup_Out $t %W %d] - bind $t [list tkFocusGroup_Destroy $t %W] + if {![info exists Priv(fg,$t)]} { + set Priv(fg,$t) 1 + set Priv(focus,$t) "" + bind $t [list tk::FocusGroup_In $t %W %d] + bind $t [list tk::FocusGroup_Out $t %W %d] + bind $t [list tk::FocusGroup_Destroy $t %W] } } -# tkFocusGroup_BindIn -- +# ::tk::FocusGroup_BindIn -- # # Add a widget into the "FocusIn" list of the focus group. The $cmd will be # called when the widget is focused on by the user. # -proc tkFocusGroup_BindIn {t w cmd} { - global tkFocusIn tkPriv - if {![info exists tkPriv(fg,$t)]} { +proc ::tk::FocusGroup_BindIn {t w cmd} { + variable FocusIn + variable ::tk::Priv + if {![info exists Priv(fg,$t)]} { error "focus group \"$t\" doesn't exist" } - set tkFocusIn($t,$w) $cmd + set FocusIn($t,$w) $cmd } -# tkFocusGroup_BindOut -- +# ::tk::FocusGroup_BindOut -- # # Add a widget into the "FocusOut" list of the focus group. The # $cmd will be called when the widget loses the focus (User # types Tab or click on another widget). # -proc tkFocusGroup_BindOut {t w cmd} { - global tkFocusOut tkPriv - if {![info exists tkPriv(fg,$t)]} { +proc ::tk::FocusGroup_BindOut {t w cmd} { + variable FocusOut + variable ::tk::Priv + if {![info exists Priv(fg,$t)]} { error "focus group \"$t\" doesn't exist" } - set tkFocusOut($t,$w) $cmd + set FocusOut($t,$w) $cmd } -# tkFocusGroup_Destroy -- +# ::tk::FocusGroup_Destroy -- # # Cleans up when members of the focus group is deleted, or when the # toplevel itself gets deleted. # -proc tkFocusGroup_Destroy {t w} { - global tkPriv tkFocusIn tkFocusOut +proc ::tk::FocusGroup_Destroy {t w} { + variable FocusIn + variable FocusOut + variable ::tk::Priv if {[string equal $t $w]} { - unset tkPriv(fg,$t) - unset tkPriv(focus,$t) + unset Priv(fg,$t) + unset Priv(focus,$t) - foreach name [array names tkFocusIn $t,*] { - unset tkFocusIn($name) + foreach name [array names FocusIn $t,*] { + unset FocusIn($name) } - foreach name [array names tkFocusOut $t,*] { - unset tkFocusOut($name) + foreach name [array names FocusOut $t,*] { + unset FocusOut($name) } } else { - if {[info exists tkPriv(focus,$t)] && \ - [string equal $tkPriv(focus,$t) $w]} { - set tkPriv(focus,$t) "" + if {[info exists Priv(focus,$t)] && \ + [string equal $Priv(focus,$t) $w]} { + set Priv(focus,$t) "" } catch { - unset tkFocusIn($t,$w) + unset FocusIn($t,$w) } catch { - unset tkFocusOut($t,$w) + unset FocusOut($t,$w) } } } -# tkFocusGroup_In -- +# ::tk::FocusGroup_In -- # # Handles the event. Calls the FocusIn command for the newly # focused widget in the focus group. # -proc tkFocusGroup_In {t w detail} { - global tkPriv tkFocusIn +proc ::tk::FocusGroup_In {t w detail} { + variable FocusIn + variable ::tk::Priv if {[string compare $detail NotifyNonlinear] && \ [string compare $detail NotifyNonlinearVirtual]} { @@ -207,56 +212,57 @@ proc tkFocusGroup_In {t w detail} { # ordinary keypresses some window managers (ie: CDE [Bug: 2960]). return } - if {![info exists tkFocusIn($t,$w)]} { - set tkFocusIn($t,$w) "" + if {![info exists FocusIn($t,$w)]} { + set FocusIn($t,$w) "" return } - if {![info exists tkPriv(focus,$t)]} { + if {![info exists Priv(focus,$t)]} { return } - if {[string equal $tkPriv(focus,$t) $w]} { + if {[string equal $Priv(focus,$t) $w]} { # This is already in focus # return } else { - set tkPriv(focus,$t) $w - eval $tkFocusIn($t,$w) + set Priv(focus,$t) $w + eval $FocusIn($t,$w) } } -# tkFocusGroup_Out -- +# ::tk::FocusGroup_Out -- # # Handles the event. Checks if this is really a lose # focus event, not one generated by the mouse moving out of the # toplevel window. Calls the FocusOut command for the widget # who loses its focus. # -proc tkFocusGroup_Out {t w detail} { - global tkPriv tkFocusOut +proc ::tk::FocusGroup_Out {t w detail} { + variable FocusOut + variable ::tk::Priv if {[string compare $detail NotifyNonlinear] && \ [string compare $detail NotifyNonlinearVirtual]} { # This is caused by mouse moving out of the window return } - if {![info exists tkPriv(focus,$t)]} { + if {![info exists Priv(focus,$t)]} { return } - if {![info exists tkFocusOut($t,$w)]} { + if {![info exists FocusOut($t,$w)]} { return } else { - eval $tkFocusOut($t,$w) - set tkPriv(focus,$t) "" + eval $FocusOut($t,$w) + set Priv(focus,$t) "" } } -# tkFDGetFileTypes -- +# ::tk::FDGetFileTypes -- # # Process the string given by the -filetypes option of the file # dialogs. Similar to the C function TkGetFileFilters() on the Mac # and Windows platform. # -proc tkFDGetFileTypes {string} { +proc ::tk::FDGetFileTypes {string} { foreach t $string { if {[llength $t] < 2 || [llength $t] > 3} { error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" diff --git a/library/console.tcl b/library/console.tcl index e996ea5..170d898 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -4,7 +4,7 @@ # can be used by non-unix systems that do not have built-in support # for shells. # -# RCS: @(#) $Id: console.tcl,v 1.11 2001/07/03 01:03:16 hobbs Exp $ +# RCS: @(#) $Id: console.tcl,v 1.12 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -15,13 +15,13 @@ # TODO: history - remember partially written command -# tkConsoleInit -- +# ::tk::ConsoleInit -- # This procedure constructs and configures the console windows. # # Arguments: # None. -proc tkConsoleInit {} { +proc ::tk::ConsoleInit {} { global tcl_platform if {![consoleinterp eval {set tcl_interactive}]} { @@ -40,7 +40,7 @@ proc tkConsoleInit {} { menu .menubar.file -tearoff 0 .menubar.file add command -label [::msgcat::mc "Source..."] \ - -underline 0 -command tkConsoleSource + -underline 0 -command tk::ConsoleSource .menubar.file add command -label [::msgcat::mc "Hide Console"] \ -underline 0 -command {wm withdraw .} if {[string compare $tcl_platform(platform) "macintosh"]} { @@ -69,7 +69,7 @@ proc tkConsoleInit {} { .menubar add cascade -label Help -menu .menubar.help -underline 0 menu .menubar.help -tearoff 0 .menubar.help add command -label [::msgcat::mc "About..."] \ - -underline 0 -command tkConsoleAbout + -underline 0 -command tk::ConsoleAbout } . configure -menu .menubar @@ -87,7 +87,7 @@ proc tkConsoleInit {} { } } - tkConsoleBind .console + ConsoleBind .console .console tag configure stderr -foreground red .console tag configure stdin -foreground blue @@ -98,19 +98,19 @@ proc tkConsoleInit {} { wm title . [::msgcat::mc "Console"] flush stdout .console mark set output [.console index "end - 1 char"] - tkTextSetCursor .console end + tk::TextSetCursor .console end .console mark set promptEnd insert .console mark gravity promptEnd left } -# tkConsoleSource -- +# ::tk::ConsoleSource -- # # Prompts the user for a file to source in the main interpreter. # # Arguments: # None. -proc tkConsoleSource {} { +proc ::tk::ConsoleSource {} { set filename [tk_getOpenFile -defaultextension .tcl -parent . \ -title [::msgcat::mc "Select a file to source"] \ -filetypes [list \ @@ -119,12 +119,12 @@ proc tkConsoleSource {} { if {[string compare $filename ""]} { set cmd [list source $filename] if {[catch {consoleinterp eval $cmd} result]} { - tkConsoleOutput stderr "$result\n" + ConsoleOutput stderr "$result\n" } } } -# tkConsoleInvoke -- +# ::tk::ConsoleInvoke -- # Processes the command line input. If the command is complete it # is evaled in the main interpreter. Otherwise, the continuation # prompt is added and more input may be added. @@ -132,7 +132,7 @@ proc tkConsoleSource {} { # Arguments: # None. -proc tkConsoleInvoke {args} { +proc ::tk::ConsoleInvoke {args} { set ranges [.console tag ranges input] set cmd "" if {[llength $ranges]} { @@ -145,7 +145,7 @@ proc tkConsoleInvoke {args} { } } if {[string equal $cmd ""]} { - tkConsolePrompt + ConsolePrompt } elseif {[info complete $cmd]} { .console mark set output end .console tag delete input @@ -153,51 +153,51 @@ proc tkConsoleInvoke {args} { if {[string compare $result ""]} { puts $result } - tkConsoleHistory reset - tkConsolePrompt + ConsoleHistory reset + ConsolePrompt } else { - tkConsolePrompt partial + ConsolePrompt partial } .console yview -pickplace insert } -# tkConsoleHistory -- +# ::tk::ConsoleHistory -- # This procedure implements command line history for the # console. In general is evals the history command in the -# main interpreter to obtain the history. The global variable -# histNum is used to store the current location in the history. +# main interpreter to obtain the history. The variable +# ::tk::HistNum is used to store the current location in the history. # # Arguments: # cmd - Which action to take: prev, next, reset. -set histNum 1 -proc tkConsoleHistory {cmd} { - global histNum +set ::tk::HistNum 1 +proc ::tk::ConsoleHistory {cmd} { + variable HistNum switch $cmd { prev { - incr histNum -1 - if {$histNum == 0} { + incr HistNum -1 + if {$HistNum == 0} { set cmd {history event [expr {[history nextid] -1}]} } else { - set cmd "history event $histNum" + set cmd "history event $HistNum" } if {[catch {consoleinterp eval $cmd} cmd]} { - incr histNum + incr HistNum return } .console delete promptEnd end .console insert promptEnd $cmd {input stdin} } next { - incr histNum - if {$histNum == 0} { + incr HistNum + if {$HistNum == 0} { set cmd {history event [expr {[history nextid] -1}]} - } elseif {$histNum > 0} { + } elseif {$HistNum > 0} { set cmd "" - set histNum 1 + set HistNum 1 } else { - set cmd "history event $histNum" + set cmd "history event $HistNum" } if {[string compare $cmd ""]} { catch {consoleinterp eval $cmd} cmd @@ -206,12 +206,12 @@ proc tkConsoleHistory {cmd} { .console insert promptEnd $cmd {input stdin} } reset { - set histNum 1 + set HistNum 1 } } } -# tkConsolePrompt -- +# ::tk::ConsolePrompt -- # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2 # exists in the main interpreter it will be called to generate the # prompt. Otherwise, a hard coded default prompt is printed. @@ -219,7 +219,7 @@ proc tkConsoleHistory {cmd} { # Arguments: # partial - Flag to specify which prompt to print. -proc tkConsolePrompt {{partial normal}} { +proc ::tk::ConsolePrompt {{partial normal}} { if {[string equal $partial "normal"]} { set temp [.console index "end - 1 char"] .console mark set output end @@ -239,12 +239,12 @@ proc tkConsolePrompt {{partial normal}} { } flush stdout .console mark set output $temp - tkTextSetCursor .console end + ::tk::TextSetCursor .console end .console mark set promptEnd insert .console mark gravity promptEnd left } -# tkConsoleBind -- +# ::tk::ConsoleBind -- # This procedure first ensures that the default bindings for the Text # class have been defined. Then certain bindings are overridden for # the class. @@ -252,7 +252,7 @@ proc tkConsolePrompt {{partial normal}} { # Arguments: # None. -proc tkConsoleBind {win} { +proc ::tk::ConsoleBind {win} { bindtags $win "$win Text . all" # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. @@ -267,14 +267,14 @@ proc tkConsoleBind {win} { bind $win {# nothing} bind $win { - tkConsoleInsert %W \t + tk::ConsoleInsert %W \t focus %W break } bind $win { %W mark set insert {end - 1c} - tkConsoleInsert %W "\n" - tkConsoleInvoke + tk::ConsoleInsert %W "\n" + tk::ConsoleInvoke break } bind $win { @@ -294,16 +294,16 @@ proc tkConsoleBind {win} { foreach left {Control-a Home} { bind $win <$left> { if {[%W compare insert < promptEnd]} { - tkTextSetCursor %W {insert linestart} + tk::TextSetCursor %W {insert linestart} } else { - tkTextSetCursor %W promptEnd + tk::TextSetCursor %W promptEnd } break } } foreach right {Control-e End} { bind $win <$right> { - tkTextSetCursor %W {insert lineend} + tk::TextSetCursor %W {insert lineend} break } } @@ -339,22 +339,22 @@ proc tkConsoleBind {win} { } foreach prev {Control-p Up} { bind $win <$prev> { - tkConsoleHistory prev + tk::ConsoleHistory prev break } } foreach prev {Control-n Down} { bind $win <$prev> { - tkConsoleHistory next + tk::ConsoleHistory next break } } bind $win { - catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]} + catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]} break } bind $win { - tkConsoleInsert %W %A + tk::ConsoleInsert %W %A break } foreach left {Control-b Left} { @@ -362,13 +362,13 @@ proc tkConsoleBind {win} { if {[%W compare insert == promptEnd]} { break } - tkTextSetCursor %W insert-1c + tk::TextSetCursor %W insert-1c break } } foreach right {Control-f Right} { bind $win <$right> { - tkTextSetCursor %W insert+1c + tk::TextSetCursor %W insert+1c break } } @@ -399,19 +399,19 @@ proc tkConsoleBind {win} { catch { set clip [::tk::GetSelection %W CLIPBOARD] set list [split $clip \n\r] - tkConsoleInsert %W [lindex $list 0] + tk::ConsoleInsert %W [lindex $list 0] foreach x [lrange $list 1 end] { %W mark set insert {end - 1c} - tkConsoleInsert %W "\n" - tkConsoleInvoke - tkConsoleInsert %W $x + tk::ConsoleInsert %W "\n" + tk::ConsoleInvoke + tk::ConsoleInsert %W $x } } break } } -# tkConsoleInsert -- +# ::tk::ConsoleInsert -- # Insert a string into a text at the point of the insertion cursor. # If there is a selection in the text, and it covers the point of the # insertion cursor, then delete the selection before inserting. Insertion @@ -421,7 +421,7 @@ proc tkConsoleBind {win} { # w - The text window in which to insert the string # s - The string to insert (usually just a single character) -proc tkConsoleInsert {w s} { +proc ::tk::ConsoleInsert {w s} { if {[string equal $s ""]} { return } @@ -439,7 +439,7 @@ proc tkConsoleInsert {w s} { $w see insert } -# tkConsoleOutput -- +# ::tk::ConsoleOutput -- # # This routine is called directly by ConsolePutsCmd to cause a string # to be displayed in the console. @@ -448,12 +448,12 @@ proc tkConsoleInsert {w s} { # dest - The output tag to be used: either "stderr" or "stdout". # string - The string to be displayed. -proc tkConsoleOutput {dest string} { +proc ::tk::ConsoleOutput {dest string} { .console insert output $string $dest .console see insert } -# tkConsoleExit -- +# ::tk::ConsoleExit -- # # This routine is called by ConsoleEventProc when the main window of # the application is destroyed. Don't call exit - that probably already @@ -462,18 +462,18 @@ proc tkConsoleOutput {dest string} { # Arguments: # None. -proc tkConsoleExit {} { +proc ::tk::ConsoleExit {} { destroy . } -# tkConsoleAbout -- +# ::tk::ConsoleAbout -- # # This routine displays an About box to show Tcl/Tk version info. # # Arguments: # None. -proc tkConsoleAbout {} { +proc ::tk::ConsoleAbout {} { global tk_patchLevel tk_messageBox -type ok -message "[::msgcat::mc {Tcl for Windows}] Copyright \251 2000 Ajuba Solutions @@ -484,4 +484,4 @@ Tk $tk_patchLevel" # now initialize the console -tkConsoleInit +::tk::ConsoleInit diff --git a/library/dialog.tcl b/library/dialog.tcl index b3c9dbd..534a9ae 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -3,7 +3,7 @@ # This file defines the procedure tk_dialog, which creates a dialog # box containing a bitmap, a message, and one or more buttons. # -# RCS: @(#) $Id: dialog.tcl,v 1.8 2000/04/18 02:18:33 ericm Exp $ +# RCS: @(#) $Id: dialog.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -13,7 +13,7 @@ # # -# tk_dialog: +# ::tk_dialog: # # This procedure displays a dialog box, waits for a button in the dialog # to be invoked, then returns the index of the selected button. If the @@ -29,8 +29,9 @@ # args - One or more strings to display in buttons across the # bottom of the dialog box. -proc tk_dialog {w title text bitmap default args} { - global tkPriv tcl_platform +proc ::tk_dialog {w title text bitmap default args} { + global tcl_platform + variable ::tk::Priv # Check that $default was properly given if {[string is int $default]} { @@ -103,7 +104,7 @@ proc tk_dialog {w title text bitmap default args} { set i 0 foreach but $args { - button $w.button$i -text $but -command [list set tkPriv(button) $i] + button $w.button$i -text $but -command [list set Priv(button) $i] if {$i == $default} { $w.button$i configure -default active } else { @@ -129,7 +130,7 @@ proc tk_dialog {w title text bitmap default args} { [list $w.button$default] configure -state active -relief sunken update idletasks after 100 - set tkPriv(button) $default + set Priv(button) $default " } @@ -137,7 +138,7 @@ proc tk_dialog {w title text bitmap default args} { # button variable to -1; this is needed in case something happens # that destroys the window, such as its parent window being destroyed. - bind $w {set tkPriv(button) -1} + bind $w {set Priv(button) -1} # 6. Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the @@ -172,12 +173,12 @@ proc tk_dialog {w title text bitmap default args} { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - tkwait variable tkPriv(button) + vwait ::tk::Priv(button) catch {focus $oldFocus} catch { # It's possible that the window has already been destroyed, # hence this "catch". Delete the Destroy handler so that - # tkPriv(button) doesn't get reset by it. + # tk::Priv(button) doesn't get reset by it. bind $w {} destroy $w @@ -189,5 +190,5 @@ proc tk_dialog {w title text bitmap default args} { grab -global $oldGrab } } - return $tkPriv(button) + return $Priv(button) } diff --git a/library/entry.tcl b/library/entry.tcl index 5392bcd..57f95fd 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: entry.tcl,v 1.15 2001/07/03 01:03:16 hobbs Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.16 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -13,7 +13,7 @@ # #------------------------------------------------------------------------- -# Elements of tkPriv that are used in this file: +# Elements of tk::Priv that are used in this file: # # afterId - If non-null, it means that auto-scanning is underway # and it gives the "after" id for the next auto-scan @@ -33,18 +33,18 @@ # The code below creates the default class bindings for entries. #------------------------------------------------------------------------- bind Entry <> { - if {![catch {tkEntryGetSelection %W} tkPriv(data)]} { + if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} { clipboard clear -displayof %W - clipboard append -displayof %W $tkPriv(data) + clipboard append -displayof %W $tk::Priv(data) %W delete sel.first sel.last - unset tkPriv(data) + unset tk::Priv(data) } } bind Entry <> { - if {![catch {tkEntryGetSelection %W} tkPriv(data)]} { + if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} { clipboard clear -displayof %W - clipboard append -displayof %W $tkPriv(data) - unset tkPriv(data) + clipboard append -displayof %W $tk::Priv(data) + unset tk::Priv(data) } } bind Entry <> { @@ -56,105 +56,105 @@ bind Entry <> { } } %W insert insert [::tk::GetSelection %W CLIPBOARD] - tkEntrySeeInsert %W + tk::EntrySeeInsert %W } } bind Entry <> { %W delete sel.first sel.last } bind Entry <> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { - tkEntryPaste %W %x + if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + tk::EntryPaste %W %x } } # Standard Motif bindings: bind Entry <1> { - tkEntryButton1 %W %x + tk::EntryButton1 %W %x %W selection clear } bind Entry { - set tkPriv(x) %x - tkEntryMouseSelect %W %x + set tk::Priv(x) %x + tk::EntryMouseSelect %W %x } bind Entry { - set tkPriv(selectMode) word - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x catch {%W icursor sel.first} } bind Entry { - set tkPriv(selectMode) line - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x %W icursor 0 } bind Entry { - set tkPriv(selectMode) char + set tk::Priv(selectMode) char %W selection adjust @%x } bind Entry { - set tkPriv(selectMode) word - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x } bind Entry { - set tkPriv(selectMode) line - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x } bind Entry { - set tkPriv(x) %x - tkEntryAutoScan %W + set tk::Priv(x) %x + tk::EntryAutoScan %W } bind Entry { - tkCancelRepeat + tk::CancelRepeat } bind Entry { - tkCancelRepeat + tk::CancelRepeat } bind Entry { %W icursor @%x } bind Entry { - tkEntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } bind Entry { - tkEntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Entry { - tkEntryKeySelect %W [expr {[%W index insert] - 1}] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + tk::EntrySeeInsert %W } bind Entry { - tkEntryKeySelect %W [expr {[%W index insert] + 1}] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + tk::EntrySeeInsert %W } bind Entry { - tkEntrySetCursor %W [tkEntryPreviousWord %W insert] + tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } bind Entry { - tkEntrySetCursor %W [tkEntryNextWord %W insert] + tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } bind Entry { - tkEntryKeySelect %W [tkEntryPreviousWord %W insert] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert] + tk::EntrySeeInsert %W } bind Entry { - tkEntryKeySelect %W [tkEntryNextWord %W insert] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryNextWord %W insert] + tk::EntrySeeInsert %W } bind Entry { - tkEntrySetCursor %W 0 + tk::EntrySetCursor %W 0 } bind Entry { - tkEntryKeySelect %W 0 - tkEntrySeeInsert %W + tk::EntryKeySelect %W 0 + tk::EntrySeeInsert %W } bind Entry { - tkEntrySetCursor %W end + tk::EntrySetCursor %W end } bind Entry { - tkEntryKeySelect %W end - tkEntrySeeInsert %W + tk::EntryKeySelect %W end + tk::EntrySeeInsert %W } bind Entry { @@ -165,7 +165,7 @@ bind Entry { } } bind Entry { - tkEntryBackspace %W + tk::EntryBackspace %W } bind Entry { @@ -187,7 +187,7 @@ bind Entry { %W selection clear } bind Entry { - tkEntryInsert %W %A + tk::EntryInsert %W %A } # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. @@ -210,7 +210,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Entry { - catch {tkEntryInsert %W [::tk::GetSelection %W PRIMARY]} + catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -218,12 +218,12 @@ if {[string compare $tcl_platform(platform) "windows"]} { bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W 0 + tk::EntrySetCursor %W 0 } } bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } } bind Entry { @@ -233,17 +233,17 @@ bind Entry { } bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W end + tk::EntrySetCursor %W end } } bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } } bind Entry { if {!$tk_strictMotif} { - tkEntryBackspace %W + tk::EntryBackspace %W } } bind Entry { @@ -253,32 +253,32 @@ bind Entry { } bind Entry { if {!$tk_strictMotif} { - tkEntryTranspose %W + tk::EntryTranspose %W } } bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W [tkEntryPreviousWord %W insert] + tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } } bind Entry { if {!$tk_strictMotif} { - %W delete insert [tkEntryNextWord %W insert] + %W delete insert [tk::EntryNextWord %W insert] } } bind Entry { if {!$tk_strictMotif} { - tkEntrySetCursor %W [tkEntryNextWord %W insert] + tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } } bind Entry { if {!$tk_strictMotif} { - %W delete [tkEntryPreviousWord %W insert] insert + %W delete [tk::EntryPreviousWord %W insert] insert } } bind Entry { if {!$tk_strictMotif} { - %W delete [tkEntryPreviousWord %W insert] insert + %W delete [tk::EntryPreviousWord %W insert] insert } } @@ -287,21 +287,21 @@ bind Entry { bind Entry <2> { if {!$tk_strictMotif} { %W scan mark %x - set tkPriv(x) %x - set tkPriv(y) %y - set tkPriv(mouseMoved) 0 + set tk::Priv(x) %x + set tk::Priv(y) %y + set tk::Priv(mouseMoved) 0 } } bind Entry { if {!$tk_strictMotif} { - if {abs(%x-$tkPriv(x)) > 2} { - set tkPriv(mouseMoved) 1 + if {abs(%x-$tk::Priv(x)) > 2} { + set tk::Priv(mouseMoved) 1 } %W scan dragto %x } } -# tkEntryClosestGap -- +# ::tk::EntryClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index # of the character just after the boundary. @@ -310,7 +310,7 @@ bind Entry { # w - The entry window. # x - X-coordinate within the window. -proc tkEntryClosestGap {w x} { +proc ::tk::EntryClosestGap {w x} { set pos [$w index @$x] set bbox [$w bbox $pos] if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { @@ -319,7 +319,7 @@ proc tkEntryClosestGap {w x} { incr pos } -# tkEntryButton1 -- +# ::tk::EntryButton1 -- # This procedure is invoked to handle button-1 presses in entry # widgets. It moves the insertion cursor, sets the selection anchor, # and claims the input focus. @@ -328,18 +328,18 @@ proc tkEntryClosestGap {w x} { # w - The entry window in which the button was pressed. # x - The x-coordinate of the button press. -proc tkEntryButton1 {w x} { - global tkPriv +proc ::tk::EntryButton1 {w x} { + variable ::tk::Priv - set tkPriv(selectMode) char - set tkPriv(mouseMoved) 0 - set tkPriv(pressX) $x - $w icursor [tkEntryClosestGap $w $x] + set Priv(selectMode) char + set Priv(mouseMoved) 0 + set Priv(pressX) $x + $w icursor [EntryClosestGap $w $x] $w selection from insert if {[string compare "disabled" [$w cget -state]]} {focus $w} } -# tkEntryMouseSelect -- +# ::tk::EntryMouseSelect -- # This procedure is invoked when dragging out a selection with # the mouse. Depending on the selection mode (character, word, # line) it selects in different-sized units. This procedure @@ -350,17 +350,17 @@ proc tkEntryButton1 {w x} { # w - The entry window in which the button was pressed. # x - The x-coordinate of the mouse. -proc tkEntryMouseSelect {w x} { - global tkPriv +proc ::tk::EntryMouseSelect {w x} { + variable ::tk::Priv - set cur [tkEntryClosestGap $w $x] + set cur [EntryClosestGap $w $x] set anchor [$w index anchor] - if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} { - set tkPriv(mouseMoved) 1 + if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} { + set Priv(mouseMoved) 1 } - switch $tkPriv(selectMode) { + switch $Priv(selectMode) { char { - if {$tkPriv(mouseMoved)} { + if {$Priv(mouseMoved)} { if {$cur < $anchor} { $w selection range $cur $anchor } elseif {$cur > $anchor} { @@ -390,13 +390,13 @@ proc tkEntryMouseSelect {w x} { $w selection range 0 end } } - if {$tkPriv(mouseMoved)} { + if {$Priv(mouseMoved)} { $w icursor $cur } update idletasks } -# tkEntryPaste -- +# ::tk::EntryPaste -- # This procedure sets the insertion cursor to the current mouse position, # pastes the selection there, and sets the focus to the window. # @@ -404,15 +404,13 @@ proc tkEntryMouseSelect {w x} { # w - The entry window. # x - X position of the mouse. -proc tkEntryPaste {w x} { - global tkPriv - - $w icursor [tkEntryClosestGap $w $x] +proc ::tk::EntryPaste {w x} { + $w icursor [EntryClosestGap $w $x] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string compare "disabled" [$w cget -state]]} {focus $w} } -# tkEntryAutoScan -- +# ::tk::EntryAutoScan -- # This procedure is invoked when the mouse leaves an entry window # with button 1 down. It scrolls the window left or right, # depending on where the mouse is, and reschedules itself as an @@ -422,21 +420,21 @@ proc tkEntryPaste {w x} { # Arguments: # w - The entry window. -proc tkEntryAutoScan {w} { - global tkPriv - set x $tkPriv(x) +proc ::tk::EntryAutoScan {w} { + variable ::tk::Priv + set x $Priv(x) if {![winfo exists $w]} return if {$x >= [winfo width $w]} { $w xview scroll 2 units - tkEntryMouseSelect $w $x + EntryMouseSelect $w $x } elseif {$x < 0} { $w xview scroll -2 units - tkEntryMouseSelect $w $x + EntryMouseSelect $w $x } - set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]] + set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]] } -# tkEntryKeySelect -- +# ::tk::EntryKeySelect -- # This procedure is invoked when stroking out selections using the # keyboard. It moves the cursor to a new position, then extends # the selection to that position. @@ -446,7 +444,7 @@ proc tkEntryAutoScan {w} { # new - A new position for the insertion cursor (the cursor hasn't # actually been moved to this position yet). -proc tkEntryKeySelect {w new} { +proc ::tk::EntryKeySelect {w new} { if {![$w selection present]} { $w selection from insert $w selection to $new @@ -456,7 +454,7 @@ proc tkEntryKeySelect {w new} { $w icursor $new } -# tkEntryInsert -- +# ::tk::EntryInsert -- # Insert a string into an entry at the point of the insertion cursor. # If there is a selection in the entry, and it covers the point of the # insertion cursor, then delete the selection before inserting. @@ -465,7 +463,7 @@ proc tkEntryKeySelect {w new} { # w - The entry window in which to insert the string # s - The string to insert (usually just a single character) -proc tkEntryInsert {w s} { +proc ::tk::EntryInsert {w s} { if {[string equal $s ""]} { return } @@ -477,10 +475,10 @@ proc tkEntryInsert {w s} { } } $w insert insert $s - tkEntrySeeInsert $w + EntrySeeInsert $w } -# tkEntryBackspace -- +# ::tk::EntryBackspace -- # Backspace over the character just before the insertion cursor. # If backspacing would move the cursor off the left edge of the # window, reposition the cursor at about the middle of the window. @@ -488,7 +486,7 @@ proc tkEntryInsert {w s} { # Arguments: # w - The entry window in which to backspace. -proc tkEntryBackspace w { +proc ::tk::EntryBackspace w { if {[$w selection present]} { $w delete sel.first sel.last } else { @@ -503,21 +501,21 @@ proc tkEntryBackspace w { } } -# tkEntrySeeInsert -- +# ::tk::EntrySeeInsert -- # Make sure that the insertion cursor is visible in the entry window. # If not, adjust the view so that it is. # # Arguments: # w - The entry window. -proc tkEntrySeeInsert w { +proc ::tk::EntrySeeInsert w { set c [$w index insert] if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} { $w xview $c } } -# tkEntrySetCursor - +# ::tk::EntrySetCursor - # Move the insertion cursor to a given position in an entry. Also # clears the selection, if there is one in the entry, and makes sure # that the insertion cursor is visible. @@ -526,13 +524,13 @@ proc tkEntrySeeInsert w { # w - The entry window. # pos - The desired new position for the cursor in the window. -proc tkEntrySetCursor {w pos} { +proc ::tk::EntrySetCursor {w pos} { $w icursor $pos $w selection clear - tkEntrySeeInsert $w + EntrySeeInsert $w } -# tkEntryTranspose - +# ::tk::EntryTranspose - # This procedure implements the "transpose" function for entry widgets. # It tranposes the characters on either side of the insertion cursor, # unless the cursor is at the end of the line. In this case it @@ -542,7 +540,7 @@ proc tkEntrySetCursor {w pos} { # Arguments: # w - The entry window. -proc tkEntryTranspose w { +proc ::tk::EntryTranspose w { set i [$w index insert] if {$i < [$w index end]} { incr i @@ -554,10 +552,10 @@ proc tkEntryTranspose w { set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first] $w delete $first $i $w insert insert $new - tkEntrySeeInsert $w + EntrySeeInsert $w } -# tkEntryNextWord -- +# ::tk::EntryNextWord -- # Returns the index of the next word position after a given position in the # entry. The next word is platform dependent and may be either the next # end-of-word position or the next start-of-word position after the next @@ -568,7 +566,7 @@ proc tkEntryTranspose w { # start - Position at which to start search. if {[string equal $tcl_platform(platform) "windows"]} { - proc tkEntryNextWord {w start} { + proc ::tk::EntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] if {$pos >= 0} { set pos [tcl_startOfNextWord [$w get] $pos] @@ -579,7 +577,7 @@ if {[string equal $tcl_platform(platform) "windows"]} { return $pos } } else { - proc tkEntryNextWord {w start} { + proc ::tk::EntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] if {$pos < 0} { return end @@ -588,7 +586,7 @@ if {[string equal $tcl_platform(platform) "windows"]} { } } -# tkEntryPreviousWord -- +# ::tk::EntryPreviousWord -- # # Returns the index of the previous word position before a given # position in the entry. @@ -597,21 +595,21 @@ if {[string equal $tcl_platform(platform) "windows"]} { # w - The entry window in which the cursor is to move. # start - Position at which to start search. -proc tkEntryPreviousWord {w start} { +proc ::tk::EntryPreviousWord {w start} { set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] if {$pos < 0} { return 0 } return $pos } -# tkEntryGetSelection -- +# ::tk::EntryGetSelection -- # # Returns the selected text of the entry with respect to the -show option. # # Arguments: # w - The entry window from which the text to get -proc tkEntryGetSelection {w} { +proc ::tk::EntryGetSelection {w} { set entryString [string range [$w get] [$w index sel.first] \ [expr {[$w index sel.last] - 1}]] if {[string compare [$w cget -show] ""]} { diff --git a/library/focus.tcl b/library/focus.tcl index 9a03ea1..75bf410 100644 --- a/library/focus.tcl +++ b/library/focus.tcl @@ -3,7 +3,7 @@ # This file defines several procedures for managing the input # focus. # -# RCS: @(#) $Id: focus.tcl,v 1.8 2000/05/09 17:28:31 hobbs Exp $ +# RCS: @(#) $Id: focus.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994-1995 Sun Microsystems, Inc. # @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# tk_focusNext -- +# ::tk_focusNext -- # This procedure returns the name of the next window after "w" in # "focus order" (the window that should receive the focus next if # Tab is typed in w). "Next" is defined by a pre-order search @@ -22,7 +22,7 @@ # Arguments: # w - Name of a window. -proc tk_focusNext w { +proc ::tk_focusNext w { set cur $w while {1} { @@ -57,13 +57,13 @@ proc tk_focusNext w { set children [winfo children $parent] set i [lsearch -exact $children $cur] } - if {[string equal $w $cur] || [tkFocusOK $cur]} { + if {[string equal $w $cur] || [tk::FocusOK $cur]} { return $cur } } } -# tk_focusPrev -- +# ::tk_focusPrev -- # This procedure returns the name of the previous window before "w" in # "focus order" (the window that should receive the focus next if # Shift-Tab is typed in w). "Next" is defined by a pre-order search @@ -74,7 +74,7 @@ proc tk_focusNext w { # Arguments: # w - Name of a window. -proc tk_focusPrev w { +proc ::tk_focusPrev w { set cur $w while {1} { @@ -108,13 +108,13 @@ proc tk_focusPrev w { set i [llength $children] } set cur $parent - if {[string equal $w $cur] || [tkFocusOK $cur]} { + if {[string equal $w $cur] || [tk::FocusOK $cur]} { return $cur } } } -# tkFocusOK -- +# ::tk::FocusOK -- # # This procedure is invoked to decide whether or not to focus on # a given window. It returns 1 if it's OK to focus on the window, @@ -128,7 +128,7 @@ proc tk_focusPrev w { # Arguments: # w - Name of a window. -proc tkFocusOK w { +proc ::tk::FocusOK w { set code [catch {$w cget -takefocus} value] if {($code == 0) && ($value != "")} { if {$value == 0} { @@ -152,7 +152,7 @@ proc tkFocusOK w { regexp Key|Focus "[bind $w] [bind [winfo class $w]]" } -# tk_focusFollowsMouse -- +# ::tk_focusFollowsMouse -- # # If this procedure is invoked, Tk will enter "focus-follows-mouse" # mode, where the focus is always on whatever window contains the @@ -162,13 +162,13 @@ proc tkFocusOK w { # Arguments: # None. -proc tk_focusFollowsMouse {} { +proc ::tk_focusFollowsMouse {} { set old [bind all ] set script { if {[string equal "%d" "NotifyAncestor"] \ || [string equal "%d" "NotifyNonlinear"] \ || [string equal "%d" "NotifyInferior"]} { - if {[tkFocusOK %W]} { + if {[tk::FocusOK %W]} { focus %W } } diff --git a/library/listbox.tcl b/library/listbox.tcl index 41b3d7a..6a51b66 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk listbox widgets # and provides procedures that help in implementing those bindings. # -# RCS: @(#) $Id: listbox.tcl,v 1.11 2000/03/24 19:38:57 ericm Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.12 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. @@ -13,7 +13,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #-------------------------------------------------------------------------- -# tkPriv elements used in this file: +# tk::Priv elements used in this file: # # afterId - Token returned by "after" for autoscanning. # listboxPrev - The last element to be selected or deselected @@ -35,7 +35,7 @@ bind Listbox <1> { if {[winfo exists %W]} { - tkListboxBeginSelect %W [%W index @%x,%y] + tk::ListboxBeginSelect %W [%W index @%x,%y] } } @@ -48,40 +48,40 @@ bind Listbox { } bind Listbox { - set tkPriv(x) %x - set tkPriv(y) %y - tkListboxMotion %W [%W index @%x,%y] + set tk::Priv(x) %x + set tk::Priv(y) %y + tk::ListboxMotion %W [%W index @%x,%y] } bind Listbox { - tkCancelRepeat + tk::CancelRepeat %W activate @%x,%y } bind Listbox { - tkListboxBeginExtend %W [%W index @%x,%y] + tk::ListboxBeginExtend %W [%W index @%x,%y] } bind Listbox { - tkListboxBeginToggle %W [%W index @%x,%y] + tk::ListboxBeginToggle %W [%W index @%x,%y] } bind Listbox { - set tkPriv(x) %x - set tkPriv(y) %y - tkListboxAutoScan %W + set tk::Priv(x) %x + set tk::Priv(y) %y + tk::ListboxAutoScan %W } bind Listbox { - tkCancelRepeat + tk::CancelRepeat } bind Listbox { - tkListboxUpDown %W -1 + tk::ListboxUpDown %W -1 } bind Listbox { - tkListboxExtendUpDown %W -1 + tk::ListboxExtendUpDown %W -1 } bind Listbox { - tkListboxUpDown %W 1 + tk::ListboxUpDown %W 1 } bind Listbox { - tkListboxExtendUpDown %W 1 + tk::ListboxExtendUpDown %W 1 } bind Listbox { %W xview scroll -1 units @@ -123,7 +123,7 @@ bind Listbox { event generate %W <> } bind Listbox { - tkListboxDataExtend %W 0 + tk::ListboxDataExtend %W 0 } bind Listbox { %W activate end @@ -133,7 +133,7 @@ bind Listbox { event generate %W <> } bind Listbox { - tkListboxDataExtend %W [%W index end] + tk::ListboxDataExtend %W [%W index end] } bind Listbox <> { if {[string equal [selection own -displayof %W] "%W"]} { @@ -142,22 +142,22 @@ bind Listbox <> { } } bind Listbox { - tkListboxBeginSelect %W [%W index active] + tk::ListboxBeginSelect %W [%W index active] } bind Listbox { %W mark set anchor insert } bind Text { - set tkPriv(selectMode) char - tkTextKeyExtend %W insert + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert } bind Text { - set tkPriv(selectMode) char - tkTextKeyExtend %W insert + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert } bind Text { %W tag add sel 1.0 end @@ -255,15 +255,15 @@ bind Text <> { catch {%W delete sel.first sel.last} } bind Text <> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { - tkTextPaste %W %x %y + if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + tk::TextPaste %W %x %y } } bind Text { - catch {tkTextInsert %W [::tk::GetSelection %W PRIMARY]} + catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} } bind Text { - tkTextInsert %W %A + tk::TextInsert %W %A } # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. @@ -284,12 +284,12 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W {insert linestart} + tk::TextSetCursor %W {insert linestart} } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W insert-1c + tk::TextSetCursor %W insert-1c } } bind Text { @@ -299,12 +299,12 @@ bind Text { } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W {insert lineend} + tk::TextSetCursor %W {insert lineend} } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W insert+1c + tk::TextSetCursor %W insert+1c } } bind Text { @@ -318,7 +318,7 @@ bind Text { } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextUpDownLine %W 1] + tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } } bind Text { @@ -329,56 +329,56 @@ bind Text { } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextUpDownLine %W -1] + tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } } bind Text { if {!$tk_strictMotif} { - tkTextTranspose %W + tk::TextTranspose %W } } if {[string compare $tcl_platform(platform) "windows"]} { bind Text { if {!$tk_strictMotif} { - tkTextScrollPages %W 1 + tk::TextScrollPages %W 1 } } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } } bind Text { if {!$tk_strictMotif} { - %W delete insert [tkTextNextWord %W insert] + %W delete insert [tk::TextNextWord %W insert] } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextNextWord %W insert] + tk::TextSetCursor %W [tk::TextNextWord %W insert] } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W 1.0 + tk::TextSetCursor %W 1.0 } } bind Text { if {!$tk_strictMotif} { - tkTextSetCursor %W end-1c + tk::TextSetCursor %W end-1c } } bind Text { if {!$tk_strictMotif} { - %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert } } bind Text { if {!$tk_strictMotif} { - %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert } } @@ -395,28 +395,28 @@ bind Text { %W configure -selectbackground white -selectforeground black } bind Text { - tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text { - tkTextSetCursor %W [tkTextNextWord %W insert] + tk::TextSetCursor %W [tk::TextNextWord %W insert] } bind Text { - tkTextSetCursor %W [tkTextPrevPara %W insert] + tk::TextSetCursor %W [tk::TextPrevPara %W insert] } bind Text { - tkTextSetCursor %W [tkTextNextPara %W insert] + tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text { - tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text { - tkTextKeySelect %W [tkTextNextWord %W insert] + tk::TextKeySelect %W [tk::TextNextWord %W insert] } bind Text { - tkTextKeySelect %W [tkTextPrevPara %W insert] + tk::TextKeySelect %W [tk::TextPrevPara %W insert] } bind Text { - tkTextKeySelect %W [tkTextNextPara %W insert] + tk::TextKeySelect %W [tk::TextNextPara %W insert] } # End of Mac only bindings @@ -435,22 +435,22 @@ bind Text { bind Text <2> { if {!$tk_strictMotif} { %W scan mark %x %y - set tkPriv(x) %x - set tkPriv(y) %y - set tkPriv(mouseMoved) 0 + set tk::Priv(x) %x + set tk::Priv(y) %y + set tk::Priv(mouseMoved) 0 } } bind Text { if {!$tk_strictMotif} { - if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { - set tkPriv(mouseMoved) 1 + if {(%x != $tk::Priv(x)) || (%y != $tk::Priv(y))} { + set tk::Priv(mouseMoved) 1 } - if {$tkPriv(mouseMoved)} { + if {$tk::Priv(mouseMoved)} { %W scan dragto %x %y } } } -set tkPriv(prevPos) {} +set ::tk::Priv(prevPos) {} # The MouseWheel will typically only fire on Windows. However, # someone could use the "event generate" command to produce one @@ -477,7 +477,7 @@ if {[string equal "unix" $tcl_platform(platform)]} { } } -# tkTextClosestGap -- +# ::tk::TextClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index # of the character just after the boundary. @@ -487,7 +487,7 @@ if {[string equal "unix" $tcl_platform(platform)]} { # x - X-coordinate within the window. # y - Y-coordinate within the window. -proc tkTextClosestGap {w x y} { +proc ::tk::TextClosestGap {w x y} { set pos [$w index @$x,$y] set bbox [$w bbox $pos] if {[string equal $bbox ""]} { @@ -499,7 +499,7 @@ proc tkTextClosestGap {w x y} { $w index "$pos + 1 char" } -# tkTextButton1 -- +# ::tk::TextButton1 -- # This procedure is invoked to handle button-1 presses in text # widgets. It moves the insertion cursor, sets the selection anchor, # and claims the input focus. @@ -509,18 +509,18 @@ proc tkTextClosestGap {w x y} { # x - The x-coordinate of the button press. # y - The x-coordinate of the button press. -proc tkTextButton1 {w x y} { - global tkPriv +proc ::tk::TextButton1 {w x y} { + variable ::tk::Priv - set tkPriv(selectMode) char - set tkPriv(mouseMoved) 0 - set tkPriv(pressX) $x - $w mark set insert [tkTextClosestGap $w $x $y] + set Priv(selectMode) char + set Priv(mouseMoved) 0 + set Priv(pressX) $x + $w mark set insert [TextClosestGap $w $x $y] $w mark set anchor insert if {[string equal [$w cget -state] "normal"]} {focus $w} } -# tkTextSelectTo -- +# ::tk::TextSelectTo -- # This procedure is invoked to extend the selection, typically when # dragging it with the mouse. Depending on the selection mode (character, # word, line) it selects in different-sized units. This procedure @@ -532,18 +532,19 @@ proc tkTextButton1 {w x y} { # x - Mouse x position. # y - Mouse y position. -proc tkTextSelectTo {w x y {extend 0}} { - global tkPriv tcl_platform +proc ::tk::TextSelectTo {w x y {extend 0}} { + global tcl_platform + variable ::tk::Priv - set cur [tkTextClosestGap $w $x $y] + set cur [TextClosestGap $w $x $y] if {[catch {$w index anchor}]} { $w mark set anchor $cur } set anchor [$w index anchor] - if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} { - set tkPriv(mouseMoved) 1 + if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} { + set Priv(mouseMoved) 1 } - switch $tkPriv(selectMode) { + switch $Priv(selectMode) { char { if {[$w compare $cur < anchor]} { set first $cur @@ -555,16 +556,16 @@ proc tkTextSelectTo {w x y {extend 0}} { } word { if {[$w compare $cur < anchor]} { - set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore] + set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore] if { !$extend } { - set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter] + set last [TextNextPos $w "anchor" tcl_wordBreakAfter] } else { set last anchor } } else { - set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter] + set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter] if { !$extend } { - set first [tkTextPrevPos $w anchor tcl_wordBreakBefore] + set first [TextPrevPos $w anchor tcl_wordBreakBefore] } else { set first anchor } @@ -580,7 +581,7 @@ proc tkTextSelectTo {w x y {extend 0}} { } } } - if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} { + if {$Priv(mouseMoved) || [string compare $Priv(selectMode) "char"]} { $w tag remove sel 0.0 end $w mark set insert $cur $w tag add sel $first $last @@ -588,7 +589,7 @@ proc tkTextSelectTo {w x y {extend 0}} { } } -# tkTextKeyExtend -- +# ::tk::TextKeyExtend -- # This procedure handles extending the selection from the keyboard, # where the point to extend to is really the boundary between two # characters rather than a particular character. @@ -597,8 +598,7 @@ proc tkTextSelectTo {w x y {extend 0}} { # w - The text window. # index - The point to which the selection is to be extended. -proc tkTextKeyExtend {w index} { - global tkPriv +proc ::tk::TextKeyExtend {w index} { set cur [$w index $index] if {[catch {$w index anchor}]} { @@ -617,7 +617,7 @@ proc tkTextKeyExtend {w index} { $w tag remove sel $last end } -# tkTextPaste -- +# ::tk::TextPaste -- # This procedure sets the insertion cursor to the mouse position, # inserts the selection, and sets the focus to the window. # @@ -625,42 +625,42 @@ proc tkTextKeyExtend {w index} { # w - The text window. # x, y - Position of the mouse. -proc tkTextPaste {w x y} { - $w mark set insert [tkTextClosestGap $w $x $y] +proc ::tk::TextPaste {w x y} { + $w mark set insert [TextClosestGap $w $x $y] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal [$w cget -state] "normal"]} {focus $w} } -# tkTextAutoScan -- +# ::tk::TextAutoScan -- # This procedure is invoked when the mouse leaves a text window # with button 1 down. It scrolls the window up, down, left, or right, # depending on where the mouse is (this information was saved in -# tkPriv(x) and tkPriv(y)), and reschedules itself as an "after" +# ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after" # command so that the window continues to scroll until the mouse # moves back into the window or the mouse button is released. # # Arguments: # w - The text window. -proc tkTextAutoScan {w} { - global tkPriv +proc ::tk::TextAutoScan {w} { + variable ::tk::Priv if {![winfo exists $w]} return - if {$tkPriv(y) >= [winfo height $w]} { + if {$Priv(y) >= [winfo height $w]} { $w yview scroll 2 units - } elseif {$tkPriv(y) < 0} { + } elseif {$Priv(y) < 0} { $w yview scroll -2 units - } elseif {$tkPriv(x) >= [winfo width $w]} { + } elseif {$Priv(x) >= [winfo width $w]} { $w xview scroll 2 units - } elseif {$tkPriv(x) < 0} { + } elseif {$Priv(x) < 0} { $w xview scroll -2 units } else { return } - tkTextSelectTo $w $tkPriv(x) $tkPriv(y) - set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]] + TextSelectTo $w $Priv(x) $Priv(y) + set Priv(afterId) [after 50 [list tk::TextAutoScan $w]] } -# tkTextSetCursor +# ::tk::TextSetCursor # Move the insertion cursor to a given position in a text. Also # clears the selection, if there is one in the text, and makes sure # that the insertion cursor is visible. Also, don't let the insertion @@ -670,8 +670,7 @@ proc tkTextAutoScan {w} { # w - The text window. # pos - The desired new position for the cursor in the window. -proc tkTextSetCursor {w pos} { - global tkPriv +proc ::tk::TextSetCursor {w pos} { if {[$w compare $pos == end]} { set pos {end - 1 chars} @@ -681,7 +680,7 @@ proc tkTextSetCursor {w pos} { $w see insert } -# tkTextKeySelect +# ::tk::TextKeySelect # This procedure is invoked when stroking out selections using the # keyboard. It moves the cursor to a new position, then extends # the selection to that position. @@ -691,8 +690,7 @@ proc tkTextSetCursor {w pos} { # new - A new position for the insertion cursor (the cursor hasn't # actually been moved to this position yet). -proc tkTextKeySelect {w new} { - global tkPriv +proc ::tk::TextKeySelect {w new} { if {[string equal [$w tag nextrange sel 1.0 end] ""]} { if {[$w compare $new < insert]} { @@ -718,7 +716,7 @@ proc tkTextKeySelect {w new} { update idletasks } -# tkTextResetAnchor -- +# ::tk::TextResetAnchor -- # Set the selection anchor to whichever end is farthest from the # index argument. One special trick: if the selection has two or # fewer characters, just leave the anchor where it is. In this @@ -732,8 +730,7 @@ proc tkTextKeySelect {w new} { # index - Position at which mouse button was pressed, which determines # which end of selection should be used as anchor point. -proc tkTextResetAnchor {w index} { - global tkPriv +proc ::tk::TextResetAnchor {w index} { if {[string equal [$w tag ranges sel] ""]} { # Don't move the anchor if there is no selection now; this makes @@ -775,7 +772,7 @@ proc tkTextResetAnchor {w index} { } } -# tkTextInsert -- +# ::tk::TextInsert -- # Insert a string into a text at the point of the insertion cursor. # If there is a selection in the text, and it covers the point of the # insertion cursor, then delete the selection before inserting. @@ -784,7 +781,7 @@ proc tkTextResetAnchor {w index} { # w - The text window in which to insert the string # s - The string to insert (usually just a single character) -proc tkTextInsert {w s} { +proc ::tk::TextInsert {w s} { if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} { return } @@ -798,7 +795,7 @@ proc tkTextInsert {w s} { $w see insert } -# tkTextUpDownLine -- +# ::tk::TextUpDownLine -- # Returns the index of the character one line above or below the # insertion cursor. There are two tricky things here. First, # we want to maintain the original column across repeated operations, @@ -811,23 +808,23 @@ proc tkTextInsert {w s} { # n - The number of lines to move: -1 for up one line, # +1 for down one line. -proc tkTextUpDownLine {w n} { - global tkPriv +proc ::tk::TextUpDownLine {w n} { + variable ::tk::Priv set i [$w index insert] scan $i "%d.%d" line char - if {[string compare $tkPriv(prevPos) $i]} { - set tkPriv(char) $char + if {[string compare $Priv(prevPos) $i]} { + set Priv(char) $char } - set new [$w index [expr {$line + $n}].$tkPriv(char)] + set new [$w index [expr {$line + $n}].$Priv(char)] if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} { set new $i } - set tkPriv(prevPos) $new + set Priv(prevPos) $new return $new } -# tkTextPrevPara -- +# ::tk::TextPrevPara -- # Returns the index of the beginning of the paragraph just before a given # position in the text (the beginning of a paragraph is the first non-blank # character after a blank line). @@ -836,7 +833,7 @@ proc tkTextUpDownLine {w n} { # w - The text window in which the cursor is to move. # pos - Position at which to start search. -proc tkTextPrevPara {w pos} { +proc ::tk::TextPrevPara {w pos} { set pos [$w index "$pos linestart"] while {1} { if {([string equal [$w get "$pos - 1 line"] "\n"] \ @@ -854,7 +851,7 @@ proc tkTextPrevPara {w pos} { } } -# tkTextNextPara -- +# ::tk::TextNextPara -- # Returns the index of the beginning of the paragraph just after a given # position in the text (the beginning of a paragraph is the first non-blank # character after a blank line). @@ -863,7 +860,7 @@ proc tkTextPrevPara {w pos} { # w - The text window in which the cursor is to move. # start - Position at which to start search. -proc tkTextNextPara {w start} { +proc ::tk::TextNextPara {w start} { set pos [$w index "$start linestart + 1 line"] while {[string compare [$w get $pos] "\n"]} { if {[$w compare $pos == end]} { @@ -884,7 +881,7 @@ proc tkTextNextPara {w start} { return $pos } -# tkTextScrollPages -- +# ::tk::TextScrollPages -- # This is a utility procedure used in bindings for moving up and down # pages and possibly extending the selection along the way. It scrolls # the view in the widget by the number of pages, and it returns the @@ -896,7 +893,7 @@ proc tkTextNextPara {w start} { # count - Number of pages forward to scroll; may be negative # to scroll backwards. -proc tkTextScrollPages {w count} { +proc ::tk::TextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages if {[string equal $bbox ""]} { @@ -905,7 +902,7 @@ proc tkTextScrollPages {w count} { return [$w index @[lindex $bbox 0],[lindex $bbox 1]] } -# tkTextTranspose -- +# ::tk::TextTranspose -- # This procedure implements the "transpose" function for text widgets. # It tranposes the characters on either side of the insertion cursor, # unless the cursor is at the end of the line. In this case it @@ -915,7 +912,7 @@ proc tkTextScrollPages {w count} { # Arguments: # w - Text window in which to transpose. -proc tkTextTranspose w { +proc ::tk::TextTranspose w { set pos insert if {[$w compare $pos != "$pos lineend"]} { set pos [$w index "$pos + 1 char"] @@ -929,21 +926,21 @@ proc tkTextTranspose w { $w see insert } -# tk_textCopy -- +# ::tk_textCopy -- # This procedure copies the selection from a text widget into the # clipboard. # # Arguments: # w - Name of a text widget. -proc tk_textCopy w { +proc ::tk_textCopy w { if {![catch {set data [$w get sel.first sel.last]}]} { clipboard clear -displayof $w clipboard append -displayof $w $data } } -# tk_textCut -- +# ::tk_textCut -- # This procedure copies the selection from a text widget into the # clipboard, then deletes the selection (if it exists in the given # widget). @@ -951,7 +948,7 @@ proc tk_textCopy w { # Arguments: # w - Name of a text widget. -proc tk_textCut w { +proc ::tk_textCut w { if {![catch {set data [$w get sel.first sel.last]}]} { clipboard clear -displayof $w clipboard append -displayof $w $data @@ -959,14 +956,14 @@ proc tk_textCut w { } } -# tk_textPaste -- +# ::tk_textPaste -- # This procedure pastes the contents of the clipboard to the insertion # point in a text widget. # # Arguments: # w - Name of a text widget. -proc tk_textPaste w { +proc ::tk_textPaste w { global tcl_platform catch { if {[string compare $tcl_platform(platform) "unix"]} { @@ -978,7 +975,7 @@ proc tk_textPaste w { } } -# tkTextNextWord -- +# ::tk::TextNextWord -- # Returns the index of the next word position after a given position in the # text. The next word is platform dependent and may be either the next # end-of-word position or the next start-of-word position after the next @@ -989,17 +986,17 @@ proc tk_textPaste w { # start - Position at which to start search. if {[string equal $tcl_platform(platform) "windows"]} { - proc tkTextNextWord {w start} { - tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \ + proc ::tk::TextNextWord {w start} { + TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ tcl_startOfNextWord } } else { - proc tkTextNextWord {w start} { - tkTextNextPos $w $start tcl_endOfWord + proc ::tk::TextNextWord {w start} { + TextNextPos $w $start tcl_endOfWord } } -# tkTextNextPos -- +# ::tk::TextNextPos -- # Returns the index of the next position after the given starting # position in the text as computed by a specified function. # @@ -1008,7 +1005,7 @@ if {[string equal $tcl_platform(platform) "windows"]} { # start - Position at which to start search. # op - Function to use to find next position. -proc tkTextNextPos {w start op} { +proc ::tk::TextNextPos {w start op} { set text "" set cur $start while {[$w compare $cur < end]} { @@ -1028,7 +1025,7 @@ proc tkTextNextPos {w start op} { return end } -# tkTextPrevPos -- +# ::tk::TextPrevPos -- # Returns the index of the previous position before the given starting # position in the text as computed by a specified function. # @@ -1037,7 +1034,7 @@ proc tkTextNextPos {w start op} { # start - Position at which to start search. # op - Function to use to find next position. -proc tkTextPrevPos {w start op} { +proc ::tk::TextPrevPos {w start op} { set text "" set cur $start while {[$w compare $cur > 0.0]} { diff --git a/library/tk.tcl b/library/tk.tcl index 64afbe7..102ac4c 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.30 2001/07/03 01:03:16 hobbs Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.31 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -24,14 +24,14 @@ if { ![interp issafe] } { # Add Tk's directory to the end of the auto-load search path, if it # isn't already on the path: -if {[info exists auto_path] && [string compare {} $tk_library] && \ - [lsearch -exact $auto_path $tk_library] < 0} { - lappend auto_path $tk_library +if {[info exists ::auto_path] && [string compare {} $::tk_library] && \ + [lsearch -exact $::auto_path $::tk_library] < 0} { + lappend ::auto_path $::tk_library } # Turn off strict Motif look and feel as a default. -set tk_strictMotif 0 +set ::tk_strictMotif 0 # Turn on useinputmethods (X Input Methods) by default. # We catch this because safe interpreters may not allow the call. @@ -183,17 +183,17 @@ if {[string equal $tcl_platform(platform) "unix"]} { } } -# tkScreenChanged -- +# ::tk::ScreenChanged -- # This procedure is invoked by the binding mechanism whenever the # "current" screen is changing. The procedure does two things. -# First, it uses "upvar" to make global variable "tkPriv" point at an +# First, it uses "upvar" to make variable "::tk::Priv" point at an # array variable that holds state for the current display. Second, # it initializes the array if it didn't already exist. # # Arguments: # screen - The name of the new screen. -proc tkScreenChanged screen { +proc ::tk::ScreenChanged screen { set x [string last . $screen] if {$x > 0} { set disp [string range $screen 0 [expr {$x - 1}]] @@ -201,15 +201,15 @@ proc tkScreenChanged screen { set disp $screen } - uplevel #0 upvar #0 tkPriv.$disp tkPriv - global tkPriv + uplevel #0 upvar #0 ::tk::Priv.$disp ::tk::Priv + variable ::tk::Priv global tcl_platform - if {[info exists tkPriv]} { - set tkPriv(screen) $screen + if {[info exists Priv]} { + set Priv(screen) $screen return } - array set tkPriv { + array set Priv { activeMenu {} activeItem {} afterId {} @@ -231,26 +231,26 @@ proc tkScreenChanged screen { prevPos 0 selectMode char } - set tkPriv(screen) $screen - set tkPriv(tearoff) [string equal $tcl_platform(platform) "unix"] - set tkPriv(window) {} + set Priv(screen) $screen + set Priv(tearoff) [string equal $tcl_platform(platform) "unix"] + set Priv(window) {} } -# Do initial setup for tkPriv, so that it is always bound to something +# Do initial setup for Priv, so that it is always bound to something # (otherwise, if someone references it, it may get set to a non-upvar-ed # value, which will cause trouble later). -tkScreenChanged [winfo screen .] +tk::ScreenChanged [winfo screen .] -# tkEventMotifBindings -- -# This procedure is invoked as a trace whenever tk_strictMotif is +# ::tk::EventMotifBindings -- +# This procedure is invoked as a trace whenever ::tk_strictMotif is # changed. It is used to turn on or turn off the motif virtual # bindings. # # Arguments: -# n1 - the name of the variable being changed ("tk_strictMotif"). +# n1 - the name of the variable being changed ("::tk_strictMotif"). -proc tkEventMotifBindings {n1 dummy dummy} { +proc ::tk::EventMotifBindings {n1 dummy dummy} { upvar $n1 name if {$name} { @@ -270,36 +270,36 @@ proc tkEventMotifBindings {n1 dummy dummy} { #---------------------------------------------------------------------- if {[string equal [info commands tk_chooseColor] ""]} { - proc tk_chooseColor {args} { - return [eval tkColorDialog $args] + proc ::tk_chooseColor {args} { + return [eval tk::dialog::color:: $args] } } if {[string equal [info commands tk_getOpenFile] ""]} { - proc tk_getOpenFile {args} { + proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - return [eval tkMotifFDialog open $args] + return [eval tk::MotifFDialog open $args] } else { - return [eval ::tk::dialog::file::tkFDialog open $args] + return [eval ::tk::dialog::file:: open $args] } } } if {[string equal [info commands tk_getSaveFile] ""]} { - proc tk_getSaveFile {args} { + proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - return [eval tkMotifFDialog save $args] + return [eval tk::MotifFDialog save $args] } else { - return [eval ::tk::dialog::file::tkFDialog save $args] + return [eval ::tk::dialog::file:: save $args] } } } if {[string equal [info commands tk_messageBox] ""]} { - proc tk_messageBox {args} { - return [eval tkMessageBox $args] + proc ::tk_messageBox {args} { + return [eval tk::MessageBox $args] } } if {[string equal [info command tk_chooseDirectory] ""]} { - proc tk_chooseDirectory {args} { - return [eval ::tk::dialog::file::chooseDir::tkChooseDirectory $args] + proc ::tk_chooseDirectory {args} { + return [eval ::tk::dialog::file::chooseDir:: $args] } } @@ -307,7 +307,7 @@ if {[string equal [info command tk_chooseDirectory] ""]} { # Define the set of common virtual events. #---------------------------------------------------------------------- -switch $tcl_platform(platform) { +switch $::tcl_platform(platform) { "unix" { event add <> event add <> @@ -329,8 +329,8 @@ switch $tcl_platform(platform) { } } } - trace variable tk_strictMotif w tkEventMotifBindings - set tk_strictMotif $tk_strictMotif + trace variable ::tk_strictMotif w ::tk::EventMotifBindings + set ::tk_strictMotif $::tk_strictMotif } "windows" { event add <> @@ -349,51 +349,53 @@ switch $tcl_platform(platform) { # ---------------------------------------------------------------------- # Read in files that define all of the class bindings. # ---------------------------------------------------------------------- -if {[string compare $tcl_platform(platform) "macintosh"] && \ - [string compare {} $tk_library]} { - source [file join $tk_library button.tcl] - source [file join $tk_library entry.tcl] - source [file join $tk_library listbox.tcl] - source [file join $tk_library menu.tcl] - source [file join $tk_library scale.tcl] - source [file join $tk_library scrlbar.tcl] - source [file join $tk_library spinbox.tcl] - source [file join $tk_library text.tcl] + +if {[string compare $::tcl_platform(platform) "macintosh"] && \ + [string compare {} $::tk_library]} { + source [file join $::tk_library button.tcl] + source [file join $::tk_library entry.tcl] + source [file join $::tk_library listbox.tcl] + source [file join $::tk_library menu.tcl] + source [file join $::tk_library scale.tcl] + source [file join $::tk_library scrlbar.tcl] + source [file join $::tk_library spinbox.tcl] + source [file join $::tk_library text.tcl] } # ---------------------------------------------------------------------- # Default bindings for keyboard traversal. # ---------------------------------------------------------------------- event add <> -bind all {tkTabToWindow [tk_focusNext %W]} -bind all <> {tkTabToWindow [tk_focusPrev %W]} +bind all {tk::TabToWindow [tk_focusNext %W]} +bind all <> {tk::TabToWindow [tk_focusPrev %W]} -# tkCancelRepeat -- +# ::tk::CancelRepeat -- # This procedure is invoked to cancel an auto-repeat action described -# by tkPriv(afterId). It's used by several widgets to auto-scroll +# by ::tk::Priv(afterId). It's used by several widgets to auto-scroll # the widget when the mouse is dragged out of the widget with a # button pressed. # # Arguments: # None. -proc tkCancelRepeat {} { - global tkPriv - after cancel $tkPriv(afterId) - set tkPriv(afterId) {} +proc ::tk::CancelRepeat {} { + variable ::tk::Priv + after cancel $Priv(afterId) + set Priv(afterId) {} } -# tkTabToWindow -- +# ::tk::TabToWindow -- # This procedure moves the focus to the given widget. If the widget # is an entry, it selects the entire contents of the widget. # # Arguments: # w - Window to which focus should be set. -proc tkTabToWindow {w} { +proc ::tk::TabToWindow {w} { if {[string equal [winfo class $w] Entry]} { $w selection range 0 end $w icursor end } focus $w } + diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 00af406..6d1f013 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -7,11 +7,11 @@ # The "TK" standard file selection dialog box is similar to the # file selection dialog box on Win95(TM). The user can navigate # the directories by clicking on the folder icons or by -# selectinf the "Directory" option menu. The user can select +# selecting the "Directory" option menu. The user can select # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.26 2001/07/19 20:15:55 drh Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.27 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -24,24 +24,22 @@ # I C O N L I S T # # This is a pseudo-widget that implements the icon list inside the -# tkFDialog dialog box. +# ::tk::dialog::file:: dialog box. # #---------------------------------------------------------------------- -# tkIconList -- +# ::tk::IconList -- # # Creates an IconList widget. # -proc tkIconList {w args} { - upvar #0 $w data - - tkIconList_Config $w $args - tkIconList_Create $w +proc ::tk::IconList {w args} { + IconList_Config $w $args + IconList_Create $w } -proc tkIconList_Index {w i} { - upvar #0 $w data - upvar #0 $w:itemList itemList +proc ::tk::IconList_Index {w i} { + upvar #0 ::tk::$w data + upvar #0 ::tk::$w:itemList itemList if {![info exists data(list)]} {set data(list) {}} switch -regexp -- $i { "^-?[0-9]+$" { @@ -72,12 +70,12 @@ proc tkIconList_Index {w i} { } } -proc tkIconList_Selection {w op args} { - upvar #0 $w data +proc ::tk::IconList_Selection {w op args} { + upvar ::tk::$w data switch -exact -- $op { "anchor" { if { [llength $args] == 1 } { - set data(index,anchor) [tkIconList_Index $w [lindex $args 0]] + set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]] } else { return $data(index,anchor) } @@ -90,11 +88,11 @@ proc tkIconList_Selection {w op args} { } elseif { [llength $args] == 1 } { set first [set last [lindex $args 0]] } else { - error "wrong # args: should be tkIconList_Selection path\ + error "wrong # args: should be [lindex [info level 0] 0] path\ clear first ?last?" } - set first [tkIconList_Index $w $first] - set last [tkIconList_Index $w $last] + set first [IconList_Index $w $first] + set last [IconList_Index $w $last] if { $first > $last } { set tmp $first set first $last @@ -121,7 +119,7 @@ proc tkIconList_Selection {w op args} { } set data(selection) [lreplace $data(selection) $first $last] event generate $w <> - tkIconList_DrawSelection $w + IconList_DrawSelection $w } "includes" { set index [lsearch -exact $data(selection) [lindex $args 0]] @@ -135,12 +133,12 @@ proc tkIconList_Selection {w op args} { } elseif { [llength $args] == 1 } { set last [set first [lindex $args 0]] } else { - error "wrong # args: should be tkIconList_Selection path\ + error "wrong # args: should be [lindex [info level 0] 0] path\ set first ?last?" } - set first [tkIconList_Index $w $first] - set last [tkIconList_Index $w $last] + set first [IconList_Index $w $first] + set last [IconList_Index $w $last] if { $first > $last } { set tmp $first set first $last @@ -151,19 +149,19 @@ proc tkIconList_Selection {w op args} { } set data(selection) [lsort -integer -unique $data(selection)] event generate $w <> - tkIconList_DrawSelection $w + IconList_DrawSelection $w } } } -proc tkIconList_Curselection {w} { - upvar #0 $w data +proc ::tk::IconList_Curselection {w} { + upvar ::tk::$w data return $data(selection) } -proc tkIconList_DrawSelection {w} { - upvar #0 $w data - upvar #0 $w:itemList itemList +proc ::tk::IconList_DrawSelection {w} { + upvar ::tk::$w data + upvar ::tk::$w:itemList itemList $data(canvas) delete selection foreach item $data(selection) { @@ -180,9 +178,9 @@ proc tkIconList_DrawSelection {w} { return } -proc tkIconList_Get {w item} { - upvar #0 $w data - upvar #0 $w:itemList itemList +proc ::tk::IconList_Get {w item} { + upvar ::tk::$w data + upvar ::tk::$w:itemList itemList set rTag [lindex [lindex $data(list) $item] 2] foreach {iTag tTag text serial} $itemList($rTag) { break @@ -190,13 +188,12 @@ proc tkIconList_Get {w item} { return $text } -# tkIconList_Config -- +# ::tk::IconList_Config -- # # Configure the widget variables of IconList, according to the command # line arguments. # -proc tkIconList_Config {w argList} { - upvar #0 $w data +proc ::tk::IconList_Config {w argList} { # 1: the configuration specs # @@ -207,17 +204,17 @@ proc tkIconList_Config {w argList} { # 2: parse the arguments # - tclParseConfigSpec $w $specs "" $argList + tclParseConfigSpec ::tk::$w $specs "" $argList } -# tkIconList_Create -- +# ::tk::IconList_Create -- # # Creates an IconList widget by assembling a canvas widget and a # scrollbar widget. Sets all the bindings necessary for the IconList's # operations. # -proc tkIconList_Create {w} { - upvar #0 $w data +proc ::tk::IconList_Create {w} { + upvar ::tk::$w data frame $w set data(sbar) [scrollbar $w.sbar -orient horizontal \ @@ -244,34 +241,34 @@ proc tkIconList_Create {w} { # Creates the event bindings. # - bind $data(canvas) [list tkIconList_Arrange $w] - - bind $data(canvas) <1> [list tkIconList_Btn1 $w %x %y] - bind $data(canvas) [list tkIconList_Motion1 $w %x %y] - bind $data(canvas) [list tkIconList_Leave1 $w %x %y] - bind $data(canvas) [list tkIconList_CtrlBtn1 $w %x %y] - bind $data(canvas) [list tkIconList_ShiftBtn1 $w %x %y] - bind $data(canvas) [list tkCancelRepeat] - bind $data(canvas) [list tkCancelRepeat] + bind $data(canvas) [list tk::IconList_Arrange $w] + + bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y] + bind $data(canvas) [list tk::IconList_Motion1 $w %x %y] + bind $data(canvas) [list tk::IconList_Leave1 $w %x %y] + bind $data(canvas) [list tk::IconList_CtrlBtn1 $w %x %y] + bind $data(canvas) [list tk::IconList_ShiftBtn1 $w %x %y] + bind $data(canvas) [list tk::CancelRepeat] + bind $data(canvas) [list tk::CancelRepeat] bind $data(canvas) \ - [list tkIconList_Double1 $w %x %y] - - bind $data(canvas) [list tkIconList_UpDown $w -1] - bind $data(canvas) [list tkIconList_UpDown $w 1] - bind $data(canvas) [list tkIconList_LeftRight $w -1] - bind $data(canvas) [list tkIconList_LeftRight $w 1] - bind $data(canvas) [list tkIconList_ReturnKey $w] - bind $data(canvas) [list tkIconList_KeyPress $w %A] + [list tk::IconList_Double1 $w %x %y] + + bind $data(canvas) [list tk::IconList_UpDown $w -1] + bind $data(canvas) [list tk::IconList_UpDown $w 1] + bind $data(canvas) [list tk::IconList_LeftRight $w -1] + bind $data(canvas) [list tk::IconList_LeftRight $w 1] + bind $data(canvas) [list tk::IconList_ReturnKey $w] + bind $data(canvas) [list tk::IconList_KeyPress $w %A] bind $data(canvas) ";" bind $data(canvas) ";" - bind $data(canvas) [list tkIconList_FocusIn $w] - bind $data(canvas) [list tkIconList_FocusOut $w] + bind $data(canvas) [list tk::IconList_FocusIn $w] + bind $data(canvas) [list tk::IconList_FocusOut $w] return $w } -# tkIconList_AutoScan -- +# ::tk::IconList_AutoScan -- # # This procedure is invoked when the mouse leaves an entry window # with button 1 down. It scrolls the window up, down, left, or @@ -282,13 +279,13 @@ proc tkIconList_Create {w} { # Arguments: # w - The IconList window. # -proc tkIconList_AutoScan {w} { - upvar #0 $w data - global tkPriv +proc ::tk::IconList_AutoScan {w} { + upvar ::tk::$w data + variable ::tk::Priv if {![winfo exists $w]} return - set x $tkPriv(x) - set y $tkPriv(y) + set x $Priv(x) + set y $Priv(y) if {$data(noScroll)} { return @@ -305,16 +302,16 @@ proc tkIconList_AutoScan {w} { return } - tkIconList_Motion1 $w $x $y - set tkPriv(afterId) [after 50 [list tkIconList_AutoScan $w]] + IconList_Motion1 $w $x $y + set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]] } # Deletes all the items inside the canvas subwidget and reset the IconList's # state. # -proc tkIconList_DeleteAll {w} { - upvar #0 $w data - upvar #0 $w:itemList itemList +proc ::tk::IconList_DeleteAll {w} { + upvar ::tk::$w data + upvar ::tk::$w:itemList itemList $data(canvas) delete all catch {unset data(selected)} @@ -336,10 +333,10 @@ proc tkIconList_DeleteAll {w} { # Adds an icon into the IconList with the designated image and text # -proc tkIconList_Add {w image items} { - upvar #0 $w data - upvar #0 $w:itemList itemList - upvar #0 $w:textList textList +proc ::tk::IconList_Add {w image items} { + upvar ::tk::$w data + upvar ::tk::$w:itemList itemList + upvar ::tk::$w:textList textList foreach text $items { set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \ @@ -384,8 +381,8 @@ proc tkIconList_Add {w image items} { # Places the icons in a column-major arrangement. # -proc tkIconList_Arrange {w} { - upvar #0 $w data +proc ::tk::IconList_Arrange {w} { + upvar ::tk::$w data if {![info exists data(list)]} { if {[info exists data(canvas)] && [winfo exists $data(canvas)]} { @@ -462,28 +459,28 @@ proc tkIconList_Arrange {w} { } if {$data(curItem) != ""} { - tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0 + IconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0 } } # Gets called when the user invokes the IconList (usually by double-clicking # or pressing the Return key). # -proc tkIconList_Invoke {w} { - upvar #0 $w data +proc ::tk::IconList_Invoke {w} { + upvar ::tk::$w data if {$data(-command) != "" && [llength $data(selection)]} { uplevel #0 $data(-command) } } -# tkIconList_See -- +# ::tk::IconList_See -- # # If the item is not (completely) visible, scroll the canvas so that # it becomes visible. -proc tkIconList_See {w rTag} { - upvar #0 $w data - upvar #0 $w:itemList itemList +proc ::tk::IconList_See {w rTag} { + upvar ::tk::$w data + upvar ::tk::$w:itemList itemList if {$data(noScroll)} { return @@ -529,103 +526,103 @@ proc tkIconList_See {w rTag} { } } -proc tkIconList_Btn1 {w x y} { - upvar #0 $w data +proc ::tk::IconList_Btn1 {w x y} { + upvar ::tk::$w data focus $data(canvas) set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] - set i [tkIconList_Index $w @${x},${y}] - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $i - tkIconList_Selection $w anchor $i + set i [IconList_Index $w @${x},${y}] + IconList_Selection $w clear 0 end + IconList_Selection $w set $i + IconList_Selection $w anchor $i } -proc tkIconList_CtrlBtn1 {w x y} { - upvar #0 $w data +proc ::tk::IconList_CtrlBtn1 {w x y} { + upvar ::tk::$w data if { $data(-multiple) } { focus $data(canvas) set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] - set i [tkIconList_Index $w @${x},${y}] - if { [tkIconList_Selection $w includes $i] } { - tkIconList_Selection $w clear $i + set i [IconList_Index $w @${x},${y}] + if { [IconList_Selection $w includes $i] } { + IconList_Selection $w clear $i } else { - tkIconList_Selection $w set $i - tkIconList_Selection $w anchor $i + IconList_Selection $w set $i + IconList_Selection $w anchor $i } } } -proc tkIconList_ShiftBtn1 {w x y} { - upvar #0 $w data +proc ::tk::IconList_ShiftBtn1 {w x y} { + upvar ::tk::$w data if { $data(-multiple) } { focus $data(canvas) set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] - set i [tkIconList_Index $w @${x},${y}] - set a [tkIconList_Index $w anchor] + set i [IconList_Index $w @${x},${y}] + set a [IconList_Index $w anchor] if { [string equal $a ""] } { set a $i } - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $a $i + IconList_Selection $w clear 0 end + IconList_Selection $w set $a $i } } # Gets called on button-1 motions # -proc tkIconList_Motion1 {w x y} { - upvar #0 $w data - global tkPriv - set tkPriv(x) $x - set tkPriv(y) $y +proc ::tk::IconList_Motion1 {w x y} { + upvar ::tk::$w data + variable ::tk::Priv + set Priv(x) $x + set Priv(y) $y set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] - set i [tkIconList_Index $w @${x},${y}] - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $i + set i [IconList_Index $w @${x},${y}] + IconList_Selection $w clear 0 end + IconList_Selection $w set $i } -proc tkIconList_Double1 {w x y} { - upvar #0 $w data +proc ::tk::IconList_Double1 {w x y} { + upvar ::tk::$w data if {[llength $data(selection)]} { - tkIconList_Invoke $w + IconList_Invoke $w } } -proc tkIconList_ReturnKey {w} { - tkIconList_Invoke $w +proc ::tk::IconList_ReturnKey {w} { + IconList_Invoke $w } -proc tkIconList_Leave1 {w x y} { - global tkPriv +proc ::tk::IconList_Leave1 {w x y} { + variable ::tk::Priv - set tkPriv(x) $x - set tkPriv(y) $y - tkIconList_AutoScan $w + set Priv(x) $x + set Priv(y) $y + IconList_AutoScan $w } -proc tkIconList_FocusIn {w} { - upvar #0 $w data +proc ::tk::IconList_FocusIn {w} { + upvar ::tk::$w data if {![info exists data(list)]} { return } if {[llength $data(selection)]} { - tkIconList_DrawSelection $w + IconList_DrawSelection $w } } -proc tkIconList_FocusOut {w} { - tkIconList_Selection $w clear 0 end +proc ::tk::IconList_FocusOut {w} { + IconList_Selection $w clear 0 end } -# tkIconList_UpDown -- +# ::tk::IconList_UpDown -- # # Moves the active element up or down by one element # @@ -633,27 +630,27 @@ proc tkIconList_FocusOut {w} { # w - The IconList widget. # amount - +1 to move down one item, -1 to move back one item. # -proc tkIconList_UpDown {w amount} { - upvar #0 $w data +proc ::tk::IconList_UpDown {w amount} { + upvar ::tk::$w data if {![info exists data(list)]} { return } - set curr [tkIconList_Curselection $w] + set curr [tk::IconList_Curselection $w] if { [llength $curr] == 0 } { set i 0 } else { - set i [tkIconList_Index $w anchor] + set i [tk::IconList_Index $w anchor] incr i $amount } - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $i - tkIconList_Selection $w anchor $i - tkIconList_See $w $i + IconList_Selection $w clear 0 end + IconList_Selection $w set $i + IconList_Selection $w anchor $i + IconList_See $w $i } -# tkIconList_LeftRight -- +# ::tk::IconList_LeftRight -- # # Moves the active element left or right by one column # @@ -661,49 +658,49 @@ proc tkIconList_UpDown {w amount} { # w - The IconList widget. # amount - +1 to move right one column, -1 to move left one column. # -proc tkIconList_LeftRight {w amount} { - upvar #0 $w data +proc ::tk::IconList_LeftRight {w amount} { + upvar ::tk::$w data if {![info exists data(list)]} { return } - set curr [tkIconList_Curselection $w] + set curr [IconList_Curselection $w] if { [llength $curr] == 0 } { set i 0 } else { - set i [tkIconList_Index $w anchor] + set i [IconList_Index $w anchor] incr i [expr {$amount*$data(itemsPerColumn)}] } - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $i - tkIconList_Selection $w anchor $i - tkIconList_See $w $i + IconList_Selection $w clear 0 end + IconList_Selection $w set $i + IconList_Selection $w anchor $i + IconList_See $w $i } #---------------------------------------------------------------------- # Accelerator key bindings #---------------------------------------------------------------------- -# tkIconList_KeyPress -- +# ::tk::IconList_KeyPress -- # # Gets called when user enters an arbitrary key in the listbox. # -proc tkIconList_KeyPress {w key} { - global tkPriv +proc ::tk::IconList_KeyPress {w key} { + variable ::tk::Priv - append tkPriv(ILAccel,$w) $key - tkIconList_Goto $w $tkPriv(ILAccel,$w) + append Priv(ILAccel,$w) $key + IconList_Goto $w $Priv(ILAccel,$w) catch { - after cancel $tkPriv(ILAccel,$w,afterId) + after cancel $Priv(ILAccel,$w,afterId) } - set tkPriv(ILAccel,$w,afterId) [after 500 [list tkIconList_Reset $w]] + set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]] } -proc tkIconList_Goto {w text} { - upvar #0 $w data - upvar #0 $w:textList textList - global tkPriv +proc ::tk::IconList_Goto {w text} { + upvar ::tk::$w data + upvar ::tk::$w:textList textList + variable ::tk::Priv if {![info exists data(list)]} { return @@ -744,17 +741,17 @@ proc tkIconList_Goto {w text} { } if {$theIndex > -1} { - tkIconList_Selection $w clear 0 end - tkIconList_Selection $w set $theIndex - tkIconList_Selection $w anchor $theIndex - tkIconList_See $w $theIndex + IconList_Selection $w clear 0 end + IconList_Selection $w set $theIndex + IconList_Selection $w anchor $theIndex + IconList_See $w $theIndex } } -proc tkIconList_Reset {w} { - global tkPriv +proc ::tk::IconList_Reset {w} { + variable ::tk::Priv - catch {unset tkPriv(ILAccel,$w)} + catch {unset Priv(ILAccel,$w)} } #---------------------------------------------------------------------- @@ -766,7 +763,7 @@ proc tkIconList_Reset {w} { namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file {} -# ::tk::dialog::file::tkFDialog -- +# ::tk::dialog::file:: -- # # Implements the TK file selection dialog. This dialog is used when # the tk_strictMotif flag is set to false. This procedure shouldn't @@ -777,8 +774,8 @@ namespace eval ::tk::dialog::file {} # args Options parsed by the procedure. # -proc ::tk::dialog::file::tkFDialog {type args} { - global tkPriv +proc ::tk::dialog::file:: {type args} { + variable ::tk::Priv set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data @@ -860,7 +857,7 @@ proc ::tk::dialog::file::tkFDialog {type args} { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - tkwait variable tkPriv(selectFilePath) + vwait tk::Priv(selectFilePath) ::tk::RestoreFocusGrab $w $data(ent) withdraw @@ -872,7 +869,7 @@ proc ::tk::dialog::file::tkFDialog {type args} { } $data(dirMenuBtn) configure -textvariable {} - return $tkPriv(selectFilePath) + return $Priv(selectFilePath) } # ::tk::dialog::file::Config -- @@ -947,7 +944,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # 5. Parse the -filetypes option # - set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)] + set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] if {![winfo exists $data(-parent)]} { error "bad window path name \"$data(-parent)\"" @@ -969,7 +966,8 @@ proc ::tk::dialog::file::Config {dataName type argList} { proc ::tk::dialog::file::Create {w class} { set dataName [lindex [split $w .] end] upvar ::tk::dialog::file::$dataName data - global tk_library tkPriv + variable ::tk::Priv + global tk_library toplevel $w -class $class @@ -980,8 +978,8 @@ proc ::tk::dialog::file::Create {w class} { set data(dirMenuBtn) $f1.menu set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""] set data(upBtn) [button $f1.up] - if {![info exists tkPriv(updirImage)]} { - set tkPriv(updirImage) [image create bitmap -data { + if {![info exists Priv(updirImage)]} { + set Priv(updirImage) [image create bitmap -data { #define updir_width 28 #define updir_height 16 static char updir_bits[] = { @@ -992,7 +990,7 @@ static char updir_bits[] = { 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01, 0xf0, 0xff, 0xff, 0x01};}] } - $data(upBtn) config -image $tkPriv(updirImage) + $data(upBtn) config -image $Priv(updirImage) $f1.menu config -takefocus 1 -highlightthickness 2 @@ -1019,7 +1017,7 @@ static char updir_bits[] = { set fCaptionWidth [string length $fNameCaption] set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w] } - set data(icons) [tkIconList $w.icons \ + set data(icons) [::tk::IconList $w.icons \ -command $iconListCommand \ -multiple $data(-multiple)] bind $data(icons) <> \ @@ -1034,8 +1032,7 @@ static char updir_bits[] = { # The font to use for the icons. The default Canvas font on Unix # is just deviant. - global $w.icons - set $w.icons(font) [$data(ent) cget -font] + set ::tk::$w.icons(font) [$data(ent) cget -font] # f3: the frame with the cancel button and the file types field # @@ -1100,8 +1097,8 @@ static char updir_bits[] = { wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w] $data(upBtn) config -command [list ::tk::dialog::file::UpDirCmd $w] $data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w] - bind $w [list tkButtonInvoke $data(cancelBtn)] - bind $w [list tkButtonInvoke $data(cancelBtn)] + bind $w [list tk::ButtonInvoke $data(cancelBtn)] + bind $w [list tk::ButtonInvoke $data(cancelBtn)] bind $w [list focus $data(dirMenuBtn)] # Set up event handlers specific to File or Directory Dialogs @@ -1123,14 +1120,14 @@ static char updir_bits[] = { bind $data(ent) $okCmd $data(okBtn) config -command $okCmd bind $w [list focus $data(ent)] - bind $w [list tkButtonInvoke $data(okBtn)] + bind $w [list tk::ButtonInvoke $data(okBtn)] } # Build the focus group for all the entries # - tkFocusGroup_Create $w - tkFocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w] - tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w] + ::tk::FocusGroup_Create $w + ::tk::FocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w] + ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w] } # ::tk::dialog::file::SetSelectMode -- @@ -1155,7 +1152,7 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { set fNameUnder 5 set iconListCommand [list ::tk::dialog::file::OkCmd $w] $w.f2.lab configure -text $fNameCaption -under $fNameUnder - tkIconList_Config $data(icons) \ + ::tk::IconList_Config $data(icons) \ [list -multiple $multi -command $iconListCommand] return } @@ -1198,19 +1195,20 @@ proc ::tk::dialog::file::Update {w} { set dataName [winfo name $w] upvar ::tk::dialog::file::$dataName data - global tk_library tkPriv + variable ::tk::Priv + global tk_library catch {unset data(updateId)} - if {![info exists tkPriv(folderImage)]} { - set tkPriv(folderImage) [image create photo -data { + if {![info exists Priv(folderImage)]} { + set Priv(folderImage) [image create photo -data { R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}] - set tkPriv(fileImage) [image create photo -data { + set Priv(fileImage) [image create photo -data { R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] } - set folder $tkPriv(folderImage) - set file $tkPriv(fileImage) + set folder $Priv(folderImage) + set file $Priv(fileImage) set appPWD [pwd] if {[catch { @@ -1236,7 +1234,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] $w config -cursor watch update idletasks - tkIconList_DeleteAll $data(icons) + ::tk::IconList_DeleteAll $data(icons) # Make the dir list # @@ -1253,7 +1251,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] lappend dirList $f } } - tkIconList_Add $data(icons) $folder $dirList + ::tk::IconList_Add $data(icons) $folder $dirList if { [string equal $class TkFDialog] } { # Make the file list if this is a File Dialog # @@ -1276,10 +1274,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] lappend fileList $f } } - tkIconList_Add $data(icons) $file $fileList + ::tk::IconList_Add $data(icons) $file $fileList } - tkIconList_Arrange $data(icons) + ::tk::IconList_Arrange $data(icons) # Update the Directory: option menu # @@ -1357,7 +1355,7 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { # proc ::tk::dialog::file::SetFilter {w type} { upvar ::tk::dialog::file::[winfo name $w] data - upvar \#0 $data(icons) icons + upvar ::tk::$data(icons) icons set data(filter) [lindex $type 1] $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1 @@ -1593,7 +1591,7 @@ proc ::tk::dialog::file::InvokeBtn {w key} { upvar ::tk::dialog::file::[winfo name $w] data if {[string equal [$data(okBtn) cget -text] $key]} { - tkButtonInvoke $data(okBtn) + ::tk::ButtonInvoke $data(okBtn) } } @@ -1624,8 +1622,8 @@ proc ::tk::dialog::file::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data set text {} - foreach item [tkIconList_Curselection $data(icons)] { - lappend text [tkIconList_Get $data(icons) $item] + foreach item [::tk::IconList_Curselection $data(icons)] { + lappend text [::tk::IconList_Get $data(icons) $item] } if {([llength $text] && !$data(-multiple)) || \ @@ -1645,9 +1643,9 @@ proc ::tk::dialog::file::OkCmd {w} { # proc ::tk::dialog::file::CancelCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data - global tkPriv + variable ::tk::Priv - set tkPriv(selectFilePath) "" + set Priv(selectFilePath) "" } # Gets called when user browses the IconList widget (dragging mouse, arrow @@ -1657,8 +1655,8 @@ proc ::tk::dialog::file::ListBrowse {w} { upvar ::tk::dialog::file::[winfo name $w] data set text {} - foreach item [tkIconList_Curselection $data(icons)] { - lappend text [tkIconList_Get $data(icons) $item] + foreach item [::tk::IconList_Curselection $data(icons)] { + lappend text [::tk::IconList_Get $data(icons) $item] } if {[llength $text] == 0} { return @@ -1733,13 +1731,13 @@ proc ::tk::dialog::file::ListInvoke {w text} { # # Gets called when user has input a valid filename. Pops up a # dialog box to confirm selection when necessary. Sets the -# tkPriv(selectFilePath) variable, which will break the "tkwait" -# loop in tkFDialog and return the selected filename to the +# tk::Priv(selectFilePath) variable, which will break the "vwait" +# loop in ::tk::dialog::file:: and return the selected filename to the # script that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data - global tkPriv + variable ::tk::Priv if {[string equal $selectFilePath ""]} { if {$data(-multiple)} { @@ -1753,8 +1751,8 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { $data(selectPath) $data(selectFile)] } - set tkPriv(selectFile) $data(selectFile) - set tkPriv(selectPath) $data(selectPath) + set Priv(selectFile) $data(selectFile) + set Priv(selectPath) $data(selectPath) if {[string equal $data(type) save]} { if {[file exists $selectFilePath]} { @@ -1767,5 +1765,5 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { } } } - set tkPriv(selectFilePath) $selectFilePath + set Priv(selectFilePath) $selectFilePath } diff --git a/library/unsupported.tcl b/library/unsupported.tcl new file mode 100644 index 0000000..467fb9c --- /dev/null +++ b/library/unsupported.tcl @@ -0,0 +1,286 @@ +# unsupported.tcl -- +# +# Commands provided by Tk without official support. Use them at your +# own risk. They may change or go away without notice. +# +# RCS: @(#) $Id: unsupported.tcl,v 1.2 2001/08/01 16:21:11 dgp Exp $ +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# ---------------------------------------------------------------------- +# Unsupported compatibility interface for folks accessing Tk's private +# commands and variable against recommended usage. +# ---------------------------------------------------------------------- + +namespace eval ::tk::unsupported { + + # Map from the old global names of Tk private commands to their + # new namespace-encapsulated names. + + variable PrivateCommands + array set PrivateCommands { + tkButtonAutoInvoke ::tk::ButtonAutoInvoke + tkButtonDown ::tk::ButtonDown + tkButtonEnter ::tk::ButtonEnter + tkButtonInvoke ::tk::ButtonInvoke + tkButtonLeave ::tk::ButtonLeave + tkButtonUp ::tk::ButtonUp + tkCancelRepeat ::tk::CancelRepeat + tkCheckRadioDown ::tk::CheckRadioDown + tkCheckRadioEnter ::tk::CheckRadioEnter + tkCheckRadioInvoke ::tk::CheckRadioInvoke + tkColorDialog ::tk::dialog::color:: + tkColorDialog_BuildDialog ::tk::dialog::color::BuildDialog + tkColorDialog_CancelCmd ::tk::dialog::color::CancelCmd + tkColorDialog_Config ::tk::dialog::color::Config + tkColorDialog_CreateSelector ::tk::dialog::color::CreateSelector + tkColorDialog_DrawColorScale ::tk::dialog::color::DrawColorScale + tkColorDialog_EnterColorBar ::tk::dialog::color::EnterColorBar + tkColorDialog_InitValues ::tk::dialog::color::InitValues + tkColorDialog_HandleRGBEntry ::tk::dialog::color::HandleRGBEntry + tkColorDialog_HandleSelEntry ::tk::dialog::color::HandleSelEntry + tkColorDialog_LeaveColorBar ::tk::dialog::color::LeaveColorBar + tkColorDialog_MoveSelector ::tk::dialog::color::MoveSelector + tkColorDialog_OkCmd ::tk::dialog::color::OkCmd + tkColorDialog_RedrawColorBars ::tk::dialog::color::RedrawColorBars + tkColorDialog_RedrawFinalColor ::tk::dialog::color::RedrawFinalColor + tkColorDialog_ReleaseMouse ::tk::dialog::color::ReleaseMouse + tkColorDialog_ResizeColorBars ::tk::dialog::color::ResizeColorBars + tkColorDialog_RgbToX ::tk::dialog::color::RgbToX + tkColorDialog_SetRGBValue ::tk::dialog::color::SetRGBValue + tkColorDialog_StartMove ::tk::dialog::color::StartMove + tkColorDialog_XToRgb ::tk::dialog::color::XToRGB + tkConsoleAbout ::tk::ConsoleAbout + tkConsoleBind ::tk::ConsoleBind + tkConsoleExit ::tk::ConsoleExit + tkConsoleHistory ::tk::ConsoleHistory + tkConsoleInit ::tk::ConsoleInit + tkConsoleInsert ::tk::ConsoleInsert + tkConsoleInvoke ::tk::ConsoleInvoke + tkConsoleOutput ::tk::ConsoleOutput + tkConsolePrompt ::tk::ConsolePrompt + tkConsoleSource ::tk::ConsoleSource + tkDarken ::tk::Darken + tkEntryAutoScan ::tk::EntryAutoScan + tkEntryBackspace ::tk::EntryBackspace + tkEntryButton1 ::tk::EntryButton1 + tkEntryClosestGap ::tk::EntryClosestGap + tkEntryGetSelection ::tk::EntryGetSelection + tkEntryInsert ::tk::EntryInsert + tkEntryKeySelect ::tk::EntryKeySelect + tkEntryMouseSelect ::tk::EntryMouseSelect + tkEntryNextWord ::tk::EntryNextWord + tkEntryPaste ::tk::EntryPaste + tkEntryPreviousWord ::tk::EntryPreviousWord + tkEntrySeeInsert ::tk::EntrySeeInsert + tkEntrySetCursor ::tk::EntrySetCursor + tkEntryTranspose ::tk::EntryTranspose + tkEventMotifBindings ::tk::EventMotifBindings + tkFDGetFileTypes ::tk::FDGetFileTypes + tkFirstMenu ::tk::FirstMenu + tkFocusGroup_BindIn ::tk::FocusGroup_BindIn + tkFocusGroup_BindOut ::tk::FocusGroup_BindOut + tkFocusGroup_Create ::tk::FocusGroup_Create + tkFocusGroup_Destroy ::tk::FocusGroup_Destroy + tkFocusGroup_In ::tk::FocusGroup_In + tkFocusGroup_Out ::tk::FocusGroup_Out + tkFocusOK ::tk::FocusOK + tkGenerateMenuSelect ::tk::GenerateMenuSelect + tkIconList ::tk::IconList + tkIconList_Add ::tk::IconList_Add + tkIconList_Arrange ::tk::IconList_Arrange + tkIconList_AutoScan ::tk::IconList_AutoScan + tkIconList_Btn1 ::tk::IconList_Btn1 + tkIconList_Config ::tk::IconList_Config + tkIconList_Create ::tk::IconList_Create + tkIconList_CtrlBtn1 ::tk::IconList_CtrlBtn1 + tkIconList_Curselection ::tk::IconList_Curselection + tkIconList_DeleteAll ::tk::IconList_DeleteAll + tkIconList_Double1 ::tk::IconList_Double1 + tkIconList_DrawSelection ::tk::IconList_DrawSelection + tkIconList_FocusIn ::tk::IconList_FocusIn + tkIconList_FocusOut ::tk::IconList_FocusOut + tkIconList_Get ::tk::IconList_Get + tkIconList_Goto ::tk::IconList_Goto + tkIconList_Index ::tk::IconList_Index + tkIconList_Invoke ::tk::IconList_Invoke + tkIconList_KeyPress ::tk::IconList_KeyPress + tkIconList_Leave1 ::tk::IconList_Leave1 + tkIconList_LeftRight ::tk::IconList_LeftRight + tkIconList_Motion1 ::tk::IconList_Motion1 + tkIconList_Reset ::tk::IconList_Reset + tkIconList_ReturnKey ::tk::IconList_ReturnKey + tkIconList_See ::tk::IconList_See + tkIconList_Select ::tk::IconList_Select + tkIconList_Selection ::tk::IconList_Selection + tkIconList_ShiftBtn1 ::tk::IconList_ShiftBtn1 + tkIconList_UpDown ::tk::IconList_UpDown + tkListbox ::tk::Listbox + tkListboxAutoScan ::tk::ListboxAutoScan + tkListboxBeginExtend ::tk::ListboxBeginExtend + tkListboxBeginSelect ::tk::ListboxBeginSelect + tkListboxBeginToggle ::tk::ListboxBeginToggle + tkListboxCancel ::tk::ListboxCancel + tkListboxDataExtend ::tk::ListboxDataExtend + tkListboxExtendUpDown ::tk::ListboxExtendUpDown + tkListboxKeyAccel_Goto ::tk::ListboxKeyAccel_Goto + tkListboxKeyAccel_Key ::tk::ListboxKeyAccel_Key + tkListboxKeyAccel_Reset ::tk::ListboxKeyAccel_Reset + tkListboxKeyAccel_Set ::tk::ListboxKeyAccel_Set + tkListboxKeyAccel_Unset ::tk::ListboxKeyAccel_Unxet + tkListboxMotion ::tk::ListboxMotion + tkListboxSelectAll ::tk::ListboxSelectAll + tkListboxUpDown ::tk::ListboxUpDown + tkListboxBeginToggle ::tk::ListboxBeginToggle + tkMbButtonUp ::tk::MbButtonUp + tkMbEnter ::tk::MbEnter + tkMbLeave ::tk::MbLeave + tkMbMotion ::tk::MbMotion + tkMbPost ::tk::MbPost + tkMenuButtonDown ::tk::MenuButtonDown + tkMenuDownArrow ::tk::MenuDownArrow + tkMenuDup ::tk::MenuDup + tkMenuEscape ::tk::MenuEscape + tkMenuFind ::tk::MenuFind + tkMenuFindName ::tk::MenuFindName + tkMenuFirstEntry ::tk::MenuFirstEntry + tkMenuInvoke ::tk::MenuInvoke + tkMenuLeave ::tk::MenuLeave + tkMenuLeftArrow ::tk::MenuLeftArrow + tkMenuMotion ::tk::MenuMotion + tkMenuNextEntry ::tk::MenuNextEntry + tkMenuNextMenu ::tk::MenuNextMenu + tkMenuRightArrow ::tk::MenuRightArrow + tkMenuUnpost ::tk::MenuUnpost + tkMenuUpArrow ::tk::MenuUpArrow + tkMessageBox ::tk::MessageBox + tkMotifFDialog ::tk::MotifFDialog + tkMotifFDialog_ActivateDList ::tk::MotifFDialog_ActivateDList + tkMotifFDialog_ActivateFList ::tk::MotifFDialog_ActivateFList + tkMotifFDialog_ActivateFEnt ::tk::MotifFDialog_ActivateFEnt + tkMotifFDialog_ActivateSEnt ::tk::MotifFDialog_ActivateSEnt + tkMotifFDialog ::tk::MotifFDialog + tkMotifFDialog_BrowseDList ::tk::MotifFDialog_BrowseDList + tkMotifFDialog_BrowseFList ::tk::MotifFDialog_BrowseFList + tkMotifFDialog_BuildUI ::tk::MotifFDialog_BuildUI + tkMotifFDialog_CancelCmd ::tk::MotifFDialog_CancelCmd + tkMotifFDialog_Config ::tk::MotifFDialog_Config + tkMotifFDialog_Create ::tk::MotifFDialog_Create + tkMotifFDialog_FileTypes ::tk::MotifFDialog_FileTypes + tkMotifFDialog_FilterCmd ::tk::MotifFDialog_FilterCmd + tkMotifFDialog_InterpFilter ::tk::MotifFDialog_InterpFilter + tkMotifFDialog_LoadFiles ::tk::MotifFDialog_LoadFiles + tkMotifFDialog_MakeSList ::tk::MotifFDialog_MakeSList + tkMotifFDialog_OkCmd ::tk::MotifFDialog_OkCmd + tkMotifFDialog_SetFilter ::tk::MotifFDialog_SetFilter + tkMotifFDialog_SetListMode ::tk::MotifFDialog_SetListMode + tkMotifFDialog_Update ::tk::MotifFDialog_Update + tkPostOverPoint ::tk::PostOverPoint + tkRecolorTree ::tk::RecolorTree + tkRestoreOldGrab ::tk::RestoreOldGrab + tkSaveGrabInfo ::tk::SaveGrabInfo + tkScaleActivate ::tk::ScaleActivate + tkScaleButtonDown ::tk::ScaleButtonDown + tkScaleButton2Down ::tk::ScaleButton2Down + tkScaleControlPress ::tk::ScaleControlPress + tkScaleDrag ::tk::ScaleDrag + tkScaleEndDrag ::tk::ScaleEndDrag + tkScaleIncrement ::tk::ScaleIncrement + tkScreenChanged ::tk::ScreenChanged + tkScrollButtonDown ::tk::ScrollButtonDown + tkScrollButton2Down ::tk::ScrollButton2Down + tkScrollButtonDrag ::tk::ScrollButtonDrag + tkScrollButtonUp ::tk::ScrollButtonUp + tkScrollByPages ::tk::ScrollByPages + tkScrollByUnits ::tk::ScrollByUnits + tkScrollEndDrag ::tk::ScrollEndDrag + tkScrollSelect ::tk::ScrollSelect + tkScrollStartDrag ::tk::ScrollStartDrag + tkScrollTopBottom ::tk::ScrollTopBottom + tkScrollToPos ::tk::ScrollToPos + tkTabToWindow ::tk::TabToWindow + tkTearOffMenu ::tk::TearOffMenu + tkTextAutoScan ::tk::TextAutoScan + tkTextButton1 ::tk::TextButton1 + tkTextClosestGap ::tk::TextClosestGap + tkTextInsert ::tk::TextInsert + tkTextKeyExtend ::tk::TextKeyExtend + tkTextKeySelect ::tk::TextKeySelect + tkTextNextPara ::tk::TextNextPara + tkTextNextPos ::tk::TextNextPos + tkTextNextWord ::tk::TextNextWord + tkTextPaste ::tk::TextPaste + tkTextPrevPara ::tk::TextPrevPara + tkTextPrevPos ::tk::TextPrevPos + tkTextPrevWord ::tk::TextPrevWord + tkTextResetAnchor ::tk::TextResetAnchor + tkTextScrollPages ::tk::TextScrollPages + tkTextSelectTo ::tk::TextSelectTo + tkTextSetCursor ::tk::TextSetCursor + tkTextTranspose ::tk::TextTranspose + tkTextUpDownLine ::tk::TextUpDownLine + tkTraverseToMenu ::tk::TraverseToMenu + tkTraverseWithinMenu ::tk::TraverseWithinMenu + } + + # Map from the old global names of Tk private variable to their + # new namespace-encapsulated names. + + variable PrivateVariables + array set PrivateVariables { + histNum ::tk::HistNum + tkFocusIn ::tk::FocusIn + tkFocusOut ::tk::FocusOut + tkPalette ::tk::Palette + tkPriv ::tk::Priv + tkPrivMsgBox ::tk::PrivMsgBox + } +} + +# ::tk::unsupported::ExposePrivateCommand -- +# +# Expose one of Tk's private commands to be visible under its +# old global name +# +# Arguments: +# cmd Global name by which the command was once known +# +# Results: +# None. +# +# Side effects: +# The old command name in the global namespace is aliased to the +# new private name. + +proc ::tk::unsupported::ExposePrivateCommand {cmd} { + variable PrivateCommands + if {![info exists PrivateCommands($cmd)]} { + return -code error "No compatibility support for \[$cmd]" + } + namespace eval :: [list interp alias {} $cmd {}] $PrivateCommands($cmd) +} + +# ::tk::unsupported::ExposePrivateVariable -- +# +# Expose one of Tk's private variables to be visible under its +# old global name +# +# Arguments: +# var Global name by which the variable was once known +# +# Results: +# None. +# +# Side effects: +# The old variable name in the global namespace is aliased to the +# new private name. + +proc ::tk::unsupported::ExposePrivateVariable {var} { + variable PrivateVariables + if {![info exists PrivateVariables($var)]} { + return -code error "No compatibility support for \$$var" + } + namespace eval :: [list upvar #0 $PrivateVariables($var) $var] +} + diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 0f3fee5..545c962 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -2,9 +2,9 @@ # # Implements the "Motif" style file selection dialog for the # Unix platform. This implementation is used only if the -# "tk_strictMotif" flag is set. +# "::tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.16 2001/07/03 14:59:25 dkf Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.17 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation @@ -16,7 +16,7 @@ namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file {} -# tkMotifFDialog -- +# ::tk::MotifFDialog -- # # Implements a file dialog similar to the standard Motif file # selection box. @@ -35,12 +35,12 @@ namespace eval ::tk::dialog::file {} # with Windows it defines the maximum amount of memory to allocate for # the returned filenames. -proc tkMotifFDialog {type args} { - global tkPriv +proc ::tk::MotifFDialog {type args} { + variable ::tk::Priv set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data - set w [tkMotifFDialog_Create $dataName $type $args] + set w [MotifFDialog_Create $dataName $type $args] # Set a grab and claim the focus too. @@ -53,19 +53,19 @@ proc tkMotifFDialog {type args} { # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. - tkwait variable tkPriv(selectFilePath) + vwait ::tk::Priv(selectFilePath) ::tk::RestoreFocusGrab $w $data(sEnt) withdraw - return $tkPriv(selectFilePath) + return $Priv(selectFilePath) } -# tkMotifFDialog_Create -- +# ::tk::MotifFDialog_Create -- # # Creates the Motif file dialog (if it doesn't exist yet) and # initialize the internal data structure associated with the # dialog. # -# This procedure is used by tkMotifFDialog to create the +# This procedure is used by ::tk::MotifFDialog to create the # dialog. It's also used by the test suite to test the Motif # file dialog implementation. User code shouldn't call this # procedure directly. @@ -78,11 +78,10 @@ proc tkMotifFDialog {type args} { # Results: # Pathname of the file dialog. -proc tkMotifFDialog_Create {dataName type argList} { - global tkPriv +proc ::tk::MotifFDialog_Create {dataName type argList} { upvar ::tk::dialog::file::$dataName data - tkMotifFDialog_Config $dataName $type $argList + MotifFDialog_Config $dataName $type $argList if {[string equal $data(-parent) .]} { set w .$dataName @@ -93,10 +92,10 @@ proc tkMotifFDialog_Create {dataName type argList} { # (re)create the dialog box if necessary # if {![winfo exists $w]} { - tkMotifFDialog_BuildUI $w + MotifFDialog_BuildUI $w } elseif {[string compare [winfo class $w] TkMotifFDialog]} { destroy $w - tkMotifFDialog_BuildUI $w + MotifFDialog_BuildUI $w } else { set data(fEnt) $w.top.f1.ent set data(dList) $w.top.f2.a.l @@ -106,12 +105,12 @@ proc tkMotifFDialog_Create {dataName type argList} { set data(filterBtn) $w.bot.filter set data(cancelBtn) $w.bot.cancel } - tkMotifFDialog_SetListMode $w + MotifFDialog_SetListMode $w wm transient $w $data(-parent) - tkMotifFDialog_FileTypes $w - tkMotifFDialog_Update $w + MotifFDialog_FileTypes $w + MotifFDialog_Update $w # Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the @@ -123,7 +122,7 @@ proc tkMotifFDialog_Create {dataName type argList} { return $w } -# tkMotifFDialog_FileTypes -- +# ::tk::MotifFDialog_FileTypes -- # # Checks the -filetypes option. If present this adds a list of radio- # buttons to pick the file types from. @@ -134,7 +133,7 @@ proc tkMotifFDialog_Create {dataName type argList} { # Results: # none -proc tkMotifFDialog_FileTypes {w} { +proc ::tk::MotifFDialog_FileTypes {w} { upvar ::tk::dialog::file::[winfo name $w] data set f $w.top.f3.types @@ -150,7 +149,7 @@ proc tkMotifFDialog_FileTypes {w} { # set data(fileType) $data(-defaulttype) set data(fileType) 0 - tkMotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] + MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] #don't produce radiobuttons for only one filetype if {[llength $data(-filetypes)] == 1} { @@ -165,9 +164,9 @@ proc tkMotifFDialog_FileTypes {w} { set filter [lindex $type 1] radiobutton $f.b$cnt \ -text $title \ - -variable [winfo name $w](fileType) \ + -variable ::tk::dialog::file::[winfo name $w](fileType) \ -value $cnt \ - -command "[list tkMotifFDialog_SetFilter $w $type]" + -command "[list tk::MotifFDialog_SetFilter $w $type]" pack $f.b$cnt -side left incr cnt } @@ -181,17 +180,17 @@ proc tkMotifFDialog_FileTypes {w} { # This proc gets called whenever data(filter) is set # -proc tkMotifFDialog_SetFilter {w type} { +proc ::tk::MotifFDialog_SetFilter {w type} { upvar ::tk::dialog::file::[winfo name $w] data - global tkpriv + variable ::tk::Priv set data(filter) [lindex $type 1] - set tkpriv(selectFileType) [lindex [lindex $type 0] 0] + set Priv(selectFileType) [lindex [lindex $type 0] 0] - tkMotifFDialog_Update $w + MotifFDialog_Update $w } -# tkMotifFDialog_Config -- +# ::tk::MotifFDialog_Config -- # # Iterates over the optional arguments to determine the option # values for the Motif file dialog; gives default values to @@ -203,7 +202,7 @@ proc tkMotifFDialog_SetFilter {w type} { # type "Save" or "Open" # argList Options parsed by the procedure. -proc tkMotifFDialog_Config {dataName type argList} { +proc ::tk::MotifFDialog_Config {dataName type argList} { upvar ::tk::dialog::file::$dataName data set data(type) $type @@ -270,7 +269,7 @@ proc tkMotifFDialog_Config {dataName type argList} { # file dialog, but we check for validity of the value to make sure # the application code also runs fine with the TK file dialog. # - set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)] + set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] if {![info exists data(filter)]} { set data(filter) * @@ -280,7 +279,7 @@ proc tkMotifFDialog_Config {dataName type argList} { } } -# tkMotifFDialog_BuildUI -- +# ::tk::MotifFDialog_BuildUI -- # # Builds the UI components of the Motif file dialog. # @@ -290,7 +289,7 @@ proc tkMotifFDialog_Config {dataName type argList} { # Results: # None. -proc tkMotifFDialog_BuildUI {w} { +proc ::tk::MotifFDialog_BuildUI {w} { set dataName [lindex [split $w .] end] upvar ::tk::dialog::file::$dataName data @@ -332,9 +331,9 @@ proc tkMotifFDialog_BuildUI {w} { # The file and directory lists # - set data(dList) [tkMotifFDialog_MakeSList $w $f2a \ + set data(dList) [MotifFDialog_MakeSList $w $f2a \ [::msgcat::mc "Directory:"] 0 DList] - set data(fList) [tkMotifFDialog_MakeSList $w $f2b \ + set data(fList) [MotifFDialog_MakeSList $w $f2b \ [::msgcat::mc "Files:"] 2 FList] # The Selection box @@ -351,13 +350,13 @@ proc tkMotifFDialog_BuildUI {w} { set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set data(okBtn) [button $bot.ok -text [::msgcat::mc "OK"] \ -width $maxWidth -under 0 \ - -command [list tkMotifFDialog_OkCmd $w]] + -command [list tk::MotifFDialog_OkCmd $w]] set data(filterBtn) [button $bot.filter -text [::msgcat::mc "Filter"] \ -width $maxWidth -under 0 \ - -command [list tkMotifFDialog_FilterCmd $w]] + -command [list tk::MotifFDialog_FilterCmd $w]] set data(cancelBtn) [button $bot.cancel -text [::msgcat::mc "Cancel"] \ -width $maxWidth -under 0 \ - -command [list tkMotifFDialog_CancelCmd $w]] + -command [list tk::MotifFDialog_CancelCmd $w]] pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \ -side left @@ -369,17 +368,17 @@ proc tkMotifFDialog_BuildUI {w} { bind $w [list focus $data(fList)] bind $w [list focus $data(sEnt)] - bind $w [list tkButtonInvoke $bot.ok] - bind $w [list tkButtonInvoke $bot.filter] - bind $w [list tkButtonInvoke $bot.cancel] + bind $w [list tk::ButtonInvoke $bot.ok] + bind $w [list tk::ButtonInvoke $bot.filter] + bind $w [list tk::ButtonInvoke $bot.cancel] - bind $data(fEnt) [list tkMotifFDialog_ActivateFEnt $w] - bind $data(sEnt) [list tkMotifFDialog_ActivateSEnt $w] + bind $data(fEnt) [list tk::MotifFDialog_ActivateFEnt $w] + bind $data(sEnt) [list tk::MotifFDialog_ActivateSEnt $w] - wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w] + wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w] } -proc tkMotifFDialog_SetListMode {w} { +proc ::tk::MotifFDialog_SetListMode {w} { upvar ::tk::dialog::file::[winfo name $w] data if {$data(-multiple) != 0} { @@ -391,7 +390,7 @@ proc tkMotifFDialog_SetListMode {w} { $f.l configure -selectmode $selectmode } -# tkMotifFDialog_MakeSList -- +# ::tk::MotifFDialog_MakeSList -- # # Create a scrolled-listbox and set the keyboard accelerator # bindings so that the list selection follows what the user @@ -406,7 +405,7 @@ proc tkMotifFDialog_SetListMode {w} { # cmdPrefix Specifies procedures to call when the listbox is # browsed or activated. -proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} { +proc ::tk::MotifFDialog_MakeSList {w f label under cmdPrefix} { label $f.lab -text $label -under $under -anchor w listbox $f.l -width 12 -height 5 -exportselection 0\ -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set] @@ -425,19 +424,19 @@ proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} { # bindings for the listboxes # set list $f.l - bind $list <> [list tkMotifFDialog_Browse$cmdPrefix $w] + bind $list <> [list tk::MotifFDialog_Browse$cmdPrefix $w] bind $list \ - [list tkMotifFDialog_Activate$cmdPrefix $w] - bind $list "tkMotifFDialog_Browse$cmdPrefix [list $w]; \ - tkMotifFDialog_Activate$cmdPrefix [list $w]" + [list tk::MotifFDialog_Activate$cmdPrefix $w] + bind $list "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \ + tk::MotifFDialog_Activate$cmdPrefix [list $w]" bindtags $list [list Listbox $list [winfo toplevel $list] all] - tkListBoxKeyAccel_Set $list + ListBoxKeyAccel_Set $list return $f.l } -# tkMotifFDialog_InterpFilter -- +# ::tk::MotifFDialog_InterpFilter -- # # Interpret the string in the filter entry into two components: # the directory and the pattern. If the string is a relative @@ -452,7 +451,7 @@ proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} { # specified # by the filter. The second element is the filter # pattern itself. -proc tkMotifFDialog_InterpFilter {w} { +proc ::tk::MotifFDialog_InterpFilter {w} { upvar ::tk::dialog::file::[winfo name $w] data set text [string trim [$data(fEnt) get]] @@ -504,7 +503,7 @@ proc tkMotifFDialog_InterpFilter {w} { return [list $dir $fil] } -# tkMotifFDialog_Update +# ::tk::MotifFDialog_Update # # Load the files and synchronize the "filter" and "selection" fields # boxes. @@ -515,7 +514,7 @@ proc tkMotifFDialog_InterpFilter {w} { # Results: # None. -proc tkMotifFDialog_Update {w} { +proc ::tk::MotifFDialog_Update {w} { upvar ::tk::dialog::file::[winfo name $w] data $data(fEnt) delete 0 end @@ -524,10 +523,10 @@ proc tkMotifFDialog_Update {w} { $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(selectFile)] - tkMotifFDialog_LoadFiles $w + MotifFDialog_LoadFiles $w } -# tkMotifFDialog_LoadFiles -- +# ::tk::MotifFDialog_LoadFiles -- # # Loads the files and directories into the two listboxes according # to the filter setting. @@ -538,7 +537,7 @@ proc tkMotifFDialog_Update {w} { # Results: # None. -proc tkMotifFDialog_LoadFiles {w} { +proc ::tk::MotifFDialog_LoadFiles {w} { upvar ::tk::dialog::file::[winfo name $w] data $data(dList) delete 0 end @@ -585,7 +584,7 @@ proc tkMotifFDialog_LoadFiles {w} { cd $appPWD } -# tkMotifFDialog_BrowseDList -- +# ::tk::MotifFDialog_BrowseDList -- # # This procedure is called when the directory list is browsed # (clicked-over) by the user. @@ -596,7 +595,7 @@ proc tkMotifFDialog_LoadFiles {w} { # Results: # None. -proc tkMotifFDialog_BrowseDList {w} { +proc ::tk::MotifFDialog_BrowseDList {w} { upvar ::tk::dialog::file::[winfo name $w] data focus $data(dList) @@ -610,7 +609,7 @@ proc tkMotifFDialog_BrowseDList {w} { $data(fList) selection clear 0 end - set list [tkMotifFDialog_InterpFilter $w] + set list [MotifFDialog_InterpFilter $w] set data(filter) [lindex $list 1] switch -- $subdir { @@ -631,7 +630,7 @@ proc tkMotifFDialog_BrowseDList {w} { $data(fEnt) insert 0 $newSpec } -# tkMotifFDialog_ActivateDList -- +# ::tk::MotifFDialog_ActivateDList -- # # This procedure is called when the directory list is activated # (double-clicked) by the user. @@ -642,7 +641,7 @@ proc tkMotifFDialog_BrowseDList {w} { # Results: # None. -proc tkMotifFDialog_ActivateDList {w} { +proc ::tk::MotifFDialog_ActivateDList {w} { upvar ::tk::dialog::file::[winfo name $w] data if {[string equal [$data(dList) curselection] ""]} { @@ -668,7 +667,7 @@ proc tkMotifFDialog_ActivateDList {w} { } set data(selectPath) $newDir - tkMotifFDialog_Update $w + MotifFDialog_Update $w if {[string compare $subdir ..]} { $data(dList) selection set 0 @@ -679,7 +678,7 @@ proc tkMotifFDialog_ActivateDList {w} { } } -# tkMotifFDialog_BrowseFList -- +# ::tk::MotifFDialog_BrowseFList -- # # This procedure is called when the file list is browsed # (clicked-over) by the user. @@ -690,7 +689,7 @@ proc tkMotifFDialog_ActivateDList {w} { # Results: # None. -proc tkMotifFDialog_BrowseFList {w} { +proc ::tk::MotifFDialog_BrowseFList {w} { upvar ::tk::dialog::file::[winfo name $w] data focus $data(fList) @@ -721,7 +720,7 @@ proc tkMotifFDialog_BrowseFList {w} { $data(sEnt) xview end } -# tkMotifFDialog_ActivateFList -- +# ::tk::MotifFDialog_ActivateFList -- # # This procedure is called when the file list is activated # (double-clicked) by the user. @@ -732,7 +731,7 @@ proc tkMotifFDialog_BrowseFList {w} { # Results: # None. -proc tkMotifFDialog_ActivateFList {w} { +proc ::tk::MotifFDialog_ActivateFList {w} { upvar ::tk::dialog::file::[winfo name $w] data if {[string equal [$data(fList) curselection] ""]} { @@ -742,11 +741,11 @@ proc tkMotifFDialog_ActivateFList {w} { if {[string equal $data(selectFile) ""]} { return } else { - tkMotifFDialog_ActivateSEnt $w + MotifFDialog_ActivateSEnt $w } } -# tkMotifFDialog_ActivateFEnt -- +# ::tk::MotifFDialog_ActivateFEnt -- # # This procedure is called when the user presses Return inside # the "filter" entry. It updates the dialog according to the @@ -758,21 +757,21 @@ proc tkMotifFDialog_ActivateFList {w} { # Results: # None. -proc tkMotifFDialog_ActivateFEnt {w} { +proc ::tk::MotifFDialog_ActivateFEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data - set list [tkMotifFDialog_InterpFilter $w] + set list [MotifFDialog_InterpFilter $w] set data(selectPath) [lindex $list 0] set data(filter) [lindex $list 1] - tkMotifFDialog_Update $w + MotifFDialog_Update $w } -# tkMotifFDialog_ActivateSEnt -- +# ::tk::MotifFDialog_ActivateSEnt -- # # This procedure is called when the user presses Return inside -# the "selection" entry. It sets the tkPriv(selectFilePath) global -# variable so that the vwait loop in tkMotifFDialog will be +# the "selection" entry. It sets the ::tk::Priv(selectFilePath) +# variable so that the vwait loop in tk::MotifFDialog will be # terminated. # # Arguments: @@ -781,14 +780,14 @@ proc tkMotifFDialog_ActivateFEnt {w} { # Results: # None. -proc tkMotifFDialog_ActivateSEnt {w} { - global tkPriv +proc ::tk::MotifFDialog_ActivateSEnt {w} { + variable ::tk::Priv upvar ::tk::dialog::file::[winfo name $w] data set selectFilePath [string trim [$data(sEnt) get]] if {[string equal $selectFilePath ""]} { - tkMotifFDialog_FilterCmd $w + MotifFDialog_FilterCmd $w return } @@ -799,7 +798,7 @@ proc tkMotifFDialog_ActivateSEnt {w} { if {[file isdirectory [lindex $selectFilePath 0]]} { set data(selectPath) [lindex [glob $selectFilePath] 0] set data(selectFile) "" - tkMotifFDialog_Update $w + MotifFDialog_Update $w return } @@ -839,52 +838,52 @@ proc tkMotifFDialog_ActivateSEnt {w} { } if {$data(-multiple) != 0} { - set tkPriv(selectFilePath) $newFileList + set Priv(selectFilePath) $newFileList } else { - set tkPriv(selectFilePath) [lindex $newFileList 0] + set Priv(selectFilePath) [lindex $newFileList 0] } # Set selectFile and selectPath to first item in list - set tkPriv(selectFile) [file tail [lindex $newFileList 0]] - set tkPriv(selectPath) [file dirname [lindex $newFileList 0]] + set Priv(selectFile) [file tail [lindex $newFileList 0]] + set Priv(selectPath) [file dirname [lindex $newFileList 0]] } -proc tkMotifFDialog_OkCmd {w} { +proc ::tk::MotifFDialog_OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data - tkMotifFDialog_ActivateSEnt $w + MotifFDialog_ActivateSEnt $w } -proc tkMotifFDialog_FilterCmd {w} { +proc ::tk::MotifFDialog_FilterCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data - tkMotifFDialog_ActivateFEnt $w + MotifFDialog_ActivateFEnt $w } -proc tkMotifFDialog_CancelCmd {w} { - global tkPriv +proc ::tk::MotifFDialog_CancelCmd {w} { + variable ::tk::Priv - set tkPriv(selectFilePath) "" - set tkPriv(selectFile) "" - set tkPriv(selectPath) "" + set Priv(selectFilePath) "" + set Priv(selectFile) "" + set Priv(selectPath) "" } -proc tkListBoxKeyAccel_Set {w} { +proc ::tk::ListBoxKeyAccel_Set {w} { bind Listbox "" - bind $w [list tkListBoxKeyAccel_Unset $w] - bind $w [list tkListBoxKeyAccel_Key $w %A] + bind $w [list tk::ListBoxKeyAccel_Unset $w] + bind $w [list tk::ListBoxKeyAccel_Key $w %A] } -proc tkListBoxKeyAccel_Unset {w} { - global tkPriv +proc ::tk::ListBoxKeyAccel_Unset {w} { + variable ::tk::Priv - catch {after cancel $tkPriv(lbAccel,$w,afterId)} - catch {unset tkPriv(lbAccel,$w)} - catch {unset tkPriv(lbAccel,$w,afterId)} + catch {after cancel $Priv(lbAccel,$w,afterId)} + catch {unset Priv(lbAccel,$w)} + catch {unset Priv(lbAccel,$w,afterId)} } -# tkListBoxKeyAccel_Key-- +# ::tk::ListBoxKeyAccel_Key-- # # This procedure maintains a list of recently entered keystrokes # over a listbox widget. It arranges an idle event to move the @@ -898,23 +897,23 @@ proc tkListBoxKeyAccel_Unset {w} { # Results: # None. -proc tkListBoxKeyAccel_Key {w key} { - global tkPriv +proc ::tk::ListBoxKeyAccel_Key {w key} { + variable ::tk::Priv if { $key == "" } { return } - append tkPriv(lbAccel,$w) $key - tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w) + append Priv(lbAccel,$w) $key + ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w) catch { - after cancel $tkPriv(lbAccel,$w,afterId) + after cancel $Priv(lbAccel,$w,afterId) } - set tkPriv(lbAccel,$w,afterId) [after 500 \ - [list tkListBoxKeyAccel_Reset $w]] + set Priv(lbAccel,$w,afterId) [after 500 \ + [list tk::ListBoxKeyAccel_Reset $w]] } -proc tkListBoxKeyAccel_Goto {w string} { - global tkPriv +proc ::tk::ListBoxKeyAccel_Goto {w string} { + variable ::tk::Priv set string [string tolower $string] set end [$w index end] @@ -940,15 +939,15 @@ proc tkListBoxKeyAccel_Goto {w string} { } } -proc tkListBoxKeyAccel_Reset {w} { - global tkPriv +proc ::tk::ListBoxKeyAccel_Reset {w} { + variable ::tk::Priv - catch {unset tkPriv(lbAccel,$w)} + catch {unset Priv(lbAccel,$w)} } +proc ::tk_getFileType {} { + variable ::tk::Priv -proc tk_getFileType {} { - global tkpriv - - return $tkpriv(selectFileType) + return $Priv(selectFileType) } + diff --git a/mac/tkMacMenu.c b/mac/tkMacMenu.c index c0db274..152bb1e 100644 --- a/mac/tkMacMenu.c +++ b/mac/tkMacMenu.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacMenu.c,v 1.18 2000/02/10 08:55:47 jingham Exp $ + * RCS: @(#) $Id: tkMacMenu.c,v 1.19 2001/08/01 16:21:11 dgp Exp $ */ #include "tkMacInt.h" @@ -3340,7 +3340,7 @@ TkMacHandleTearoffMenu(void) if (windowPart != inMenuBar) { Tcl_DStringInit(&tearoffCmdStr); - Tcl_DStringAppendElement(&tearoffCmdStr, "tkTearOffMenu"); + Tcl_DStringAppendElement(&tearoffCmdStr, "tk::TearOffMenu"); Tcl_DStringAppendElement(&tearoffCmdStr, Tk_PathName(tearoffStruct.menuPtr->tkwin)); sprintf(intString, "%d", tearoffStruct.point.h); diff --git a/tests/clrpick.test b/tests/clrpick.test index 94a99c0..2259fe7 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: clrpick.test,v 1.5 2000/03/02 03:02:13 ericm Exp $ +# RCS: @(#) $Id: clrpick.test,v 1.6 2001/08/01 16:21:12 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -54,7 +54,7 @@ test clrpick-1.7 {tk_chooseColor command} { list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg } {1 {invalid color name "##badbadbaadcolor"}} -if {[info commands tkColorDialog] == ""} { +if {[info commands tk::dialog::color::] == ""} { set isNative 1 } else { set isNative 0 @@ -82,7 +82,7 @@ proc PressButton {btn} { proc ChooseColorByKey {parent r g b} { set w .__tk__color - upvar #0 $w data + upvar ::tk::dialog::color::[winfo name $w] data update $data(red,entry) delete 0 end @@ -96,14 +96,14 @@ proc ChooseColorByKey {parent r g b} { # Manually force the refresh of the color values instead # of counting on the timing of the event stream to change # the values for us. - tkColorDialog_HandleRGBEntry $w + tk::dialog::color::HandleRGBEntry $w SendButtonPress $parent ok mouse } proc SendButtonPress {parent btn type} { set w .__tk__color - upvar #0 $w data + upvar ::tk::dialog::color::[winfo name $w] data set button $data($btn\Btn) if ![winfo ismapped $button] { diff --git a/tests/filebox.test b/tests/filebox.test index bff0465..e288b39 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: filebox.test,v 1.10 2000/06/30 20:19:07 ericm Exp $ +# RCS: @(#) $Id: filebox.test,v 1.11 2001/08/01 16:21:12 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -161,7 +161,7 @@ foreach mode $modes { list [catch {$command -filetypes {Foo}} msg] $msg } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}} - if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} { + if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} { set isNative 1 } else { set isNative 0 diff --git a/tests/macMenu.test b/tests/macMenu.test index 808e46d..b261180 100644 --- a/tests/macMenu.test +++ b/tests/macMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macMenu.test,v 1.4 2001/03/28 17:27:10 dgp Exp $ +# RCS: @(#) $Id: macMenu.test,v 1.5 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -916,7 +916,7 @@ test macMenu-21.8 {TkpSetMainMenubar - tearoff window} { menu .t2.m1.foo .t2.m1.foo add command -label foo raise .t2 - tkTearOffMenu .t2.m1.foo 100 100 + tk::TearOffMenu .t2.m1.foo 100 100 list [catch {update} msg] $msg [destroy .t2] } {0 {} {}} @@ -932,62 +932,62 @@ test macMenu-24.1 {GetMenuIndicatorGeometry} { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.2 {GetMenuAccelGeometry - no accel} { catch {destroy .m1} menu .m1 .m1 add command - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} { catch {destroy .m1} menu .m1 .m1 add command -accel "Test" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.4 {GetMenuAccelGeometry - Command} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.5 {GetMenuAccelGeometry - Control} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.6 {GetMenuAccelGeometry - Shift} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Shift+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.7 {GetMenuAccelGeometry - Option} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Opt+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.8 {GetMenuAccelGeometry - Combination} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+Shift+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-25.9 {GetMenuAccelGeometry - extra text} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Command+Delete" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-26.1 {GetTearoffEntryGeometry} { @@ -998,14 +998,14 @@ test macMenu-27.1 {GetMenuSeparatorGeometry} { catch {destroy .m1} menu .m1 .m1 add separator - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} { @@ -1013,14 +1013,14 @@ test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} { menu .m1 .m1 add checkbutton -label foo -indicatoron 0 .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-28.3 {DrawMenuEntryIndicator - not selected} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} { @@ -1028,7 +1028,7 @@ test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} { @@ -1036,7 +1036,7 @@ test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} { menu .m1 .m1 add radiobutton -label foo .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -1045,7 +1045,7 @@ test macMenu-29.1 {DrawSICN} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -1054,56 +1054,56 @@ test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.4 {DrawMenuEntryAccelerator - Command} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.5 {DrawMenuEntryAccelerator - Option} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Opt+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Shift+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.7 {DrawMenuEntryAccelerator - Control} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test macMenu-30.8 {DrawMenuEntryAccelerator - combination} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+Shift+S" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -1111,7 +1111,7 @@ test macMenu-31.1 {DrawMenuSeparator} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -1119,7 +1119,7 @@ test macMenu-32.1 {TkpDrawMenuEntryLabel} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -1143,7 +1143,7 @@ test macMenu-40.1 {TkpDrawMenuEntry - gc for active and not strict motif} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1151,7 +1151,7 @@ test macMenu-40.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1160,7 +1160,7 @@ test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} { menu .m1 set tk_strictMotif 1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -1168,35 +1168,35 @@ test macMenu-40.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.7 {TkpDrawMenuEntry - gc for normal - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.8 {TkpDrawMenuEntry - gc for normal} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { @@ -1204,7 +1204,7 @@ test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} { @@ -1212,14 +1212,14 @@ test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1227,7 +1227,7 @@ test macMenu-40.12 {TkpDrawMenuEntry - border} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1236,7 +1236,7 @@ test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} { set tk_strictMotif 1 menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -1244,7 +1244,7 @@ test macMenu-40.14 {TkpDrawMenuEntry - active border - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1252,7 +1252,7 @@ test macMenu-40.15 {TkpDrawMenuEntry - active border} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -1260,28 +1260,28 @@ test macMenu-40.16 {TkpDrawMenuEntry - font - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.17 {TkpDrawMenuEntry - font} { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.18 {TkpDrawMenuEntry - separator} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.19 {TkpDrawMenuEntry - standard} { catch {destroy .mb} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} { @@ -1291,7 +1291,7 @@ test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} { menu .m1.file .m1.file add command -label foo .m1 entryconfigure File -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.21 {TkpDrawMenuEntry - indicator} { @@ -1299,7 +1299,7 @@ test macMenu-40.21 {TkpDrawMenuEntry - indicator} { menu .m1 .m1 add checkbutton -label macMenu-40.20 .m1 invoke 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} { @@ -1307,7 +1307,7 @@ test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} { menu .m1 .m1 add checkbutton -label macMenu-40.21 -hidemargin 1 .m1 invoke 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -1457,7 +1457,7 @@ test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} test macMenu-42.2 {DrawMenuEntryLabel - drawing image} { @@ -1466,7 +1466,7 @@ test macMenu-42.2 {DrawMenuEntryLabel - drawing image} { image create test image1 menu .m1 .m1 add command -image image1 - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} { @@ -1477,35 +1477,35 @@ test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} { menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] [eval image delete [image names]] } {{} {} {}} test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} { catch {destroy .m1} menu .m1 .m1 add command - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" -underline 3 - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label "This is a long label" -state disabled - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} test macMenu-42.8 {DrawMenuEntryLabel - disabled images} { @@ -1514,7 +1514,7 @@ test macMenu-42.8 {DrawMenuEntryLabel - disabled images} { image create test image1 menu .m1 .m1 add command -image image1 -state disabled - set tearoff [tkTearOffMenu .m1 100 100] + set tearoff [tk::TearOffMenu .m1 100 100] list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} @@ -1549,14 +1549,14 @@ test macMenu-44.1 {DrawMenuEntryBackground} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test macMenu-44.2 {DrawMenuEntryBackground} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 list [update] [destroy .m1] } {{} {}} diff --git a/tests/menu.test b/tests/menu.test index db13f8f..33995b0 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menu.test,v 1.6 2001/03/28 17:27:10 dgp Exp $ +# RCS: @(#) $Id: menu.test,v 1.7 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1066,20 +1066,20 @@ test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} { test menu-5.7 {DestroyMenuInstance - basic clones} { catch {destroy .m1} menu .m1 - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [catch {destroy $tearoff} msg] $msg [destroy .m1] } {0 {} {}} test menu-5.8 {DestroyMenuInstance - multiple clones} { catch {destroy .m1} menu .m1 - set tearoff1 [tkTearOffMenu .m1] - set tearoff2 [tkTearOffMenu .m1] + set tearoff1 [tk::TearOffMenu .m1] + set tearoff2 [tk::TearOffMenu .m1] list [catch {destroy $tearoff1} msg] $msg [destroy .m1] } {0 {} {}} test menu-5.9 {DestroyMenuInstace - master menu} { catch {destroy .m1} menu .m1 - tkTearOffMenu .m1 + tk::TearOffMenu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} test menu-5.10 {DestroyMenuInstance - freeing entries} { @@ -1105,7 +1105,7 @@ test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} { menu .m1 menu .m2 .m1 add cascade -menu .m2 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [destroy .m2] [destroy .m1] } {{} {}} @@ -1899,7 +1899,7 @@ test menu-16.16 {MenuAddOrInsert} { catch {destroy .m2} menu .m1 menu .m2 - set tearoff [tkTearOffMenu .m2] + set tearoff [tk::TearOffMenu .m2] list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3 } {0 {} {} 0 {} 0 {}} test menu-16.17 {MenuAddOrInsert} { @@ -1908,7 +1908,7 @@ test menu-16.17 {MenuAddOrInsert} { menu .m1 menu .container . configure -menu .container - set tearoff [tkTearOffMenu .container] + set tearoff [tk::TearOffMenu .container] list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container] } {0 {} {} {}} test menu-16.18 {MenuAddOrInsert} { diff --git a/tests/menuDraw.test b/tests/menuDraw.test index fdb051b..ea3503b 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menuDraw.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ +# RCS: @(#) $Id: menuDraw.test,v 1.4 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -168,7 +168,7 @@ test menuDraw-7.1 {TkEventuallyRecomputeMenu} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] update idletasks list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] } {{} {}} @@ -176,7 +176,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" - set tearoff [tkTearOffMenu .m1] + set tearoff [tk::TearOffMenu .m1] list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] } {{} {}} @@ -196,14 +196,14 @@ test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} { menu .m1 set foo 0 .m1 add radiobutton -variable foo -label test - tkTearOffMenu .m1 + tk::TearOffMenu .m1 update idletasks list [set foo test] [destroy .m1] [unset foo] } {test {} {}} test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} { catch {destroy .m1} menu .m1 - list [catch {tkTearOffMenu .m1}] [destroy .m1] + list [catch {tk::TearOffMenu .m1}] [destroy .m1] } {0 {}} # Don't know how to test when window has been deleted and ComputeMenuGeometry @@ -244,7 +244,7 @@ test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] update idletasks list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} @@ -256,7 +256,7 @@ test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} { menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} { @@ -266,7 +266,7 @@ test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} { image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] update idletasks list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} @@ -282,14 +282,14 @@ test menuDraw-12.1 {DisplayMenu - menubar background} {unixOnly} { test menuDraw-12.2 {Display menu - no entries} { catch {destroy .m1} menu .m1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.3 {DisplayMenu - one entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.4 {DisplayMenu - two entries} { @@ -297,7 +297,7 @@ test menuDraw-12.4 {DisplayMenu - two entries} { menu .m1 .m1 add command -label "one" .m1 add command -label "two" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw.12.5 {DisplayMenu - two columns - first bigger} { @@ -306,7 +306,7 @@ test menuDraw.12.5 {DisplayMenu - two columns - first bigger} { .m1 add command -label "one" .m1 add command -label "two" .m1 add command -label "three" -columnbreak 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.5 {DisplayMenu - two column - second bigger} { @@ -315,7 +315,7 @@ test menuDraw-12.5 {DisplayMenu - two column - second bigger} { .m1 add command -label "one" .m1 add command -label "two" -columnbreak 1 .m1 add command -label "three" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw.12.7 {DisplayMenu - three columns} { @@ -327,7 +327,7 @@ test menuDraw.12.7 {DisplayMenu - three columns} { .m1 add command -label "four" .m1 add command -label "five" .m1 add command -label "six" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.6 {Display menu - testing for extra space and menubars} {unixOnly} { @@ -341,7 +341,7 @@ test menuDraw-12.7 {Display menu - extra space at end of menu} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] wm geometry $tearoff 200x100 list [update] [destroy .m1] } {{} {}} @@ -353,15 +353,15 @@ test menuDraw-13.1 {TkMenuEventProc - Expose} { .m1 add command -label "one" menu .m2 .m2 add command -label "two" - set tearoff1 [tkTearOffMenu .m1 40 40] - set tearoff2 [tkTearOffMenu .m2 40 40] + set tearoff1 [tk::TearOffMenu .m1 40 40] + set tearoff2 [tk::TearOffMenu .m2 40 40] list [raise $tearoff2] [update] [destroy .m1] [destroy .m2] } {{} {} {} {}} test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [wm geometry $tearoff 200x100] [update] [destroy .m1] } {{} {} {}} test menuDraw-13.3 {TkMenuEventProc - ActivateNotify} {macOnly} { @@ -369,7 +369,7 @@ test menuDraw-13.3 {TkMenuEventProc - ActivateNotify} {macOnly} { toplevel .t2 -menu .t2.m1 menu .t2.m1 .t2.m1 add command -label foo - tkTearOffMenu .t2.m1 40 40 + tk::TearOffMenu .t2.m1 40 40 list [catch {update} msg] $msg [destroy .t2] } {0 {} {}} # Testing deletes is hard, and I am going to do my best. Don't know how @@ -410,13 +410,13 @@ test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" -state active - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff index active] [destroy .m1] } {none {}} test menuDraw-15.3 {TkPostTearoffMenu - post command} { @@ -424,27 +424,27 @@ test menuDraw-15.3 {TkPostTearoffMenu - post command} { catch {unset foo} menu .m1 -postcommand "set foo .m1" .m1 add command -label "foo" - list [catch {tkTearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] } {0 .m1 {} {}} test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" .m1 add command -label "foo" - list [catch {tkTearOffMenu .m1 40 40} msg] $msg [winfo exists .m1] + list [catch {tk::TearOffMenu .m1 40 40} msg] $msg [winfo exists .m1] } {0 {} 0} test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set height [winfo screenheight .m1] - list [catch {tkTearOffMenu .m1 40 $height}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 $height}] [destroy .m1] } {0 {}} test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set width [winfo screenwidth .m1] - list [catch {tkTearOffMenu .m1 $width 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 $width 40}] [destroy .m1] } {0 {}} @@ -455,7 +455,7 @@ test menuDraw-16.1 {TkPostSubmenu} {unixOnly} { .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away." - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} @@ -470,7 +470,7 @@ test menuDraw-16.2 {TkPostSubMenu} {unixOnly} { .m2 add command -label "two" menu .m3 .m3 add command -label "three" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3] } {{} {} {} {}} @@ -484,7 +484,7 @@ test menuDraw-16.4 {TkPostSubMenu} { catch {destroy .m1} menu .m1 .m1 add cascade -label test - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] } {{} {}} test menuDraw-16.5 {TkPostSubMenu} {unixOnly} { @@ -493,7 +493,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} { menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 -postcommand "glorp" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] } {1 {invalid command name "glorp"} {} {}} test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} { @@ -503,7 +503,7 @@ test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} { .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to get rid of this menu" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} @@ -529,7 +529,7 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} { .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} diff --git a/tests/msgbox.test b/tests/msgbox.test index 78adb81..b37305c 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: msgbox.test,v 1.4 2000/04/18 02:18:34 ericm Exp $ +# RCS: @(#) $Id: msgbox.test,v 1.5 2001/08/01 16:21:12 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -72,7 +72,7 @@ test msgbox-1.10 {tk_messageBox command} { list [catch {tk_messageBox -parent foo.bar} msg] $msg } {1 {bad window path name "foo.bar"}} -if {[info commands tkMessageBox] == ""} { +if {[info commands tk::MessageBox] == ""} { set isNative 1 } else { set isNative 0 diff --git a/tests/text.test b/tests/text.test index 5e676dd..94ba999 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.12 2000/07/25 00:05:40 ericm Exp $ +# RCS: @(#) $Id: text.test,v 1.13 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -964,7 +964,7 @@ test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} { # Test for fix of bug #1643 .t insert end "\n" - tkTextSetCursor .t 4.0 + tk::TextSetCursor .t 4.0 .t search -forward -regexp {^$} insert end } {4.0} @@ -1362,7 +1362,7 @@ test text-24.1 {bug fix - 1642} { .t insert end "line 3\n" .t insert end "line 4\n" .t insert end "line 5\n" - tkTextSetCursor .t 3.0 + tk::TextSetCursor .t 3.0 .t search -backward -regexp "\$" insert 1.0 } {2.6} diff --git a/tests/unixMenu.test b/tests/unixMenu.test index 30bb07a..fe67be6 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixMenu.test,v 1.4 1999/05/25 20:40:54 stanton Exp $ +# RCS: @(#) $Id: unixMenu.test,v 1.5 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -88,13 +88,13 @@ test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} { catch {destroy .m1} menu .m1 .m1 add command -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} { catch {destroy .m1} @@ -103,21 +103,21 @@ test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} { image create test image1 .m1 add checkbutton -image image1 -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] } {0 {} {}} test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} { catch {destroy .m1} menu .m1 .m1 add checkbutton -bitmap questhead -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} { catch {destroy .m1} @@ -126,47 +126,47 @@ test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} { image create test image1 .m1 add radiobutton -image image1 -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] } {0 {} {}} test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} { catch {destroy .m1} menu .m1 .m1 add radiobutton -bitmap questhead -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo -hidemargin 1 .m1 invoke foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.3 {GetMenuAccelGeometry - null label} { catch {destroy .m1} menu .m1 .m1 add command -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} { @@ -181,7 +181,7 @@ test unixMenu-10.2 {DrawMenuEntryBackground - active} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -189,7 +189,7 @@ test unixMenu-10.3 {DrawMenuEntryBackground - non-active} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -205,21 +205,21 @@ test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -227,21 +227,21 @@ test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} { @@ -249,21 +249,21 @@ test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo -indicatoron 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} { @@ -271,7 +271,7 @@ test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} { menu .m1 .m1 add radiobutton -label foo .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -286,7 +286,7 @@ test unixMenu-13.2 {DrawMenuSepartor - normal menu} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -294,7 +294,7 @@ test unixMenu-14.1 {DrawMenuEntryLabel} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -309,7 +309,7 @@ test unixMenu-15.2 {DrawMenuUnderline - no menubar} { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} @@ -317,14 +317,14 @@ test unixMenu-16.1 {TkpPostMenu} { catch {destroy .m1} menu .m1 .m1 add command -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-17.1 {GetMenuSeparatorGeometry} { catch {destroy .m1} menu .m1 .m1 add separator - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-18.1 {GetTearoffEntryGeometry} { @@ -334,7 +334,7 @@ test unixMenu-18.1 {GetTearoffEntryGeometry} { .mb.m add command -label test pack .mb raise . - list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb] + list [catch {tk::MbPost .mb} msg] $msg [tk::MenuUnpost .mb.m] [destroy .mb] } {0 {} {} {}} # Don't know how to reproduce the case where the tkwin has been deleted. @@ -624,7 +624,7 @@ test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -632,7 +632,7 @@ test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -641,7 +641,7 @@ test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} { menu .m1 set tk_strictMotif 1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -649,35 +649,35 @@ test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custo catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { @@ -685,7 +685,7 @@ test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} { @@ -693,14 +693,14 @@ test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -708,7 +708,7 @@ test unixMenu-23.12 {TkpDrawMenuEntry - border} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -717,7 +717,7 @@ test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} { set tk_strictMotif 1 menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -725,7 +725,7 @@ test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -733,7 +733,7 @@ test unixMenu-23.15 {TkpDrawMenuEntry - active border} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -741,28 +741,28 @@ test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.17 {TkpDrawMenuEntry - font} { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.18 {TkpDrawMenuEntry - separator} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.19 {TkpDrawMenuEntry - standard} { catch {destroy .mb} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} { @@ -772,7 +772,7 @@ test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} { menu .m1.file .m1.file add command -label foo .m1 entryconfigure File -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.21 {TkpDrawMenuEntry - indicator} { @@ -780,7 +780,7 @@ test unixMenu-23.21 {TkpDrawMenuEntry - indicator} { menu .m1 .m1 add checkbutton -label Foo .m1 invoke Foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} { @@ -788,7 +788,7 @@ test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} { menu .m1 .m1 add checkbutton -label Foo -hidemargin 1 .m1 invoke Foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -849,8 +849,8 @@ test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { menu .mb.m .mb.m add command -label test pack .mb - catch {tkMbPost .mb} - list [update] [tkMenuUnpost .mb.m] [destroy .mb] + catch {tk::MbPost .mb} + list [update] [tk::MenuUnpost .mb.m] [destroy .mb] } {{} {} {}} test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} { catch {destroy .m1} diff --git a/tests/winMenu.test b/tests/winMenu.test index 576646f..fe4d90a 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winMenu.test,v 1.3 1999/04/16 01:51:43 stanton Exp $ +# RCS: @(#) $Id: winMenu.test,v 1.4 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -322,7 +322,7 @@ test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} { menu .mb.menu .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE." pack .mb - list [tkMbPost .mb] [destroy .m1] + list [tk::MbPost .mb] [destroy .m1] } {{} {}} test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} { catch {destroy .m1} @@ -440,32 +440,32 @@ test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -hidemargin 1 - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo -accel Ctrl+U - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} { @@ -479,7 +479,7 @@ test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator - list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] + list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} # Currently, the only callers to DrawWindowsSystemBitmap want things @@ -489,14 +489,14 @@ test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -505,14 +505,14 @@ test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \ catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} { @@ -520,7 +520,7 @@ test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} { @@ -528,7 +528,7 @@ test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} { menu .m1 .m1 add radiobutton -label foo .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} { @@ -537,7 +537,7 @@ test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} { .m1 add checkbutton -label foo .m1 invoke foo .m1 entryconfigure foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} { @@ -545,7 +545,7 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} { menu .m1 .m1 add checkbutton -label foo -indicatoron 0 .m1 invoke foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -553,14 +553,14 @@ test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -accel "Ctrl+U" -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \ @@ -568,14 +568,14 @@ test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \ catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -accel "Ctrl+U" -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \ @@ -590,7 +590,7 @@ test winMenu-21.1 {DrawMenuSeparator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -598,7 +598,7 @@ test winMenu-22.1 {DrawMenuUnderline} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -611,21 +611,21 @@ test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -662,7 +662,7 @@ test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \ catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -671,7 +671,7 @@ test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \ catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -680,7 +680,7 @@ test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} { menu .m1 set tk_strictMotif 1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -690,35 +690,35 @@ test winMenu-29.4 \ catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} { @@ -726,7 +726,7 @@ test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} { @@ -734,14 +734,14 @@ test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -749,7 +749,7 @@ test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -758,7 +758,7 @@ test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} { set tk_strictMotif 1 menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} @@ -766,7 +766,7 @@ test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -774,7 +774,7 @@ test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} @@ -782,28 +782,28 @@ test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} { catch {destroy .mb} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} { @@ -813,7 +813,7 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} { menu .m1.file .m1.file add command -label foo .m1 entryconfigure File -state disabled - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} { @@ -821,7 +821,7 @@ test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} { menu .m1 .m1 add checkbutton -label winMenu-31.20 .m1 invoke winMenu-31.20 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} { @@ -829,7 +829,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} { menu .m1 .m1 add checkbutton -label winMenu-31.21 -hidemargin 1 .m1 invoke winMenu-31.21 - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} @@ -864,14 +864,14 @@ test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo - set tearoff [tkTearOffMenu .m1 40 40] + set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 list [update] [destroy .m1] } {{} {}} @@ -906,7 +906,7 @@ test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { menu .mb.m .mb.m add command -label test pack .mb - catch {tkMbPost .mb} + catch {tk::MbPost .mb} list [update] [destroy .mb] } {{} {}} test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \ diff --git a/tests/xmfbox.test b/tests/xmfbox.test index 52ed35d..8035e44 100644 --- a/tests/xmfbox.test +++ b/tests/xmfbox.test @@ -9,7 +9,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: xmfbox.test,v 1.4 2000/03/24 23:13:19 ericm Exp $ +# RCS: @(#) $Id: xmfbox.test,v 1.5 2001/08/01 16:21:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -59,82 +59,82 @@ proc cleanup {} { catch {destroy .foo} } -test xmfbox-1.1 {tkMotifFDialog_Create, -parent switch} {unixOnly} { +test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} {unixOnly} { catch {unset foo} - set x [tkMotifFDialog_Create foo open {-parent .}] + set x [tk::MotifFDialog_Create foo open {-parent .}] catch {destroy $x} set x } .foo -test xmfbox-1.2 {tkMotifFDialog_Create, -parent switch} {unixOnly} { +test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} {unixOnly} { catch {unset foo} toplevel .bar wm geometry .bar +0+0 - set x [tkMotifFDialog_Create foo open {-parent .bar}] + set x [tk::MotifFDialog_Create foo open {-parent .bar}] catch {destroy $x} catch {destroy .bar} set x } .bar.foo -test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} { +test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} {unixOnly} { cleanup file mkdir ./~nosuchuser1 - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 - set kk [tkMotifFDialog_InterpFilter $x] + set kk [tk::MotifFDialog_InterpFilter $x] } [list $testPWD/~nosuchuser1 *] -test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} { +test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} {unixOnly} { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 - set kk [tkMotifFDialog_InterpFilter $x] + set kk [tk::MotifFDialog_InterpFilter $x] } [list $testPWD ./~nosuchuser1] -test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} { +test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} {unixOnly} { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 - tkMotifFDialog_InterpFilter $x - tkMotifFDialog_Update $x + tk::MotifFDialog_InterpFilter $x + tk::MotifFDialog_Update $x $::tk::dialog::file::foo(fList) get end } ~nosuchuser1 -test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} { +test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} {unixOnly} { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] expr {$i >= 0} } 1 -test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} { +test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} {unixOnly} { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] $::tk::dialog::file::foo(fList) selection clear 0 end $::tk::dialog::file::foo(fList) selection set $i - tkMotifFDialog_BrowseFList $x + tk::MotifFDialog_BrowseFList $x $::tk::dialog::file::foo(sEnt) get } $testPWD/~nosuchuser1 -test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} { +test xmfbox-2.5 {tk::MotifFDialog_ActivateFList, ~ in file names} {unixOnly} { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] - set x [tkMotifFDialog_Create foo open {}] + set x [tk::MotifFDialog_Create foo open {}] set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] $::tk::dialog::file::foo(fList) selection clear 0 end $::tk::dialog::file::foo(fList) selection set $i - tkMotifFDialog_BrowseFList $x - tkMotifFDialog_ActivateFList $x + tk::MotifFDialog_BrowseFList $x + tk::MotifFDialog_ActivateFList $x list $::tk::dialog::file::foo(selectPath) \ - $::tk::dialog::file::foo(selectFile) $tkPriv(selectFilePath) + $::tk::dialog::file::foo(selectFile) $tk::Priv(selectFilePath) } [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1] # cleanup diff --git a/unix/mkLinks b/unix/mkLinks index 79155ea..9e9079d 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -28,10 +28,6 @@ if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then exit fi -if test -r SetClassProcs.3; then - rm -f Tk_SetClassProcs.3 - ln SetClassProcs.3 Tk_SetClassProcs.3 -fi if test -r 3DBorder.3; then rm -f Tk_Alloc3DBorderFromObj.3 rm -f Tk_Get3DBorder.3 @@ -570,6 +566,10 @@ if test -r SetClass.3; then ln SetClass.3 Tk_SetClass.3 ln SetClass.3 Tk_Class.3 fi +if test -r SetClassProcs.3; then + rm -f Tk_SetClassProcs.3 + ln SetClassProcs.3 Tk_SetClassProcs.3 +fi if test -r SetGrid.3; then rm -f Tk_SetGrid.3 rm -f Tk_UnsetGrid.3 @@ -706,6 +706,10 @@ if test -r getOpenFile.n; then ln getOpenFile.n tk_getOpenFile.n ln getOpenFile.n tk_getSaveFile.n fi +if test -r menu.n; then + rm -f tk_menuSetFocus.n + ln menu.n tk_menuSetFocus.n +fi if test -r menubar.n; then rm -f tk_menuBar.n rm -f tk_bindForTraversal.n @@ -730,4 +734,12 @@ if test -r popup.n; then rm -f tk_popup.n ln popup.n tk_popup.n fi +if test -r text.n; then + rm -f tk_textCopy.n + rm -f tk_textCut.n + rm -f tk_textPaste.n + ln text.n tk_textCopy.n + ln text.n tk_textCut.n + ln text.n tk_textPaste.n +fi exit 0 diff --git a/unix/tkUnixDialog.c b/unix/tkUnixDialog.c index 787fae6..9e31fd9 100644 --- a/unix/tkUnixDialog.c +++ b/unix/tkUnixDialog.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixDialog.c,v 1.2 1998/09/14 18:23:55 stanton Exp $ + * RCS: @(#) $Id: tkUnixDialog.c,v 1.3 2001/08/01 16:21:12 dgp Exp $ * */ @@ -103,7 +103,7 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { - return EvalArgv(interp, "tkColorDialog", argc, argv); + return EvalArgv(interp, "tk::ColorDialog", argc, argv); } /* @@ -137,9 +137,9 @@ Tk_GetOpenFileCmd(clientData, interp, argc, argv) Tk_Window tkwin = (Tk_Window)clientData; if (Tk_StrictMotif(tkwin)) { - return EvalArgv(interp, "tkMotifFDialog", argc, argv); + return EvalArgv(interp, "tk::MotifFDialog", argc, argv); } else { - return EvalArgv(interp, "tkFDialog", argc, argv); + return EvalArgv(interp, "tk::FDialog", argc, argv); } } @@ -170,9 +170,9 @@ Tk_GetSaveFileCmd(clientData, interp, argc, argv) Tk_Window tkwin = (Tk_Window)clientData; if (Tk_StrictMotif(tkwin)) { - return EvalArgv(interp, "tkMotifFDialog", argc, argv); + return EvalArgv(interp, "tk::MotifFDialog", argc, argv); } else { - return EvalArgv(interp, "tkFDialog", argc, argv); + return EvalArgv(interp, "tk::FDialog", argc, argv); } } @@ -202,6 +202,6 @@ Tk_MessageBoxCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { - return EvalArgv(interp, "tkMessageBox", argc, argv); + return EvalArgv(interp, "tk::MessageBox", argc, argv); } -- cgit v0.12