diff options
| -rw-r--r-- | library/bgerror.tcl | 21 | ||||
| -rw-r--r-- | library/button.tcl | 291 | ||||
| -rw-r--r-- | library/choosedir.tcl | 29 | ||||
| -rw-r--r-- | library/clrpick.tcl | 276 | ||||
| -rw-r--r-- | library/comdlg.tcl | 110 | ||||
| -rw-r--r-- | library/console.tcl | 798 | ||||
| -rw-r--r-- | library/dialog.tcl | 28 | ||||
| -rw-r--r-- | library/entry.tcl | 281 | ||||
| -rw-r--r-- | library/focus.tcl | 24 | ||||
| -rw-r--r-- | library/listbox.tcl | 156 | ||||
| -rw-r--r-- | library/menu.tcl | 495 | ||||
| -rw-r--r-- | library/msgbox.tcl | 43 | ||||
| -rw-r--r-- | library/msgs/cs.msg | 67 | ||||
| -rw-r--r-- | library/msgs/de.msg | 6 | ||||
| -rw-r--r-- | library/optMenu.tcl | 6 | ||||
| -rw-r--r-- | library/palette.tcl | 62 | ||||
| -rw-r--r-- | library/panedwindow.tcl | 181 | ||||
| -rw-r--r-- | library/scale.tcl | 130 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 204 | ||||
| -rw-r--r-- | library/spinbox.tcl | 395 | ||||
| -rw-r--r-- | library/tclIndex | 447 | ||||
| -rw-r--r-- | library/tearoff.tcl | 14 | ||||
| -rw-r--r-- | library/text.tcl | 447 | ||||
| -rw-r--r-- | library/tk.tcl | 165 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 480 | ||||
| -rw-r--r-- | library/unsupported.tcl | 289 | ||||
| -rw-r--r-- | library/xmfbox.tcl | 253 |
27 files changed, 3377 insertions, 2321 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index c2fd1df..ce41f61 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.13 2000/07/17 21:07:54 ericm Exp $ -# $Id: bgerror.tcl,v 1.13 2000/07/17 21:07:54 ericm Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.13.2.1 2002/04/06 01:02:01 hobbs Exp $ +# $Id: bgerror.tcl,v 1.13.2.1 2002/04/06 01:02:01 hobbs 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 @@ -143,7 +143,7 @@ proc bgerror err { wm transient .bgerrorDialog .bgerrorDialog if {$tcl_platform(platform) == "macintosh"} { - unsupported1 style .bgerrorDialog dBoxProc + ::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc } frame .bgerrorDialog.bot @@ -172,6 +172,7 @@ proc bgerror err { pack $W.text -side left -expand yes -fill both $W.text insert 0.0 "$err\n$info" $W.text mark set insert 0.0 + bind $W.text <ButtonPress-1> { focus %W } $W.text configure -state disabled # 2. Fill the top part with bitmap and message @@ -237,10 +238,10 @@ proc bgerror err { set parent [winfo parent .bgerrorDialog] set width [winfo reqwidth .bgerrorDialog] set height [winfo reqheight .bgerrorDialog] - set x [expr ([winfo screenwidth .bgerrorDialog] - $width )/2 - \ - [winfo vrootx $parent]] - set y [expr ([winfo screenheight .bgerrorDialog] - $height)/2 - \ - [winfo vrooty $parent]] + set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \ + [winfo vrootx $parent]}] + set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \ + [winfo vrooty $parent]}] .bgerrorDialog configure -width $width wm geometry .bgerrorDialog +$x+$y wm deiconify .bgerrorDialog @@ -261,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..ef94de9 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.10.2.1 2002/04/06 01:02:01 hobbs 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,25 @@ 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) + set Priv(repeated) 0 if { ![catch {$w cget -repeatdelay} delay] } { - set delay [$w cget -repeatdelay] - set tkPriv(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 +521,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 +551,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 +570,7 @@ proc tkButtonInvoke w { } } -# tkButtonAutoInvoke -- +# ::tk::ButtonAutoInvoke -- # # Invoke an auto-repeating button, and set it up to continue to repeat. # @@ -582,22 +581,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 +606,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..6fc05f5 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.9.2.1 2002/04/06 01:02:01 hobbs 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,12 +220,13 @@ 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 filenameFragment \ + [tk::IconList_Get $data(icons) [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { - ::tk::dialog::file::ListInvoke $w $text + ::tk::dialog::file::ListInvoke $w [list $filenameFragment] return } } @@ -250,13 +251,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 +268,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 c173015..eff22d6 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.11 2000/06/30 06:38:38 ericm Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.11.2.1 2002/04/06 01:02:01 hobbs 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. @@ -41,11 +47,11 @@ proc tkColorDialog {args} { # Note that the bars may be of any width. # However, NUM_COLORBARS must be a number that evenly divides 256. # Such as 256, 128, 64, etc. - set data(NUM_COLORBARS) 8 + set data(NUM_COLORBARS) 16 # BARS_WIDTH is the number of pixels wide the color bar portion of the # canvas is. This number must be a multiple of NUM_COLORBARS - set data(BARS_WIDTH) 128 + set data(BARS_WIDTH) 160 # PLGN_WIDTH is the number of pixels wide of the triangular selection # polygon. This also results in the definition of the padding on the @@ -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 # @@ -198,7 +204,7 @@ proc tkColorDialog_BuildDialog {w} { set stripsFrame [frame $topFrame.colorStrip] set maxWidth [::msgcat::mcmax Red Green Blue] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set colorList [list \ red [::msgcat::mc "Red"] \ green [::msgcat::mc "Green"] \ @@ -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 @@ -276,13 +284,13 @@ proc tkColorDialog_BuildDialog {w} { # set botFrame [frame $w.bot -relief raised -bd 1] set maxWidth [::msgcat::mcmax OK Cancel] - set maxWidth [expr $maxWidth<8?8:$maxWidth] + 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,63 @@ 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)}] + set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] + if {$x > 255} { set x 255 } + return $x } -# 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 +384,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 +399,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 +455,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 +492,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 +535,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,15 +552,15 @@ 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 if { $x < 0 } { set x 0 - } elseif { $x >= $data(BARS_WIDTH)} { - set x [expr {$data(BARS_WIDTH) - 1}] + } elseif { $x > $data(BARS_WIDTH)} { + set x $data(BARS_WIDTH) } set diff [expr {$x - $data($color,x)}] $sel move $data($color,index) $diff 0 @@ -561,49 +570,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 +625,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 +651,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..5dcef2c 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.7.4.1 2002/04/06 01:02:01 hobbs 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 472dcf5..f286cf8 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.10 2000/11/02 22:55:16 hobbs Exp $ +# RCS: @(#) $Id: console.tcl,v 1.10.2.1 2002/04/06 01:02:01 hobbs Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -14,14 +14,35 @@ # # TODO: history - remember partially written command +package require msgcat -# tkConsoleInit -- +namespace eval ::tk::console { + variable blinkTime 500 ; # msecs to blink braced range for + variable blinkRange 1 ; # enable blinking of the entire braced range + variable magicKeys 1 ; # enable brace matching and proc/var recognition + variable maxLines 600 ; # maximum # of lines buffered in console + variable showMatches 1 ; # show multiple expand matches + + variable inPlugin [info exists embed_args] + variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used + + if {$inPlugin} { + set defaultPrompt {subst "[history nextid] % "} + } else { + set defaultPrompt {subst "([file tail [pwd]]) [history nextid] % "} + } +} + +# simple compat function for tkcon code added for this console +interp alias {} EvalAttached {} consoleinterp eval + +# ::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}]} { @@ -34,15 +55,17 @@ proc tkConsoleInit {} { set mod "Cmd" } - menu .menubar + if {[catch {menu .menubar} err]} { bgerror "INIT: $err" } .menubar add cascade -label File -menu .menubar.file -underline 0 .menubar add cascade -label Edit -menu .menubar.edit -underline 0 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 .} + -underline 0 -command {wm withdraw .} + .menubar.file add command -label [::msgcat::mc "Clear Console"] \ + -underline 0 -command {.console delete 1.0 "promptEnd linestart"} if {[string compare $tcl_platform(platform) "macintosh"]} { .menubar.file add command -label [::msgcat::mc "Exit"] \ -underline 1 -command exit @@ -69,62 +92,68 @@ 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 - text .console -yscrollcommand ".sb set" -setgrid true - scrollbar .sb -command ".console yview" + set con [text .console -yscrollcommand [list .sb set] -setgrid true] + scrollbar .sb -command [list $con yview] pack .sb -side right -fill both - pack .console -fill both -expand 1 -side left + pack $con -fill both -expand 1 -side left switch -exact $tcl_platform(platform) { "macintosh" { - .console configure -font {Monaco 9 normal} -highlightthickness 0 + $con configure -font {Monaco 9 normal} -highlightthickness 0 } "windows" { - .console configure -font systemfixed + $con configure -font systemfixed } } - tkConsoleBind .console + ConsoleBind $con + + $con tag configure stderr -foreground red + $con tag configure stdin -foreground blue + $con tag configure prompt -foreground \#8F4433 + $con tag configure proc -foreground \#008800 + $con tag configure var -background \#FFC0D0 + $con tag raise sel + $con tag configure blink -background \#FFFF00 + $con tag configure find -background \#FFFF00 - .console tag configure stderr -foreground red - .console tag configure stdin -foreground blue + focus $con - focus .console - wm protocol . WM_DELETE_WINDOW { wm withdraw . } wm title . [::msgcat::mc "Console"] flush stdout - .console mark set output [.console index "end - 1 char"] - tkTextSetCursor .console end - .console mark set promptEnd insert - .console mark gravity promptEnd left + $con mark set output [$con index "end - 1 char"] + tk::TextSetCursor $con end + $con mark set promptEnd insert + $con 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 \ - [list [::msgcat::mc "Tcl Scripts"] .tcl] \ - [list [::msgcat::mc "All Files"] *]]] + -title [::msgcat::mc "Select a file to source"] \ + -filetypes [list \ + [list [::msgcat::mc "Tcl Scripts"] .tcl] \ + [list [::msgcat::mc "All Files"] *]]] 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 +161,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 +174,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 +182,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 +235,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,18 +248,19 @@ proc tkConsoleHistory {cmd} { # Arguments: # partial - Flag to specify which prompt to print. -proc tkConsolePrompt {{partial normal}} { +proc ::tk::ConsolePrompt {{partial normal}} { + set w .console if {[string equal $partial "normal"]} { - set temp [.console index "end - 1 char"] - .console mark set output end + set temp [$w index "end - 1 char"] + $w mark set output end if {[consoleinterp eval "info exists tcl_prompt1"]} { consoleinterp eval "eval \[set tcl_prompt1\]" } else { - puts -nonewline "% " + puts -nonewline [EvalAttached $::tk::console::defaultPrompt] } } else { - set temp [.console index output] - .console mark set output end + set temp [$w index output] + $w mark set output end if {[consoleinterp eval "info exists tcl_prompt2"]} { consoleinterp eval "eval \[set tcl_prompt2\]" } else { @@ -238,13 +268,15 @@ proc tkConsolePrompt {{partial normal}} { } } flush stdout - .console mark set output $temp - tkTextSetCursor .console end - .console mark set promptEnd insert - .console mark gravity promptEnd left + $w mark set output $temp + ::tk::TextSetCursor $w end + $w mark set promptEnd insert + $w mark gravity promptEnd left + ::tk::console::ConstrainBuffer $w $::tk::console::maxLines + $w see end } -# 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,166 +284,235 @@ proc tkConsolePrompt {{partial normal}} { # Arguments: # None. -proc tkConsoleBind {win} { - bindtags $win "$win Text . all" +proc ::tk::ConsoleBind {w} { + bindtags $w [list $w Console PostConsole [winfo toplevel $w] all] + + ## Get all Text bindings into Console + foreach ev [bind Text] { bind Console $ev [bind Text $ev] } + ## We really didn't want the newline insertion... + bind Console <Control-Key-o> {} + ## ...or any Control-v binding (would block <<Paste>>) + bind Console <Control-Key-v> {} + + # For the moment, transpose isn't enabled until the console + # gets and overhaul of how it handles input -- hobbs + bind Console <Control-Key-t> {} # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the - # <KeyPress> class binding will also fire and insert the character, - # which is wrong. Ditto for <Escape>. - bind $win <Alt-KeyPress> {# nothing } - bind $win <Meta-KeyPress> {# nothing} - bind $win <Control-KeyPress> {# nothing} - bind $win <Escape> {# nothing} - bind $win <KP_Enter> {# nothing} - - bind $win <Tab> { - tkConsoleInsert %W \t + bind Console <Alt-KeyPress> {# nothing } + bind Console <Meta-KeyPress> {# nothing} + bind Console <Control-KeyPress> {# nothing} + + foreach {ev key} { + <<Console_Prev>> <Key-Up> + <<Console_Next>> <Key-Down> + <<Console_NextImmediate>> <Control-Key-n> + <<Console_PrevImmediate>> <Control-Key-p> + <<Console_PrevSearch>> <Control-Key-r> + <<Console_NextSearch>> <Control-Key-s> + + <<Console_Expand>> <Key-Escape> + <<Console_ExpandFile>> <Control-Shift-Key-F> + <<Console_ExpandProc>> <Control-Shift-Key-P> + <<Console_ExpandVar>> <Control-Shift-Key-V> + <<Console_Tab>> <Control-Key-i> + <<Console_Tab>> <Meta-Key-i> + <<Console_Eval>> <Key-Return> + <<Console_Eval>> <Key-KP_Enter> + + <<Console_Clear>> <Control-Key-l> + <<Console_KillLine>> <Control-Key-k> + <<Console_Transpose>> <Control-Key-t> + <<Console_ClearLine>> <Control-Key-u> + <<Console_SaveCommand>> <Control-Key-z> + } { + event add $ev $key + bind Console $key {} + } + + bind Console <Tab> { + tk::ConsoleInsert %W \t focus %W break } - bind $win <Return> { + bind Console <<Console_Expand>> { + if {[%W compare insert > promptEnd]} {::tk::console::Expand %W} + } + bind Console <<Console_ExpandFile>> { + if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path} + } + bind Console <<Console_ExpandProc>> { + if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc} + } + bind Console <<Console_ExpandVar>> { + if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var} + } + bind Console <<Console_Eval>> { %W mark set insert {end - 1c} - tkConsoleInsert %W "\n" - tkConsoleInvoke + tk::ConsoleInsert %W "\n" + tk::ConsoleInvoke break } - bind $win <Delete> { - if {[string compare [%W tag nextrange sel 1.0 end] ""]} { - %W tag remove sel sel.first promptEnd - } elseif {[%W compare insert < promptEnd]} { - break + bind Console <Delete> { + if {[string compare {} [%W tag nextrange sel 1.0 end]] \ + && [%W compare sel.first >= promptEnd]} { + %W delete sel.first sel.last + } elseif {[%W compare insert >= promptEnd]} { + %W delete insert + %W see insert } } - bind $win <BackSpace> { - if {[string compare [%W tag nextrange sel 1.0 end] ""]} { - %W tag remove sel sel.first promptEnd - } elseif {[%W compare insert <= promptEnd]} { - break + bind Console <BackSpace> { + if {[string compare {} [%W tag nextrange sel 1.0 end]] \ + && [%W compare sel.first >= promptEnd]} { + %W delete sel.first sel.last + } elseif {[%W compare insert != 1.0] && \ + [%W compare insert > promptEnd]} { + %W delete insert-1c + %W see insert } } - foreach left {Control-a Home} { - bind $win <$left> { - if {[%W compare insert < promptEnd]} { - tkTextSetCursor %W {insert linestart} - } else { - tkTextSetCursor %W promptEnd - } - break + bind Console <Control-h> [bind Console <BackSpace>] + + bind Console <Home> { + if {[%W compare insert < promptEnd]} { + tk::TextSetCursor %W {insert linestart} + } else { + tk::TextSetCursor %W promptEnd } } - foreach right {Control-e End} { - bind $win <$right> { - tkTextSetCursor %W {insert lineend} - break - } + bind Console <Control-a> [bind Console <Home>] + bind Console <End> { + tk::TextSetCursor %W {insert lineend} } - bind $win <Control-d> { - if {[%W compare insert < promptEnd]} { - break - } + bind Console <Control-e> [bind Console <End>] + bind Console <Control-d> { + if {[%W compare insert < promptEnd]} break + %W delete insert } - bind $win <Control-k> { - if {[%W compare insert < promptEnd]} { - %W mark set insert promptEnd + bind Console <<Console_KillLine>> { + if {[%W compare insert < promptEnd]} break + if {[%W compare insert == {insert lineend}]} { + %W delete insert + } else { + %W delete insert {insert lineend} } } - bind $win <Control-t> { - if {[%W compare insert < promptEnd]} { - break - } + bind Console <<Console_Clear>> { + ## Clear console display + %W delete 1.0 "promptEnd linestart" } - bind $win <Meta-d> { - if {[%W compare insert < promptEnd]} { - break + bind Console <<Console_ClearLine>> { + ## Clear command line (Unix shell staple) + %W delete promptEnd end + } + bind Console <Meta-d> { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} } } - bind $win <Meta-BackSpace> { - if {[%W compare insert <= promptEnd]} { - break + bind Console <Meta-BackSpace> { + if {[%W compare {insert -1c wordstart} >= promptEnd]} { + %W delete {insert -1c wordstart} insert } } - bind $win <Control-h> { - if {[%W compare insert <= promptEnd]} { - break + bind Console <Meta-d> { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} } } - foreach prev {Control-p Up} { - bind $win <$prev> { - tkConsoleHistory prev - break + bind Console <Meta-BackSpace> { + if {[%W compare {insert -1c wordstart} >= promptEnd]} { + %W delete {insert -1c wordstart} insert } } - foreach prev {Control-n Down} { - bind $win <$prev> { - tkConsoleHistory next - break + bind Console <Meta-Delete> { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} } } - bind $win <Insert> { - catch {tkConsoleInsert %W [selection get -displayof %W]} - break + bind Console <<Console_Prev>> { + tk::ConsoleHistory prev } - bind $win <KeyPress> { - tkConsoleInsert %W %A - break + bind Console <<Console_Next>> { + tk::ConsoleHistory next } - foreach left {Control-b Left} { - bind $win <$left> { - if {[%W compare insert == promptEnd]} { - break - } - tkTextSetCursor %W insert-1c - break - } + bind Console <Insert> { + catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]} } - foreach right {Control-f Right} { - bind $win <$right> { - tkTextSetCursor %W insert+1c - break - } + bind Console <KeyPress> { + tk::ConsoleInsert %W %A } - bind $win <F9> { + bind Console <F9> { eval destroy [winfo child .] if {[string equal $tcl_platform(platform) "macintosh"]} { - source -rsrc Console + if {[catch {source $tk_library:console.tcl}]} {source -rsrc console} } else { source [file join $tk_library console.tcl] } } - bind $win <<Cut>> { + bind Console <<Cut>> { # Same as the copy event if {![catch {set data [%W get sel.first sel.last]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data } - break } - bind $win <<Copy>> { + bind Console <<Copy>> { if {![catch {set data [%W get sel.first sel.last]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data } - break } - bind $win <<Paste>> { + bind Console <<Paste>> { catch { - set clip [selection get -displayof %W -selection CLIPBOARD] + 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 } } + } + + ## + ## Bindings for doing special things based on certain keys + ## + bind PostConsole <Key-parenright> { + if {[string compare \\ [%W get insert-2c]]} { + ::tk::console::MatchPair %W \( \) promptEnd + } + } + bind PostConsole <Key-bracketright> { + if {[string compare \\ [%W get insert-2c]]} { + ::tk::console::MatchPair %W \[ \] promptEnd + } + } + bind PostConsole <Key-braceright> { + if {[string compare \\ [%W get insert-2c]]} { + ::tk::console::MatchPair %W \{ \} promptEnd + } + } + bind PostConsole <Key-quotedbl> { + if {[string compare \\ [%W get insert-2c]]} { + ::tk::console::MatchQuote %W promptEnd + } + } + + bind PostConsole <KeyPress> { + if {"%A" != ""} { + ::tk::console::TagProc %W + } 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 +522,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 } @@ -433,13 +534,13 @@ proc tkConsoleInsert {w s} { } } if {[$w compare insert < promptEnd]} { - $w mark set insert end + $w mark set insert end } $w insert insert $s {input stdin} $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 +549,14 @@ 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} { - .console insert output $string $dest - .console see insert +proc ::tk::ConsoleOutput {dest string} { + set w .console + $w insert output $string $dest + ::tk::console::ConstrainBuffer $w $::tk::console::maxLines + $w 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,26 +565,367 @@ 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 {} { - global tk_patchLevel +proc ::tk::ConsoleAbout {} { tk_messageBox -type ok -message "[::msgcat::mc {Tcl for Windows}] -Copyright \251 2000 Ajuba Solutions -Tcl [info patchlevel] -Tk $tk_patchLevel" +Tcl $::tcl_patchLevel +Tk $::tk_patchLevel" } -# now initialize the console +# ::tk::console::TagProc -- +# +# Tags a procedure in the console if it's recognized +# This procedure is not perfect. However, making it perfect wastes +# too much CPU time... +# +# Arguments: +# w - console text widget + +proc ::tk::console::TagProc w { + if {!$::tk::console::magicKeys} { return } + set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]" + set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c] + if {$i == ""} {set i promptEnd} else {append i +2c} + regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c + if {[llength [EvalAttached [list info commands $c]]]} { + $w tag add proc $i "insert-1c wordend" + } else { + $w tag remove proc $i "insert-1c wordend" + } + if {[llength [EvalAttached [list info vars $c]]]} { + $w tag add var $i "insert-1c wordend" + } else { + $w tag remove var $i "insert-1c wordend" + } +} -tkConsoleInit +# ::tk::console::MatchPair -- +# +# Blinks a matching pair of characters +# c2 is assumed to be at the text index 'insert'. +# This proc is really loopy and took me an hour to figure out given +# all possible combinations with escaping except for escaped \'s. +# It doesn't take into account possible commenting... Oh well. If +# anyone has something better, I'd like to see/use it. This is really +# only efficient for small contexts. +# +# Arguments: +# w - console text widget +# c1 - first char of pair +# c2 - second char of pair +# +# Calls: ::tk::console::Blink + +proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { + if {!$::tk::console::magicKeys} { return } + if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} { + while { + [string match {\\} [$w get $ix-1c]] && + [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]] + } {} + set i1 insert-1c + while {[string compare {} $ix]} { + set i0 $ix + set j 0 + while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} { + append i0 +1c + if {[string match {\\} [$w get $i0-2c]]} continue + incr j + } + if {!$j} break + set i1 $ix + while {$j && [string compare {} \ + [set ix [$w search -back $c1 $ix $lim]]]} { + if {[string match {\\} [$w get $ix-1c]]} continue + incr j -1 + } + } + if {[string match {} $ix]} { set ix [$w index $lim] } + } else { set ix [$w index $lim] } + if {$::tk::console::blinkRange} { + Blink $w $ix [$w index insert] + } else { + Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert] + } +} + +# ::tk::console::MatchQuote -- +# +# Blinks between matching quotes. +# Blinks just the quote if it's unmatched, otherwise blinks quoted string +# The quote to match is assumed to be at the text index 'insert'. +# +# Arguments: +# w - console text widget +# +# Calls: ::tk::console::Blink + +proc ::tk::console::MatchQuote {w {lim 1.0}} { + if {!$::tk::console::magicKeys} { return } + set i insert-1c + set j 0 + while {[string compare [set i [$w search -back \" $i $lim]] {}]} { + if {[string match {\\} [$w get $i-1c]]} continue + if {!$j} {set i0 $i} + incr j + } + if {$j&1} { + if {$::tk::console::blinkRange} { + Blink $w $i0 [$w index insert] + } else { + Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert] + } + } else { + Blink $w [$w index insert-1c] [$w index insert] + } +} + +# ::tk::console::Blink -- +# +# Blinks between n index pairs for a specified duration. +# +# Arguments: +# w - console text widget +# i1 - start index to blink region +# i2 - end index of blink region +# dur - duration in usecs to blink for +# +# Outputs: +# blinks selected characters in $w + +proc ::tk::console::Blink {w args} { + eval [list $w tag add blink] $args + after $::tk::console::blinkTime [list $w] tag remove blink $args +} + +# ::tk::console::ConstrainBuffer -- +# +# This limits the amount of data in the text widget +# Called by Prompt and ConsoleOutput +# +# Arguments: +# w - console text widget +# size - # of lines to constrain to +# +# Outputs: +# may delete data in console widget + +proc ::tk::console::ConstrainBuffer {w size} { + if {[$w index end] > $size} { + $w delete 1.0 [expr {int([$w index end])-$size}].0 + } +} + +# ::tk::console::Expand -- +# +# Arguments: +# ARGS: w - text widget in which to expand str +# type - type of expansion (path / proc / variable) +# +# Calls: ::tk::console::Expand(Pathname|Procname|Variable) +# +# Outputs: The string to match is expanded to the longest possible match. +# If ::tk::console::showMatches is non-zero and the longest match +# equaled the string to expand, then all possible matches are +# output to stdout. Triggers bell if no matches are found. +# +# Returns: number of matches found + +proc ::tk::console::Expand {w {type ""}} { + set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]" + set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c] + if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c} + if {[$w compare $tmp >= insert]} { return } + set str [$w get $tmp insert] + switch -glob $type { + path* { set res [ExpandPathname $str] } + proc* { set res [ExpandProcname $str] } + var* { set res [ExpandVariable $str] } + default { + set res {} + foreach t {Pathname Procname Variable} { + if {![catch {Expand$t $str} res] && ($res != "")} { break } + } + } + } + set len [llength $res] + if {$len} { + set repl [lindex $res 0] + $w delete $tmp insert + $w insert $tmp $repl {input stdin} + if {($len > 1) && $::tk::console::showMatches \ + && [string equal $repl $str]} { + puts stdout [lsort [lreplace $res 0 0]] + } + } else { bell } + return [incr len -1] +} + +# ::tk::console::ExpandPathname -- +# +# Expand a file pathname based on $str +# This is based on UNIX file name conventions +# +# Arguments: +# str - partial file pathname to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandPathname str { + set pwd [EvalAttached pwd] + if {[catch {EvalAttached [list cd [file dirname $str]]} err]} { + return -code error $err + } + set dir [file tail $str] + ## Check to see if it was known to be a directory and keep the trailing + ## slash if so (file tail cuts it off) + if {[string match */ $str]} { append dir / } + if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} { + set match {} + } else { + if {[llength $m] > 1} { + global tcl_platform + if {[string match windows $tcl_platform(platform)]} { + ## Windows is screwy because it's case insensitive + set tmp [ExpandBestMatch [string tolower $m] \ + [string tolower $dir]] + ## Don't change case if we haven't changed the word + if {[string length $dir]==[string length $tmp]} { + set tmp $dir + } + } else { + set tmp [ExpandBestMatch $m $dir] + } + if {[string match ?*/* $str]} { + set tmp [file dirname $str]/$tmp + } elseif {[string match /* $str]} { + set tmp /$tmp + } + regsub -all { } $tmp {\\ } tmp + set match [linsert $m 0 $tmp] + } else { + ## This may look goofy, but it handles spaces in path names + eval append match $m + if {[file isdir $match]} {append match /} + if {[string match ?*/* $str]} { + set match [file dirname $str]/$match + } elseif {[string match /* $str]} { + set match /$match + } + regsub -all { } $match {\\ } match + ## Why is this one needed and the ones below aren't!! + set match [list $match] + } + } + EvalAttached [list cd $pwd] + return $match +} + +# ::tk::console::ExpandProcname -- +# +# Expand a tcl proc name based on $str +# +# Arguments: +# str - partial proc name to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandProcname str { + set match [EvalAttached [list info commands $str*]] + if {[llength $match] == 0} { + set ns [EvalAttached \ + "namespace children \[namespace current\] [list $str*]"] + if {[llength $ns]==1} { + set match [EvalAttached [list info commands ${ns}::*]] + } else { + set match $ns + } + } + if {[llength $match] > 1} { + regsub -all { } [ExpandBestMatch $match $str] {\\ } str + set match [linsert $match 0 $str] + } else { + regsub -all { } $match {\\ } match + } + return $match +} + +# ::tk::console::ExpandVariable -- +# +# Expand a tcl variable name based on $str +# +# Arguments: +# str - partial tcl var name to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandVariable str { + if {[regexp {([^\(]*)\((.*)} $str junk ary str]} { + ## Looks like they're trying to expand an array. + set match [EvalAttached [list array names $ary $str*]] + if {[llength $match] > 1} { + set vars $ary\([ExpandBestMatch $match $str] + foreach var $match {lappend vars $ary\($var\)} + return $vars + } else {set match $ary\($match\)} + ## Space transformation avoided for array names. + } else { + set match [EvalAttached [list info vars $str*]] + if {[llength $match] > 1} { + regsub -all { } [ExpandBestMatch $match $str] {\\ } str + set match [linsert $match 0 $str] + } else { + regsub -all { } $match {\\ } match + } + } + return $match +} + +# ::tk::console::ExpandBestMatch -- +# +# Finds the best unique match in a list of names. +# The extra $e in this argument allows us to limit the innermost loop a little +# further. This improves speed as $l becomes large or $e becomes long. +# +# Arguments: +# l - list to find best unique match in +# e - currently best known unique match +# +# Returns: longest unique match in the list + +proc ::tk::console::ExpandBestMatch {l {e {}}} { + set ec [lindex $l 0] + if {[llength $l]>1} { + set e [string length $e]; incr e -1 + set ei [string length $ec]; incr ei -1 + foreach l $l { + while {$ei>=$e && [string first $ec $l]} { + set ec [string range $ec 0 [incr ei -1]] + } + } + } + return $ec +} + +# now initialize the console +::tk::ConsoleInit diff --git a/library/dialog.tcl b/library/dialog.tcl index b3c9dbd..f78d6d9 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.8.4.1 2002/04/06 01:02:01 hobbs 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]} { @@ -65,12 +66,12 @@ proc tk_dialog {w title text bitmap default args} { } if {[string equal $tcl_platform(platform) "macintosh"]} { - unsupported1 style $w dBoxProc + ::tk::unsupported::MacWindowStyle style $w dBoxProc } frame $w.bot frame $w.top - if {[string equal $tcl_platform(platform) "unix"]} { + if {[string compare $tcl_platform(platform) "macintosh"]} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -103,13 +104,14 @@ 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 ::tk::Priv(button) $i] if {$i == $default} { $w.button$i configure -default active } else { $w.button$i configure -default normal } - grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10 + grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \ + -padx 10 -pady 4 grid columnconfigure $w.bot $i # We boost the size of some Mac buttons for l&f if {[string equal $tcl_platform(platform) "macintosh"]} { @@ -129,7 +131,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 ::tk::Priv(button) $default " } @@ -137,7 +139,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 ::tk::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 +174,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. + # Priv(button) doesn't get reset by it. bind $w <Destroy> {} destroy $w @@ -189,5 +191,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 b44eaad..1db1ebe 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.13 2000/05/29 01:43:14 hobbs Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.13.2.1 2002/04/06 01:02:01 hobbs 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>> { @@ -55,106 +55,107 @@ bind Entry <<Paste>> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] - tkEntrySeeInsert %W + %W insert insert [::tk::GetSelection %W CLIPBOARD] + 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_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { + 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 - catch {%W icursor sel.first} + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x + catch {%W icursor sel.last} } bind Entry <Triple-1> { - set tkPriv(selectMode) line - tkEntryMouseSelect %W %x - %W icursor 0 + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x + catch {%W icursor sel.last} } 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 +166,7 @@ bind Entry <Delete> { } } bind Entry <BackSpace> { - tkEntryBackspace %W + tk::EntryBackspace %W } bind Entry <Control-space> { @@ -187,7 +188,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 +211,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 [selection get -displayof %W]} + catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -218,12 +219,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 +234,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 +254,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 } } @@ -286,22 +287,16 @@ 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 + ::tk::EntryScanMark %W %x } } bind Entry <B2-Motion> { if {!$tk_strictMotif} { - if {abs(%x-$tkPriv(x)) > 2} { - set tkPriv(mouseMoved) 1 - } - %W scan dragto %x + ::tk::EntryScanDrag %W %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 +305,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 +314,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 +323,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 +345,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,10 +385,13 @@ proc tkEntryMouseSelect {w x} { $w selection range 0 end } } + 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. # @@ -401,15 +399,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] - catch {$w insert insert [selection get -displayof $w]} +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 @@ -419,21 +415,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. @@ -443,7 +439,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 @@ -453,7 +449,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. @@ -462,7 +458,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 } @@ -474,10 +470,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. @@ -485,7 +481,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 { @@ -500,21 +496,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. @@ -523,13 +519,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 @@ -539,7 +535,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 @@ -548,13 +544,14 @@ proc tkEntryTranspose w { if {$first < 0} { return } - set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first] + set data [$w get] + set new [string index $data [expr {$i-1}]][string index $data $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 @@ -565,7 +562,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] @@ -576,7 +573,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 @@ -585,7 +582,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. @@ -594,25 +591,61 @@ 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::EntryScanMark -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The entry window from which the text to get +# x - x location on screen + +proc ::tk::EntryScanMark {w x} { + $w scan mark $x + set ::tk::Priv(x) $x + set ::tk::Priv(y) 0 ; # not used + set ::tk::Priv(mouseMoved) 0 +} + +# ::tk::EntryScanDrag -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The entry window from which the text to get +# x - x location on screen + +proc ::tk::EntryScanDrag {w x} { + # Make sure these exist, as some weird situations can trigger the + # motion binding without the initial press. [Bug #220269] + if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } + # allow for a delta + if {abs($x-$::tk::Priv(x)) > 2} { + set ::tk::Priv(mouseMoved) 1 + } + $w scan dragto $x +} + +# ::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] ""]} { - regsub -all . $entryString [string index [$w cget -show] 0] entryString + return [string repeat [string index [$w cget -show] 0] \ + [string length $entryString]] } return $entryString } diff --git a/library/focus.tcl b/library/focus.tcl index 9a03ea1..c3a531f 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.8.2.1 2002/04/06 01:02:01 hobbs 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..6ccc37d 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.11.4.1 2002/04/06 01:02:01 hobbs 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..4d8b9cf 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.12.4.1 2002/04/06 01:02:01 hobbs 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] @@ -779,16 +780,13 @@ proc tkMenuNextMenu {menu direction} { set count -1 set m2 [winfo parent $menu] if {[string equal [winfo class $m2] "Menu"]} { + $menu activate none + GenerateMenuSelect $menu + tk_menuSetFocus $m2 + + $m2 postcascade none + if {[string compare [$m2 cget -type] "menubar"]} { - $menu activate none - tkGenerateMenuSelect $menu - tk_menuSetFocus $m2 - - # This code unposts any posted submenu in the parent. - - set tmp [$m2 index active] - $m2 activate none - $m2 activate $tmp return } } @@ -801,12 +799,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 +830,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 +843,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 @@ -873,7 +870,9 @@ proc tkMenuNextEntry {menu count} { incr i -$length } if {[catch {$menu entrycget $i -state} state] == 0} { - if {[string compare $state "disabled"]} { + if {$state!="disabled" && + ($i!=0 || [$menu cget -type]!="tearoff" + || [$menu type 0]!="tearoff")} { break } } @@ -884,20 +883,22 @@ proc tkMenuNextEntry {menu count} { incr quitAfter -1 } $menu activate $i - tkGenerateMenuSelect $menu - if {[string equal [$menu type $i] "cascade"]} { + GenerateMenuSelect $menu + + if {[string equal [$menu type $i] "cascade"] \ + && [string equal [$menu cget -type] "menubar"]} { set cascade [$menu entrycget $i -menu] if {[string compare $cascade ""]} { # Here we auto-post a cascade. This is necessary when # 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 +914,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 +965,7 @@ proc tkMenuFind {w char} { } default { - set match [tkMenuFind $child $char] + set match [MenuFind $child $char] if {[string compare $match ""]} { return $match } @@ -975,7 +975,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 +987,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 +1002,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 +1025,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 +1053,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 +1074,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 +1085,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 +1113,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 +1123,7 @@ proc tkMenuFirstEntry menu { set cascade [$menu entrycget $i -menu] if {[string compare $cascade ""]} { $menu postcascade $i - tkMenuFirstEntry $cascade + MenuFirstEntry $cascade } } return @@ -1130,7 +1131,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 +1142,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 +1162,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 +1174,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 +1191,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 +1267,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 1ed1acc..575f73a 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.12 2000/06/30 06:38:38 ericm Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.12.2.1 2002/04/06 01:02:01 hobbs 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 @@ -170,8 +171,8 @@ proc tkMessageBox {args} { switch -- $data(-type) { abortretryignore { - set maxWidth [::msgcat::mcmax Abort Retry Ignore] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Abort Retry Ignore] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list abort -width $maxWidth -text [::msgcat::mc "Abort"] \ -under 0]\ @@ -191,8 +192,8 @@ proc tkMessageBox {args} { } } okcancel { - set maxWidth [::msgcat::mcmax OK Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax OK Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list ok -width $maxWidth \ -text [::msgcat::mc "OK"] -under 0] \ @@ -201,8 +202,8 @@ proc tkMessageBox {args} { ] } retrycancel { - set maxWidth [::msgcat::mcmax Retry Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Retry Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list retry -width $maxWidth \ -text [::msgcat::mc "Retry"] -under 0] \ @@ -211,8 +212,8 @@ proc tkMessageBox {args} { ] } yesno { - set maxWidth [::msgcat::mcmax Yes No] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Yes No] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list yes -width $maxWidth \ -text [::msgcat::mc "Yes"] -under 0]\ @@ -221,8 +222,8 @@ proc tkMessageBox {args} { ] } yesnocancel { - set maxWidth [::msgcat::mcmax Yes No Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Yes No Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list yes -width $maxWidth \ -text [::msgcat::mc "Yes"] -under 0]\ @@ -285,7 +286,7 @@ proc tkMessageBox {args} { } if {[string equal $tcl_platform(platform) "macintosh"]} { - unsupported1 style $w dBoxProc + unsupported::MacWindowStyle style $w dBoxProc } frame $w.bot @@ -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/msgs/cs.msg b/library/msgs/cs.msg new file mode 100644 index 0000000..37a21a1 --- /dev/null +++ b/library/msgs/cs.msg @@ -0,0 +1,67 @@ +::msgcat::mcset cs "Abort" "P\u0159eru\u0161it" +::msgcat::mcset cs "About..." "O programu..." +::msgcat::mcset cs "All Files" "V\u0161echny soubory" +::msgcat::mcset cs "Application Error" "Chyba programu" +::msgcat::mcset cs "Blue" "Modr\341" +::msgcat::mcset cs "Cancel" "Zru\u0161it" +::msgcat::mcset cs "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nemohu zm\u011bnit atku\341ln\355 adres\341\u0159 na \"%1\$s\".\nP\u0159\355stup odm\355tnut." +::msgcat::mcset cs "Choose Directory" "V\375b\u011br adres\341\u0159e" +::msgcat::mcset cs "Clear" "Smazat" +::msgcat::mcset cs "Color" "Barva" +::msgcat::mcset cs "Console" "Konzole" +::msgcat::mcset cs "Copy" "Kop\355rovat" +::msgcat::mcset cs "Cut" "Vy\u0159\355znout" +::msgcat::mcset cs "Delete" "Smazat" +::msgcat::mcset cs "Details >>" "Detaily >>" +::msgcat::mcset cs "Directory \"%1\$s\" does not exist." "Adres\341\u0159 \"%1\$s\" neexistuje." +::msgcat::mcset cs "Directory:" "Adres\341\u0159:" +::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s" +::msgcat::mcset cs "Exit" "Konec" +::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n" +::msgcat::mcset cs "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Soubor \"%1\$s\" ji\u017e existuje.\nChcete jej p\u0159epsat?" +::msgcat::mcset cs "File \"%1\$s\" does not exist." "Soubor \"%1\$s\" neexistuje." +::msgcat::mcset cs "File name:" "Jm\351no souboru:" +::msgcat::mcset cs "File names:" "Jm\351na soubor\u016f:" +::msgcat::mcset cs "Files of type:" "Typy soubor\u016f:" +::msgcat::mcset cs "Files:" "Soubory:" +::msgcat::mcset cs "Filter" "Filtr" +::msgcat::mcset cs "Filter:" "Filtr:" +::msgcat::mcset cs "Green" "Zelen\341" +::msgcat::mcset cs "Hi" +::msgcat::mcset cs "Hide Console" "Skr\375t konsolu" +::msgcat::mcset cs "Ignore" "Ignorovat" +::msgcat::mcset cs "Invalid file name \"%1\$s\"." "\u0160patn\351 jm\351no souboru \"%1\$s\"." +::msgcat::mcset cs "Log Files" "Log soubory" +::msgcat::mcset cs "No" "Ne" +::msgcat::mcset cs "OK" +::msgcat::mcset cs "Ok" +::msgcat::mcset cs "Open" "Otev\u0159\355t" +::msgcat::mcset cs "Open Multiple Files" "Otev\u0159\355t v\355ce soubor\u016f" +::msgcat::mcset cs "Paste" "Vlo\u017eit" +::msgcat::mcset cs "Quit" "Skon\u010dit" +::msgcat::mcset cs "Red" "\u010cerven\341" +::msgcat::mcset cs "Replace existing file?" "Nahradit st\341vaj\355c\355 soubor?" +::msgcat::mcset cs "Retry" "Znovu" +::msgcat::mcset cs "Save" "Ulo\u017eit" +::msgcat::mcset cs "Save As" "Ulo\u017eit jako" +::msgcat::mcset cs "Save To Log" "Ulo\u017eit do logu" +::msgcat::mcset cs "Select Log File" "Vybrat log soubor" +::msgcat::mcset cs "Select a file to source" "Vybrat soubor k nahr\341n\355" +::msgcat::mcset cs "Selection:" "V\375b\u011br:" +::msgcat::mcset cs "Skip Messages" "P\u0159esko\u010dit zpr\341vy" +::msgcat::mcset cs "Source..." "Nahr\341t..." +::msgcat::mcset cs "Tcl Scripts" "Tcl skripty" +::msgcat::mcset cs "Tcl for Windows" "Tcl pro Windows" +::msgcat::mcset cs "Text Files" "Textov\351 soubory" +::msgcat::mcset cs "Yes" "Ano" +::msgcat::mcset cs "abort" "p\u0159eru\u0161it" +::msgcat::mcset cs "blue" "modr\341" +::msgcat::mcset cs "cancel" "zru\u0161it" +::msgcat::mcset cs "extension" "p\u0159\355pona" +::msgcat::mcset cs "extensions" "p\u0159\355pony" +::msgcat::mcset cs "green" "zelen\341" +::msgcat::mcset cs "ignore" "ignorovat" +::msgcat::mcset cs "ok" +::msgcat::mcset cs "red" "\u010derven\341" +::msgcat::mcset cs "retry" "znovu" +::msgcat::mcset cs "yes" "ano" diff --git a/library/msgs/de.msg b/library/msgs/de.msg index a4309a1..60e2ce7 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -21,7 +21,7 @@ ::msgcat::mcset de "File \"%1\$s\" already exists.\n\n" "Die Datei \"%1\$s\" ist bereits vorhanden.\n\n" ::msgcat::mcset de "File \"%1\$s\" does not exist." "Die Datei \"%1\$s\" existiert nicht." ::msgcat::mcset de "File name:" "Dateiname:" -::msgcat::mcset de "File names:" "Nombre de archivos:" +::msgcat::mcset de "File names:" "Dateinamen:" ::msgcat::mcset de "Files of type:" "Dateien des Typs:" ::msgcat::mcset de "Files:" "Dateien:" ::msgcat::mcset de "Filter" @@ -40,7 +40,7 @@ ::msgcat::mcset de "Paste" "Einf\u00fcgen" ::msgcat::mcset de "Quit" "Beenden" ::msgcat::mcset de "Red" "Rot" -::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen ?" +::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?" ::msgcat::mcset de "Retry" "Wiederholen" ::msgcat::mcset de "Save" "Speichern" ::msgcat::mcset de "Save As" "Speichern unter" @@ -50,7 +50,7 @@ ::msgcat::mcset de "Selection:" "Auswahl:" ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen" ::msgcat::mcset de "Source..." "Ausf\u00fchren..." -::msgcat::mcset de "Tcl Scripts" "Tcl Skripte" +::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte" ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows" ::msgcat::mcset de "Text Files" "Textdateien" ::msgcat::mcset de "Yes" "Ja" diff --git a/library/optMenu.tcl b/library/optMenu.tcl index 4f83ce7..1c01204 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.3.20.1 2002/04/06 01:02:01 hobbs 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..d37e8ec 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.5.4.1 2002/04/06 01:02:01 hobbs 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. @@ -42,10 +40,18 @@ proc tk_setPalette {args} { if {![info exists new(background)]} { error "must specify a background color" } + set bg [winfo rgb . $new(background)] if {![info exists new(foreground)]} { - set new(foreground) black + # Note that the range of each value in the triple returned by + # [winfo rgb] is 0-65535, and your eyes are more sensitive to + # green than to red, and more to red than to blue. + foreach {r g b} $bg {break} + if {$r+1.5*$g+0.5*$b > 100000} { + set new(foreground) black + } else { + set new(foreground) white + } } - set bg [winfo rgb . $new(background)] set fg [winfo rgb . $new(foreground)] set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] @@ -100,15 +106,18 @@ proc tk_setPalette {args} { # defaults are currently for this platform. toplevel .___tk_set_palette wm withdraw .___tk_set_palette - foreach q {button canvas checkbutton entry frame label listbox \ - menubutton menu message radiobutton scale scrollbar text} { + foreach q { + button canvas checkbutton entry frame label labelframe + listbox menubutton menu message radiobutton scale scrollbar + spinbox text + } { $q .___tk_set_palette.$q } # 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 +126,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 +137,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,18 +158,25 @@ 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 {} + set prototype .___tk_set_palette.[string tolower [winfo class $w]] + if {![winfo exists $prototype]} { + unset prototype + } foreach dbOption [array names c] { set option -[string tolower $dbOption] + set class [string replace $dbOption 0 0 [string toupper \ + [string index $dbOption 0]]] if {![catch {$w config $option} value]} { # if the option database has a preference for this # dbOption, then use it, otherwise use the defaults # for the widget. - set defaultcolor [option get $w $dbOption widgetDefault] - if {[string match {} $defaultcolor]} { + set defaultcolor [option get $w $dbOption $class] + if {[string match {} $defaultcolor] || \ + ([info exists prototype] && \ + [$prototype cget $option] ne "$defaultcolor")} { set defaultcolor [winfo rgb . [lindex $value 3]] } else { set defaultcolor [winfo rgb . $defaultcolor] @@ -176,12 +192,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 +207,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 +226,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/panedwindow.tcl b/library/panedwindow.tcl new file mode 100644 index 0000000..10aa7b9 --- /dev/null +++ b/library/panedwindow.tcl @@ -0,0 +1,181 @@ +# panedwindow.tcl -- +# +# This file defines the default bindings for Tk panedwindow widgets and +# provides procedures that help in implementing those bindings. +# +# RCS: @(#) $Id: panedwindow.tcl,v 1.5.2.1 2002/04/06 01:02:01 hobbs Exp $ +# + +bind PanedWindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 } +bind PanedWindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 } + +bind PanedWindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 } +bind PanedWindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 } + +bind PanedWindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1} +bind PanedWindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0} + +bind PanedWindow <Motion> { ::tk::panedwindow::Motion %W %x %y } + +bind PanedWindow <Leave> { ::tk::panedwindow::Leave %W } + +# Initialize namespace +namespace eval ::tk::panedwindow {} + +# ::tk::panedwindow::MarkSash -- +# +# Handle marking the correct sash for possible dragging +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# proxy whether this should be a proxy sash +# Results: +# None +# +proc ::tk::panedwindow::MarkSash {w x y proxy} { + set what [$w identify $x $y] + if { [llength $what] == 2 } { + foreach {index which} $what break + if { !$::tk_strictMotif || [string equal $which "handle"] } { + if {!$proxy} { $w sash mark $index $x $y } + set ::tk::Priv(sash) $index + foreach {sx sy} [$w sash coord $index] break + set ::tk::Priv(dx) [expr {$sx-$x}] + set ::tk::Priv(dy) [expr {$sy-$y}] + } + } +} + +# ::tk::panedwindow::DragSash -- +# +# Handle dragging of the correct sash +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# proxy whether this should be a proxy sash +# Results: +# Moves sash +# +proc ::tk::panedwindow::DragSash {w x y proxy} { + if { [info exists ::tk::Priv(sash)] } { + if {$proxy} { + $w proxy place \ + [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + } else { + $w sash place $::tk::Priv(sash) \ + [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + } + } +} + +# ::tk::panedwindow::ReleaseSash -- +# +# Handle releasing of the sash +# +# Arguments: +# w the widget +# proxy whether this should be a proxy sash +# Results: +# Returns ... +# +proc ::tk::panedwindow::ReleaseSash {w proxy} { + if { [info exists ::tk::Priv(sash)] } { + if {$proxy} { + foreach {x y} [$w proxy coord] break + $w sash place $::tk::Priv(sash) $x $y + $w proxy forget + } + unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy) + } +} + +# ::tk::panedwindow::Motion -- +# +# Handle motion on the widget. This is used to change the cursor +# when the user moves over the sash area. +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# Results: +# May change the cursor. Sets up a timer to verify that we are still +# over the widget. +# +proc ::tk::panedwindow::Motion {w x y} { + variable ::tk::Priv + set id [$w identify $x $y] + if {([llength $id] == 2) && \ + (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} { + if { ![info exists Priv(panecursor)] } { + set Priv(panecursor) [$w cget -cursor] + if { [string equal [$w cget -sashcursor] ""] } { + if { [string equal [$w cget -orient] "horizontal"] } { + $w configure -cursor sb_h_double_arrow + } else { + $w configure -cursor sb_v_double_arrow + } + } else { + $w configure -cursor [$w cget -sashcursor] + } + if {[info exists Priv(pwAfterId)]} { + after cancel $Priv(pwAfterId) + } + set Priv(pwAfterId) [after 150 \ + [list ::tk::panedwindow::Cursor $w]] + } + return + } + if { [info exists Priv(panecursor)] } { + $w configure -cursor $Priv(panecursor) + unset Priv(panecursor) + } +} + +# ::tk::panedwindow::Cursor -- +# +# Handles returning the normal cursor when we are no longer over the +# sash area. This needs to be done this way, because the PanedWindow +# won't see Leave events when the mouse moves from the sash to a +# paned child, although the child does receive an Enter event. +# +# Arguments: +# w the widget +# Results: +# May restore the default cursor, or schedule a timer to do it. +# +proc ::tk::panedwindow::Cursor {w} { + variable ::tk::Priv + if {[info exists Priv(panecursor)]} { + if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == $w} { + set Priv(pwAfterId) [after 150 [list ::tk::panedwindow::Cursor $w]] + } else { + $w configure -cursor $Priv(panecursor) + unset Priv(panecursor) + if {[info exists Priv(pwAfterId)]} { + after cancel $Priv(pwAfterId) + unset Priv(pwAfterId) + } + } + } +} + +# ::tk::panedwindow::Leave -- +# +# Return to default cursor when leaving the pw widget. +# +# Arguments: +# w the widget +# Results: +# Restores the default cursor +# +proc ::tk::panedwindow::Leave {w} { + if {[info exists ::tk::Priv(panecursor)]} { + $w configure -cursor $::tk::Priv(panecursor) + unset ::tk::Priv(panecursor) + } +} diff --git a/library/scale.tcl b/library/scale.tcl index da24e15..78144a1 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.7.4.1 2002/04/06 01:02:01 hobbs Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. @@ -20,74 +20,82 @@ 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 +} +if {[string equal $tcl_platform(platform) "windows"]} { + # On Windows do the same with button 3, as that is the right mouse button + bind Scale <3> [bind Scale <2>] + bind Scale <B3-Motion> [bind Scale <B2-Motion>] + bind Scale <B3-Leave> [bind Scale <B2-Leave>] + bind Scale <B3-Enter> [bind Scale <B2-Enter>] + bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>] } 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 +104,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 +113,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 +127,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 +135,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 +163,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 +200,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 +220,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 +240,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 +249,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 +258,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..0be38e0 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.8.4.1 2002/04/06 01:02:01 hobbs 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 b93479b..b866960 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -1,9 +1,10 @@ # spinbox.tcl -- # # This file defines the default bindings for Tk spinbox widgets and provides -# procedures that help in implementing those bindings. +# procedures that help in implementing those bindings. The spinbox builds +# off the entry widget, so it can reuse Entry bindings and procedures. # -# RCS: @(#) $Id: spinbox.tcl,v 1.1 2000/05/29 01:43:15 hobbs Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.1.2.1 2002/04/06 01:02:01 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -15,7 +16,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 +39,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>> { @@ -60,15 +61,16 @@ bind Spinbox <<Paste>> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] - ::tk::spinbox::SeeInsert %W + %W insert insert [::tk::GetSelection %W CLIPBOARD] + ::tk::EntrySeeInsert %W } } bind Spinbox <<Clear>> { %W delete sel.first sel.last } bind Spinbox <<PasteSelection>> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { ::tk::spinbox::Paste %W %x } } @@ -82,31 +84,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 @@ -123,46 +125,46 @@ bind Spinbox <Down> { } bind Spinbox <Left> { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } bind Spinbox <Right> { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Spinbox <Shift-Left> { - ::tk::spinbox::KeySelect %W [expr {[%W index insert] - 1}] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + ::tk::EntrySeeInsert %W } bind Spinbox <Shift-Right> { - ::tk::spinbox::KeySelect %W [expr {[%W index insert] + 1}] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + ::tk::EntrySeeInsert %W } bind Spinbox <Control-Left> { - ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } bind Spinbox <Control-Right> { - ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } bind Spinbox <Shift-Control-Left> { - ::tk::spinbox::KeySelect %W [::tk::spinbox::PreviousWord %W insert] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <Shift-Control-Right> { - ::tk::spinbox::KeySelect %W [::tk::spinbox::NextWord %W insert] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <Home> { - ::tk::spinbox::SetCursor %W 0 + ::tk::EntrySetCursor %W 0 } bind Spinbox <Shift-Home> { - ::tk::spinbox::KeySelect %W 0 - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W 0 + ::tk::EntrySeeInsert %W } bind Spinbox <End> { - ::tk::spinbox::SetCursor %W end + ::tk::EntrySetCursor %W end } bind Spinbox <Shift-End> { - ::tk::spinbox::KeySelect %W end - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W end + ::tk::EntrySeeInsert %W } bind Spinbox <Delete> { @@ -173,7 +175,7 @@ bind Spinbox <Delete> { } } bind Spinbox <BackSpace> { - ::tk::spinbox::Backspace %W + ::tk::EntryBackspace %W } bind Spinbox <Control-space> { @@ -195,7 +197,7 @@ bind Spinbox <Control-backslash> { %W selection clear } bind Spinbox <KeyPress> { - ::tk::spinbox::Insert %W %A + ::tk::EntryInsert %W %A } # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. @@ -218,7 +220,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 Spinbox <Insert> { - catch {::tk::spinbox::Insert %W [selection get -displayof %W]} + catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -226,12 +228,12 @@ if {[string compare $tcl_platform(platform) "windows"]} { bind Spinbox <Control-a> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W 0 + ::tk::EntrySetCursor %W 0 } } bind Spinbox <Control-b> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } } bind Spinbox <Control-d> { @@ -241,17 +243,17 @@ bind Spinbox <Control-d> { } bind Spinbox <Control-e> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W end + ::tk::EntrySetCursor %W end } } bind Spinbox <Control-f> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } } bind Spinbox <Control-h> { if {!$tk_strictMotif} { - ::tk::spinbox::Backspace %W + ::tk::EntryBackspace %W } } bind Spinbox <Control-k> { @@ -261,32 +263,32 @@ bind Spinbox <Control-k> { } bind Spinbox <Control-t> { if {!$tk_strictMotif} { - ::tk::spinbox::Transpose %W + ::tk::EntryTranspose %W } } bind Spinbox <Meta-b> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } } bind Spinbox <Meta-d> { if {!$tk_strictMotif} { - %W delete insert [::tk::spinbox::NextWord %W insert] + %W delete insert [::tk::EntryNextWord %W insert] } } bind Spinbox <Meta-f> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } } bind Spinbox <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [::tk::spinbox::PreviousWord %W insert] insert + %W delete [::tk::EntryPreviousWord %W insert] insert } } bind Spinbox <Meta-Delete> { if {!$tk_strictMotif} { - %W delete [::tk::spinbox::PreviousWord %W insert] insert + %W delete [::tk::EntryPreviousWord %W insert] insert } } @@ -294,18 +296,12 @@ 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 + ::tk::EntryScanMark %W %x } } bind Spinbox <B2-Motion> { if {!$tk_strictMotif} { - if {abs(%x-$tkPriv(x)) > 2} { - set tkPriv(mouseMoved) 1 - } - %W scan dragto %x + ::tk::EntryScanDrag %W %x } } @@ -317,15 +313,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 +354,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] + catch {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 +405,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 +434,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,10 +497,8 @@ 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 [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal "disabled" [$w cget -state]]} {focus $w} } @@ -516,26 +510,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 +544,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,182 +554,13 @@ 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]] -} - -# ::tk::spinbox::KeySelect -- -# 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. -# -# Arguments: -# w - The spinbox window. -# new - A new position for the insertion cursor (the cursor hasn't -# actually been moved to this position yet). - -proc ::tk::spinbox::KeySelect {w new} { - if {![$w selection present]} { - $w selection from insert - $w selection to $new - } else { - $w selection adjust $new - } - $w icursor $new -} - -# ::tk::spinbox::Insert -- -# Insert a string into an spinbox at the point of the insertion cursor. -# If there is a selection in the spinbox, and it covers the point of the -# insertion cursor, then delete the selection before inserting. -# -# Arguments: -# w - The spinbox window in which to insert the string -# s - The string to insert (usually just a single character) - -proc ::tk::spinbox::Insert {w s} { - if {$s == ""} { - return - } - catch { - set insert [$w index insert] - if {([$w index sel.first] <= $insert) \ - && ([$w index sel.last] >= $insert)} { - $w delete sel.first sel.last - } - } - $w insert insert $s - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::Backspace -- -# 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. -# -# Arguments: -# w - The spinbox window in which to backspace. - -proc ::tk::spinbox::Backspace w { - if {[$w selection present]} { - $w delete sel.first sel.last - } else { - set x [expr {[$w index insert] - 1}] - if {$x >= 0} {$w delete $x} - if {[$w index @0] >= [$w index insert]} { - set range [$w xview] - set left [lindex $range 0] - set right [lindex $range 1] - $w xview moveto [expr {$left - ($right - $left)/2.0}] - } - } -} - -# ::tk::spinbox::SeeInsert -- -# Make sure that the insertion cursor is visible in the spinbox window. -# If not, adjust the view so that it is. -# -# Arguments: -# w - The spinbox window. - -proc ::tk::spinbox::SeeInsert w { - set c [$w index insert] - if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} { - $w xview $c - } -} - -# ::tk::spinbox::SetCursor - -# Move the insertion cursor to a given position in an spinbox. Also -# clears the selection, if there is one in the spinbox, and makes sure -# that the insertion cursor is visible. -# -# Arguments: -# w - The spinbox window. -# pos - The desired new position for the cursor in the window. - -proc ::tk::spinbox::SetCursor {w pos} { - $w icursor $pos - $w selection clear - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::Transpose - -# This procedure implements the "transpose" function for spinbox 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 -# transposes the two characters to the left of the cursor. In either -# case, the cursor ends up to the right of the transposed characters. -# -# Arguments: -# w - The spinbox window. - -proc ::tk::spinbox::Transpose w { - set i [$w index insert] - if {$i < [$w index end]} { - incr i - } - set first [expr {$i-2}] - if {$first < 0} { - return - } - set data [$w get] - set new [string index $data [expr {$i-1}]][string index $data $first] - $w delete $first $i - $w insert insert $new - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::NextWord -- -# Returns the index of the next word position after a given position in the -# spinbox. 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 -# end-of-word position. -# -# Arguments: -# w - The spinbox window in which the cursor is to move. -# start - Position at which to start search. - -if {[string equal $tcl_platform(platform) "windows"]} { - proc ::tk::spinbox::NextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos >= 0} { - set pos [tcl_startOfNextWord [$w get] $pos] - } - if {$pos < 0} { - return end - } - return $pos - } -} else { - proc ::tk::spinbox::NextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos < 0} { - return end - } - return $pos - } -} - -# ::tk::spinbox::PreviousWord -- -# -# Returns the index of the previous word position before a given -# position in the spinbox. -# -# Arguments: -# w - The spinbox window in which the cursor is to move. -# start - Position at which to start search. - -proc ::tk::spinbox::PreviousWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] - if {$pos < 0} { - return 0 - } - return $pos + set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] } # ::tk::spinbox::GetSelection -- # -# Returns the selected text of the spinbox. +# Returns the selected text of the spinbox. Differs from entry in that +# a spinbox has no -show option to obscure contents. # # Arguments: # w - The spinbox window from which the text to get 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..c109901 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.6.4.1 2002/04/06 01:02:02 hobbs 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 742f82f..9ddc65f 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.13 2000/07/19 23:22:20 ericm Exp $ +# RCS: @(#) $Id: text.tcl,v 1.13.2.1 2002/04/06 01:02:02 hobbs 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,110 @@ # 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] + tk::TextKeySelect %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 +155,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 +198,11 @@ 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 + if {[%W cget -autoseparators]} {%W edit separator} } bind Text <Delete> { if {[string compare [%W tag nextrange sel 1.0 end] ""]} { @@ -229,12 +228,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 +254,16 @@ bind Text <<Clear>> { catch {%W delete sel.first sel.last} } bind Text <<PasteSelection>> { - if {!$tkPriv(mouseMoved) || $tk_strictMotif} { - tkTextPaste %W %x %y + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { + tk::TextPasteSelection %W %x %y } } bind Text <Insert> { - catch {tkTextInsert %W [selection get -displayof %W]} + 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,68 @@ 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 + } +} + +bind Text <<Undo>> { + if { ! [ catch { %W edit undo } ] } { + %W see insert + } +} + +bind Text <<Redo>> { + if { ! [ catch { %W edit redo } ] } { + %W see insert } } 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 +407,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 @@ -434,23 +446,15 @@ 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 + tk::TextScanMark %W %x %y } } bind Text <B2-Motion> { if {!$tk_strictMotif} { - if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { - set tkPriv(mouseMoved) 1 - } - if {$tkPriv(mouseMoved)} { - %W scan dragto %x %y - } + tk::TextScanDrag %W %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 +481,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 +491,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 +503,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 +513,22 @@ 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} + # Allow focus in any case on Windows, because that will let the + # selection be displayed even for state disabled text widgets. + if {[string equal $::tcl_platform(platform) "windows"] \ + || [string equal [$w cget -state] "normal"]} {focus $w} + if {[$w cget -autoseparators]} {$w edit separator} } -# 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 +540,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 +564,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,21 +589,15 @@ proc tkTextSelectTo {w x y {extend 0}} { } } } - if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} { - if {[string compare $tcl_platform(platform) "unix"] \ - && [$w compare $cur < anchor]} { - $w mark set insert $first - } else { - $w mark set insert $last - } - $w tag remove sel 0.0 $first + 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 - $w tag remove sel $last end update idletasks } } -# 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. @@ -603,8 +606,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}]} { @@ -623,7 +625,7 @@ proc tkTextKeyExtend {w index} { $w tag remove sel $last end } -# tkTextPaste -- +# ::tk::TextPasteSelection -- # This procedure sets the insertion cursor to the mouse position, # inserts the selection, and sets the focus to the window. # @@ -631,42 +633,53 @@ 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] - catch {$w insert insert [selection get -displayof $w]} +proc ::tk::TextPasteSelection {w x y} { + $w mark set insert [TextClosestGap $w $x $y] + if {![catch {::tk::GetSelection $w PRIMARY} sel]} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w configure -autoseparators 0 + $w edit separator + } + $w insert insert $sel + if {$oldSeparator} { + $w edit separator + $w configure -autoseparators 1 + } + } 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 @@ -676,8 +689,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} @@ -685,9 +697,10 @@ proc tkTextSetCursor {w pos} { $w mark set insert $pos $w tag remove sel 1.0 end $w see insert + if {[$w cget -autoseparators]} {$w edit separator} } -# 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. @@ -697,8 +710,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]} { @@ -724,7 +736,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 @@ -738,8 +750,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 @@ -781,7 +792,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. @@ -790,21 +801,32 @@ 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 } + set compound 0 catch { if {[$w compare sel.first <= insert] \ && [$w compare sel.last >= insert]} { + set oldSeparator [$w cget -autoseparators] + if { $oldSeparator } { + $w configure -autoseparators 0 + $w edit separator + set compound 1 + } $w delete sel.first sel.last } } $w insert insert $s $w see insert + if { $compound && $oldSeparator } { + $w edit separator + $w configure -autoseparators 1 + } } -# 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, @@ -817,23 +839,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). @@ -842,7 +864,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"] \ @@ -860,7 +882,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). @@ -869,7 +891,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]} { @@ -890,7 +912,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 @@ -902,7 +924,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 ""]} { @@ -911,7 +933,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 @@ -921,7 +943,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"] @@ -935,21 +957,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). @@ -957,7 +979,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 @@ -965,26 +987,33 @@ 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 {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { + set oldSeparator [$w cget -autoseparators] + if { $oldSeparator } { + $w configure -autoseparators 0 + $w edit separator + } if {[string compare $tcl_platform(platform) "unix"]} { - catch { - $w delete sel.first sel.last - } + catch { $w delete sel.first sel.last } + } + $w insert insert $sel + if { $oldSeparator } { + $w edit separator + $w configure -autoseparators 1 } - $w insert insert [selection get -displayof $w -selection CLIPBOARD] } } -# 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 @@ -995,17 +1024,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. # @@ -1014,7 +1043,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]} { @@ -1034,7 +1063,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. # @@ -1043,7 +1072,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]} { @@ -1068,3 +1097,41 @@ proc tkTextPrevPos {w start op} { } return 0.0 } + +# ::tk::TextScanMark -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanMark {w x y} { + $w scan mark $x $y + set ::tk::Priv(x) $x + set ::tk::Priv(y) $y + set ::tk::Priv(mouseMoved) 0 +} + +# ::tk::TextScanDrag -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanDrag {w x y} { + # Make sure these exist, as some weird situations can trigger the + # motion binding without the initial press. [Bug #220269] + if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } + if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y } + if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} { + set ::tk::Priv(mouseMoved) 1 + } + if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} { + $w scan dragto $x $y + } +} diff --git a/library/tk.tcl b/library/tk.tcl index 1428a9d..c41b771 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.27 2000/10/31 01:12:38 hobbs Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.27.2.1 2002/04/06 01:02:02 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -13,25 +13,25 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Insist on running with compatible versions of Tcl and Tk. - package require -exact Tk 8.4 package require -exact Tcl 8.4 -package require msgcat + if { ![interp issafe] } { + package require msgcat ::msgcat::mcload [file join $::tk_library msgs] } # 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. @@ -151,17 +151,49 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } } -# tkScreenChanged -- +# ::tk::GetSelection -- +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. +# Arguments: +# w The widget for which the selection will be retrieved. +# Important for the -displayof property. +# sel The source of the selection (PRIMARY or CLIPBOARD) +# Results: +# Returns the selection, or an error if none could be found +# +if {[string equal $tcl_platform(platform) "unix"]} { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel \ + -type UTF8_STRING} txt] \ + && [catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} else { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} + +# ::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}]] @@ -169,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 {} @@ -199,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} { @@ -230,6 +262,7 @@ proc tkEventMotifBindings {n1 dummy dummy} { event $op <<Cut>> <Control-Key-w> event $op <<Copy>> <Meta-Key-w> event $op <<Paste>> <Control-Key-y> + event $op <<Undo>> <Control-underscore> } #---------------------------------------------------------------------- @@ -238,36 +271,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] } } @@ -275,12 +308,14 @@ 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> event add <<Paste>> <Control-Key-v> <Key-F18> event add <<PasteSelection>> <ButtonRelease-2> + event add <<Undo>> <Control-Key-z> + event add <<Redo>> <Control-Key-Z> # Some OS's define a goofy (as in, not <Shift-Tab>) keysym # that is returned when the user presses <Shift-Tab>. In order for # tab traversal to work, we have to add these keysyms to the @@ -291,17 +326,22 @@ switch $tcl_platform(platform) { switch $tcl_platform(os) { "IRIX" - "Linux" { event add <<PrevWindow>> <ISO_Left_Tab> } - "HP-UX" { event add <<PrevWindow>> <hpBackTab> } + "HP-UX" { + # This seems to be correct on *some* HP systems. + catch { event add <<PrevWindow>> <hpBackTab> } + } } } - 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> event add <<Copy>> <Control-Key-c> <Control-Key-Insert> event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> event add <<PasteSelection>> <ButtonRelease-2> + event add <<Undo>> <Control-Key-z> + event add <<Redo>> <Control-Key-y> } "macintosh" { event add <<Cut>> <Control-Key-x> <Key-F2> @@ -309,59 +349,60 @@ switch $tcl_platform(platform) { event add <<Paste>> <Control-Key-v> <Key-F4> event add <<PasteSelection>> <ButtonRelease-2> event add <<Clear>> <Clear> + event add <<Undo>> <Control-Key-z> <Key-F1> + event add <<Redo>> <Control-Key-Z> } } - # ---------------------------------------------------------------------- # 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 {$::tcl_platform(platform) ne "macintosh" && $::tk_library ne ""} { + 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 panedwindow.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 b8b3322..14e665a 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.24 2000/10/19 01:05:01 ericm Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.24.2.1 2002/04/06 01:02:02 hobbs Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -24,24 +24,23 @@ # 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]+$" { if { $i < 0 } { @@ -71,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) } @@ -89,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 @@ -120,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]] @@ -134,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 @@ -150,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) { @@ -179,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 @@ -189,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 # @@ -206,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 \ @@ -243,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 @@ -281,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 @@ -304,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)} @@ -335,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 \ @@ -383,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)]} { @@ -461,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 @@ -528,103 +526,107 @@ 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}] + if {$i==""} return + 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 {$i==""} return + 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}] + if {$i==""} return + 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}] + if {$i==""} return + 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 # @@ -632,27 +634,28 @@ 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] + if {$i==""} return 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 # @@ -660,49 +663,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] + if {$i==""} return 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 if {![info exists data(list)]} { return @@ -743,17 +746,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)} } #---------------------------------------------------------------------- @@ -765,7 +768,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 @@ -776,8 +779,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 @@ -859,7 +862,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 @@ -871,7 +874,7 @@ proc ::tk::dialog::file::tkFDialog {type args} { } $data(dirMenuBtn) configure -textvariable {} - return $tkPriv(selectFilePath) + return $Priv(selectFilePath) } # ::tk::dialog::file::Config -- @@ -946,7 +949,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)\"" @@ -956,19 +959,18 @@ proc ::tk::dialog::file::Config {dataName type argList} { # like "yes") so we can use it in tests more easily. if {![string compare $type save]} { set data(-multiple) 0 + } elseif {$data(-multiple)} { + set data(-multiple) 1 } else { - if {$data(-multiple)} { - set data(-multiple) 1 - } else { - set data(-multiple) 0 - } + set data(-multiple) 0 } } 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 @@ -979,8 +981,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[] = { @@ -991,7 +993,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 @@ -1003,9 +1005,9 @@ static char updir_bits[] = { # if { [string equal $class TkFDialog] } { if { $data(-multiple) } { - set fNameCaption "[::msgcat::mc {File names:}]" + set fNameCaption "[::msgcat::mc {File names:}]" } else { - set fNameCaption "[::msgcat::mc {File name:}]" + set fNameCaption "[::msgcat::mc {File name:}]" } set fTypeCaption [::msgcat::mc "Files of type:"] set fCaptionWidth [::msgcat::mcmax $fNameCaption $fTypeCaption] @@ -1018,7 +1020,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>> \ @@ -1033,8 +1035,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 # @@ -1099,8 +1100,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 @@ -1122,14 +1123,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 -- @@ -1147,14 +1148,14 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data if { $multi } { - set fNameCaption "[::msgcat::mc {File names:}]" + set fNameCaption "[::msgcat::mc {File names:}]" } else { - set fNameCaption "[::msgcat::mc {File name:}]" + set fNameCaption "[::msgcat::mc {File name:}]" } 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 } @@ -1197,19 +1198,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 { @@ -1235,7 +1237,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] $w config -cursor watch update idletasks - tkIconList_DeleteAll $data(icons) + ::tk::IconList_DeleteAll $data(icons) # Make the dir list # @@ -1252,7 +1254,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 # @@ -1275,10 +1277,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 # @@ -1356,11 +1358,34 @@ 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 + # If we aren't using a default extension, use the one suppled + # by the filter. + if {![info exists data(extUsed)]} { + if {[string length $data(-defaultextension)]} { + set data(extUsed) 1 + } else { + set data(extUsed) 0 + } + } + + if {!$data(extUsed)} { + # Get the first extension in the list that matches {^\*\.\w+$} + # and remove all * from the filter. + set index [lsearch -regexp $data(filter) {^\*\.\w+$}] + if {$index >= 0} { + set data(-defaultextension) \ + [string trimleft [lindex $data(filter) $index] "*"] + } else { + # Couldn't find anything! Reset to a safe default... + set data(-defaultextension) "" + } + } + $icons(sbar) set 0.0 0.0 ::tk::dialog::file::UpdateWhenIdle $w @@ -1499,12 +1524,17 @@ proc ::tk::dialog::file::EntFocusOut {w} { # proc ::tk::dialog::file::ActivateEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data - + set text [$data(ent) get] if {$data(-multiple)} { + # For the multiple case we have to be careful to get the file + # names as a true list, watching out for a single file with a + # space in the name. Thus we query the IconList directly. + set data(selectFile) "" - foreach fname $text { - ::tk::dialog::file::VerifyFileName $w $fname + foreach item [::tk::IconList_Curselection $data(icons)] { + ::tk::dialog::file::VerifyFileName $w \ + [::tk::IconList_Get $data(icons) $item] } } else { ::tk::dialog::file::VerifyFileName $w $text @@ -1587,7 +1617,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) } } @@ -1617,16 +1647,17 @@ proc ::tk::dialog::file::JoinFile {path file} { 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] + set filenames {} + foreach item [::tk::IconList_Curselection $data(icons)] { + lappend filenames [::tk::IconList_Get $data(icons) $item] } - if {[llength $text] && !$data(-multiple)} { - set text [lindex $text 0] - set file [::tk::dialog::file::JoinFile $data(selectPath) $text] + if {([llength $filenames] && !$data(-multiple)) || \ + ($data(-multiple) && ([llength $filenames] == 1))} { + set filename [lindex $filenames 0] + set file [::tk::dialog::file::JoinFile $data(selectPath) $filename] if {[file isdirectory $file]} { - ::tk::dialog::file::ListInvoke $w [list $text] + ::tk::dialog::file::ListInvoke $w [list $filename] return } } @@ -1638,9 +1669,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 @@ -1650,8 +1681,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 @@ -1692,14 +1723,15 @@ proc ::tk::dialog::file::ListBrowse {w} { # Gets called when user invokes the IconList widget (double-click, # Return key, etc) # -proc ::tk::dialog::file::ListInvoke {w text} { +proc ::tk::dialog::file::ListInvoke {w filenames} { upvar ::tk::dialog::file::[winfo name $w] data - if {[llength $text] == 0} { + if {[llength $filenames] == 0} { return } - set file [::tk::dialog::file::JoinFile $data(selectPath) [lindex $text 0]] + set file [::tk::dialog::file::JoinFile $data(selectPath) \ + [lindex $filenames 0]] set class [winfo class $w] if {[string equal $class TkChooseDir] || [file isdirectory $file]} { @@ -1714,7 +1746,7 @@ proc ::tk::dialog::file::ListInvoke {w text} { } } else { if {$data(-multiple)} { - set data(selectFile) $text + set data(selectFile) $filenames } else { set data(selectFile) $file } @@ -1726,13 +1758,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)} { @@ -1746,8 +1778,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]} { @@ -1760,5 +1792,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..c9534c7 --- /dev/null +++ b/library/unsupported.tcl @@ -0,0 +1,289 @@ +# 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.3.4.1 2002/04/06 01:02:02 hobbs 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 + unsupported1 ::tk::unsupported::MacWindowStyle + } + + # Map from the old global names of Tk private variable to their + # new namespace-encapsulated names. + + variable PrivateVariables + array set PrivateVariables { + droped_to_start ::tk::mac::Droped_to_start + histNum ::tk::HistNum + stub_location ::tk::mac::Stub_location + 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 1861abc..fe104b2 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.14 2000/06/30 20:19:07 ericm Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.14.2.1 2002/04/06 01:02:02 hobbs 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 @@ -347,17 +346,17 @@ proc tkMotifFDialog_BuildUI {w} { # The buttons # - set maxWidth [::msgcat::mcmax OK Filter Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax OK Filter Cancel] + 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,19 +514,20 @@ 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 - $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] + $data(fEnt) insert 0 \ + [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] $data(sEnt) delete 0 end $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 +538,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 @@ -567,16 +567,19 @@ proc tkMotifFDialog_LoadFiles {w} { if {[file isdir ./$f]} { lappend dlist $f } else { - if {[string match $data(filter) $f]} { + foreach pat $data(filter) { + if {[string match $pat $f]} { if {[string match .* $f]} { incr top } lappend flist $f + break } + } } } - eval $data(dList) insert end [lsort -dictionary $dlist] - eval $data(fList) insert end [lsort -dictionary $flist] + eval [list $data(dList) insert end] [lsort -dictionary $dlist] + eval [list $data(fList) insert end] [lsort -dictionary $flist] # The user probably doesn't want to see the . files. We adjust the view # so that the listbox displays all the non-dot files @@ -585,7 +588,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 +599,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 +613,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 +634,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 +645,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 +671,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 +682,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 +693,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 +724,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 +735,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 +745,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 +761,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 +784,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 +802,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 } @@ -825,7 +828,7 @@ proc tkMotifFDialog_ActivateSEnt {w} { if {[string equal $data(type) save]} { set message [format %s%s \ [::msgcat::mc {File "%1$s" already exists.\n\n} \ - $selectFilePath ] + $selectFilePath ] \ [::msgcat::mc {Replace existing file?}]] set answer [tk_messageBox -icon warning -type yesno \ -message $message] @@ -839,52 +842,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 +901,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 +943,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) } + |