diff options
44 files changed, 2679 insertions, 2163 deletions
@@ -1,8 +1,70 @@ +2001-08-01 Don Porter <dgp@users.sourceforge.net> + + * 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 <mdejong@redhat.com> * generic/default.h: Include tkWinDefault.h when built with Cygwin or Mingw. +2001-07-18 Don Porter <dgp@users.sourceforge.net> + + BRANCH dgp-privates-into-namespace: + * doc/console.n: Updated names of private console commands. + +2001-07-16 Don Porter <dgp@users.sourceforge.net> + + 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 <mdejong@redhat.com> * 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 <dgp@users.sourceforge.net> + + BRANCH dgp-privates-into-namespace: + * doc/menu.n: + * unix/mkLinks: Added documentation for [tk_menuSetFocus]. + +2001-03-12 Don Porter <dgp@users.sourceforge.net> + + 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 <dgp@users.sourceforge.net> + + 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 <dgp@users.sourceforge.net> + + 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 <dgp@users.sourceforge.net> + + 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 <ericm@interwoven.com> * 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.) @@ -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. @@ -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 <Enter> { - tkButtonEnter %W + tk::ButtonEnter %W } bind Radiobutton <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Radiobutton <ButtonRelease-1> { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton <Enter> { - tkButtonEnter %W + tk::ButtonEnter %W } bind Checkbutton <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Checkbutton <ButtonRelease-1> { - tkButtonUp %W + tk::ButtonUp %W } } if {[string match "windows" $tcl_platform(platform)]} { bind Checkbutton <equal> { - tkCheckRadioInvoke %W select + tk::CheckRadioInvoke %W select } bind Checkbutton <plus> { - tkCheckRadioInvoke %W select + tk::CheckRadioInvoke %W select } bind Checkbutton <minus> { - tkCheckRadioInvoke %W deselect + tk::CheckRadioInvoke %W deselect } bind Checkbutton <1> { - tkCheckRadioDown %W + tk::CheckRadioDown %W } bind Checkbutton <ButtonRelease-1> { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton <Enter> { - tkCheckRadioEnter %W + tk::CheckRadioEnter %W } bind Radiobutton <1> { - tkCheckRadioDown %W + tk::CheckRadioDown %W } bind Radiobutton <ButtonRelease-1> { - tkButtonUp %W + tk::ButtonUp %W } bind Radiobutton <Enter> { - tkCheckRadioEnter %W + tk::CheckRadioEnter %W } } if {[string match "unix" $tcl_platform(platform)]} { bind Checkbutton <Return> { if {!$tk_strictMotif} { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } } bind Radiobutton <Return> { 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 <Enter> { - tkButtonEnter %W + tk::ButtonEnter %W } bind Radiobutton <Enter> { - tkButtonEnter %W + tk::ButtonEnter %W } } bind Button <space> { - tkButtonInvoke %W + tk::ButtonInvoke %W } bind Checkbutton <space> { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Radiobutton <space> { - tkCheckRadioInvoke %W + tk::CheckRadioInvoke %W } bind Button <FocusIn> {} bind Button <Enter> { - tkButtonEnter %W + tk::ButtonEnter %W } bind Button <Leave> { - tkButtonLeave %W + tk::ButtonLeave %W } bind Button <1> { - tkButtonDown %W + tk::ButtonDown %W } bind Button <ButtonRelease-1> { - tkButtonUp %W + tk::ButtonUp %W } bind Checkbutton <FocusIn> {} bind Checkbutton <Leave> { - tkButtonLeave %W + tk::ButtonLeave %W } bind Radiobutton <FocusIn> {} bind Radiobutton <Leave> { - 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) <Configure> \ - [list tkColorDialog_DrawColorScale $w $color 1] + [list tk::dialog::color::DrawColorScale $w $color 1] bind $data($color,col) <Enter> \ - [list tkColorDialog_EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,col) <Leave> \ - [list tkColorDialog_LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] bind $data($color,sel) <Enter> \ - [list tkColorDialog_EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,sel) <Leave> \ - [list tkColorDialog_LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] - bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w] + bind $box.entry <Return> [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 <Return> [list tkColorDialog_HandleSelEntry $w] + bind $ent <Return> [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 <Alt-g> [list focus $data(green,entry)] bind $w <Alt-b> [list focus $data(blue,entry)] bind $w <Alt-s> [list focus $ent] - bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)] - bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)] - bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)] + bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)] + bind $w <Alt-c> [list tk::ButtonInvoke $data(cancelBtn)] + bind $w <Alt-o> [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) <ButtonPress-1> \ - [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) <B1-Motion> \ - [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) <ButtonRelease-1> \ - [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 <ButtonPress-1> \ - [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)] + [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] bind $col <B1-Motion> \ - [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)] + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)] bind $col <ButtonRelease-1> \ - [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) <ButtonPress-1> \ - [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) <B1-Motion> \ - [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) <ButtonRelease-1> \ - [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 <FocusIn> [list tkFocusGroup_In $t %W %d] - bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d] - bind $t <Destroy> [list tkFocusGroup_Destroy $t %W] + if {![info exists Priv(fg,$t)]} { + set Priv(fg,$t) 1 + set Priv(focus,$t) "" + bind $t <FocusIn> [list tk::FocusGroup_In $t %W %d] + bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d] + bind $t <Destroy> [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 <FocusIn> 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 <FocusOut> 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 <KP_Enter> {# nothing} bind $win <Tab> { - tkConsoleInsert %W \t + tk::ConsoleInsert %W \t focus %W break } bind $win <Return> { %W mark set insert {end - 1c} - tkConsoleInsert %W "\n" - tkConsoleInvoke + tk::ConsoleInsert %W "\n" + tk::ConsoleInvoke break } bind $win <Delete> { @@ -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 <Insert> { - catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]} + catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]} break } bind $win <KeyPress> { - 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 <Destroy> {set tkPriv(button) -1} + bind $w <Destroy> {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> {} 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 <<Cut>> { - 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 <<Copy>> { - 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 <<Paste>> { @@ -56,105 +56,105 @@ bind Entry <<Paste>> { } } %W insert insert [::tk::GetSelection %W CLIPBOARD] - tkEntrySeeInsert %W + tk::EntrySeeInsert %W } } bind Entry <<Clear>> { %W delete sel.first sel.last } bind Entry <<PasteSelection>> { - 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 <B1-Motion> { - set tkPriv(x) %x - tkEntryMouseSelect %W %x + set tk::Priv(x) %x + tk::EntryMouseSelect %W %x } bind Entry <Double-1> { - set tkPriv(selectMode) word - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x catch {%W icursor sel.first} } bind Entry <Triple-1> { - set tkPriv(selectMode) line - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x %W icursor 0 } bind Entry <Shift-1> { - set tkPriv(selectMode) char + set tk::Priv(selectMode) char %W selection adjust @%x } bind Entry <Double-Shift-1> { - set tkPriv(selectMode) word - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x } bind Entry <Triple-Shift-1> { - set tkPriv(selectMode) line - tkEntryMouseSelect %W %x + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x } bind Entry <B1-Leave> { - set tkPriv(x) %x - tkEntryAutoScan %W + set tk::Priv(x) %x + tk::EntryAutoScan %W } bind Entry <B1-Enter> { - tkCancelRepeat + tk::CancelRepeat } bind Entry <ButtonRelease-1> { - tkCancelRepeat + tk::CancelRepeat } bind Entry <Control-1> { %W icursor @%x } bind Entry <Left> { - tkEntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } bind Entry <Right> { - tkEntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Entry <Shift-Left> { - tkEntryKeySelect %W [expr {[%W index insert] - 1}] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + tk::EntrySeeInsert %W } bind Entry <Shift-Right> { - tkEntryKeySelect %W [expr {[%W index insert] + 1}] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + tk::EntrySeeInsert %W } bind Entry <Control-Left> { - tkEntrySetCursor %W [tkEntryPreviousWord %W insert] + tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } bind Entry <Control-Right> { - tkEntrySetCursor %W [tkEntryNextWord %W insert] + tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } bind Entry <Shift-Control-Left> { - tkEntryKeySelect %W [tkEntryPreviousWord %W insert] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert] + tk::EntrySeeInsert %W } bind Entry <Shift-Control-Right> { - tkEntryKeySelect %W [tkEntryNextWord %W insert] - tkEntrySeeInsert %W + tk::EntryKeySelect %W [tk::EntryNextWord %W insert] + tk::EntrySeeInsert %W } bind Entry <Home> { - tkEntrySetCursor %W 0 + tk::EntrySetCursor %W 0 } bind Entry <Shift-Home> { - tkEntryKeySelect %W 0 - tkEntrySeeInsert %W + tk::EntryKeySelect %W 0 + tk::EntrySeeInsert %W } bind Entry <End> { - tkEntrySetCursor %W end + tk::EntrySetCursor %W end } bind Entry <Shift-End> { - tkEntryKeySelect %W end - tkEntrySeeInsert %W + tk::EntryKeySelect %W end + tk::EntrySeeInsert %W } bind Entry <Delete> { @@ -165,7 +165,7 @@ bind Entry <Delete> { } } bind Entry <BackSpace> { - tkEntryBackspace %W + tk::EntryBackspace %W } bind Entry <Control-space> { @@ -187,7 +187,7 @@ bind Entry <Control-backslash> { %W selection clear } bind Entry <KeyPress> { - 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 <<Paste>> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Entry <Insert> { - 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 <Control-a> { if {!$tk_strictMotif} { - tkEntrySetCursor %W 0 + tk::EntrySetCursor %W 0 } } bind Entry <Control-b> { if {!$tk_strictMotif} { - tkEntrySetCursor %W [expr {[%W index insert] - 1}] + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } } bind Entry <Control-d> { @@ -233,17 +233,17 @@ bind Entry <Control-d> { } bind Entry <Control-e> { if {!$tk_strictMotif} { - tkEntrySetCursor %W end + tk::EntrySetCursor %W end } } bind Entry <Control-f> { if {!$tk_strictMotif} { - tkEntrySetCursor %W [expr {[%W index insert] + 1}] + tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } } bind Entry <Control-h> { if {!$tk_strictMotif} { - tkEntryBackspace %W + tk::EntryBackspace %W } } bind Entry <Control-k> { @@ -253,32 +253,32 @@ bind Entry <Control-k> { } bind Entry <Control-t> { if {!$tk_strictMotif} { - tkEntryTranspose %W + tk::EntryTranspose %W } } bind Entry <Meta-b> { if {!$tk_strictMotif} { - tkEntrySetCursor %W [tkEntryPreviousWord %W insert] + tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } } bind Entry <Meta-d> { if {!$tk_strictMotif} { - %W delete insert [tkEntryNextWord %W insert] + %W delete insert [tk::EntryNextWord %W insert] } } bind Entry <Meta-f> { if {!$tk_strictMotif} { - tkEntrySetCursor %W [tkEntryNextWord %W insert] + tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } } bind Entry <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [tkEntryPreviousWord %W insert] insert + %W delete [tk::EntryPreviousWord %W insert] insert } } bind Entry <Meta-Delete> { if {!$tk_strictMotif} { - %W delete [tkEntryPreviousWord %W insert] insert + %W delete [tk::EntryPreviousWord %W insert] insert } } @@ -287,21 +287,21 @@ bind Entry <Meta-Delete> { 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 <B2-Motion> { 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 <B2-Motion> { # 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 <Enter>] 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 <Double-1> { } bind Listbox <B1-Motion> { - 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 <ButtonRelease-1> { - tkCancelRepeat + tk::CancelRepeat %W activate @%x,%y } bind Listbox <Shift-1> { - tkListboxBeginExtend %W [%W index @%x,%y] + tk::ListboxBeginExtend %W [%W index @%x,%y] } bind Listbox <Control-1> { - tkListboxBeginToggle %W [%W index @%x,%y] + tk::ListboxBeginToggle %W [%W index @%x,%y] } bind Listbox <B1-Leave> { - 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 <B1-Enter> { - tkCancelRepeat + tk::CancelRepeat } bind Listbox <Up> { - tkListboxUpDown %W -1 + tk::ListboxUpDown %W -1 } bind Listbox <Shift-Up> { - tkListboxExtendUpDown %W -1 + tk::ListboxExtendUpDown %W -1 } bind Listbox <Down> { - tkListboxUpDown %W 1 + tk::ListboxUpDown %W 1 } bind Listbox <Shift-Down> { - tkListboxExtendUpDown %W 1 + tk::ListboxExtendUpDown %W 1 } bind Listbox <Left> { %W xview scroll -1 units @@ -123,7 +123,7 @@ bind Listbox <Control-Home> { event generate %W <<ListboxSelect>> } bind Listbox <Shift-Control-Home> { - tkListboxDataExtend %W 0 + tk::ListboxDataExtend %W 0 } bind Listbox <Control-End> { %W activate end @@ -133,7 +133,7 @@ bind Listbox <Control-End> { event generate %W <<ListboxSelect>> } bind Listbox <Shift-Control-End> { - tkListboxDataExtend %W [%W index end] + tk::ListboxDataExtend %W [%W index end] } bind Listbox <<Copy>> { if {[string equal [selection own -displayof %W] "%W"]} { @@ -142,22 +142,22 @@ bind Listbox <<Copy>> { } } bind Listbox <space> { - tkListboxBeginSelect %W [%W index active] + tk::ListboxBeginSelect %W [%W index active] } bind Listbox <Select> { - tkListboxBeginSelect %W [%W index active] + tk::ListboxBeginSelect %W [%W index active] } bind Listbox <Control-Shift-space> { - tkListboxBeginExtend %W [%W index active] + tk::ListboxBeginExtend %W [%W index active] } bind Listbox <Shift-Select> { - tkListboxBeginExtend %W [%W index active] + tk::ListboxBeginExtend %W [%W index active] } bind Listbox <Escape> { - tkListboxCancel %W + tk::ListboxCancel %W } bind Listbox <Control-slash> { - tkListboxSelectAll %W + tk::ListboxSelectAll %W } bind Listbox <Control-backslash> { if {[string compare [%W cget -selectmode] "browse"]} { @@ -200,7 +200,7 @@ if {[string equal "unix" $tcl_platform(platform)]} { } } -# tkListboxBeginSelect -- +# ::tk::ListboxBeginSelect -- # # This procedure is typically invoked on button-1 presses. It begins # the process of making a selection in the listbox. Its exact behavior @@ -212,8 +212,8 @@ if {[string equal "unix" $tcl_platform(platform)]} { # el - The element for the selection operation (typically the # one under the pointer). Must be in numerical form. -proc tkListboxBeginSelect {w el} { - global tkPriv +proc ::tk::ListboxBeginSelect {w el} { + variable ::tk::Priv if {[string equal [$w cget -selectmode] "multiple"]} { if {[$w selection includes $el]} { $w selection clear $el @@ -224,13 +224,13 @@ proc tkListboxBeginSelect {w el} { $w selection clear 0 end $w selection set $el $w selection anchor $el - set tkPriv(listboxSelection) {} - set tkPriv(listboxPrev) $el + set Priv(listboxSelection) {} + set Priv(listboxPrev) $el } event generate $w <<ListboxSelect>> } -# tkListboxMotion -- +# ::tk::ListboxMotion -- # # This procedure is called to process mouse motion events while # button 1 is down. It may move or extend the selection, depending @@ -240,9 +240,9 @@ proc tkListboxBeginSelect {w el} { # w - The listbox widget. # el - The element under the pointer (must be a number). -proc tkListboxMotion {w el} { - global tkPriv - if {$el == $tkPriv(listboxPrev)} { +proc ::tk::ListboxMotion {w el} { + variable ::tk::Priv + if {$el == $Priv(listboxPrev)} { return } set anchor [$w index anchor] @@ -250,11 +250,11 @@ proc tkListboxMotion {w el} { browse { $w selection clear 0 end $w selection set $el - set tkPriv(listboxPrev) $el + set Priv(listboxPrev) $el event generate $w <<ListboxSelect>> } extended { - set i $tkPriv(listboxPrev) + set i $Priv(listboxPrev) if {[string equal {} $i]} { set i $el $w selection set $el @@ -266,28 +266,28 @@ proc tkListboxMotion {w el} { $w selection clear $i $el $w selection clear anchor $el } - if {![info exists tkPriv(listboxSelection)]} { - set tkPriv(listboxSelection) [$w curselection] + if {![info exists Priv(listboxSelection)]} { + set Priv(listboxSelection) [$w curselection] } while {($i < $el) && ($i < $anchor)} { - if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { + if {[lsearch $Priv(listboxSelection) $i] >= 0} { $w selection set $i } incr i } while {($i > $el) && ($i > $anchor)} { - if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { + if {[lsearch $Priv(listboxSelection) $i] >= 0} { $w selection set $i } incr i -1 } - set tkPriv(listboxPrev) $el + set Priv(listboxPrev) $el event generate $w <<ListboxSelect>> } } } -# tkListboxBeginExtend -- +# ::tk::ListboxBeginExtend -- # # This procedure is typically invoked on shift-button-1 presses. It # begins the process of extending a selection in the listbox. Its @@ -299,18 +299,18 @@ proc tkListboxMotion {w el} { # el - The element for the selection operation (typically the # one under the pointer). Must be in numerical form. -proc tkListboxBeginExtend {w el} { +proc ::tk::ListboxBeginExtend {w el} { if {[string equal [$w cget -selectmode] "extended"]} { if {[$w selection includes anchor]} { - tkListboxMotion $w $el + ListboxMotion $w $el } else { # No selection yet; simulate the begin-select operation. - tkListboxBeginSelect $w $el + ListboxBeginSelect $w $el } } } -# tkListboxBeginToggle -- +# ::tk::ListboxBeginToggle -- # # This procedure is typically invoked on control-button-1 presses. It # begins the process of toggling a selection in the listbox. Its @@ -322,11 +322,11 @@ proc tkListboxBeginExtend {w el} { # el - The element for the selection operation (typically the # one under the pointer). Must be in numerical form. -proc tkListboxBeginToggle {w el} { - global tkPriv +proc ::tk::ListboxBeginToggle {w el} { + variable ::tk::Priv if {[string equal [$w cget -selectmode] "extended"]} { - set tkPriv(listboxSelection) [$w curselection] - set tkPriv(listboxPrev) $el + set Priv(listboxSelection) [$w curselection] + set Priv(listboxPrev) $el $w selection anchor $el if {[$w selection includes $el]} { $w selection clear $el @@ -337,7 +337,7 @@ proc tkListboxBeginToggle {w el} { } } -# tkListboxAutoScan -- +# ::tk::ListboxAutoScan -- # This procedure is invoked when the mouse leaves an entry window # with button 1 down. It scrolls the window up, down, left, or # right, depending on where the mouse left the window, and reschedules @@ -347,11 +347,11 @@ proc tkListboxBeginToggle {w el} { # Arguments: # w - The entry window. -proc tkListboxAutoScan {w} { - global tkPriv +proc ::tk::ListboxAutoScan {w} { + 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 {$y >= [winfo height $w]} { $w yview scroll 1 units } elseif {$y < 0} { @@ -363,11 +363,11 @@ proc tkListboxAutoScan {w} { } else { return } - tkListboxMotion $w [$w index @$x,$y] - set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]] + ListboxMotion $w [$w index @$x,$y] + set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]] } -# tkListboxUpDown -- +# ::tk::ListboxUpDown -- # # Moves the location cursor (active element) up or down by one element, # and changes the selection if we're in browse or extended selection @@ -377,8 +377,8 @@ proc tkListboxAutoScan {w} { # w - The listbox widget. # amount - +1 to move down one item, -1 to move back one item. -proc tkListboxUpDown {w amount} { - global tkPriv +proc ::tk::ListboxUpDown {w amount} { + variable ::tk::Priv $w activate [expr {[$w index active] + $amount}] $w see active switch [$w cget -selectmode] { @@ -391,14 +391,14 @@ proc tkListboxUpDown {w amount} { $w selection clear 0 end $w selection set active $w selection anchor active - set tkPriv(listboxPrev) [$w index active] - set tkPriv(listboxSelection) {} + set Priv(listboxPrev) [$w index active] + set Priv(listboxSelection) {} event generate $w <<ListboxSelect>> } } } -# tkListboxExtendUpDown -- +# ::tk::ListboxExtendUpDown -- # # Does nothing unless we're in extended selection mode; in this # case it moves the location cursor (active element) up or down by @@ -408,22 +408,22 @@ proc tkListboxUpDown {w amount} { # w - The listbox widget. # amount - +1 to move down one item, -1 to move back one item. -proc tkListboxExtendUpDown {w amount} { +proc ::tk::ListboxExtendUpDown {w amount} { + variable ::tk::Priv if {[string compare [$w cget -selectmode] "extended"]} { return } set active [$w index active] - if {![info exists tkPriv(listboxSelection)]} { - global tkPriv + if {![info exists Priv(listboxSelection)]} { $w selection set $active - set tkPriv(listboxSelection) [$w curselection] + set Priv(listboxSelection) [$w curselection] } $w activate [expr {$active + $amount}] $w see active - tkListboxMotion $w [$w index active] + ListboxMotion $w [$w index active] } -# tkListboxDataExtend +# ::tk::ListboxDataExtend # # This procedure is called for key-presses such as Shift-KEndData. # If the selection mode isn't multiple or extend then it does nothing. @@ -434,13 +434,13 @@ proc tkListboxExtendUpDown {w amount} { # w - The listbox widget. # el - An integer element number. -proc tkListboxDataExtend {w el} { +proc ::tk::ListboxDataExtend {w el} { set mode [$w cget -selectmode] if {[string equal $mode "extended"]} { $w activate $el $w see $el if {[$w selection includes anchor]} { - tkListboxMotion $w $el + ListboxMotion $w $el } } elseif {[string equal $mode "multiple"]} { $w activate $el @@ -448,7 +448,7 @@ proc tkListboxDataExtend {w el} { } } -# tkListboxCancel +# ::tk::ListboxCancel # # This procedure is invoked to cancel an extended selection in # progress. If there is an extended selection in progress, it @@ -458,13 +458,13 @@ proc tkListboxDataExtend {w el} { # Arguments: # w - The listbox widget. -proc tkListboxCancel w { - global tkPriv +proc ::tk::ListboxCancel w { + variable ::tk::Priv if {[string compare [$w cget -selectmode] "extended"]} { return } set first [$w index anchor] - set last $tkPriv(listboxPrev) + set last $Priv(listboxPrev) if { [string equal $last ""] } { # Not actually doing any selection right now return @@ -476,7 +476,7 @@ proc tkListboxCancel w { } $w selection clear $first $last while {$first <= $last} { - if {[lsearch $tkPriv(listboxSelection) $first] >= 0} { + if {[lsearch $Priv(listboxSelection) $first] >= 0} { $w selection set $first } incr first @@ -484,7 +484,7 @@ proc tkListboxCancel w { event generate $w <<ListboxSelect>> } -# tkListboxSelectAll +# ::tk::ListboxSelectAll # # This procedure is invoked to handle the "select all" operation. # For single and browse mode, it just selects the active element. @@ -493,7 +493,7 @@ proc tkListboxCancel w { # Arguments: # w - The listbox widget. -proc tkListboxSelectAll w { +proc ::tk::ListboxSelectAll w { set mode [$w cget -selectmode] if {[string equal $mode "single"] || [string equal $mode "browse"]} { $w selection clear 0 end diff --git a/library/menu.tcl b/library/menu.tcl index cd1260f..c9d9c8f 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -4,7 +4,7 @@ # It also implements keyboard traversal of menus and implements a few # other utility procedures related to menus. # -# RCS: @(#) $Id: menu.tcl,v 1.12 2000/04/17 19:32:00 ericm Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.13 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. @@ -15,13 +15,13 @@ # #------------------------------------------------------------------------- -# Elements of tkPriv that are used in this file: +# Elements of tk::Priv that are used in this file: # # cursor - Saves the -cursor option for the posted menubutton. # focus - Saves the focus during a menu selection operation. # Focus gets restored here when the menu is unposted. -# grabGlobal - Used in conjunction with tkPriv(oldGrab): if -# tkPriv(oldGrab) is non-empty, then tkPriv(grabGlobal) +# grabGlobal - Used in conjunction with tk::Priv(oldGrab): if +# tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal) # contains either an empty string or "-global" to # indicate whether the old grab was a local one or # a global one. @@ -62,14 +62,14 @@ # can be used: # # 1. As a pulldown from a menubutton. In this style, the variable -# tkPriv(postedMb) identifies the posted menubutton. +# tk::Priv(postedMb) identifies the posted menubutton. # 2. As a torn-off menu copied from some other menu. In this style -# tkPriv(postedMb) is empty, and menu's type is "tearoff". +# tk::Priv(postedMb) is empty, and menu's type is "tearoff". # 3. As an option menu, triggered from an option menubutton. In this -# style tkPriv(postedMb) identifies the posted menubutton. -# 4. As a popup menu. In this style tkPriv(postedMb) is empty and +# style tk::Priv(postedMb) identifies the posted menubutton. +# 4. As a popup menu. In this style tk::Priv(postedMb) is empty and # the top-level menu's type is "normal". -# 5. As a pulldown from a menubar. The variable tkPriv(menubar) has +# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has # the owning menubar, and the menu itself is of type "normal". # # The various binding procedures use the state described above to @@ -84,28 +84,28 @@ bind Menubutton <FocusIn> {} bind Menubutton <Enter> { - tkMbEnter %W + tk::MbEnter %W } bind Menubutton <Leave> { - tkMbLeave %W + tk::MbLeave %W } bind Menubutton <1> { - if {[string compare $tkPriv(inMenubutton) ""]} { - tkMbPost $tkPriv(inMenubutton) %X %Y + if {[string compare $tk::Priv(inMenubutton) ""]} { + tk::MbPost $tk::Priv(inMenubutton) %X %Y } } bind Menubutton <Motion> { - tkMbMotion %W up %X %Y + tk::MbMotion %W up %X %Y } bind Menubutton <B1-Motion> { - tkMbMotion %W down %X %Y + tk::MbMotion %W down %X %Y } bind Menubutton <ButtonRelease-1> { - tkMbButtonUp %W + tk::MbButtonUp %W } bind Menubutton <space> { - tkMbPost %W - tkMenuFirstEntry [%W cget -menu] + tk::MbPost %W + tk::MenuFirstEntry [%W cget -menu] } # Must set focus when mouse enters a menu, in order to allow @@ -118,7 +118,7 @@ bind Menubutton <space> { bind Menu <FocusIn> {} bind Menu <Enter> { - set tkPriv(window) %W + set tk::Priv(window) %W if {[string equal [%W cget -type] "tearoff"]} { if {[string compare "%m" "NotifyUngrab"]} { if {[string equal $tcl_platform(platform) "unix"]} { @@ -126,44 +126,44 @@ bind Menu <Enter> { } } } - tkMenuMotion %W %x %y %s + tk::MenuMotion %W %x %y %s } bind Menu <Leave> { - tkMenuLeave %W %X %Y %s + tk::MenuLeave %W %X %Y %s } bind Menu <Motion> { - tkMenuMotion %W %x %y %s + tk::MenuMotion %W %x %y %s } bind Menu <ButtonPress> { - tkMenuButtonDown %W + tk::MenuButtonDown %W } bind Menu <ButtonRelease> { - tkMenuInvoke %W 1 + tk::MenuInvoke %W 1 } bind Menu <space> { - tkMenuInvoke %W 0 + tk::MenuInvoke %W 0 } bind Menu <Return> { - tkMenuInvoke %W 0 + tk::MenuInvoke %W 0 } bind Menu <Escape> { - tkMenuEscape %W + tk::MenuEscape %W } bind Menu <Left> { - tkMenuLeftArrow %W + tk::MenuLeftArrow %W } bind Menu <Right> { - tkMenuRightArrow %W + tk::MenuRightArrow %W } bind Menu <Up> { - tkMenuUpArrow %W + tk::MenuUpArrow %W } bind Menu <Down> { - tkMenuDownArrow %W + tk::MenuDownArrow %W } bind Menu <KeyPress> { - tkTraverseWithinMenu %W %A + tk::TraverseWithinMenu %W %A } # The following bindings apply to all windows, and are used to @@ -171,54 +171,54 @@ bind Menu <KeyPress> { if {[string equal $tcl_platform(platform) "unix"]} { bind all <Alt-KeyPress> { - tkTraverseToMenu %W %A + tk::TraverseToMenu %W %A } bind all <F10> { - tkFirstMenu %W + tk::FirstMenu %W } } else { bind Menubutton <Alt-KeyPress> { - tkTraverseToMenu %W %A + tk::TraverseToMenu %W %A } bind Menubutton <F10> { - tkFirstMenu %W + tk::FirstMenu %W } } -# tkMbEnter -- +# ::tk::MbEnter -- # This procedure is invoked when the mouse enters a menubutton # widget. It activates the widget unless it is disabled. Note: # this procedure is only invoked when mouse button 1 is *not* down. -# The procedure tkMbB1Enter is invoked if the button is down. +# The procedure ::tk::MbB1Enter is invoked if the button is down. # # Arguments: # w - The name of the widget. -proc tkMbEnter w { - global tkPriv +proc ::tk::MbEnter w { + variable ::tk::Priv - if {[string compare $tkPriv(inMenubutton) ""]} { - tkMbLeave $tkPriv(inMenubutton) + if {[string compare $Priv(inMenubutton) ""]} { + MbLeave $Priv(inMenubutton) } - set tkPriv(inMenubutton) $w + set Priv(inMenubutton) $w if {[string compare [$w cget -state] "disabled"]} { $w configure -state active } } -# tkMbLeave -- +# ::tk::MbLeave -- # This procedure is invoked when the mouse leaves a menubutton widget. # It de-activates the widget, if the widget still exists. # # Arguments: # w - The name of the widget. -proc tkMbLeave w { - global tkPriv +proc ::tk::MbLeave w { + variable ::tk::Priv - set tkPriv(inMenubutton) {} + set Priv(inMenubutton) {} if {![winfo exists $w]} { return } @@ -227,7 +227,7 @@ proc tkMbLeave w { } } -# tkMbPost -- +# ::tk::MbPost -- # Given a menubutton, this procedure does all the work of posting # its associated menu and unposting any other menu that is currently # posted. @@ -239,12 +239,13 @@ proc tkMbLeave w { # option menus. If not specified, then the center # of the menubutton is used for an option menu. -proc tkMbPost {w {x {}} {y {}}} { - global tkPriv errorInfo +proc ::tk::MbPost {w {x {}} {y {}}} { + global errorInfo + variable ::tk::Priv global tcl_platform if {[string equal [$w cget -state] "disabled"] || \ - [string equal $w $tkPriv(postedMb)]} { + [string equal $w $Priv(postedMb)]} { return } set menu [$w cget -menu] @@ -256,19 +257,19 @@ proc tkMbPost {w {x {}} {y {}}} { if {[string first $w $menu] != 0} { error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" } - set cur $tkPriv(postedMb) + set cur $Priv(postedMb) if {[string compare $cur ""]} { - tkMenuUnpost {} + MenuUnpost {} } - set tkPriv(cursor) [$w cget -cursor] - set tkPriv(relief) [$w cget -relief] + set Priv(cursor) [$w cget -cursor] + set Priv(relief) [$w cget -relief] $w configure -cursor arrow $w configure -relief raised - set tkPriv(postedMb) $w - set tkPriv(focus) [focus] + set Priv(postedMb) $w + set Priv(focus) [focus] $menu activate none - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu # If this looks like an option menubutton then post the menu so # that the current entry is on top of the mouse. Otherwise post @@ -290,7 +291,7 @@ proc tkMbPost {w {x {}} {y {}}} { left { set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] - set entry [tkMenuFindName $menu [$w cget -text]] + set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -303,13 +304,13 @@ proc tkMbPost {w {x {}} {y {}}} { $menu post $x $y if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] - set entry [tkMenuFindName $menu [$w cget -text]] + set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -322,7 +323,7 @@ proc tkMbPost {w {x {}} {y {}}} { $menu post $x $y if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } } default { @@ -331,7 +332,7 @@ proc tkMbPost {w {x {}} {y {}}} { set x [expr {[winfo rootx $w] + [winfo width $w]/2}] set y [expr {[winfo rooty $w] + [winfo height $w]/2}] } - tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]] + PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]] } else { $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] } @@ -342,22 +343,22 @@ proc tkMbPost {w {x {}} {y {}}} { # reflect the error. set savedInfo $errorInfo - tkMenuUnpost {} + MenuUnpost {} error $msg $savedInfo } - set tkPriv(tearoff) $tearoff + set Priv(tearoff) $tearoff if {$tearoff != 0} { focus $menu if {[winfo viewable $w]} { - tkSaveGrabInfo $w + SaveGrabInfo $w grab -global $w } } } -# tkMenuUnpost -- +# ::tk::MenuUnpost -- # This procedure unposts a given menu, plus all of its ancestors up # to (and including) a menubutton, if any. It also restores various # values to what they were before the menu was posted, and releases @@ -373,17 +374,17 @@ proc tkMbPost {w {x {}} {y {}}} { # menu - Name of a menu to unpost. Ignored if there # is a posted menubutton. -proc tkMenuUnpost menu { +proc ::tk::MenuUnpost menu { global tcl_platform - global tkPriv - set mb $tkPriv(postedMb) + variable ::tk::Priv + set mb $Priv(postedMb) # Restore focus right away (otherwise X will take focus away when # the menu is unmapped and under some window managers (e.g. olvwm) # we'll lose the focus completely). - catch {focus $tkPriv(focus)} - set tkPriv(focus) "" + catch {focus $Priv(focus)} + set Priv(focus) "" # Unpost menu(s) and restore some stuff that's dependent on # what was posted. @@ -392,12 +393,12 @@ proc tkMenuUnpost menu { if {[string compare $mb ""]} { set menu [$mb cget -menu] $menu unpost - set tkPriv(postedMb) {} - $mb configure -cursor $tkPriv(cursor) - $mb configure -relief $tkPriv(relief) - } elseif {[string compare $tkPriv(popup) ""]} { - $tkPriv(popup) unpost - set tkPriv(popup) {} + set Priv(postedMb) {} + $mb configure -cursor $Priv(cursor) + $mb configure -relief $Priv(relief) + } elseif {[string compare $Priv(popup) ""]} { + $Priv(popup) unpost + set Priv(popup) {} } elseif {[string compare [$menu cget -type] "menubar"] \ && [string compare [$menu cget -type] "tearoff"]} { # We're in a cascaded sub-menu from a torn-off menu or popup. @@ -413,7 +414,7 @@ proc tkMenuUnpost menu { } $parent activate none $parent postcascade none - tkGenerateMenuSelect $parent + GenerateMenuSelect $parent set type [$parent cget -type] if {[string equal $type "menubar"] || \ [string equal $type "tearoff"]} { @@ -427,7 +428,7 @@ proc tkMenuUnpost menu { } } - if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} { + if {($Priv(tearoff) != 0) || [string compare $Priv(menuBar) ""]} { # Release grab, if any, and restore the previous grab, if there # was one. if {[string compare $menu ""]} { @@ -436,18 +437,18 @@ proc tkMenuUnpost menu { grab release $grab } } - tkRestoreOldGrab - if {[string compare $tkPriv(menuBar) ""]} { - $tkPriv(menuBar) configure -cursor $tkPriv(cursor) - set tkPriv(menuBar) {} + RestoreOldGrab + if {[string compare $Priv(menuBar) ""]} { + $Priv(menuBar) configure -cursor $Priv(cursor) + set Priv(menuBar) {} } if {[string compare $tcl_platform(platform) "unix"]} { - set tkPriv(tearoff) 0 + set Priv(tearoff) 0 } } } -# tkMbMotion -- +# ::tk::MbMotion -- # This procedure handles mouse motion events inside menubuttons, and # also outside menubuttons when a menubutton has a grab (e.g. when a # menu selection operation is in progress). @@ -458,33 +459,33 @@ proc tkMenuUnpost menu { # it isn't. # rootx, rooty - Coordinates of mouse, in (virtual?) root window. -proc tkMbMotion {w upDown rootx rooty} { - global tkPriv +proc ::tk::MbMotion {w upDown rootx rooty} { + variable ::tk::Priv - if {[string equal $tkPriv(inMenubutton) $w]} { + if {[string equal $Priv(inMenubutton) $w]} { return } set new [winfo containing $rootx $rooty] - if {[string compare $new $tkPriv(inMenubutton)] \ + if {[string compare $new $Priv(inMenubutton)] \ && ([string equal $new ""] \ || [string equal [winfo toplevel $new] [winfo toplevel $w]])} { - if {[string compare $tkPriv(inMenubutton) ""]} { - tkMbLeave $tkPriv(inMenubutton) + if {[string compare $Priv(inMenubutton) ""]} { + MbLeave $Priv(inMenubutton) } if {[string compare $new ""] \ && [string equal [winfo class $new] "Menubutton"] \ && ([$new cget -indicatoron] == 0) \ && ([$w cget -indicatoron] == 0)} { if {[string equal $upDown "down"]} { - tkMbPost $new $rootx $rooty + MbPost $new $rootx $rooty } else { - tkMbEnter $new + MbEnter $new } } } } -# tkMbButtonUp -- +# ::tk::MbButtonUp -- # This procedure is invoked to handle button 1 releases for menubuttons. # If the release happens inside the menubutton then leave its menu # posted with element 0 activated. Otherwise, unpost the menu. @@ -492,23 +493,23 @@ proc tkMbMotion {w upDown rootx rooty} { # Arguments: # w - The name of the menubutton widget. -proc tkMbButtonUp w { - global tkPriv +proc ::tk::MbButtonUp w { + variable ::tk::Priv global tcl_platform set menu [$w cget -menu] set tearoff [expr {[string equal $tcl_platform(platform) "unix"] || \ ([string compare $menu {}] && \ [string equal [$menu cget -type] "tearoff"])}] - if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \ - && [string equal $tkPriv(inMenubutton) $w]} { - tkMenuFirstEntry [$tkPriv(postedMb) cget -menu] + if {($tearoff != 0) && [string equal $Priv(postedMb) $w] \ + && [string equal $Priv(inMenubutton) $w]} { + MenuFirstEntry [$Priv(postedMb) cget -menu] } else { - tkMenuUnpost {} + MenuUnpost {} } } -# tkMenuMotion -- +# ::tk::MenuMotion -- # This procedure is called to handle mouse motion events for menus. # It does two things. First, it resets the active element in the # menu, if the mouse is over the menu. Second, if a mouse button @@ -521,18 +522,18 @@ proc tkMbButtonUp w { # y - The y position of the mouse. # state - Modifier state (tells whether buttons are down). -proc tkMenuMotion {menu x y state} { - global tkPriv - if {[string equal $menu $tkPriv(window)]} { +proc ::tk::MenuMotion {menu x y state} { + variable ::tk::Priv + if {[string equal $menu $Priv(window)]} { if {[string equal [$menu cget -type] "menubar"]} { - if {[info exists tkPriv(focus)] && \ - [string compare $menu $tkPriv(focus)]} { + if {[info exists Priv(focus)] && \ + [string compare $menu $Priv(focus)]} { $menu activate @$x,$y - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } } else { $menu activate @$x,$y - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } } if {($state & 0x1f00) != 0} { @@ -540,7 +541,7 @@ proc tkMenuMotion {menu x y state} { } } -# tkMenuButtonDown -- +# ::tk::MenuButtonDown -- # Handles button presses in menus. There are a couple of tricky things # here: # 1. Change the posted cascade entry (if any) to match the mouse position. @@ -555,17 +556,17 @@ proc tkMenuMotion {menu x y state} { # Arguments: # menu - The menu window. -proc tkMenuButtonDown menu { - global tkPriv +proc ::tk::MenuButtonDown menu { + variable ::tk::Priv global tcl_platform if {![winfo viewable $menu]} { return } $menu postcascade active - if {[string compare $tkPriv(postedMb) ""] && \ - [winfo viewable $tkPriv(postedMb)]} { - grab -global $tkPriv(postedMb) + if {[string compare $Priv(postedMb) ""] && \ + [winfo viewable $Priv(postedMb)]} { + grab -global $Priv(postedMb) } else { while {[string equal [$menu cget -type] "normal"] \ && [string equal [winfo class [winfo parent $menu]] "Menu"] \ @@ -573,9 +574,9 @@ proc tkMenuButtonDown menu { set menu [winfo parent $menu] } - if {[string equal $tkPriv(menuBar) {}]} { - set tkPriv(menuBar) $menu - set tkPriv(cursor) [$menu cget -cursor] + if {[string equal $Priv(menuBar) {}]} { + set Priv(menuBar) $menu + set Priv(cursor) [$menu cget -cursor] $menu configure -cursor arrow } @@ -585,7 +586,7 @@ proc tkMenuButtonDown menu { # anymore. if {[string compare $menu [grab current $menu]]} { - tkSaveGrabInfo $menu + SaveGrabInfo $menu } # Must re-grab even if the grab window hasn't changed, in order @@ -597,7 +598,7 @@ proc tkMenuButtonDown menu { } } -# tkMenuLeave -- +# ::tk::MenuLeave -- # This procedure is invoked to handle Leave events for a menu. It # deactivates everything unless the active element is a cascade element # and the mouse is now over the submenu. @@ -607,9 +608,9 @@ proc tkMenuButtonDown menu { # rootx, rooty - Root coordinates of mouse. # state - Modifier state. -proc tkMenuLeave {menu rootx rooty state} { - global tkPriv - set tkPriv(window) {} +proc ::tk::MenuLeave {menu rootx rooty state} { + variable ::tk::Priv + set Priv(window) {} if {[string equal [$menu index active] "none"]} { return } @@ -619,10 +620,10 @@ proc tkMenuLeave {menu rootx rooty state} { return } $menu activate none - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } -# tkMenuInvoke -- +# ::tk::MenuInvoke -- # This procedure is invoked when button 1 is released over a menu. # It invokes the appropriate menu action and unposts the menu if # it came from a menubutton. @@ -632,10 +633,10 @@ proc tkMenuLeave {menu rootx rooty state} { # buttonRelease - 1 means this procedure is called because of # a button release; 0 means because of keystroke. -proc tkMenuInvoke {w buttonRelease} { - global tkPriv +proc ::tk::MenuInvoke {w buttonRelease} { + variable ::tk::Priv - if {$buttonRelease && [string equal $tkPriv(window) {}]} { + if {$buttonRelease && [string equal $Priv(window) {}]} { # Mouse was pressed over a menu without a menu button, then # dragged off the menu (possibly with a cascade posted) and # released. Unpost everything and quit. @@ -643,16 +644,16 @@ proc tkMenuInvoke {w buttonRelease} { $w postcascade none $w activate none event generate $w <<MenuSelect>> - tkMenuUnpost $w + MenuUnpost $w return } if {[string equal [$w type active] "cascade"]} { $w postcascade active set menu [$w entrycget active -menu] - tkMenuFirstEntry $menu + MenuFirstEntry $menu } elseif {[string equal [$w type active] "tearoff"]} { - tkTearOffMenu $w - tkMenuUnpost $w + ::tk::TearOffMenu $w + MenuUnpost $w } elseif {[string equal [$w cget -type] "menubar"]} { $w postcascade none set active [$w index active] @@ -667,7 +668,7 @@ proc tkMenuInvoke {w buttonRelease} { event generate $w <<MenuSelect>> } - tkMenuUnpost $w + MenuUnpost $w # If the active item is not a cascade, invoke it. This enables # the use of checkbuttons/commands/etc. on menubars (which is legal, @@ -677,12 +678,12 @@ proc tkMenuInvoke {w buttonRelease} { uplevel #0 [list $w invoke $active] } } else { - tkMenuUnpost $w + MenuUnpost $w uplevel #0 [list $w invoke active] } } -# tkMenuEscape -- +# ::tk::MenuEscape -- # This procedure is invoked for the Cancel (or Escape) key. It unposts # the given menu and, if it is the top-level menu for a menu button, # unposts the menu button as well. @@ -690,54 +691,54 @@ proc tkMenuInvoke {w buttonRelease} { # Arguments: # menu - Name of the menu window. -proc tkMenuEscape menu { +proc ::tk::MenuEscape menu { set parent [winfo parent $menu] if {[string compare [winfo class $parent] "Menu"]} { - tkMenuUnpost $menu + MenuUnpost $menu } elseif {[string equal [$parent cget -type] "menubar"]} { - tkMenuUnpost $menu - tkRestoreOldGrab + MenuUnpost $menu + RestoreOldGrab } else { - tkMenuNextMenu $menu left + MenuNextMenu $menu left } } # The following routines handle arrow keys. Arrow keys behave # differently depending on whether the menu is a menu bar or not. -proc tkMenuUpArrow {menu} { +proc ::tk::MenuUpArrow {menu} { if {[string equal [$menu cget -type] "menubar"]} { - tkMenuNextMenu $menu left + MenuNextMenu $menu left } else { - tkMenuNextEntry $menu -1 + MenuNextEntry $menu -1 } } -proc tkMenuDownArrow {menu} { +proc ::tk::MenuDownArrow {menu} { if {[string equal [$menu cget -type] "menubar"]} { - tkMenuNextMenu $menu right + MenuNextMenu $menu right } else { - tkMenuNextEntry $menu 1 + MenuNextEntry $menu 1 } } -proc tkMenuLeftArrow {menu} { +proc ::tk::MenuLeftArrow {menu} { if {[string equal [$menu cget -type] "menubar"]} { - tkMenuNextEntry $menu -1 + MenuNextEntry $menu -1 } else { - tkMenuNextMenu $menu left + MenuNextMenu $menu left } } -proc tkMenuRightArrow {menu} { +proc ::tk::MenuRightArrow {menu} { if {[string equal [$menu cget -type] "menubar"]} { - tkMenuNextEntry $menu 1 + MenuNextEntry $menu 1 } else { - tkMenuNextMenu $menu right + MenuNextMenu $menu right } } -# tkMenuNextMenu -- +# ::tk::MenuNextMenu -- # This procedure is invoked to handle "left" and "right" traversal # motions in menus. It traverses to the next menu in a menu bar, # or into or out of a cascaded menu. @@ -747,8 +748,8 @@ proc tkMenuRightArrow {menu} { # event. # direction - Direction in which to move: "left" or "right" -proc tkMenuNextMenu {menu direction} { - global tkPriv +proc ::tk::MenuNextMenu {menu direction} { + variable ::tk::Priv # First handle traversals into and out of cascaded menus. @@ -760,7 +761,7 @@ proc tkMenuNextMenu {menu direction} { $menu postcascade active set m2 [$menu entrycget active -menu] if {[string compare $m2 ""]} { - tkMenuFirstEntry $m2 + MenuFirstEntry $m2 } return } else { @@ -769,7 +770,7 @@ proc tkMenuNextMenu {menu direction} { if {[string equal [winfo class $parent] "Menu"] \ && [string equal [$parent cget -type] "menubar"]} { tk_menuSetFocus $parent - tkMenuNextEntry $parent 1 + MenuNextEntry $parent 1 return } set parent [winfo parent $parent] @@ -781,7 +782,7 @@ proc tkMenuNextMenu {menu direction} { if {[string equal [winfo class $m2] "Menu"]} { if {[string compare [$m2 cget -type] "menubar"]} { $menu activate none - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu tk_menuSetFocus $m2 # This code unposts any posted submenu in the parent. @@ -801,12 +802,12 @@ proc tkMenuNextMenu {menu direction} { if {[string equal [winfo class $m2] "Menu"]} { if {[string equal [$m2 cget -type] "menubar"]} { tk_menuSetFocus $m2 - tkMenuNextEntry $m2 -1 + MenuNextEntry $m2 -1 return } } - set w $tkPriv(postedMb) + set w $Priv(postedMb) if {[string equal $w ""]} { return } @@ -832,11 +833,11 @@ proc tkMenuNextMenu {menu direction} { } incr i $count } - tkMbPost $mb - tkMenuFirstEntry [$mb cget -menu] + MbPost $mb + MenuFirstEntry [$mb cget -menu] } -# tkMenuNextEntry -- +# ::tk::MenuNextEntry -- # Activate the next higher or lower entry in the posted menu, # wrapping around at the ends. Disabled entries are skipped. # @@ -845,8 +846,7 @@ proc tkMenuNextMenu {menu direction} { # count - 1 means go to the next lower entry, # -1 means go to the next higher entry. -proc tkMenuNextEntry {menu count} { - global tkPriv +proc ::tk::MenuNextEntry {menu count} { if {[string equal [$menu index last] "none"]} { return @@ -884,7 +884,7 @@ proc tkMenuNextEntry {menu count} { incr quitAfter -1 } $menu activate $i - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu if {[string equal [$menu type $i] "cascade"]} { set cascade [$menu entrycget $i -menu] if {[string compare $cascade ""]} { @@ -892,12 +892,12 @@ proc tkMenuNextEntry {menu count} { # we traverse left/right in the menubar, but undesirable when # we traverse up/down in a menu. $menu postcascade $i - tkMenuFirstEntry $cascade + MenuFirstEntry $cascade } } } -# tkMenuFind -- +# ::tk::MenuFind -- # This procedure searches the entire window hierarchy under w for # a menubutton that isn't disabled and whose underlined character # is "char" or an entry in a menubar that isn't disabled and whose @@ -913,8 +913,7 @@ proc tkMenuNextEntry {menu count} { # may be either upper or lower case, and # will match either upper or lower case. -proc tkMenuFind {w char} { - global tkPriv +proc ::tk::MenuFind {w char} { set char [string tolower $char] set windowlist [winfo child $w] @@ -965,7 +964,7 @@ proc tkMenuFind {w char} { } default { - set match [tkMenuFind $child $char] + set match [MenuFind $child $char] if {[string compare $match ""]} { return $match } @@ -975,7 +974,7 @@ proc tkMenuFind {w char} { return {} } -# tkTraverseToMenu -- +# ::tk::TraverseToMenu -- # This procedure implements keyboard traversal of menus. Given an # ASCII character "char", it looks for a menubutton with that character # underlined. If one is found, it posts the menubutton's menu @@ -987,14 +986,14 @@ proc tkMenuFind {w char} { # is ignored. If an empty string, nothing # happens. -proc tkTraverseToMenu {w char} { - global tkPriv +proc ::tk::TraverseToMenu {w char} { + variable ::tk::Priv if {[string equal $char ""]} { return } while {[string equal [winfo class $w] "Menu"]} { if {[string compare [$w cget -type] "menubar"] \ - && [string equal $tkPriv(postedMb) ""]} { + && [string equal $Priv(postedMb) ""]} { return } if {[string equal [$w cget -type] "menubar"]} { @@ -1002,22 +1001,22 @@ proc tkTraverseToMenu {w char} { } set w [winfo parent $w] } - set w [tkMenuFind [winfo toplevel $w] $char] + set w [MenuFind [winfo toplevel $w] $char] if {[string compare $w ""]} { if {[string equal [winfo class $w] "Menu"]} { tk_menuSetFocus $w - set tkPriv(window) $w - tkSaveGrabInfo $w + set Priv(window) $w + SaveGrabInfo $w grab -global $w - tkTraverseWithinMenu $w $char + TraverseWithinMenu $w $char } else { - tkMbPost $w - tkMenuFirstEntry [$w cget -menu] + MbPost $w + MenuFirstEntry [$w cget -menu] } } } -# tkFirstMenu -- +# ::tk::FirstMenu -- # This procedure traverses to the first menubutton in the toplevel # for a given window, and posts that menubutton's menu. # @@ -1025,23 +1024,24 @@ proc tkTraverseToMenu {w char} { # w - Name of a window. Selects which toplevel # to search for menubuttons. -proc tkFirstMenu w { - set w [tkMenuFind [winfo toplevel $w] ""] +proc ::tk::FirstMenu w { + variable ::tk::Priv + set w [MenuFind [winfo toplevel $w] ""] if {[string compare $w ""]} { if {[string equal [winfo class $w] "Menu"]} { tk_menuSetFocus $w - set tkPriv(window) $w - tkSaveGrabInfo $w + set Priv(window) $w + SaveGrabInfo $w grab -global $w - tkMenuFirstEntry $w + MenuFirstEntry $w } else { - tkMbPost $w - tkMenuFirstEntry [$w cget -menu] + MbPost $w + MenuFirstEntry [$w cget -menu] } } } -# tkTraverseWithinMenu +# ::tk::TraverseWithinMenu # This procedure implements keyboard traversal within a menu. It # searches for an entry in the menu that has "char" underlined. If # such an entry is found, it is invoked and the menu is unposted. @@ -1052,7 +1052,7 @@ proc tkFirstMenu w { # ignored. If the string is empty then # nothing happens. -proc tkTraverseWithinMenu {w char} { +proc ::tk::TraverseWithinMenu {w char} { if {[string equal $char ""]} { return } @@ -1073,10 +1073,10 @@ proc tkTraverseWithinMenu {w char} { event generate $w <<MenuSelect>> set m2 [$w entrycget $i -menu] if {[string compare $m2 ""]} { - tkMenuFirstEntry $m2 + MenuFirstEntry $m2 } } else { - tkMenuUnpost $w + MenuUnpost $w uplevel #0 [list $w invoke $i] } return @@ -1084,18 +1084,18 @@ proc tkTraverseWithinMenu {w char} { } } -# tkMenuFirstEntry -- +# ::tk::MenuFirstEntry -- # Given a menu, this procedure finds the first entry that isn't # disabled or a tear-off or separator, and activates that entry. # However, if there is already an active entry in the menu (e.g., -# because of a previous call to tkPostOverPoint) then the active +# because of a previous call to tk::PostOverPoint) then the active # entry isn't changed. This procedure also sets the input focus # to the menu. # # Arguments: # menu - Name of the menu window (possibly empty). -proc tkMenuFirstEntry menu { +proc ::tk::MenuFirstEntry menu { if {[string equal $menu ""]} { return } @@ -1112,7 +1112,7 @@ proc tkMenuFirstEntry menu { && [string compare $state "disabled"] \ && [string compare [$menu type $i] "tearoff"]} { $menu activate $i - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu # Only post the cascade if the current menu is a menubar; # otherwise, if the first entry of the cascade is a cascade, # we can get an annoying cascading effect resulting in a bunch of @@ -1122,7 +1122,7 @@ proc tkMenuFirstEntry menu { set cascade [$menu entrycget $i -menu] if {[string compare $cascade ""]} { $menu postcascade $i - tkMenuFirstEntry $cascade + MenuFirstEntry $cascade } } return @@ -1130,7 +1130,7 @@ proc tkMenuFirstEntry menu { } } -# tkMenuFindName -- +# ::tk::MenuFindName -- # Given a menu and a text string, return the index of the menu entry # that displays the string as its label. If there is no such entry, # return an empty string. This procedure is tricky because some names @@ -1141,7 +1141,7 @@ proc tkMenuFirstEntry menu { # menu - Name of the menu widget. # s - String to look for. -proc tkMenuFindName {menu s} { +proc ::tk::MenuFindName {menu s} { set i "" if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} { catch {set i [$menu index $s]} @@ -1161,7 +1161,7 @@ proc tkMenuFindName {menu s} { return "" } -# tkPostOverPoint -- +# ::tk::PostOverPoint -- # This procedure posts a given menu such that a given entry in the # menu is centered over a given point in the root window. It also # activates the given entry. @@ -1173,7 +1173,7 @@ proc tkMenuFindName {menu s} { # If omitted or specified as {}, then the menu's # upper-left corner goes at (x,y). -proc tkPostOverPoint {menu x y {entry {}}} { +proc ::tk::PostOverPoint {menu x y {entry {}}} { global tcl_platform if {[string compare $entry {}]} { @@ -1190,71 +1190,71 @@ proc tkPostOverPoint {menu x y {entry {}}} { if {[string compare $entry {}] \ && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry - tkGenerateMenuSelect $menu + GenerateMenuSelect $menu } } -# tkSaveGrabInfo -- -# Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record +# ::tk::SaveGrabInfo -- +# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record # the state of any existing grab on the w's display. # # Arguments: # w - Name of a window; used to select the display # whose grab information is to be recorded. -proc tkSaveGrabInfo w { - global tkPriv - set tkPriv(oldGrab) [grab current $w] - if {[string compare $tkPriv(oldGrab) ""]} { - set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)] +proc tk::SaveGrabInfo w { + variable ::tk::Priv + set Priv(oldGrab) [grab current $w] + if {[string compare $Priv(oldGrab) ""]} { + set Priv(grabStatus) [grab status $Priv(oldGrab)] } } -# tkRestoreOldGrab -- +# ::tk::RestoreOldGrab -- # Restores the grab to what it was before TkSaveGrabInfo was called. # -proc tkRestoreOldGrab {} { - global tkPriv +proc ::tk::RestoreOldGrab {} { + variable ::tk::Priv - if {[string compare $tkPriv(oldGrab) ""]} { + if {[string compare $Priv(oldGrab) ""]} { # Be careful restoring the old grab, since it's window may not # be visible anymore. catch { - if {[string equal $tkPriv(grabStatus) "global"]} { - grab set -global $tkPriv(oldGrab) + if {[string equal $Priv(grabStatus) "global"]} { + grab set -global $Priv(oldGrab) } else { - grab set $tkPriv(oldGrab) + grab set $Priv(oldGrab) } } - set tkPriv(oldGrab) "" + set Priv(oldGrab) "" } } -proc tk_menuSetFocus {menu} { - global tkPriv - if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} { - set tkPriv(focus) [focus] +proc ::tk_menuSetFocus {menu} { + variable ::tk::Priv + if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} { + set Priv(focus) [focus] } focus $menu } -proc tkGenerateMenuSelect {menu} { - global tkPriv +proc ::tk::GenerateMenuSelect {menu} { + variable ::tk::Priv - if {[string equal $tkPriv(activeMenu) $menu] \ - && [string equal $tkPriv(activeItem) [$menu index active]]} { + if {[string equal $Priv(activeMenu) $menu] \ + && [string equal $Priv(activeItem) [$menu index active]]} { return } - set tkPriv(activeMenu) $menu - set tkPriv(activeItem) [$menu index active] + set Priv(activeMenu) $menu + set Priv(activeItem) [$menu index active] event generate $menu <<MenuSelect>> } -# tk_popup -- +# ::tk_popup -- # This procedure pops up a menu and sets things up for traversing # the menu and its submenus. # @@ -1266,19 +1266,19 @@ proc tkGenerateMenuSelect {menu} { # If omitted or specified as {}, then menu's # upper-left corner goes at (x,y). -proc tk_popup {menu x y {entry {}}} { - global tkPriv +proc ::tk_popup {menu x y {entry {}}} { + variable ::tk::Priv global tcl_platform - if {[string compare $tkPriv(popup) ""] \ - || [string compare $tkPriv(postedMb) ""]} { - tkMenuUnpost {} + if {[string compare $Priv(popup) ""] \ + || [string compare $Priv(postedMb) ""]} { + tk::MenuUnpost {} } - tkPostOverPoint $menu $x $y $entry + tk::PostOverPoint $menu $x $y $entry if {[string equal $tcl_platform(platform) "unix"] \ && [winfo viewable $menu]} { - tkSaveGrabInfo $menu + tk::SaveGrabInfo $menu grab -global $menu - set tkPriv(popup) $menu + set Priv(popup) $menu tk_menuSetFocus $menu } } diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 87b3e10..ade57ce 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.13 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.14 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -114,7 +114,7 @@ static unsigned char w3_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" -# tkMessageBox -- +# ::tk::MessageBox -- # # Pops up a messagebox with an application-supplied message with # an icon and a list of buttons. This procedure will be called @@ -130,11 +130,12 @@ static unsigned char w3_bits[] = { # # See the user documentation for details on what tk_messageBox does. # -proc tkMessageBox {args} { - global tkPriv tcl_platform tk_strictMotif +proc ::tk::MessageBox {args} { + global tcl_platform tk_strictMotif + variable ::tk::Priv - set w tkPrivMsgBox - upvar #0 $w data + set w ::tk::PrivMsgBox + upvar $w data # # The default value of the title is space (" ") not the empty string @@ -364,7 +365,7 @@ proc tkMessageBox {args} { set opts [list -text $capName] } - eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]] + eval button [list $w.$name] $opts [list -command [list set tk::Priv(button) $name]] if {[string equal $name $data(-default)]} { $w.$name configure -default active @@ -399,7 +400,7 @@ proc tkMessageBox {args} { bind $w <Return> { if {[string equal Button [winfo class %W]]} { - tkButtonInvoke %W + tk::ButtonInvoke %W } } @@ -424,9 +425,9 @@ proc tkMessageBox {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) ::tk::RestoreFocusGrab $w $focus - return $tkPriv(button) + return $Priv(button) } diff --git a/library/optMenu.tcl b/library/optMenu.tcl index 4f83ce7..05b3a45 100644 --- a/library/optMenu.tcl +++ b/library/optMenu.tcl @@ -3,7 +3,7 @@ # This file defines the procedure tk_optionMenu, which creates # an option button and its associated menu. # -# RCS: @(#) $Id: optMenu.tcl,v 1.3 1998/09/14 18:23:24 stanton Exp $ +# RCS: @(#) $Id: optMenu.tcl,v 1.4 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# tk_optionMenu -- +# ::tk_optionMenu -- # This procedure creates an option button named $w and an associated # menu. Together they provide the functionality of Motif option menus: # they can be used to select one of many values, and the current value @@ -27,7 +27,7 @@ # firstValue - First of legal values for option (must be >= 1). # args - Any number of additional values. -proc tk_optionMenu {w varName firstValue args} { +proc ::tk_optionMenu {w varName firstValue args} { upvar #0 $varName var if {![info exists var]} { diff --git a/library/palette.tcl b/library/palette.tcl index de34604..f278268 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -3,7 +3,7 @@ # This file contains procedures that change the color palette used # by Tk. # -# RCS: @(#) $Id: palette.tcl,v 1.5 1999/09/02 17:02:53 hobbs Exp $ +# RCS: @(#) $Id: palette.tcl,v 1.6 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# tk_setPalette -- +# ::tk_setPalette -- # Changes the default color scheme for a Tk application by setting # default colors in the option database and by modifying all of the # color options for existing widgets that have the default value. @@ -23,14 +23,12 @@ # option names and values. The name for an option is the one used # for the option database, such as activeForeground, not -activeforeground. -proc tk_setPalette {args} { +proc ::tk_setPalette {args} { if {[winfo depth .] == 1} { # Just return on monochrome displays, otherwise errors will occur return } - global tkPalette - # Create an array that has the complete new palette. If some colors # aren't specified, compute them from other colors that are specified. @@ -108,7 +106,7 @@ proc tk_setPalette {args} { # Walk the widget hierarchy, recoloring all existing windows. # The option database must be set according to what we do here, # but it breaks things if we set things in the database while - # we are changing colors...so, tkRecolorTree now returns the + # we are changing colors...so, ::tk::RecolorTree now returns the # option database changes that need to be made, and they # need to be evalled here to take effect. # We have to walk the whole widget tree instead of just @@ -117,7 +115,7 @@ proc tk_setPalette {args} { # of widgets that we don't currently know about, so we'll # walk the whole hierarchy just in case. - eval [tkRecolorTree . new] + eval [tk::RecolorTree . new] catch {destroy .___tk_set_palette} @@ -128,13 +126,13 @@ proc tk_setPalette {args} { option add *$option $new($option) widgetDefault } - # Save the options in the global variable tkPalette, for use the + # Save the options in the variable ::tk::Palette, for use the # next time we change the options. - array set tkPalette [array get new] + array set ::tk::Palette [array get new] } -# tkRecolorTree -- +# ::tk::RecolorTree -- # This procedure changes the colors in a window and all of its # descendants, according to information provided by the colors # argument. This looks at the defaults provided by the option @@ -149,8 +147,7 @@ proc tk_setPalette {args} { # is named after a widget configuration option, and # each value is the value for that option. -proc tkRecolorTree {w colors} { - global tkPalette +proc ::tk::RecolorTree {w colors} { upvar $colors c set result {} foreach dbOption [array names c] { @@ -176,12 +173,12 @@ proc tkRecolorTree {w colors} { } } foreach child [winfo children $w] { - append result ";\n[tkRecolorTree $child c]" + append result ";\n[::tk::RecolorTree $child c]" } return $result } -# tkDarken -- +# ::tk::Darken -- # Given a color name, computes a new color value that darkens (or # brightens) the given color by a given percent. # @@ -191,7 +188,7 @@ proc tkRecolorTree {w colors} { # percent: 50 means darken by 50%, 110 means brighten # by 10%. -proc tkDarken {color percent} { +proc ::tk::Darken {color percent} { foreach {red green blue} [winfo rgb . $color] { set red [expr {($red/256)*$percent/100}] set green [expr {($green/256)*$percent/100}] @@ -210,13 +207,13 @@ proc tkDarken {color percent} { return [format "#%02x%02x%02x" $red $green $blue] } -# tk_bisque -- +# ::tk_bisque -- # Reset the Tk color palette to the old "bisque" colors. # # Arguments: # None. -proc tk_bisque {} { +proc ::tk_bisque {} { tk_setPalette activeBackground #e6ceb1 activeForeground black \ background #ffe4c4 disabledForeground #b0b0b0 foreground black \ highlightBackground #ffe4c4 highlightColor black \ diff --git a/library/scale.tcl b/library/scale.tcl index da24e15..ac891be 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk scale widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: scale.tcl,v 1.7 2000/04/14 08:33:31 hobbs Exp $ +# RCS: @(#) $Id: scale.tcl,v 1.8 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. @@ -20,74 +20,74 @@ bind Scale <Enter> { if {$tk_strictMotif} { - set tkPriv(activeBg) [%W cget -activebackground] + set tk::Priv(activeBg) [%W cget -activebackground] %W config -activebackground [%W cget -background] } - tkScaleActivate %W %x %y + tk::ScaleActivate %W %x %y } bind Scale <Motion> { - tkScaleActivate %W %x %y + tk::ScaleActivate %W %x %y } bind Scale <Leave> { if {$tk_strictMotif} { - %W config -activebackground $tkPriv(activeBg) + %W config -activebackground $tk::Priv(activeBg) } if {[string equal [%W cget -state] "active"]} { %W configure -state normal } } bind Scale <1> { - tkScaleButtonDown %W %x %y + tk::ScaleButtonDown %W %x %y } bind Scale <B1-Motion> { - tkScaleDrag %W %x %y + tk::ScaleDrag %W %x %y } bind Scale <B1-Leave> { } bind Scale <B1-Enter> { } bind Scale <ButtonRelease-1> { - tkCancelRepeat - tkScaleEndDrag %W - tkScaleActivate %W %x %y + tk::CancelRepeat + tk::ScaleEndDrag %W + tk::ScaleActivate %W %x %y } bind Scale <2> { - tkScaleButton2Down %W %x %y + tk::ScaleButton2Down %W %x %y } bind Scale <B2-Motion> { - tkScaleDrag %W %x %y + tk::ScaleDrag %W %x %y } bind Scale <B2-Leave> { } bind Scale <B2-Enter> { } bind Scale <ButtonRelease-2> { - tkCancelRepeat - tkScaleEndDrag %W - tkScaleActivate %W %x %y + tk::CancelRepeat + tk::ScaleEndDrag %W + tk::ScaleActivate %W %x %y } bind Scale <Control-1> { - tkScaleControlPress %W %x %y + tk::ScaleControlPress %W %x %y } bind Scale <Up> { - tkScaleIncrement %W up little noRepeat + tk::ScaleIncrement %W up little noRepeat } bind Scale <Down> { - tkScaleIncrement %W down little noRepeat + tk::ScaleIncrement %W down little noRepeat } bind Scale <Left> { - tkScaleIncrement %W up little noRepeat + tk::ScaleIncrement %W up little noRepeat } bind Scale <Right> { - tkScaleIncrement %W down little noRepeat + tk::ScaleIncrement %W down little noRepeat } bind Scale <Control-Up> { - tkScaleIncrement %W up big noRepeat + tk::ScaleIncrement %W up big noRepeat } bind Scale <Control-Down> { - tkScaleIncrement %W down big noRepeat + tk::ScaleIncrement %W down big noRepeat } bind Scale <Control-Left> { - tkScaleIncrement %W up big noRepeat + tk::ScaleIncrement %W up big noRepeat } bind Scale <Control-Right> { - tkScaleIncrement %W down big noRepeat + tk::ScaleIncrement %W down big noRepeat } bind Scale <Home> { %W set [%W cget -from] @@ -96,7 +96,7 @@ bind Scale <End> { %W set [%W cget -to] } -# tkScaleActivate -- +# ::tk::ScaleActivate -- # This procedure is invoked to check a given x-y position in the # scale and activate the slider if the x-y position falls within # the slider. @@ -105,7 +105,7 @@ bind Scale <End> { # w - The scale widget. # x, y - Mouse coordinates. -proc tkScaleActivate {w x y} { +proc ::tk::ScaleActivate {w x y} { if {[string equal [$w cget -state] "disabled"]} { return } @@ -119,7 +119,7 @@ proc tkScaleActivate {w x y} { } } -# tkScaleButtonDown -- +# ::tk::ScaleButtonDown -- # This procedure is invoked when a button is pressed in a scale. It # takes different actions depending on where the button was pressed. # @@ -127,25 +127,25 @@ proc tkScaleActivate {w x y} { # w - The scale widget. # x, y - Mouse coordinates of button press. -proc tkScaleButtonDown {w x y} { - global tkPriv - set tkPriv(dragging) 0 +proc ::tk::ScaleButtonDown {w x y} { + variable ::tk::Priv + set Priv(dragging) 0 set el [$w identify $x $y] if {[string equal $el "trough1"]} { - tkScaleIncrement $w up little initial + ScaleIncrement $w up little initial } elseif {[string equal $el "trough2"]} { - tkScaleIncrement $w down little initial + ScaleIncrement $w down little initial } elseif {[string equal $el "slider"]} { - set tkPriv(dragging) 1 - set tkPriv(initValue) [$w get] + set Priv(dragging) 1 + set Priv(initValue) [$w get] set coords [$w coords] - set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}] - set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}] + set Priv(deltaX) [expr {$x - [lindex $coords 0]}] + set Priv(deltaY) [expr {$y - [lindex $coords 1]}] $w configure -sliderrelief sunken } } -# tkScaleDrag -- +# ::tk::ScaleDrag -- # This procedure is called when the mouse is dragged with # mouse button 1 down. If the drag started inside the slider # (i.e. the scale is active) then the scale's value is adjusted @@ -155,28 +155,28 @@ proc tkScaleButtonDown {w x y} { # w - The scale widget. # x, y - Mouse coordinates. -proc tkScaleDrag {w x y} { - global tkPriv - if {!$tkPriv(dragging)} { +proc ::tk::ScaleDrag {w x y} { + variable ::tk::Priv + if {!$Priv(dragging)} { return } - $w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]] + $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]] } -# tkScaleEndDrag -- +# ::tk::ScaleEndDrag -- # This procedure is called to end an interactive drag of the # slider. It just marks the drag as over. # # Arguments: # w - The scale widget. -proc tkScaleEndDrag {w} { - global tkPriv - set tkPriv(dragging) 0 +proc ::tk::ScaleEndDrag {w} { + variable ::tk::Priv + set Priv(dragging) 0 $w configure -sliderrelief raised } -# tkScaleIncrement -- +# ::tk::ScaleIncrement -- # This procedure is invoked to increment the value of a scale and # to set up auto-repeating of the action if that is desired. The # way the value is incremented depends on the "dir" and "big" @@ -192,8 +192,8 @@ proc tkScaleEndDrag {w} { # first action in an auto-repeat sequence, and "again" # means this is the second repetition or later. -proc tkScaleIncrement {w dir big repeat} { - global tkPriv +proc ::tk::ScaleIncrement {w dir big repeat} { + variable ::tk::Priv if {![winfo exists $w]} return if {[string equal $big "big"]} { set inc [$w cget -bigincrement] @@ -212,18 +212,18 @@ proc tkScaleIncrement {w dir big repeat} { $w set [expr {[$w get] + $inc}] if {[string equal $repeat "again"]} { - set tkPriv(afterId) [after [$w cget -repeatinterval] \ - [list tkScaleIncrement $w $dir $big again]] + set Priv(afterId) [after [$w cget -repeatinterval] \ + [list tk::ScaleIncrement $w $dir $big again]] } elseif {[string equal $repeat "initial"]} { set delay [$w cget -repeatdelay] if {$delay > 0} { - set tkPriv(afterId) [after $delay \ - [list tkScaleIncrement $w $dir $big again]] + set Priv(afterId) [after $delay \ + [list tk::ScaleIncrement $w $dir $big again]] } } } -# tkScaleControlPress -- +# ::tk::ScaleControlPress -- # This procedure handles button presses that are made with the Control # key down. Depending on the mouse position, it adjusts the scale # value to one end of the range or the other. @@ -232,7 +232,7 @@ proc tkScaleIncrement {w dir big repeat} { # w - The scale widget. # x, y - Mouse coordinates where the button was pressed. -proc tkScaleControlPress {w x y} { +proc ::tk::ScaleControlPress {w x y} { set el [$w identify $x $y] if {[string equal $el "trough1"]} { $w set [$w cget -from] @@ -241,7 +241,7 @@ proc tkScaleControlPress {w x y} { } } -# tkScaleButton2Down +# ::tk::ScaleButton2Down # This procedure is invoked when button 2 is pressed over a scale. # It sets the value to correspond to the mouse position and starts # a slider drag. @@ -250,17 +250,17 @@ proc tkScaleControlPress {w x y} { # w - The scrollbar widget. # x, y - Mouse coordinates within the widget. -proc tkScaleButton2Down {w x y} { - global tkPriv +proc ::tk::ScaleButton2Down {w x y} { + variable ::tk::Priv if {[string equal [$w cget -state] "disabled"]} { return } $w configure -state active $w set [$w get $x $y] - set tkPriv(dragging) 1 - set tkPriv(initValue) [$w get] + set Priv(dragging) 1 + set Priv(initValue) [$w get] set coords "$x $y" - set tkPriv(deltaX) 0 - set tkPriv(deltaY) 0 + set Priv(deltaX) 0 + set Priv(deltaY) 0 } diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 95cacae..fb4bc0d 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk scrollbar widgets. # It also provides procedures that help in implementing the bindings. # -# RCS: @(#) $Id: scrlbar.tcl,v 1.8 2000/01/06 02:22:24 hobbs Exp $ +# RCS: @(#) $Id: scrlbar.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -22,7 +22,7 @@ if {[string compare $tcl_platform(platform) "windows"] && \ bind Scrollbar <Enter> { if {$tk_strictMotif} { - set tkPriv(activeBg) [%W cget -activebackground] + set tk::Priv(activeBg) [%W cget -activebackground] %W config -activebackground [%W cget -background] } %W activate [%W identify %x %y] @@ -37,22 +37,22 @@ bind Scrollbar <Motion> { # unknown reasons. bind Scrollbar <Leave> { - if {$tk_strictMotif && [info exists tkPriv(activeBg)]} { - %W config -activebackground $tkPriv(activeBg) + if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} { + %W config -activebackground $tk::Priv(activeBg) } %W activate {} } bind Scrollbar <1> { - tkScrollButtonDown %W %x %y + tk::ScrollButtonDown %W %x %y } bind Scrollbar <B1-Motion> { - tkScrollDrag %W %x %y + tk::ScrollDrag %W %x %y } bind Scrollbar <B1-B2-Motion> { - tkScrollDrag %W %x %y + tk::ScrollDrag %W %x %y } bind Scrollbar <ButtonRelease-1> { - tkScrollButtonUp %W %x %y + tk::ScrollButtonUp %W %x %y } bind Scrollbar <B1-Leave> { # Prevents <Leave> binding from being invoked. @@ -61,7 +61,7 @@ bind Scrollbar <B1-Enter> { # Prevents <Enter> binding from being invoked. } bind Scrollbar <2> { - tkScrollButton2Down %W %x %y + tk::ScrollButton2Down %W %x %y } bind Scrollbar <B1-2> { # Do nothing, since button 1 is already down. @@ -70,10 +70,10 @@ bind Scrollbar <B2-1> { # Do nothing, since button 2 is already down. } bind Scrollbar <B2-Motion> { - tkScrollDrag %W %x %y + tk::ScrollDrag %W %x %y } bind Scrollbar <ButtonRelease-2> { - tkScrollButtonUp %W %x %y + tk::ScrollButtonUp %W %x %y } bind Scrollbar <B1-ButtonRelease-2> { # Do nothing: B1 release will handle it. @@ -88,50 +88,50 @@ bind Scrollbar <B2-Enter> { # Prevents <Enter> binding from being invoked. } bind Scrollbar <Control-1> { - tkScrollTopBottom %W %x %y + tk::ScrollTopBottom %W %x %y } bind Scrollbar <Control-2> { - tkScrollTopBottom %W %x %y + tk::ScrollTopBottom %W %x %y } bind Scrollbar <Up> { - tkScrollByUnits %W v -1 + tk::ScrollByUnits %W v -1 } bind Scrollbar <Down> { - tkScrollByUnits %W v 1 + tk::ScrollByUnits %W v 1 } bind Scrollbar <Control-Up> { - tkScrollByPages %W v -1 + tk::ScrollByPages %W v -1 } bind Scrollbar <Control-Down> { - tkScrollByPages %W v 1 + tk::ScrollByPages %W v 1 } bind Scrollbar <Left> { - tkScrollByUnits %W h -1 + tk::ScrollByUnits %W h -1 } bind Scrollbar <Right> { - tkScrollByUnits %W h 1 + tk::ScrollByUnits %W h 1 } bind Scrollbar <Control-Left> { - tkScrollByPages %W h -1 + tk::ScrollByPages %W h -1 } bind Scrollbar <Control-Right> { - tkScrollByPages %W h 1 + tk::ScrollByPages %W h 1 } bind Scrollbar <Prior> { - tkScrollByPages %W hv -1 + tk::ScrollByPages %W hv -1 } bind Scrollbar <Next> { - tkScrollByPages %W hv 1 + tk::ScrollByPages %W hv 1 } bind Scrollbar <Home> { - tkScrollToPos %W 0 + tk::ScrollToPos %W 0 } bind Scrollbar <End> { - tkScrollToPos %W 1 + tk::ScrollToPos %W 1 } } -# tkScrollButtonDown -- +# tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. # It changes the way the scrollbar is displayed and takes actions # depending on where the mouse is. @@ -140,19 +140,19 @@ bind Scrollbar <End> { # w - The scrollbar widget. # x, y - Mouse coordinates. -proc tkScrollButtonDown {w x y} { - global tkPriv - set tkPriv(relief) [$w cget -activerelief] +proc tk::ScrollButtonDown {w x y} { + variable ::tk::Priv + set Priv(relief) [$w cget -activerelief] $w configure -activerelief sunken set element [$w identify $x $y] if {[string equal $element "slider"]} { - tkScrollStartDrag $w $x $y + ScrollStartDrag $w $x $y } else { - tkScrollSelect $w $element initial + ScrollSelect $w $element initial } } -# tkScrollButtonUp -- +# ::tk::ScrollButtonUp -- # This procedure is invoked when a button is released in a scrollbar. # It cancels scans and auto-repeats that were in progress, and restores # the way the active element is displayed. @@ -161,18 +161,18 @@ proc tkScrollButtonDown {w x y} { # w - The scrollbar widget. # x, y - Mouse coordinates. -proc tkScrollButtonUp {w x y} { - global tkPriv - tkCancelRepeat - if {[info exists tkPriv(relief)]} { +proc ::tk::ScrollButtonUp {w x y} { + variable ::tk::Priv + tk::CancelRepeat + if {[info exists Priv(relief)]} { # Avoid error due to spurious release events - $w configure -activerelief $tkPriv(relief) - tkScrollEndDrag $w $x $y + $w configure -activerelief $Priv(relief) + ScrollEndDrag $w $x $y $w activate [$w identify $x $y] } } -# tkScrollSelect -- +# ::tk::ScrollSelect -- # This procedure is invoked when a button is pressed over the scrollbar. # It invokes one of several scrolling actions depending on where in # the scrollbar the button was pressed. @@ -186,29 +186,29 @@ proc tkScrollButtonUp {w x y} { # first action in an auto-repeat sequence, and "again" # means this is the second repetition or later. -proc tkScrollSelect {w element repeat} { - global tkPriv +proc ::tk::ScrollSelect {w element repeat} { + variable ::tk::Priv if {![winfo exists $w]} return switch -- $element { - "arrow1" {tkScrollByUnits $w hv -1} - "trough1" {tkScrollByPages $w hv -1} - "trough2" {tkScrollByPages $w hv 1} - "arrow2" {tkScrollByUnits $w hv 1} + "arrow1" {ScrollByUnits $w hv -1} + "trough1" {ScrollByPages $w hv -1} + "trough2" {ScrollByPages $w hv 1} + "arrow2" {ScrollByUnits $w hv 1} default {return} } if {[string equal $repeat "again"]} { - set tkPriv(afterId) [after [$w cget -repeatinterval] \ - [list tkScrollSelect $w $element again]] + set Priv(afterId) [after [$w cget -repeatinterval] \ + [list tk::ScrollSelect $w $element again]] } elseif {[string equal $repeat "initial"]} { set delay [$w cget -repeatdelay] if {$delay > 0} { - set tkPriv(afterId) [after $delay \ - [list tkScrollSelect $w $element again]] + set Priv(afterId) [after $delay \ + [list tk::ScrollSelect $w $element again]] } } } -# tkScrollStartDrag -- +# ::tk::ScrollStartDrag -- # This procedure is called to initiate a drag of the slider. It just # remembers the starting position of the mouse and slider. # @@ -216,27 +216,27 @@ proc tkScrollSelect {w element repeat} { # w - The scrollbar widget. # x, y - The mouse position at the start of the drag operation. -proc tkScrollStartDrag {w x y} { - global tkPriv +proc ::tk::ScrollStartDrag {w x y} { + variable ::tk::Priv if {[string equal [$w cget -command] ""]} { return } - set tkPriv(pressX) $x - set tkPriv(pressY) $y - set tkPriv(initValues) [$w get] - set iv0 [lindex $tkPriv(initValues) 0] - if {[llength $tkPriv(initValues)] == 2} { - set tkPriv(initPos) $iv0 + set Priv(pressX) $x + set Priv(pressY) $y + set Priv(initValues) [$w get] + set iv0 [lindex $Priv(initValues) 0] + if {[llength $Priv(initValues)] == 2} { + set Priv(initPos) $iv0 } elseif {$iv0 == 0} { - set tkPriv(initPos) 0.0 + set Priv(initPos) 0.0 } else { - set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \ - / [lindex $tkPriv(initValues) 0]}] + set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \ + / [lindex $Priv(initValues) 0]}] } } -# tkScrollDrag -- +# ::tk::ScrollDrag -- # This procedure is called for each mouse motion even when the slider # is being dragged. It notifies the associated widget if we're not # jump scrolling, and it just updates the scrollbar if we are jump @@ -246,29 +246,29 @@ proc tkScrollStartDrag {w x y} { # w - The scrollbar widget. # x, y - The current mouse position. -proc tkScrollDrag {w x y} { - global tkPriv +proc ::tk::ScrollDrag {w x y} { + variable ::tk::Priv - if {[string equal $tkPriv(initPos) ""]} { + if {[string equal $Priv(initPos) ""]} { return } - set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]] + set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]] if {[$w cget -jump]} { - if {[llength $tkPriv(initValues)] == 2} { - $w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \ - [expr {[lindex $tkPriv(initValues) 1] + $delta}] + if {[llength $Priv(initValues)] == 2} { + $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \ + [expr {[lindex $Priv(initValues) 1] + $delta}] } else { - set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}] - eval [list $w] set [lreplace $tkPriv(initValues) 2 3 \ - [expr {[lindex $tkPriv(initValues) 2] + $delta}] \ - [expr {[lindex $tkPriv(initValues) 3] + $delta}]] + set delta [expr {round($delta * [lindex $Priv(initValues) 0])}] + eval [list $w] set [lreplace $Priv(initValues) 2 3 \ + [expr {[lindex $Priv(initValues) 2] + $delta}] \ + [expr {[lindex $Priv(initValues) 3] + $delta}]] } } else { - tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}] + ScrollToPos $w [expr {$Priv(initPos) + $delta}] } } -# tkScrollEndDrag -- +# ::tk::ScrollEndDrag -- # This procedure is called to end an interactive drag of the slider. # It scrolls the window if we're in jump mode, otherwise it does nothing. # @@ -276,21 +276,21 @@ proc tkScrollDrag {w x y} { # w - The scrollbar widget. # x, y - The mouse position at the end of the drag operation. -proc tkScrollEndDrag {w x y} { - global tkPriv +proc ::tk::ScrollEndDrag {w x y} { + variable ::tk::Priv - if {[string equal $tkPriv(initPos) ""]} { + if {[string equal $Priv(initPos) ""]} { return } if {[$w cget -jump]} { - set delta [$w delta [expr {$x - $tkPriv(pressX)}] \ - [expr {$y - $tkPriv(pressY)}]] - tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}] + set delta [$w delta [expr {$x - $Priv(pressX)}] \ + [expr {$y - $Priv(pressY)}]] + ScrollToPos $w [expr {$Priv(initPos) + $delta}] } - set tkPriv(initPos) "" + set Priv(initPos) "" } -# tkScrollByUnits -- +# ::tk::ScrollByUnits -- # This procedure tells the scrollbar's associated widget to scroll up # or down by a given number of units. It notifies the associated widget # in different ways for old and new command syntaxes. @@ -301,7 +301,7 @@ proc tkScrollEndDrag {w x y} { # horizontal, "v" for vertical, "hv" for both. # amount - How many units to scroll: typically 1 or -1. -proc tkScrollByUnits {w orient amount} { +proc ::tk::ScrollByUnits {w orient amount} { set cmd [$w cget -command] if {[string equal $cmd ""] || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { @@ -315,7 +315,7 @@ proc tkScrollByUnits {w orient amount} { } } -# tkScrollByPages -- +# ::tk::ScrollByPages -- # This procedure tells the scrollbar's associated widget to scroll up # or down by a given number of screenfuls. It notifies the associated # widget in different ways for old and new command syntaxes. @@ -326,7 +326,7 @@ proc tkScrollByUnits {w orient amount} { # horizontal, "v" for vertical, "hv" for both. # amount - How many screens to scroll: typically 1 or -1. -proc tkScrollByPages {w orient amount} { +proc ::tk::ScrollByPages {w orient amount} { set cmd [$w cget -command] if {[string equal $cmd ""] || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { @@ -340,7 +340,7 @@ proc tkScrollByPages {w orient amount} { } } -# tkScrollToPos -- +# ::tk::ScrollToPos -- # This procedure tells the scrollbar's associated widget to scroll to # a particular location, given by a fraction between 0 and 1. It notifies # the associated widget in different ways for old and new command syntaxes. @@ -350,7 +350,7 @@ proc tkScrollByPages {w orient amount} { # pos - A fraction between 0 and 1 indicating a desired position # in the document. -proc tkScrollToPos {w pos} { +proc ::tk::ScrollToPos {w pos} { set cmd [$w cget -command] if {[string equal $cmd ""]} { return @@ -363,7 +363,7 @@ proc tkScrollToPos {w pos} { } } -# tkScrollTopBottom +# ::tk::ScrollTopBottom # Scroll to the top or bottom of the document, depending on the mouse # position. # @@ -371,21 +371,21 @@ proc tkScrollToPos {w pos} { # w - The scrollbar widget. # x, y - Mouse coordinates within the widget. -proc tkScrollTopBottom {w x y} { - global tkPriv +proc ::tk::ScrollTopBottom {w x y} { + variable ::tk::Priv set element [$w identify $x $y] if {[string match *1 $element]} { - tkScrollToPos $w 0 + ScrollToPos $w 0 } elseif {[string match *2 $element]} { - tkScrollToPos $w 1 + ScrollToPos $w 1 } - # Set tkPriv(relief), since it's needed by tkScrollButtonUp. + # Set Priv(relief), since it's needed by tk::ScrollButtonUp. - set tkPriv(relief) [$w cget -activerelief] + set Priv(relief) [$w cget -activerelief] } -# tkScrollButton2Down +# ::tk::ScrollButton2Down # This procedure is invoked when button 2 is pressed over a scrollbar. # If the button is over the trough or slider, it sets the scrollbar to # the mouse position and starts a slider drag. Otherwise it just @@ -395,15 +395,15 @@ proc tkScrollTopBottom {w x y} { # w - The scrollbar widget. # x, y - Mouse coordinates within the widget. -proc tkScrollButton2Down {w x y} { - global tkPriv +proc ::tk::ScrollButton2Down {w x y} { + variable ::tk::Priv set element [$w identify $x $y] if {[string match {arrow[12]} $element]} { - tkScrollButtonDown $w $x $y + ScrollButtonDown $w $x $y return } - tkScrollToPos $w [$w fraction $x $y] - set tkPriv(relief) [$w cget -activerelief] + ScrollToPos $w [$w fraction $x $y] + set Priv(relief) [$w cget -activerelief] # Need the "update idletasks" below so that the widget calls us # back to reset the actual scrollbar position before we start the @@ -412,5 +412,5 @@ proc tkScrollButton2Down {w x y} { update idletasks $w configure -activerelief sunken $w activate slider - tkScrollStartDrag $w $x $y + ScrollStartDrag $w $x $y } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index a1ba4f4..666e500 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk spinbox widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: spinbox.tcl,v 1.2 2001/07/03 01:03:16 hobbs Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.3 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. @@ -15,7 +15,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 @@ -38,18 +38,18 @@ namespace eval ::tk::spinbox {} # The code below creates the default class bindings for entries. #------------------------------------------------------------------------- bind Spinbox <<Cut>> { - if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + if {![catch {::tk::spinbox::GetSelection %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 Spinbox <<Copy>> { - if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + if {![catch {::tk::spinbox::GetSelection %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 Spinbox <<Paste>> { @@ -68,7 +68,7 @@ bind Spinbox <<Clear>> { %W delete sel.first sel.last } bind Spinbox <<PasteSelection>> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { + if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { ::tk::spinbox::Paste %W %x } } @@ -82,31 +82,31 @@ bind Spinbox <B1-Motion> { ::tk::spinbox::Motion %W %x %y } bind Spinbox <Double-1> { - set tkPriv(selectMode) word + set tk::Priv(selectMode) word ::tk::spinbox::MouseSelect %W %x sel.first } bind Spinbox <Triple-1> { - set tkPriv(selectMode) line + set tk::Priv(selectMode) line ::tk::spinbox::MouseSelect %W %x 0 } bind Spinbox <Shift-1> { - set tkPriv(selectMode) char + set tk::Priv(selectMode) char %W selection adjust @%x } bind Spinbox <Double-Shift-1> { - set tkPriv(selectMode) word + set tk::Priv(selectMode) word ::tk::spinbox::MouseSelect %W %x } bind Spinbox <Triple-Shift-1> { - set tkPriv(selectMode) line + set tk::Priv(selectMode) line ::tk::spinbox::MouseSelect %W %x } bind Spinbox <B1-Leave> { - set tkPriv(x) %x + set tk::Priv(x) %x ::tk::spinbox::AutoScan %W } bind Spinbox <B1-Enter> { - tkCancelRepeat + tk::CancelRepeat } bind Spinbox <ButtonRelease-1> { ::tk::spinbox::ButtonUp %W %x %y @@ -295,15 +295,15 @@ bind Spinbox <Meta-Delete> { bind Spinbox <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 Spinbox <B2-Motion> { 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 } @@ -317,15 +317,15 @@ bind Spinbox <B2-Motion> { # elem - Element to invoke proc ::tk::spinbox::Invoke {w elem} { - global tkPriv + variable ::tk::Priv - if {![info exists tkPriv(outsideElement)]} { + if {![info exists Priv(outsideElement)]} { $w invoke $elem - incr tkPriv(repeated) + incr Priv(repeated) } set delay [$w cget -repeatinterval] if {$delay > 0} { - set tkPriv(afterId) [after $delay \ + set Priv(afterId) [after $delay \ [list ::tk::spinbox::Invoke $w $elem]] } } @@ -358,44 +358,44 @@ proc ::tk::spinbox::ClosestGap {w x} { # x - The x-coordinate of the button press. proc ::tk::spinbox::ButtonDown {w x y} { - global tkPriv + variable ::tk::Priv # Get the element that was clicked in. If we are not directly over # the spinbox, default to entry. This is necessary for spinbox grabs. # - set tkPriv(element) [$w identify $x $y] - if {$tkPriv(element) eq ""} { - set tkPriv(element) "entry" + set Priv(element) [$w identify $x $y] + if {$Priv(element) eq ""} { + set Priv(element) "entry" } - switch -exact $tkPriv(element) { + switch -exact $Priv(element) { "buttonup" - "buttondown" { if {[string compare "disabled" [$w cget -state]]} { - $w selection element $tkPriv(element) - set tkPriv(repeated) 0 - set tkPriv(relief) [$w cget -$tkPriv(element)relief] - after cancel $tkPriv(afterId) + $w selection element $Priv(element) + set Priv(repeated) 0 + set Priv(relief) [$w cget -$Priv(element)relief] + after cancel $Priv(afterId) set delay [$w cget -repeatdelay] if {$delay > 0} { - set tkPriv(afterId) [after $delay \ - [list ::tk::spinbox::Invoke $w $tkPriv(element)]] + set Priv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $Priv(element)]] } - if {[info exists tkPriv(outsideElement)]} { - unset tkPriv(outsideElement) + if {[info exists Priv(outsideElement)]} { + unset Priv(outsideElement) } } } "entry" { - set tkPriv(selectMode) char - set tkPriv(mouseMoved) 0 - set tkPriv(pressX) $x + set Priv(selectMode) char + set Priv(mouseMoved) 0 + set Priv(pressX) $x $w icursor [::tk::spinbox::ClosestGap $w $x] $w selection from insert if {[string compare "disabled" [$w cget -state]]} {focus $w} $w selection clear } default { - return -code error "unknown spinbox element \"$tkPriv(element)\"" + return -code error "unknown spinbox element \"$Priv(element)\"" } } } @@ -409,18 +409,18 @@ proc ::tk::spinbox::ButtonDown {w x y} { # x - The x-coordinate of the button press. proc ::tk::spinbox::ButtonUp {w x y} { - global tkPriv + variable ::tk::Priv - tkCancelRepeat + ::tk::CancelRepeat - # tkPriv(relief) may not exist if the ButtonUp is not paired with + # Priv(relief) may not exist if the ButtonUp is not paired with # a preceding ButtonDown - if {[info exists tkPriv(element)] && [info exists tkPriv(relief)] && \ - [string match "button*" $tkPriv(element)]} { - if {[info exists tkPriv(repeated)] && !$tkPriv(repeated)} { - $w invoke $tkPriv(element) + if {[info exists Priv(element)] && [info exists Priv(relief)] && \ + [string match "button*" $Priv(element)]} { + if {[info exists Priv(repeated)] && !$Priv(repeated)} { + $w invoke $Priv(element) } - $w configure -$tkPriv(element)relief $tkPriv(relief) + $w configure -$Priv(element)relief $Priv(relief) $w selection element none } } @@ -438,25 +438,25 @@ proc ::tk::spinbox::ButtonUp {w x y} { # cursor - optional place to set cursor. proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { - global tkPriv + variable ::tk::Priv - if {[string compare "entry" $tkPriv(element)]} { - if {[string compare "none" $tkPriv(element)] && \ + if {[string compare "entry" $Priv(element)]} { + if {[string compare "none" $Priv(element)] && \ [string compare "ignore" $cursor]} { $w selection element none - $w invoke $tkPriv(element) - $w selection element $tkPriv(element) + $w invoke $Priv(element) + $w selection element $Priv(element) } return } set cur [::tk::spinbox::ClosestGap $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} { @@ -501,7 +501,6 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { # x - X position of the mouse. proc ::tk::spinbox::Paste {w x} { - global tkPriv $w icursor [::tk::spinbox::ClosestGap $w $x] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} @@ -516,26 +515,26 @@ proc ::tk::spinbox::Paste {w x} { # w - The spinbox window. proc ::tk::spinbox::Motion {w x y} { - global tkPriv + variable ::tk::Priv - if {![info exists tkPriv(element)]} { - set tkPriv(element) [$w identify $x $y] + if {![info exists Priv(element)]} { + set Priv(element) [$w identify $x $y] } - set tkPriv(x) $x - if {[string equal "entry" $tkPriv(element)]} { + set Priv(x) $x + if {[string equal "entry" $Priv(element)]} { ::tk::spinbox::MouseSelect $w $x ignore - } elseif {[string compare [$w identify $x $y] $tkPriv(element)]} { - if {![info exists tkPriv(outsideElement)]} { + } elseif {[string compare [$w identify $x $y] $Priv(element)]} { + if {![info exists Priv(outsideElement)]} { # We've wandered out of the spin button # setting outside element will cause ::tk::spinbox::Invoke to # loop without doing anything - set tkPriv(outsideElement) "" + set Priv(outsideElement) "" $w selection element none } - } elseif {[info exists tkPriv(outsideElement)]} { - unset tkPriv(outsideElement) - $w selection element $tkPriv(element) + } elseif {[info exists Priv(outsideElement)]} { + unset Priv(outsideElement) + $w selection element $Priv(element) } } @@ -550,9 +549,9 @@ proc ::tk::spinbox::Motion {w x y} { # w - The spinbox window. proc ::tk::spinbox::AutoScan {w} { - global tkPriv + variable ::tk::Priv - set x $tkPriv(x) + set x $Priv(x) if {$x >= [winfo width $w]} { $w xview scroll 2 units ::tk::spinbox::MouseSelect $w $x ignore @@ -560,7 +559,7 @@ proc ::tk::spinbox::AutoScan {w} { $w xview scroll -2 units ::tk::spinbox::MouseSelect $w $x ignore } - set tkPriv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] + set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] } # ::tk::spinbox::KeySelect -- diff --git a/library/tclIndex b/library/tclIndex index 659e012..72ac96e 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -6,213 +6,238 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]] -set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]] -set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]] -set auto_index(tkButtonDown) [list source [file join $dir button.tcl]] -set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]] -set auto_index(tkButtonUp) [list source [file join $dir button.tcl]] -set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]] -set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]] -set auto_index(tkButtonDown) [list source [file join $dir button.tcl]] -set auto_index(tkButtonUp) [list source [file join $dir button.tcl]] -set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]] -set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]] -set auto_index(tkButtonDown) [list source [file join $dir button.tcl]] -set auto_index(tkButtonUp) [list source [file join $dir button.tcl]] -set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]] -set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]] +set auto_index(::tk::dialog::error::Return) [list source [file join $dir bgerror.tcl]] +set auto_index(::tk::dialog::error::details) [list source [file join $dir bgerror.tcl]] +set auto_index(::tk::dialog::error::evalFunction) [list source [file join $dir bgerror.tcl]] +set auto_index(::tk::dialog::error::saveToLog) [list source [file join $dir bgerror.tcl]] +set auto_index(::tk::dialog::error::Destroy) [list source [file join $dir bgerror.tcl]] +set auto_index(bgerror) [list source [file join $dir bgerror.tcl]] +set auto_index(::tk::ButtonInvoke) [list source [file join $dir button.tcl]] +set auto_index(::tk::ButtonAutoInvoke) [list source [file join $dir button.tcl]] +set auto_index(::tk::CheckRadioInvoke) [list source [file join $dir button.tcl]] +set auto_index(::tk::dialog::file::chooseDir::) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::file::chooseDir::Config) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::file::chooseDir::OkCmd) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::file::chooseDir::DblClick) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::file::chooseDir::ListBrowse) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::file::chooseDir::Done) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::dialog::color::) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::InitValues) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::Config) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::BuildDialog) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::SetRGBValue) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::XToRgb) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::RgbToX) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::DrawColorScale) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::CreateSelector) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::RedrawFinalColor) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::RedrawColorBars) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::StartMove) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::MoveSelector) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::ReleaseMouse) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::ResizeColorBars) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::HandleSelEntry) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::HandleRGBEntry) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::EnterColorBar) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::LeaveColorBar) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::OkCmd) [list source [file join $dir clrpick.tcl]] +set auto_index(::tk::dialog::color::CancelCmd) [list source [file join $dir clrpick.tcl]] +set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]] +set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_Create) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_BindIn) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_BindOut) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_Destroy) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_In) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FocusGroup_Out) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::FDGetFileTypes) [list source [file join $dir comdlg.tcl]] +set auto_index(::tk::ConsoleInit) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleSource) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleInvoke) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleHistory) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsolePrompt) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleBind) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleInsert) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleOutput) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleExit) [list source [file join $dir console.tcl]] +set auto_index(::tk::ConsoleAbout) [list source [file join $dir console.tcl]] set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]] -set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]] -set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]] -set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]] -set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]] -set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]] -set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]] -set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]] -set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]] -set auto_index(tkMbPost) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]] -set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]] -set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]] -set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]] -set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]] -set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]] -set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]] -set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]] -set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]] -set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]] +set auto_index(::tk::EntryClosestGap) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryButton1) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryMouseSelect) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryPaste) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryAutoScan) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryKeySelect) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryInsert) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryBackspace) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntrySeeInsert) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntrySetCursor) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryTranspose) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryPreviousWord) [list source [file join $dir entry.tcl]] +set auto_index(::tk::EntryGetSelection) [list source [file join $dir entry.tcl]] +set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]] +set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]] +set auto_index(::tk::FocusOK) [list source [file join $dir focus.tcl]] +set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]] +set auto_index(::tk::ListboxBeginSelect) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxMotion) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxBeginExtend) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxBeginToggle) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxAutoScan) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxUpDown) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxExtendUpDown) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxDataExtend) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxCancel) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::ListboxSelectAll) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::MbEnter) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MbLeave) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MbPost) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuUnpost) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MbMotion) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MbButtonUp) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuMotion) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuButtonDown) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuLeave) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuInvoke) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuEscape) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuUpArrow) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuDownArrow) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuLeftArrow) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuRightArrow) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuNextMenu) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuNextEntry) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuFind) [list source [file join $dir menu.tcl]] +set auto_index(::tk::TraverseToMenu) [list source [file join $dir menu.tcl]] +set auto_index(::tk::FirstMenu) [list source [file join $dir menu.tcl]] +set auto_index(::tk::TraverseWithinMenu) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuFirstEntry) [list source [file join $dir menu.tcl]] +set auto_index(::tk::MenuFindName) [list source [file join $dir menu.tcl]] +set auto_index(::tk::PostOverPoint) [list source [file join $dir menu.tcl]] +set auto_index(::tk::SaveGrabInfo) [list source [file join $dir menu.tcl]] +set auto_index(::tk::RestoreOldGrab) [list source [file join $dir menu.tcl]] set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]] -set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]] +set auto_index(::tk::GenerateMenuSelect) [list source [file join $dir menu.tcl]] set auto_index(tk_popup) [list source [file join $dir menu.tcl]] -set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]] -set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]] -set auto_index(tkTextButton1) [list source [file join $dir text.tcl]] -set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]] -set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]] -set auto_index(tkTextPaste) [list source [file join $dir text.tcl]] -set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]] -set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]] -set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]] -set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]] -set auto_index(tkTextInsert) [list source [file join $dir text.tcl]] -set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]] -set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]] -set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]] -set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]] -set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]] -set auto_index(tk_textCopy) [list source [file join $dir text.tcl]] -set auto_index(tk_textCut) [list source [file join $dir text.tcl]] -set auto_index(tk_textPaste) [list source [file join $dir text.tcl]] -set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]] -set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]] -set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]] -set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]] -set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]] -set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]] -set auto_index(bgerror) [list source [file join $dir bgerror.tcl]] -set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]] -set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]] -set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]] -set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]] -set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]] +set auto_index(::tk::MessageBox) [list source [file join $dir msgbox.tcl]] set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]] set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]] -set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]] -set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]] -set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]] -set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]] -set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]] -set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]] -set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]] +set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]] set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]] -set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]] -set auto_index(tkDarken) [list source [file join $dir palette.tcl]] +set auto_index(::tk::RecolorTree) [list source [file join $dir palette.tcl]] +set auto_index(::tk::Darken) [list source [file join $dir palette.tcl]] set auto_index(tk_bisque) [list source [file join $dir palette.tcl]] -set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]] -set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]] -set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]] -set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]] -set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]] -set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]] -set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]] +set auto_index(::safe::tkInterpInit) [list source [file join $dir safetk.tcl]] set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]] set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]] set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]] +set auto_index(::safe::disallowTk) [list source [file join $dir safetk.tcl]] +set auto_index(::safe::tkDelete) [list source [file join $dir safetk.tcl]] set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]] -set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]] -set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::dialog::file::tkFDialog) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::ScaleActivate) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleButtonDown) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleDrag) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleEndDrag) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleIncrement) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleControlPress) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScaleButton2Down) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScrollButtonDown) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollButtonUp) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollSelect) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollStartDrag) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollDrag) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollEndDrag) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollByUnits) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollByPages) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollToPos) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollTopBottom) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::ScrollButton2Down) [list source [file join $dir scrlbar.tcl]] +set auto_index(::tk::spinbox::Invoke) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::ClosestGap) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::ButtonDown) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::ButtonUp) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::MouseSelect) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::Paste) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::Motion) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::AutoScan) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::KeySelect) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::Insert) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::Backspace) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::SeeInsert) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::SetCursor) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::Transpose) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::PreviousWord) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::spinbox::GetSelection) [list source [file join $dir spinbox.tcl]] +set auto_index(::tk::TearOffMenu) [list source [file join $dir tearoff.tcl]] +set auto_index(::tk::MenuDup) [list source [file join $dir tearoff.tcl]] +set auto_index(::tk::TextClosestGap) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextButton1) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextSelectTo) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextKeyExtend) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextPaste) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextAutoScan) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextSetCursor) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextKeySelect) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextResetAnchor) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextInsert) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextUpDownLine) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextPrevPara) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextNextPara) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextScrollPages) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextTranspose) [list source [file join $dir text.tcl]] +set auto_index(tk_textCopy) [list source [file join $dir text.tcl]] +set auto_index(tk_textCut) [list source [file join $dir text.tcl]] +set auto_index(tk_textPaste) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextNextPos) [list source [file join $dir text.tcl]] +set auto_index(::tk::TextPrevPos) [list source [file join $dir text.tcl]] +set auto_index(::tk::PlaceWindow) [list source [file join $dir tk.tcl]] +set auto_index(::tk::SetFocusGrab) [list source [file join $dir tk.tcl]] +set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]] +set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] +set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] +set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] +set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] +set auto_index(::tk::IconList) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Index) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Selection) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Curselection) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_DrawSelection) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Get) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Config) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Create) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_AutoScan) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_DeleteAll) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Add) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Arrange) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Invoke) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_See) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Btn1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_CtrlBtn1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_ShiftBtn1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Motion1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Double1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_ReturnKey) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Leave1) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_FocusIn) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_FocusOut) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_UpDown) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_LeftRight) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_KeyPress) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Goto) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::IconList_Reset) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::dialog::file::SetSelectMode) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Update) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::SetPathSilently) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::SetPath) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::SetFilter) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::dialog::file::ResolveFile) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::EntFocusIn) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::EntFocusOut) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::ActivateEnt) [list source [file join $dir tkfbox.tcl]] +set auto_index(::tk::dialog::file::VerifyFileName) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::InvokeBtn) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::UpDirCmd) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::JoinFile) [list source [file join $dir tkfbox.tcl]] @@ -221,25 +246,31 @@ set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbo set auto_index(::tk::dialog::file::ListBrowse) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::ListInvoke) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Done) [list source [file join $dir tkfbox.tcl]] -set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]] -set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]] -set auto_index(::tk::dialog::file::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]] +set auto_index(::tk::MotifFDialog) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_Create) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_FileTypes) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_SetFilter) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_Config) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_BuildUI) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_SetListMode) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_Update) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::MotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::ListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::ListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::ListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::ListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]] +set auto_index(tk_getFileType) [list source [file join $dir xmfbox.tcl]] +set auto_index(::tk::unsupported::ExposePrivateCommand) [list source [file join $dir unsupported.tcl]] +set auto_index(::tk::unsupported::ExposePrivateVariable) [list source [file join $dir unsupported.tcl]] diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 7844057..8bcdc81 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -2,7 +2,7 @@ # # This file contains procedures that implement tear-off menus. # -# RCS: @(#) $Id: tearoff.tcl,v 1.6 2000/01/06 02:22:24 hobbs Exp $ +# RCS: @(#) $Id: tearoff.tcl,v 1.7 2001/08/01 16:21:11 dgp Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# tkTearoffMenu -- +# ::tk::TearoffMenu -- # Given the name of a menu, this procedure creates a torn-off menu # that is identical to the given menu (including nested submenus). # The new torn-off menu exists as a toplevel window managed by the @@ -23,7 +23,7 @@ # x - x coordinate where window is created # y - y coordinate where window is created -proc tkTearOffMenu {w {x 0} {y 0}} { +proc ::tk::TearOffMenu {w {x 0} {y 0}} { # Find a unique name to use for the torn-off menu. Find the first # ancestor of w that is a toplevel but not a menu, and use this as # the parent of the new menu. This guarantees that the torn off @@ -80,12 +80,12 @@ proc tkTearOffMenu {w {x 0} {y 0}} { return "" } - # Set tkPriv(focus) on entry: otherwise the focus will get lost + # Set tk::Priv(focus) on entry: otherwise the focus will get lost # after keyboard invocation of a sub-menu (it will stay on the # submenu). bind $menu <Enter> { - set tkPriv(focus) %W + set tk::Priv(focus) %W } # If there is a -tearoffcommand option for the menu, invoke it @@ -98,7 +98,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { return $menu } -# tkMenuDup -- +# ::tk::MenuDup -- # Given a menu (hierarchy), create a duplicate menu (hierarchy) # in a given window. # @@ -108,7 +108,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { # dst - Name to use for topmost menu in duplicate # hierarchy. -proc tkMenuDup {src dst type} { +proc ::tk::MenuDup {src dst type} { set cmd [list menu $dst -type $type] foreach option [$src configure] { if {[llength $option] == 2} { diff --git a/library/text.tcl b/library/text.tcl index 38f2efc..c3ff764 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.15 2001/07/03 01:03:16 hobbs Exp $ +# RCS: @(#) $Id: text.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. @@ -14,7 +14,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 @@ -42,112 +42,112 @@ # Standard Motif bindings: bind Text <1> { - tkTextButton1 %W %x %y + tk::TextButton1 %W %x %y %W tag remove sel 0.0 end } bind Text <B1-Motion> { - set tkPriv(x) %x - set tkPriv(y) %y - tkTextSelectTo %W %x %y + set tk::Priv(x) %x + set tk::Priv(y) %y + tk::TextSelectTo %W %x %y } bind Text <Double-1> { - set tkPriv(selectMode) word - tkTextSelectTo %W %x %y + set tk::Priv(selectMode) word + tk::TextSelectTo %W %x %y catch {%W mark set insert sel.last} catch {%W mark set anchor sel.first} } bind Text <Triple-1> { - set tkPriv(selectMode) line - tkTextSelectTo %W %x %y + set tk::Priv(selectMode) line + tk::TextSelectTo %W %x %y catch {%W mark set insert sel.last} catch {%W mark set anchor sel.first} } bind Text <Shift-1> { - tkTextResetAnchor %W @%x,%y - set tkPriv(selectMode) char - tkTextSelectTo %W %x %y + tk::TextResetAnchor %W @%x,%y + set tk::Priv(selectMode) char + tk::TextSelectTo %W %x %y } bind Text <Double-Shift-1> { - set tkPriv(selectMode) word - tkTextSelectTo %W %x %y 1 + set tk::Priv(selectMode) word + tk::TextSelectTo %W %x %y 1 } bind Text <Triple-Shift-1> { - set tkPriv(selectMode) line - tkTextSelectTo %W %x %y + set tk::Priv(selectMode) line + tk::TextSelectTo %W %x %y } bind Text <B1-Leave> { - set tkPriv(x) %x - set tkPriv(y) %y - tkTextAutoScan %W + set tk::Priv(x) %x + set tk::Priv(y) %y + tk::TextAutoScan %W } bind Text <B1-Enter> { - tkCancelRepeat + tk::CancelRepeat } bind Text <ButtonRelease-1> { - tkCancelRepeat + tk::CancelRepeat } bind Text <Control-1> { %W mark set insert @%x,%y } bind Text <Left> { - tkTextSetCursor %W insert-1c + tk::TextSetCursor %W insert-1c } bind Text <Right> { - tkTextSetCursor %W insert+1c + tk::TextSetCursor %W insert+1c } bind Text <Up> { - tkTextSetCursor %W [tkTextUpDownLine %W -1] + tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } bind Text <Down> { - tkTextSetCursor %W [tkTextUpDownLine %W 1] + tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <Shift-Left> { - tkTextKeySelect %W [%W index {insert - 1c}] + tk::TextKeySelect %W [%W index {insert - 1c}] } bind Text <Shift-Right> { - tkTextKeySelect %W [%W index {insert + 1c}] + tk::TextKeySelect %W [%W index {insert + 1c}] } bind Text <Shift-Up> { - tkTextKeySelect %W [tkTextUpDownLine %W -1] + tkT::extKeySelect %W [tk::TextUpDownLine %W -1] } bind Text <Shift-Down> { - tkTextKeySelect %W [tkTextUpDownLine %W 1] + tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } bind Text <Control-Left> { - tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text <Control-Right> { - tkTextSetCursor %W [tkTextNextWord %W insert] + tk::TextSetCursor %W [tk::TextNextWord %W insert] } bind Text <Control-Up> { - tkTextSetCursor %W [tkTextPrevPara %W insert] + tk::TextSetCursor %W [tk::TextPrevPara %W insert] } bind Text <Control-Down> { - tkTextSetCursor %W [tkTextNextPara %W insert] + tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text <Shift-Control-Left> { - tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text <Shift-Control-Right> { - tkTextKeySelect %W [tkTextNextWord %W insert] + tk::TextKeySelect %W [tk::TextNextWord %W insert] } bind Text <Shift-Control-Up> { - tkTextKeySelect %W [tkTextPrevPara %W insert] + tk::TextKeySelect %W [tk::TextPrevPara %W insert] } bind Text <Shift-Control-Down> { - tkTextKeySelect %W [tkTextNextPara %W insert] + tk::TextKeySelect %W [tk::TextNextPara %W insert] } bind Text <Prior> { - tkTextSetCursor %W [tkTextScrollPages %W -1] + tk::TextSetCursor %W [tk::TextScrollPages %W -1] } bind Text <Shift-Prior> { - tkTextKeySelect %W [tkTextScrollPages %W -1] + tk::TextKeySelect %W [tk::TextScrollPages %W -1] } bind Text <Next> { - tkTextSetCursor %W [tkTextScrollPages %W 1] + tk::TextSetCursor %W [tk::TextScrollPages %W 1] } bind Text <Shift-Next> { - tkTextKeySelect %W [tkTextScrollPages %W 1] + tk::TextKeySelect %W [tk::TextScrollPages %W 1] } bind Text <Control-Prior> { %W xview scroll -1 page @@ -157,33 +157,33 @@ bind Text <Control-Next> { } bind Text <Home> { - tkTextSetCursor %W {insert linestart} + tk::TextSetCursor %W {insert linestart} } bind Text <Shift-Home> { - tkTextKeySelect %W {insert linestart} + tk::TextKeySelect %W {insert linestart} } bind Text <End> { - tkTextSetCursor %W {insert lineend} + tk::TextSetCursor %W {insert lineend} } bind Text <Shift-End> { - tkTextKeySelect %W {insert lineend} + tk::TextKeySelect %W {insert lineend} } bind Text <Control-Home> { - tkTextSetCursor %W 1.0 + tk::TextSetCursor %W 1.0 } bind Text <Control-Shift-Home> { - tkTextKeySelect %W 1.0 + tk::TextKeySelect %W 1.0 } bind Text <Control-End> { - tkTextSetCursor %W {end - 1 char} + tk::TextSetCursor %W {end - 1 char} } bind Text <Control-Shift-End> { - tkTextKeySelect %W {end - 1 char} + tk::TextKeySelect %W {end - 1 char} } bind Text <Tab> { if { [string equal [%W cget -state] "normal"] } { - tkTextInsert %W \t + tk::TextInsert %W \t focus %W break } @@ -200,10 +200,10 @@ bind Text <Control-Shift-Tab> { focus [tk_focusPrev %W] } bind Text <Control-i> { - tkTextInsert %W \t + tk::TextInsert %W \t } bind Text <Return> { - tkTextInsert %W \n + tk::TextInsert %W \n } bind Text <Delete> { if {[string compare [%W tag nextrange sel 1.0 end] ""]} { @@ -229,12 +229,12 @@ bind Text <Select> { %W mark set anchor insert } bind Text <Control-Shift-space> { - set tkPriv(selectMode) char - tkTextKeyExtend %W insert + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert } bind Text <Shift-Select> { - set tkPriv(selectMode) char - tkTextKeyExtend %W insert + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert } bind Text <Control-slash> { %W tag add sel 1.0 end @@ -255,15 +255,15 @@ bind Text <<Clear>> { catch {%W delete sel.first sel.last} } bind Text <<PasteSelection>> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { - tkTextPaste %W %x %y + if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + tk::TextPaste %W %x %y } } bind Text <Insert> { - catch {tkTextInsert %W [::tk::GetSelection %W PRIMARY]} + catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} } bind Text <KeyPress> { - 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 <Control-a> { if {!$tk_strictMotif} { - tkTextSetCursor %W {insert linestart} + tk::TextSetCursor %W {insert linestart} } } bind Text <Control-b> { if {!$tk_strictMotif} { - tkTextSetCursor %W insert-1c + tk::TextSetCursor %W insert-1c } } bind Text <Control-d> { @@ -299,12 +299,12 @@ bind Text <Control-d> { } bind Text <Control-e> { if {!$tk_strictMotif} { - tkTextSetCursor %W {insert lineend} + tk::TextSetCursor %W {insert lineend} } } bind Text <Control-f> { if {!$tk_strictMotif} { - tkTextSetCursor %W insert+1c + tk::TextSetCursor %W insert+1c } } bind Text <Control-k> { @@ -318,7 +318,7 @@ bind Text <Control-k> { } bind Text <Control-n> { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextUpDownLine %W 1] + tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } } bind Text <Control-o> { @@ -329,56 +329,56 @@ bind Text <Control-o> { } bind Text <Control-p> { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextUpDownLine %W -1] + tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } } bind Text <Control-t> { if {!$tk_strictMotif} { - tkTextTranspose %W + tk::TextTranspose %W } } if {[string compare $tcl_platform(platform) "windows"]} { bind Text <Control-v> { if {!$tk_strictMotif} { - tkTextScrollPages %W 1 + tk::TextScrollPages %W 1 } } } bind Text <Meta-b> { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } } bind Text <Meta-d> { if {!$tk_strictMotif} { - %W delete insert [tkTextNextWord %W insert] + %W delete insert [tk::TextNextWord %W insert] } } bind Text <Meta-f> { if {!$tk_strictMotif} { - tkTextSetCursor %W [tkTextNextWord %W insert] + tk::TextSetCursor %W [tk::TextNextWord %W insert] } } bind Text <Meta-less> { if {!$tk_strictMotif} { - tkTextSetCursor %W 1.0 + tk::TextSetCursor %W 1.0 } } bind Text <Meta-greater> { if {!$tk_strictMotif} { - tkTextSetCursor %W end-1c + tk::TextSetCursor %W end-1c } } bind Text <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert } } bind Text <Meta-Delete> { 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 <FocusOut> { %W configure -selectbackground white -selectforeground black } bind Text <Option-Left> { - tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text <Option-Right> { - tkTextSetCursor %W [tkTextNextWord %W insert] + tk::TextSetCursor %W [tk::TextNextWord %W insert] } bind Text <Option-Up> { - tkTextSetCursor %W [tkTextPrevPara %W insert] + tk::TextSetCursor %W [tk::TextPrevPara %W insert] } bind Text <Option-Down> { - tkTextSetCursor %W [tkTextNextPara %W insert] + tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text <Shift-Option-Left> { - tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } bind Text <Shift-Option-Right> { - tkTextKeySelect %W [tkTextNextWord %W insert] + tk::TextKeySelect %W [tk::TextNextWord %W insert] } bind Text <Shift-Option-Up> { - tkTextKeySelect %W [tkTextPrevPara %W insert] + tk::TextKeySelect %W [tk::TextPrevPara %W insert] } bind Text <Shift-Option-Down> { - tkTextKeySelect %W [tkTextNextPara %W insert] + tk::TextKeySelect %W [tk::TextNextPara %W insert] } # End of Mac only bindings @@ -435,22 +435,22 @@ bind Text <Control-h> { 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 <B2-Motion> { 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 <<Cut>> <Control-Key-x> <Key-F20> event add <<Copy>> <Control-Key-c> <Key-F16> @@ -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 <<Cut>> <Control-Key-x> <Shift-Key-Delete> @@ -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 <<PrevWindow>> <Shift-Tab> -bind all <Tab> {tkTabToWindow [tk_focusNext %W]} -bind all <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]} +bind all <Tab> {tk::TabToWindow [tk_focusNext %W]} +bind all <<PrevWindow>> {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 <<ListboxSelect>> - 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 <<ListboxSelect>> - 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) <Configure> [list tkIconList_Arrange $w] - - bind $data(canvas) <1> [list tkIconList_Btn1 $w %x %y] - bind $data(canvas) <B1-Motion> [list tkIconList_Motion1 $w %x %y] - bind $data(canvas) <B1-Leave> [list tkIconList_Leave1 $w %x %y] - bind $data(canvas) <Control-1> [list tkIconList_CtrlBtn1 $w %x %y] - bind $data(canvas) <Shift-1> [list tkIconList_ShiftBtn1 $w %x %y] - bind $data(canvas) <B1-Enter> [list tkCancelRepeat] - bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat] + bind $data(canvas) <Configure> [list tk::IconList_Arrange $w] + + bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y] + bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y] + bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y] + bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y] + bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y] + bind $data(canvas) <B1-Enter> [list tk::CancelRepeat] + bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat] bind $data(canvas) <Double-ButtonRelease-1> \ - [list tkIconList_Double1 $w %x %y] - - bind $data(canvas) <Up> [list tkIconList_UpDown $w -1] - bind $data(canvas) <Down> [list tkIconList_UpDown $w 1] - bind $data(canvas) <Left> [list tkIconList_LeftRight $w -1] - bind $data(canvas) <Right> [list tkIconList_LeftRight $w 1] - bind $data(canvas) <Return> [list tkIconList_ReturnKey $w] - bind $data(canvas) <KeyPress> [list tkIconList_KeyPress $w %A] + [list tk::IconList_Double1 $w %x %y] + + bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1] + bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1] + bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1] + bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1] + bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w] + bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A] bind $data(canvas) <Control-KeyPress> ";" bind $data(canvas) <Alt-KeyPress> ";" - bind $data(canvas) <FocusIn> [list tkIconList_FocusIn $w] - bind $data(canvas) <FocusOut> [list tkIconList_FocusOut $w] + bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w] + bind $data(canvas) <FocusOut> [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) <<ListboxSelect>> \ @@ -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 <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)] - bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)] + bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)] + bind $w <Alt-c> [list tk::ButtonInvoke $data(cancelBtn)] bind $w <Alt-d> [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) <Return> $okCmd $data(okBtn) config -command $okCmd bind $w <Alt-s> [list focus $data(ent)] - bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)] + bind $w <Alt-o> [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 <Alt-l> [list focus $data(fList)] bind $w <Alt-s> [list focus $data(sEnt)] - bind $w <Alt-o> [list tkButtonInvoke $bot.ok] - bind $w <Alt-f> [list tkButtonInvoke $bot.filter] - bind $w <Alt-c> [list tkButtonInvoke $bot.cancel] + bind $w <Alt-o> [list tk::ButtonInvoke $bot.ok] + bind $w <Alt-f> [list tk::ButtonInvoke $bot.filter] + bind $w <Alt-c> [list tk::ButtonInvoke $bot.cancel] - bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w] - bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w] + bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w] + bind $data(sEnt) <Return> [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 <<ListboxSelect>> [list tkMotifFDialog_Browse$cmdPrefix $w] + bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w] bind $list <Double-ButtonRelease-1> \ - [list tkMotifFDialog_Activate$cmdPrefix $w] - bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix [list $w]; \ - tkMotifFDialog_Activate$cmdPrefix [list $w]" + [list tk::MotifFDialog_Activate$cmdPrefix $w] + bind $list <Return> "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 <Any-KeyPress> "" - bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w] - bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A] + bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w] + bind $w <Any-KeyPress> [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); } |