mattia/BiblioMxWeb
Archived
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add files via upload

Browse Source
This commit is contained in:
MatMasIt 2021-06-17 01:30:13 +02:00 committed by GitHub
parent 3ecdf0fad5
commit 01e0e57dbc
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
87 changed files with 26625 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

265
windowsAgent/dist/tk/bgerror.tcl vendored Normal file
View File

@ -0,0 +1,265 @@
# bgerror.tcl --
#
# Implementation of the bgerror procedure. It posts a dialog box with
# the error message and gives the user a chance to see a more detailed
# stack trace, and possible do something more interesting with that
# trace (like save it to a log). This is adapted from work done by
# Donal K. Fellows.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2007 by ActiveState Software Inc.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
namespace export bgerror
option add *ErrorDialog.function.text [mc "Save To Log"] \
widgetDefault
option add *ErrorDialog.function.command [namespace code SaveToLog]
option add *ErrorDialog*Label.font TkCaptionFont widgetDefault
if {[tk windowingsystem] eq "aqua"} {
option add *ErrorDialog*background systemAlertBackgroundActive \
widgetDefault
option add *ErrorDialog*info.text.background white widgetDefault
option add *ErrorDialog*Button.highlightBackground \
systemAlertBackgroundActive widgetDefault
}
}
proc ::tk::dialog::error::Return {which code} {
variable button
.bgerrorDialog.$which state {active selected focus}
update idletasks
after 100
set button $code
}
proc ::tk::dialog::error::Details {} {
set w .bgerrorDialog
set caption [option get $w.function text {}]
set command [option get $w.function command {}]
if { ($caption eq "") || ($command eq "") } {
grid forget $w.function
}
lappend command [$w.top.info.text get 1.0 end-1c]
$w.function configure -text $caption -command $command
grid $w.top.info - -sticky nsew -padx 3m -pady 3m
}
proc ::tk::dialog::error::SaveToLog {text} {
if { $::tcl_platform(platform) eq "windows" } {
set allFiles *.*
} else {
set allFiles *
}
set types [list \
[list [mc "Log Files"] .log] \
[list [mc "Text Files"] .txt] \
[list [mc "All Files"] $allFiles] \
]
set filename [tk_getSaveFile -title [mc "Select Log File"] \
-filetypes $types -defaultextension .log -parent .bgerrorDialog]
if {$filename ne {}} {
set f [open $filename w]
puts -nonewline $f $text
close $f
}
return
}
proc ::tk::dialog::error::Destroy {w} {
if {$w eq ".bgerrorDialog"} {
variable button
set button -1
}
}
proc ::tk::dialog::error::DeleteByProtocol {} {
variable button
set button 1
}
proc ::tk::dialog::error::ReturnInDetails w {
bind $w <Return> {}; # Remove this binding
$w invoke
return -code break
}
# ::tk::dialog::error::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 trace.
#
# Arguments:
# err - The error message.
#
proc ::tk::dialog::error::bgerror err {
global errorInfo
variable button
set info $errorInfo
set ret [catch {::tkerror $err} msg];
if {$ret != 1} {return -code $ret $msg}
# Ok the application's tkerror either failed or was not found
# we use the default dialog then :
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
set ok [mc Ok]
} else {
set ok [mc OK]
}
# Truncate the message if it is too wide (>maxLine characters) or
# too tall (>4 lines). Truncation occurs at the first point at
# which one of those conditions is met.
set displayedErr ""
set lines 0
set maxLine 45
foreach line [split $err \n] {
if { [string length $line] > $maxLine } {
append displayedErr "[string range $line 0 [expr {$maxLine-3}]]..."
break
}
if { $lines > 4 } {
append displayedErr "..."
break
} else {
append displayedErr "${line}\n"
}
incr lines
}
set title [mc "Application Error"]
set text [mc "Error: %1\$s" $displayedErr]
set buttons [list ok $ok dismiss [mc "Skip Messages"] \
function [mc "Details >>"]]
# 1. Create the top-level window and divide it into top
# and bottom parts.
set dlg .bgerrorDialog
set bg [ttk::style lookup . -background]
destroy $dlg
toplevel $dlg -class ErrorDialog -background $bg
wm withdraw $dlg
wm title $dlg $title
wm iconname $dlg ErrorDialog
wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol]
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
} elseif {$windowingsystem eq "x11"} {
wm attributes $dlg -type dialog
}
ttk::frame $dlg.bot
ttk::frame $dlg.top
pack $dlg.bot -side bottom -fill both
pack $dlg.top -side top -fill both -expand 1
set W [ttk::frame $dlg.top.info]
text $W.text -setgrid true -height 10 -wrap char \
-yscrollcommand [list $W.scroll set]
if {$windowingsystem ne "aqua"} {
$W.text configure -width 40
}
ttk::scrollbar $W.scroll -command [list $W.text yview]
pack $W.scroll -side right -fill y
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
# Max-width of message is the width of the screen...
set wrapwidth [winfo screenwidth $dlg]
# ...minus the width of the icon, padding and a fudge factor for
# the window manager decorations and aesthetics.
set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}]
ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth
ttk::label $dlg.bitmap -image ::tk::icons::error
grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m
grid configure $dlg.bitmap -sticky ne
grid configure $dlg.msg -sticky nsw -padx {0 3m}
grid rowconfigure $dlg.top 1 -weight 1
grid columnconfigure $dlg.top 1 -weight 1
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach {name caption} $buttons {
ttk::button $dlg.$name -text $caption -default normal \
-command [namespace code [list set button $i]]
grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10
grid columnconfigure $dlg.bot $i -weight 1
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
if {($name eq "ok") || ($name eq "dismiss")} {
grid columnconfigure $dlg.bot $i -minsize 90
}
grid configure $dlg.$name -pady 7
}
incr i
}
# The "OK" button is the default for this dialog.
$dlg.ok configure -default active
bind $dlg <Return> [namespace code {Return ok 0}]
bind $dlg <Escape> [namespace code {Return dismiss 1}]
bind $dlg <Destroy> [namespace code {Destroy %W}]
bind $dlg.function <Return> [namespace code {ReturnInDetails %W}]
$dlg.function configure -command [namespace code Details]
# 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
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $dlg
# 7. Set a grab and claim the focus too.
::tk::SetFocusGrab $dlg $dlg.ok
# 8. Ensure that we are topmost.
raise $dlg
if {[tk windowingsystem] eq "win32"} {
# Place it topmost if we aren't at the top of the stacking
# order to ensure that it's seen
if {[lindex [wm stackorder .] end] ne "$dlg"} {
wm attributes $dlg -topmost 1
}
}
# 9. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait [namespace which -variable button]
set copy $button; # Save a copy...
::tk::RestoreFocusGrab $dlg $dlg.ok destroy
if {$copy == 1} {
return -code break
}
}
namespace eval :: {
# Fool the indexer
proc bgerror err {}
rename bgerror {}
namespace import ::tk::dialog::error::bgerror
}

778
windowsAgent/dist/tk/button.tcl vendored Normal file
View File

@ -0,0 +1,778 @@
# button.tcl --
#
# This file defines the default bindings for Tk label, button,
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 2002 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# The code below creates the default class bindings for buttons.
#-------------------------------------------------------------------------
if {[tk windowingsystem] eq "aqua"} {
bind Radiobutton <Enter> {
tk::ButtonEnter %W
}
bind Radiobutton <1> {
tk::ButtonDown %W
}
bind Radiobutton <ButtonRelease-1> {
tk::ButtonUp %W
}
bind Checkbutton <Enter> {
tk::ButtonEnter %W
}
bind Checkbutton <1> {
tk::ButtonDown %W
}
bind Checkbutton <ButtonRelease-1> {
tk::ButtonUp %W
}
bind Checkbutton <Leave> {
tk::ButtonLeave %W
}
}
if {"win32" eq [tk windowingsystem]} {
bind Checkbutton <equal> {
tk::CheckRadioInvoke %W select
}
bind Checkbutton <plus> {
tk::CheckRadioInvoke %W select
}
bind Checkbutton <minus> {
tk::CheckRadioInvoke %W deselect
}
bind Checkbutton <1> {
tk::CheckRadioDown %W
}
bind Checkbutton <ButtonRelease-1> {
tk::ButtonUp %W
}
bind Checkbutton <Enter> {
tk::CheckRadioEnter %W
}
bind Checkbutton <Leave> {
tk::ButtonLeave %W
}
bind Radiobutton <1> {
tk::CheckRadioDown %W
}
bind Radiobutton <ButtonRelease-1> {
tk::ButtonUp %W
}
bind Radiobutton <Enter> {
tk::CheckRadioEnter %W
}
}
if {"x11" eq [tk windowingsystem]} {
bind Checkbutton <Return> {
if {!$tk_strictMotif} {
tk::CheckInvoke %W
}
}
bind Radiobutton <Return> {
if {!$tk_strictMotif} {
tk::CheckRadioInvoke %W
}
}
bind Checkbutton <1> {
tk::CheckInvoke %W
}
bind Radiobutton <1> {
tk::CheckRadioInvoke %W
}
bind Checkbutton <Enter> {
tk::CheckEnter %W
}
bind Radiobutton <Enter> {
tk::ButtonEnter %W
}
bind Checkbutton <Leave> {
tk::CheckLeave %W
}
}
bind Button <space> {
tk::ButtonInvoke %W
}
bind Checkbutton <space> {
tk::CheckRadioInvoke %W
}
bind Radiobutton <space> {
tk::CheckRadioInvoke %W
}
bind Button <<Invoke>> {
tk::ButtonInvoke %W
}
bind Checkbutton <<Invoke>> {
tk::CheckRadioInvoke %W
}
bind Radiobutton <<Invoke>> {
tk::CheckRadioInvoke %W
}
bind Button <FocusIn> {}
bind Button <Enter> {
tk::ButtonEnter %W
}
bind Button <Leave> {
tk::ButtonLeave %W
}
bind Button <1> {
tk::ButtonDown %W
}
bind Button <ButtonRelease-1> {
tk::ButtonUp %W
}
bind Checkbutton <FocusIn> {}
bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
tk::ButtonLeave %W
}
if {"win32" eq [tk windowingsystem]} {
#########################
# Windows implementation
#########################
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonEnter w {
variable ::tk::Priv
if {[$w cget -state] ne "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.
set Priv($w,relief) [$w cget -relief]
if {$Priv(buttonWindow) eq $w} {
$w configure -relief sunken -state active
set Priv($w,prelief) sunken
} elseif {[set over [$w cget -overrelief]] ne ""} {
$w configure -relief $over
set Priv($w,prelief) $over
}
}
set Priv(window) $w
}
# ::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.
# Restore any modified relief too.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonLeave w {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
$w configure -state normal
}
# Restore the original button relief if it was changed by Tk.
# That is signaled by the existence of Priv($w,prelief).
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
set Priv(window) ""
}
# ::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
# the relief to sunken.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonDown w {
variable ::tk::Priv
# Only save the button's relief if it does not yet exist. If there
# is an overrelief setting, Priv($w,relief) will already have been set,
# and the current value of the -relief option will be incorrect.
if {![info exists Priv($w,relief)]} {
set Priv($w,relief) [$w cget -relief]
}
if {[$w cget -state] ne "disabled"} {
set Priv(buttonWindow) $w
$w configure -relief sunken -state active
set Priv($w,prelief) sunken
# If this button has a repeatdelay set up, get it going with an after
after cancel $Priv(afterId)
set delay [$w cget -repeatdelay]
set Priv(repeated) 0
if {$delay > 0} {
set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonUp w {
variable ::tk::Priv
if {$Priv(buttonWindow) eq $w} {
set Priv(buttonWindow) ""
# Restore the button's relief if it was cached.
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
# Clean up the after event from the auto-repeater
after cancel $Priv(afterId)
if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
$w configure -state normal
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
}
}
# ::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
# disabled.
#
# Arguments:
# w - The name of the widget.
proc ::tk::CheckRadioEnter w {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
if {$Priv(buttonWindow) eq $w} {
$w configure -state active
}
if {[set over [$w cget -overrelief]] ne ""} {
set Priv($w,relief) [$w cget -relief]
set Priv($w,prelief) $over
$w configure -relief $over
}
}
set Priv(window) $w
}
# ::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
# the relief to sunken.
#
# Arguments:
# w - The name of the widget.
proc ::tk::CheckRadioDown w {
variable ::tk::Priv
if {![info exists Priv($w,relief)]} {
set Priv($w,relief) [$w cget -relief]
}
if {[$w cget -state] ne "disabled"} {
set Priv(buttonWindow) $w
set Priv(repeated) 0
$w configure -state active
}
}
}
if {"x11" eq [tk windowingsystem]} {
#####################
# Unix implementation
#####################
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonEnter {w} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
# On unix the state is active just with mouse-over
$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.
set Priv($w,relief) [$w cget -relief]
if {$Priv(buttonWindow) eq $w} {
$w configure -relief sunken
set Priv($w,prelief) sunken
} elseif {[set over [$w cget -overrelief]] ne ""} {
$w configure -relief $over
set Priv($w,prelief) $over
}
}
set Priv(window) $w
}
# ::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.
# Restore any modified relief too.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonLeave w {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
$w configure -state normal
}
# Restore the original button relief if it was changed by Tk.
# That is signaled by the existence of Priv($w,prelief).
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
set Priv(window) ""
}
# ::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
# the relief to sunken.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonDown w {
variable ::tk::Priv
# Only save the button's relief if it does not yet exist. If there
# is an overrelief setting, Priv($w,relief) will already have been set,
# and the current value of the -relief option will be incorrect.
if {![info exists Priv($w,relief)]} {
set Priv($w,relief) [$w cget -relief]
}
if {[$w cget -state] ne "disabled"} {
set Priv(buttonWindow) $w
$w configure -relief sunken
set Priv($w,prelief) sunken
# If this button has a repeatdelay set up, get it going with an after
after cancel $Priv(afterId)
set delay [$w cget -repeatdelay]
set Priv(repeated) 0
if {$delay > 0} {
set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonUp w {
variable ::tk::Priv
if {$w eq $Priv(buttonWindow)} {
set Priv(buttonWindow) ""
# Restore the button's relief if it was cached.
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
# Clean up the after event from the auto-repeater
after cancel $Priv(afterId)
if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
}
}
}
if {[tk windowingsystem] eq "aqua"} {
####################
# Mac implementation
####################
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonEnter {w} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
# If there's an -overrelief value, set the relief to that.
if {$Priv(buttonWindow) eq $w} {
$w configure -state active
} elseif {[set over [$w cget -overrelief]] ne ""} {
set Priv($w,relief) [$w cget -relief]
set Priv($w,prelief) $over
$w configure -relief $over
}
}
set Priv(window) $w
}
# ::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 (Priv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonLeave w {
variable ::tk::Priv
if {$w eq $Priv(buttonWindow)} {
$w configure -state normal
}
# Restore the original button relief if it was changed by Tk.
# That is signaled by the existence of Priv($w,prelief).
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
set Priv(window) ""
}
# ::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
# the relief to sunken.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonDown w {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
set Priv(buttonWindow) $w
$w configure -state active
# If this button has a repeatdelay set up, get it going with an after
after cancel $Priv(afterId)
set Priv(repeated) 0
if { ![catch {$w cget -repeatdelay} delay] } {
if {$delay > 0} {
set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
}
# ::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.
#
# Arguments:
# w - The name of the widget.
proc ::tk::ButtonUp w {
variable ::tk::Priv
if {$Priv(buttonWindow) eq $w} {
set Priv(buttonWindow) ""
$w configure -state normal
# Restore the button's relief if it was cached.
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
# Clean up the after event from the auto-repeater
after cancel $Priv(afterId)
if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
}
}
}
##################
# Shared routines
##################
# ::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 ::tk::ButtonInvoke w {
if {[winfo exists $w] && [$w cget -state] ne "disabled"} {
set oldRelief [$w cget -relief]
set oldState [$w cget -state]
$w configure -state active -relief sunken
after 100 [list ::tk::ButtonInvokeEnd $w $oldState $oldRelief]
}
}
# ::tk::ButtonInvokeEnd --
# The procedure below is called after a button is invoked through
# the keyboard. It simulate a release of the button via the mouse.
#
# Arguments:
# w - The name of the widget.
# oldState - Old state to be set back.
# oldRelief - Old relief to be set back.
proc ::tk::ButtonInvokeEnd {w oldState oldRelief} {
if {[winfo exists $w]} {
$w configure -state $oldState -relief $oldRelief
uplevel #0 [list $w invoke]
}
}
# ::tk::ButtonAutoInvoke --
#
# Invoke an auto-repeating button, and set it up to continue to repeat.
#
# Arguments:
# w button to invoke.
#
# Results:
# None.
#
# Side effects:
# May create an after event to call ::tk::ButtonAutoInvoke.
proc ::tk::ButtonAutoInvoke {w} {
variable ::tk::Priv
after cancel $Priv(afterId)
set delay [$w cget -repeatinterval]
if {$Priv(window) eq $w} {
incr Priv(repeated)
uplevel #0 [list $w invoke]
}
if {$delay > 0} {
set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
# ::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
# isn't disabled.
#
# Arguments:
# w - The name of the widget.
# cmd - The subcommand to invoke (one of invoke, select, or deselect).
proc ::tk::CheckRadioInvoke {w {cmd invoke}} {
if {[$w cget -state] ne "disabled"} {
uplevel #0 [list $w $cmd]
}
}
# Special versions of the handlers for checkbuttons on Unix that do the magic
# to make things work right when the checkbutton indicator is hidden;
# radiobuttons don't need this complexity.
# ::tk::CheckInvoke --
# The procedure below invokes the checkbutton, like ButtonInvoke, but handles
# what to do when the checkbutton indicator is missing. Only used on Unix.
#
# Arguments:
# w - The name of the widget.
proc ::tk::CheckInvoke {w} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
# Additional logic to switch the "selected" colors around if necessary
# (when we're indicator-less).
if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
if {[$w cget -selectcolor] eq $Priv($w,aselectcolor)} {
$w configure -selectcolor $Priv($w,selectcolor)
} else {
$w configure -selectcolor $Priv($w,aselectcolor)
}
}
uplevel #0 [list $w invoke]
}
}
# ::tk::CheckEnter --
# The procedure below enters the checkbutton, like ButtonEnter, but handles
# what to do when the checkbutton indicator is missing. Only used on Unix.
#
# Arguments:
# w - The name of the widget.
proc ::tk::CheckEnter {w} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
# On unix the state is active just with mouse-over
$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.
set Priv($w,relief) [$w cget -relief]
if {$Priv(buttonWindow) eq $w} {
$w configure -relief sunken
set Priv($w,prelief) sunken
} elseif {[set over [$w cget -overrelief]] ne ""} {
$w configure -relief $over
set Priv($w,prelief) $over
}
# Compute what the "selected and active" color should be.
if {![$w cget -indicatoron] && [$w cget -selectcolor] ne ""} {
set Priv($w,selectcolor) [$w cget -selectcolor]
lassign [winfo rgb $w [$w cget -selectcolor]] r1 g1 b1
lassign [winfo rgb $w [$w cget -activebackground]] r2 g2 b2
set Priv($w,aselectcolor) \
[format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \
[expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]]
# use uplevel to work with other var resolvers
if {[uplevel #0 [list set [$w cget -variable]]]
eq [$w cget -onvalue]} {
$w configure -selectcolor $Priv($w,aselectcolor)
}
}
}
set Priv(window) $w
}
# ::tk::CheckLeave --
# The procedure below leaves the checkbutton, like ButtonLeave, but handles
# what to do when the checkbutton indicator is missing. Only used on Unix.
#
# Arguments:
# w - The name of the widget.
proc ::tk::CheckLeave {w} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled"} {
$w configure -state normal
}
# Restore the original button "selected" color; assume that the user
# wasn't monkeying around with things too much.
if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
$w configure -selectcolor $Priv($w,selectcolor)
}
unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor)
# Restore the original button relief if it was changed by Tk. That is
# signaled by the existence of Priv($w,prelief).
if {[info exists Priv($w,relief)]} {
if {[info exists Priv($w,prelief)] && \
$Priv($w,prelief) eq [$w cget -relief]} {
$w configure -relief $Priv($w,relief)
}
unset -nocomplain Priv($w,relief) Priv($w,prelief)
}
set Priv(window) ""
}
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:

308
windowsAgent/dist/tk/choosedir.tcl vendored Normal file
View File

@ -0,0 +1,308 @@
# choosedir.tcl --
#
# Choose directory dialog implementation for Unix/Mac.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
# Make sure the tk::dialog namespace, in which all dialogs should live, exists
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {}
# Make the chooseDir namespace inside the dialog namespace
namespace eval ::tk::dialog::file::chooseDir {
namespace import -force ::tk::msgcat::*
}
# ::tk::dialog::file::chooseDir:: --
#
# Implements the TK directory selection dialog.
#
# Arguments:
# args Options parsed by the procedure.
#
proc ::tk::dialog::file::chooseDir:: {args} {
variable ::tk::Priv
set dataName __tk_choosedir
upvar ::tk::dialog::file::$dataName data
Config $dataName $args
if {$data(-parent) eq "."} {
set w .$dataName
} else {
set w $data(-parent).$dataName
}
# (re)create the dialog box if necessary
#
if {![winfo exists $w]} {
::tk::dialog::file::Create $w TkChooseDir
} elseif {[winfo class $w] ne "TkChooseDir"} {
destroy $w
::tk::dialog::file::Create $w TkChooseDir
} else {
set data(dirMenuBtn) $w.contents.f1.menu
set data(dirMenu) $w.contents.f1.menu.menu
set data(upBtn) $w.contents.f1.up
set data(icons) $w.contents.icons
set data(ent) $w.contents.f2.ent
set data(okBtn) $w.contents.f2.ok
set data(cancelBtn) $w.contents.f2.cancel
set data(hiddenBtn) $w.contents.f2.hidden
}
if {$::tk::dialog::file::showHiddenBtn} {
$data(hiddenBtn) configure -state normal
grid $data(hiddenBtn)
} else {
$data(hiddenBtn) configure -state disabled
grid remove $data(hiddenBtn)
}
# When using -mustexist, manage the OK button state for validity
$data(okBtn) configure -state normal
if {$data(-mustexist)} {
$data(ent) configure -validate key \
-validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P]
} else {
$data(ent) configure -validate none
}
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
}
trace add variable data(selectPath) write \
[list ::tk::dialog::file::SetPath $w]
$data(dirMenuBtn) configure \
-textvariable ::tk::dialog::file::${dataName}(selectPath)
set data(filter) "*"
set data(previousEntryText) ""
::tk::dialog::file::UpdateWhenIdle $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
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
# Set a grab and claim the focus too.
::tk::SetFocusGrab $w $data(ent)
$data(ent) delete 0 end
$data(ent) insert 0 $data(selectPath)
$data(ent) selection range 0 end
$data(ent) icursor end
# Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(selectFilePath)
::tk::RestoreFocusGrab $w $data(ent) withdraw
# Cleanup traces on selectPath variable
#
foreach trace [trace info variable data(selectPath)] {
trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
}
$data(dirMenuBtn) configure -textvariable {}
# Return value to user
#
return $Priv(selectFilePath)
}
# ::tk::dialog::file::chooseDir::Config --
#
# Configures the Tk choosedir dialog according to the argument list
#
proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
upvar ::tk::dialog::file::$dataName data
# 0: Delete all variable that were set on data(selectPath) the
# last time the file dialog is used. The traces may cause troubles
# if the dialog is now used with a different -parent option.
#
foreach trace [trace info variable data(selectPath)] {
trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
}
# 1: the configuration specs
#
set specs {
{-mustexist "" "" 0}
{-initialdir "" "" ""}
{-parent "" "" "."}
{-title "" "" ""}
}
# 2: default values depending on the type of the dialog
#
if {![info exists data(selectPath)]} {
# first time the dialog has been popped up
set data(selectPath) [pwd]
}
# 3: parse the arguments
#
tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
if {$data(-title) eq ""} {
set data(-title) "[mc "Choose Directory"]"
}
# Stub out the -multiple value for the dialog; it doesn't make sense for
# choose directory dialogs, but we have to have something there because we
# share so much code with the file dialogs.
set data(-multiple) 0
# 4: set the default directory and selection according to the -initial
# settings
#
if {$data(-initialdir) ne ""} {
# Ensure that initialdir is an absolute path name.
if {[file isdirectory $data(-initialdir)]} {
set old [pwd]
cd $data(-initialdir)
set data(selectPath) [pwd]
cd $old
} else {
set data(selectPath) [pwd]
}
}
if {![winfo exists $data(-parent)]} {
return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
"bad window path name \"$data(-parent)\""
}
}
# Gets called when user presses Return in the "Selection" entry or presses OK.
#
proc ::tk::dialog::file::chooseDir::OkCmd {w} {
upvar ::tk::dialog::file::[winfo name $w] data
# This is the brains behind selecting non-existant directories. Here's
# the flowchart:
# 1. If the icon list has a selection, join it with the current dir,
# and return that value.
# 1a. If the icon list does not have a selection ...
# 2. If the entry is empty, do nothing.
# 3. If the entry contains an invalid directory, then...
# 3a. If the value is the same as last time through here, end dialog.
# 3b. If the value is different than last time, save it and return.
# 4. If entry contains a valid directory, then...
# 4a. If the value is the same as the current directory, end dialog.
# 4b. If the value is different from the current directory, change to
# that directory.
set selection [$data(icons) selection get]
if {[llength $selection] != 0} {
set iconText [$data(icons) get [lindex $selection 0]]
set iconText [file join $data(selectPath) $iconText]
Done $w $iconText
} else {
set text [$data(ent) get]
if {$text eq ""} {
return
}
set text [file join {*}[file split [string trim $text]]]
if {![file exists $text] || ![file isdirectory $text]} {
# Entry contains an invalid directory. If it's the same as the
# last time they came through here, reset the saved value and end
# the dialog. Otherwise, save the value (so we can do this test
# next time).
if {$text eq $data(previousEntryText)} {
set data(previousEntryText) ""
Done $w $text
} else {
set data(previousEntryText) $text
}
} else {
# Entry contains a valid directory. If it is the same as the
# current directory, end the dialog. Otherwise, change to that
# directory.
if {$text eq $data(selectPath)} {
Done $w $text
} else {
set data(selectPath) $text
}
}
}
return
}
# Change state of OK button to match -mustexist correctness of entry
#
proc ::tk::dialog::file::chooseDir::IsOK? {w text} {
upvar ::tk::dialog::file::[winfo name $w] data
set ok [file isdirectory $text]
$data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}]
# always return 1
return 1
}
proc ::tk::dialog::file::chooseDir::DblClick {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set selection [$data(icons) selection get]
if {[llength $selection] != 0} {
set filenameFragment [$data(icons) get [lindex $selection 0]]
set file $data(selectPath)
if {[file isdirectory $file]} {
::tk::dialog::file::ListInvoke $w [list $filenameFragment]
return
}
}
}
# Gets called when user browses the IconList widget (dragging mouse, arrow
# keys, etc)
#
proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
upvar ::tk::dialog::file::[winfo name $w] data
if {$text eq ""} {
return
}
set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
$data(ent) delete 0 end
$data(ent) insert 0 $file
}
# ::tk::dialog::file::chooseDir::Done --
#
# Gets called when user has input a valid filename. Pops up a
# dialog box to confirm selection when necessary. Sets the
# 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
variable ::tk::Priv
if {$selectFilePath eq ""} {
set selectFilePath $data(selectPath)
}
if {$data(-mustexist) && ![file isdirectory $selectFilePath]} {
return
}
set Priv(selectFilePath) $selectFilePath
}

695
windowsAgent/dist/tk/clrpick.tcl vendored Normal file
View File

@ -0,0 +1,695 @@
# clrpick.tcl --
#
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ToDo:
#
# (1): Find out how many free colors are left in the colormap and
# don't allocate too many colors.
# (2): Implement HSV color selection.
#
# Make sure namespaces exist
namespace eval ::tk {}
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::color {
namespace import ::tk::msgcat::*
}
# ::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 ::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.
set data(lines,red,start) 0
set data(lines,red,last) -1
set data(lines,green,start) 0
set data(lines,green,last) -1
set data(lines,blue,start) 0
set data(lines,blue,last) -1
# This is the actual number of lines that are drawn in each color strip.
# 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) 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) 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
# left and right sides which is half of PLGN_WIDTH. Make this number even.
set data(PLGN_HEIGHT) 10
# PLGN_HEIGHT is the height of the selection polygon and the height of the
# selection rectangle at the bottom of the color bar. No restrictions.
set data(PLGN_WIDTH) 10
Config $dataName $args
InitValues $dataName
set sc [winfo screen $data(-parent)]
set winExists [winfo exists $w]
if {!$winExists || $sc ne [winfo screen $w]} {
if {$winExists} {
destroy $w
}
toplevel $w -class TkColorDialog -screen $sc
if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
BuildDialog $w
}
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
}
# 5. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
# 6. Set a grab and claim the focus too.
::tk::SetFocusGrab $w $data(okBtn)
# 7. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(selectColor)
set result $Priv(selectColor)
::tk::RestoreFocusGrab $w $data(okBtn)
unset data
return $result
}
# ::tk::dialog::color::InitValues --
#
# Get called during initialization or when user resets NUM_COLORBARS
#
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.
set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
# ColorbarWidth is the width of each colorbar
set data(colorbarWidth) [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
# Indent is the width of the space at the left and right side of the
# colorbar. It is always half the selector polygon width, because the
# polygon extends into the space.
set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
set data(colorPad) 2
set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]
#
# minX is the x coordinate of the first colorbar
#
set data(minX) $data(indent)
#
# maxX is the x coordinate of the last colorbar
#
set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
#
# canvasWidth is the width of the entire canvas, including the indents
#
set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
# Set the initial color, specified by -initialcolor, or the
# color chosen by the user the last time.
set data(selection) $data(-initialcolor)
set data(finalColor) $data(-initialcolor)
set rgb [winfo rgb . $data(selection)]
set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]
set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]
}
# ::tk::dialog::color::Config --
#
# Parses the command line arguments to tk_chooseColor
#
proc ::tk::dialog::color::Config {dataName argList} {
variable ::tk::Priv
upvar ::tk::dialog::color::$dataName data
# 1: the configuration specs
#
if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} {
set defaultColor $Priv(selectColor)
} else {
set defaultColor [. cget -background]
}
set specs [list \
[list -initialcolor "" "" $defaultColor] \
[list -parent "" "" "."] \
[list -title "" "" [mc "Color"]] \
]
# 2: parse the arguments
#
tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
if {$data(-title) eq ""} {
set data(-title) " "
}
if {[catch {winfo rgb . $data(-initialcolor)} err]} {
return -code error -errorcode [list TK LOOKUP COLOR $data(-initialcolor)] \
$err
}
if {![winfo exists $data(-parent)]} {
return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
"bad window path name \"$data(-parent)\""
}
}
# ::tk::dialog::color::BuildDialog --
#
# Build the dialog.
#
proc ::tk::dialog::color::BuildDialog {w} {
upvar ::tk::dialog::color::[winfo name $w] data
# TopFrame contains the color strips and the color selection
#
set topFrame [frame $w.top -relief raised -bd 1]
# StripsFrame contains the colorstrips and the individual RGB entries
set stripsFrame [frame $topFrame.colorStrip]
set maxWidth [::tk::mcmaxamp &Red &Green &Blue]
set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}]
set colorList {
red "&Red"
green "&Green"
blue "&Blue"
}
foreach {color l} $colorList {
# each f frame contains an [R|G|B] entry and the equiv. color strip.
set f [frame $stripsFrame.$color]
# The box frame contains the label and entry widget for an [R|G|B]
set box [frame $f.box]
::tk::AmpWidget label $box.label -text "[mc $l]:" \
-width $maxWidth -anchor ne
bind $box.label <<AltUnderlined>> [list focus $box.entry]
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
set height [expr {
[winfo reqheight $box.entry] -
2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])
}]
canvas $f.color -height $height \
-width $data(BARS_WIDTH) -relief sunken -bd 2
canvas $f.sel -height $data(PLGN_HEIGHT) \
-width $data(canvasWidth) -highlightthickness 0
pack $f.color -expand yes -fill both
pack $f.sel -expand yes -fill both
pack $f -side top -fill x -padx 0 -pady 2
set data($color,entry) $box.entry
set data($color,col) $f.color
set data($color,sel) $f.sel
bind $data($color,col) <Configure> \
[list tk::dialog::color::DrawColorScale $w $color 1]
bind $data($color,col) <Enter> \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,col) <Leave> \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $data($color,sel) <Enter> \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,sel) <Leave> \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
}
pack $stripsFrame -side left -fill both -padx 4 -pady 10
# The selFrame contains a frame that demonstrates the currently
# selected color
#
set selFrame [frame $topFrame.sel]
set lab [::tk::AmpWidget label $selFrame.lab \
-text [mc "&Selection:"] -anchor sw]
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]
pack $lab $ent -side top -fill x -padx 4 -pady 2
pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
pack $data(finalCanvas) -expand yes -fill both
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
# the botFrame frame contains the buttons
#
set botFrame [frame $w.bot -relief raised -bd 1]
::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \
-command [list tk::dialog::color::OkCmd $w]
::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"] \
-command [list tk::dialog::color::CancelCmd $w]
set data(okBtn) $botFrame.ok
set data(cancelBtn) $botFrame.cancel
grid x $botFrame.ok x $botFrame.cancel x -sticky ew
grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
grid columnconfigure $botFrame 2 -weight 2 -uniform space
pack $botFrame -side bottom -fill x
# Accelerator bindings
bind $lab <<AltUnderlined>> [list focus $ent]
bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w]
}
# ::tk::dialog::color::SetRGBValue --
#
# Sets the current selection of the dialog box
#
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]
RedrawColorBars $w all
# Now compute the new x value of each colorbars pointer polygon
foreach color {red green blue} {
set x [RgbToX $w $data($color,intensity)]
MoveSelector $w $data($color,sel) $color $x 0
}
}
# ::tk::dialog::color::XToRgb --
#
# Converts a screen coordinate to intensity
#
proc ::tk::dialog::color::XToRgb {w x} {
upvar ::tk::dialog::color::[winfo name $w] data
set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
if {$x > 255} {
set x 255
}
return $x
}
# ::tk::dialog::color::RgbToX
#
# Converts an intensity to screen coordinate.
#
proc ::tk::dialog::color::RgbToX {w color} {
upvar ::tk::dialog::color::[winfo name $w] data
return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
}
# ::tk::dialog::color::DrawColorScale --
#
# Draw color scale is called whenever the size of one of the color
# scale canvases is changed.
#
proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
upvar ::tk::dialog::color::[winfo name $w] data
# col: color bar canvas
# sel: selector canvas
set col $data($c,col)
set sel $data($c,sel)
# First handle the case that we are creating everything for the first time.
if {$create} {
# First remove all the lines that already exist.
if { $data(lines,$c,last) > $data(lines,$c,start)} {
for {set i $data(lines,$c,start)} \
{$i <= $data(lines,$c,last)} {incr i} {
$sel delete $i
}
}
# Delete the selector if it exists
if {[info exists data($c,index)]} {
$sel delete $data($c,index)
}
# Draw the selection polygons
CreateSelector $w $sel $c
$sel bind $data($c,index) <ButtonPress-1> \
[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
$sel bind $data($c,index) <B1-Motion> \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,index) <ButtonRelease-1> \
[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
# that aren't on the selector.
set data($c,clickRegion) [$sel create rectangle 0 0 \
$data(canvasWidth) $height -fill {} -outline {}]
bind $col <ButtonPress-1> \
[list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
bind $col <B1-Motion> \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
bind $col <ButtonRelease-1> \
[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
$sel bind $data($c,clickRegion) <ButtonPress-1> \
[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <B1-Motion> \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <ButtonRelease-1> \
[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)
}
# Draw the color bars.
set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
set intensity [expr {$i * $data(intensityIncr)}]
set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
if {$c eq "red"} {
set color [format "#%02x%02x%02x" \
$intensity $data(green,intensity) $data(blue,intensity)]
} elseif {$c eq "green"} {
set color [format "#%02x%02x%02x" \
$data(red,intensity) $intensity $data(blue,intensity)]
} else {
set color [format "#%02x%02x%02x" \
$data(red,intensity) $data(green,intensity) $intensity]
}
if {$create} {
set index [$col create rect $startx $highlightW \
[expr {$startx +$data(colorbarWidth)}] \
[expr {[winfo height $col] + $highlightW}] \
-fill $color -outline $color]
} else {
$col itemconfigure $l -fill $color -outline $color
incr l
}
}
$sel raise $data($c,index)
if {$create} {
set data(lines,$c,last) $index
set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
}
RedrawFinalColor $w
}
# ::tk::dialog::color::CreateSelector --
#
# Creates and draws the selector polygon at the position
# $data($c,intensity).
#
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) [RgbToX $w $data($c,intensity)]
$sel move $data($c,index) $data($c,x) 0
}
# ::tk::dialog::color::RedrawFinalColor
#
# Combines the intensities of the three colors into the final color
#
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)]
$data(finalCanvas) configure -bg $color
set data(finalColor) $color
set data(selection) $color
set data(finalRGB) [list \
$data(red,intensity) \
$data(green,intensity) \
$data(blue,intensity)]
}
# ::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 ::tk::dialog::color::RedrawColorBars {w colorChanged} {
upvar ::tk::dialog::color::[winfo name $w] data
switch $colorChanged {
red {
DrawColorScale $w green
DrawColorScale $w blue
}
green {
DrawColorScale $w red
DrawColorScale $w blue
}
blue {
DrawColorScale $w red
DrawColorScale $w green
}
default {
DrawColorScale $w red
DrawColorScale $w green
DrawColorScale $w blue
}
}
RedrawFinalColor $w
}
#----------------------------------------------------------------------
# Event handlers
#----------------------------------------------------------------------
# ::tk::dialog::color::StartMove --
#
# Handles a mousedown button event over the selector polygon.
# Adds the bindings for moving the mouse while the button is
# pressed. Sets the binding for the button-release event.
#
# Params: sel is the selector canvas window, color is the color of the strip.
#
proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
upvar ::tk::dialog::color::[winfo name $w] data
if {!$dontMove} {
MoveSelector $w $sel $color $x $delta
}
}
# ::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],
# the selector is set to the closest endpoint.
#
# Params: sel is the selector canvas, c is [red|green|blue]
# x is a x-coordinate.
#
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 $data(BARS_WIDTH)
}
set diff [expr {$x - $data($color,x)}]
$sel move $data($color,index) $diff 0
set data($color,x) [expr {$data($color,x) + $diff}]
# Return the x value that it was actually set at
return $x
}
# ::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 ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
upvar ::tk::dialog::color::[winfo name $w] data
set x [MoveSelector $w $sel $color $x $delta]
# Determine exactly what color we are looking at.
set data($color,intensity) [XToRgb $w $x]
RedrawColorBars $w $color
}
# ::tk::dialog::color::ResizeColorbars --
#
# Completely redraws the colorbars, including resizing the
# colorstrips
#
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)
} then {
set data(BARS_WIDTH) $data(NUM_COLORBARS)
}
InitValues [winfo name $w]
foreach color {red green blue} {
$data($color,col) configure -width $data(canvasWidth)
DrawColorScale $w $color 1
}
}
# ::tk::dialog::color::HandleSelEntry --
#
# Handles the return keypress event in the "Selection:" entry
#
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
if {[catch {set color [winfo rgb . $text]} ]} {
set data(selection) $data(finalColor)
return
}
set R [expr {[lindex $color 0]/0x100}]
set G [expr {[lindex $color 1]/0x100}]
set B [expr {[lindex $color 2]/0x100}]
SetRGBValue $w "$R $G $B"
set data(selection) $text
}
# ::tk::dialog::color::HandleRGBEntry --
#
# Handles the return keypress event in the R, G or B entry
#
proc ::tk::dialog::color::HandleRGBEntry {w} {
upvar ::tk::dialog::color::[winfo name $w] data
foreach c {red green blue} {
if {[catch {
set data($c,intensity) [expr {int($data($c,intensity))}]
}]} {
set data($c,intensity) 0
}
if {$data($c,intensity) < 0} {
set data($c,intensity) 0
}
if {$data($c,intensity) > 255} {
set data($c,intensity) 255
}
}
SetRGBValue $w "$data(red,intensity) \
$data(green,intensity) $data(blue,intensity)"
}
# mouse cursor enters a color bar
#
proc ::tk::dialog::color::EnterColorBar {w color} {
upvar ::tk::dialog::color::[winfo name $w] data
$data($color,sel) itemconfigure $data($color,index) -fill red
}
# mouse leaves enters a color bar
#
proc ::tk::dialog::color::LeaveColorBar {w color} {
upvar ::tk::dialog::color::[winfo name $w] data
$data($color,sel) itemconfigure $data($color,index) -fill black
}
# user hits OK button
#
proc ::tk::dialog::color::OkCmd {w} {
variable ::tk::Priv
upvar ::tk::dialog::color::[winfo name $w] data
set Priv(selectColor) $data(finalColor)
}
# user hits Cancel button or destroys window
#
proc ::tk::dialog::color::CancelCmd {w} {
variable ::tk::Priv
set Priv(selectColor) ""
}

319
windowsAgent/dist/tk/comdlg.tcl vendored Normal file
View File

@ -0,0 +1,319 @@
# comdlg.tcl --
#
# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# tclParseConfigSpec --
#
# Parses a list of "-option value" pairs. If all options and
# values are legal, the values are stored in
# $data($option). Otherwise an error message is returned. When
# an error happens, the data() array may have been partially
# modified, but all the modified members of the data(0 array are
# guaranteed to have valid values. This is different than
# Tk_ConfigureWidget() which does not modify the value of a
# widget record if any error occurs.
#
# Arguments:
#
# w = widget record to modify. Must be the pathname of a widget.
#
# specs = {
# {-commandlineswitch resourceName ResourceClass defaultValue verifier}
# {....}
# }
#
# flags = currently unused.
#
# argList = The list of "-option value" pairs.
#
proc tclParseConfigSpec {w specs flags argList} {
upvar #0 $w data
# 1: Put the specs in associative arrays for faster access
#
foreach spec $specs {
if {[llength $spec] < 4} {
return -code error -errorcode {TK VALUE CONFIG_SPEC} \
"\"spec\" should contain 5 or 4 elements"
}
set cmdsw [lindex $spec 0]
set cmd($cmdsw) ""
set rname($cmdsw) [lindex $spec 1]
set rclass($cmdsw) [lindex $spec 2]
set def($cmdsw) [lindex $spec 3]
set verproc($cmdsw) [lindex $spec 4]
}
if {[llength $argList] & 1} {
set cmdsw [lindex $argList end]
if {![info exists cmd($cmdsw)]} {
return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \
"bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
return -code error -errorcode {TK VALUE_MISSING} \
"value for \"$cmdsw\" missing"
}
# 2: set the default values
#
foreach cmdsw [array names cmd] {
set data($cmdsw) $def($cmdsw)
}
# 3: parse the argument list
#
foreach {cmdsw value} $argList {
if {![info exists cmd($cmdsw)]} {
return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \
"bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
set data($cmdsw) $value
}
# Done!
}
proc tclListValidFlags {v} {
upvar $v cmd
set len [llength [array names cmd]]
set i 1
set separator ""
set errormsg ""
foreach cmdsw [lsort [array names cmd]] {
append errormsg "$separator$cmdsw"
incr i
if {$i == $len} {
set separator ", or "
} else {
set separator ", "
}
}
return $errormsg
}
#----------------------------------------------------------------------
#
# Focus Group
#
# Focus groups are used to handle the user's focusing actions inside a
# toplevel.
#
# One example of using focus groups is: when the user focuses on an
# entry, the text in the entry is highlighted and the cursor is put to
# the end of the text. When the user changes focus to another widget,
# the text in the previously focused entry is validated.
#
#----------------------------------------------------------------------
# ::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 ::tk::FocusGroup_Create {t} {
variable ::tk::Priv
if {[winfo toplevel $t] ne $t} {
return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \
"$t is not a toplevel window"
}
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]
}
}
# ::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 ::tk::FocusGroup_BindIn {t w cmd} {
variable FocusIn
variable ::tk::Priv
if {![info exists Priv(fg,$t)]} {
return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
"focus group \"$t\" doesn't exist"
}
set FocusIn($t,$w) $cmd
}
# ::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 ::tk::FocusGroup_BindOut {t w cmd} {
variable FocusOut
variable ::tk::Priv
if {![info exists Priv(fg,$t)]} {
return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
"focus group \"$t\" doesn't exist"
}
set FocusOut($t,$w) $cmd
}
# ::tk::FocusGroup_Destroy --
#
# Cleans up when members of the focus group is deleted, or when the
# toplevel itself gets deleted.
#
proc ::tk::FocusGroup_Destroy {t w} {
variable FocusIn
variable FocusOut
variable ::tk::Priv
if {$t eq $w} {
unset Priv(fg,$t)
unset Priv(focus,$t)
foreach name [array names FocusIn $t,*] {
unset FocusIn($name)
}
foreach name [array names FocusOut $t,*] {
unset FocusOut($name)
}
} else {
if {[info exists Priv(focus,$t)] && ($Priv(focus,$t) eq $w)} {
set Priv(focus,$t) ""
}
unset -nocomplain FocusIn($t,$w) FocusOut($t,$w)
}
}
# ::tk::FocusGroup_In --
#
# Handles the <FocusIn> event. Calls the FocusIn command for the newly
# focused widget in the focus group.
#
proc ::tk::FocusGroup_In {t w detail} {
variable FocusIn
variable ::tk::Priv
if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
# This is caused by mouse moving out&in of the window *or*
# ordinary keypresses some window managers (ie: CDE [Bug: 2960]).
return
}
if {![info exists FocusIn($t,$w)]} {
set FocusIn($t,$w) ""
return
}
if {![info exists Priv(focus,$t)]} {
return
}
if {$Priv(focus,$t) eq $w} {
# This is already in focus
#
return
} else {
set Priv(focus,$t) $w
eval $FocusIn($t,$w)
}
}
# ::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 ::tk::FocusGroup_Out {t w detail} {
variable FocusOut
variable ::tk::Priv
if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
# This is caused by mouse moving out of the window
return
}
if {![info exists Priv(focus,$t)]} {
return
}
if {![info exists FocusOut($t,$w)]} {
return
} else {
eval $FocusOut($t,$w)
set Priv(focus,$t) ""
}
}
# ::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 ::tk::FDGetFileTypes {string} {
foreach t $string {
if {[llength $t] < 2 || [llength $t] > 3} {
return -code error -errorcode {TK VALUE FILE_TYPE} \
"bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
}
lappend fileTypes([lindex $t 0]) {*}[lindex $t 1]
}
set types {}
foreach t $string {
set label [lindex $t 0]
set exts {}
if {[info exists hasDoneType($label)]} {
continue
}
# Validate each macType. This is to agree with the
# behaviour of TkGetFileFilters(). This list may be
# empty.
foreach macType [lindex $t 2] {
if {[string length $macType] != 4} {
return -code error -errorcode {TK VALUE MAC_TYPE} \
"bad Macintosh file type \"$macType\""
}
}
set name "$label \("
set sep ""
set doAppend 1
foreach ext $fileTypes($label) {
if {$ext eq ""} {
continue
}
regsub {^[.]} $ext "*." ext
if {![info exists hasGotExt($label,$ext)]} {
if {$doAppend} {
if {[string length $sep] && [string length $name]>40} {
set doAppend 0
append name $sep...
} else {
append name $sep$ext
}
}
lappend exts $ext
set hasGotExt($label,$ext) 1
}
set sep ","
}
append name "\)"
lappend types [list $name $exts]
set hasDoneType($label) 1
}
return $types
}

1150
windowsAgent/dist/tk/console.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

180
windowsAgent/dist/tk/dialog.tcl vendored Normal file
View File

@ -0,0 +1,180 @@
# dialog.tcl --
#
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# ::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
# dialog somehow gets destroyed, -1 is returned.
#
# Arguments:
# w - Window to use for dialog top-level.
# title - Title to display in dialog's decorative frame.
# text - Message to display in dialog.
# bitmap - Bitmap to display in dialog (empty string means none).
# default - Index of button that is to display the default ring
# (-1 means none).
# 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} {
variable ::tk::Priv
# Check that $default was properly given
if {[string is integer -strict $default]} {
if {$default >= [llength $args]} {
return -code error -errorcode {TK DIALOG BAD_DEFAULT} \
"default button index greater than number of buttons\
specified for tk_dialog"
}
} elseif {"" eq $default} {
set default -1
} else {
set default [lsearch -exact $args $default]
}
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
option add *Dialog*background systemDialogBackgroundActive widgetDefault
option add *Dialog*Button.highlightBackground \
systemDialogBackgroundActive widgetDefault
}
# 1. Create the top-level window and divide it into top
# and bottom parts.
destroy $w
toplevel $w -class Dialog
wm title $w $title
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW { }
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
#
if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
wm transient $w [winfo toplevel [winfo parent $w]]
}
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
} elseif {$windowingsystem eq "x11"} {
wm attributes $w -type dialog
}
frame $w.bot
frame $w.top
if {$windowingsystem eq "x11"} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
pack $w.bot -side bottom -fill both
pack $w.top -side top -fill both -expand 1
grid anchor $w.bot center
# 2. Fill the top part with bitmap and message (use the option
# database for -wraplength and -font so that they can be
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
option add *Dialog.msg.font TkCaptionFont widgetDefault
label $w.msg -justify left -text $text
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
if {$bitmap ne ""} {
if {$windowingsystem eq "aqua" && $bitmap eq "error"} {
set bitmap "stop"
}
label $w.bitmap -bitmap $bitmap
pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
}
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach but $args {
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 -pady 4
grid columnconfigure $w.bot $i
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
set tmp [string tolower $but]
if {$tmp eq "ok" || $tmp eq "cancel"} {
grid columnconfigure $w.bot $i -minsize 90
}
grid configure $w.button$i -pady 7
}
incr i
}
# 4. Create a binding for <Return> on the dialog if there is a
# default button.
# Convention also dictates that if the keyboard focus moves among the
# the buttons that the <Return> binding affects the button with the focus.
if {$default >= 0} {
bind $w <Return> [list $w.button$default invoke]
}
bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}]
bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}]
# 5. Create a <Destroy> binding for the window that sets the
# 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 ::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
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w
tkwait visibility $w
# 7. Set a grab and claim the focus too.
if {$default >= 0} {
set focus $w.button$default
} else {
set focus $w
}
tk::SetFocusGrab $w $focus
# 8. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(button)
catch {
# It's possible that the window has already been destroyed,
# hence this "catch". Delete the Destroy handler so that
# Priv(button) doesn't get reset by it.
bind $w <Destroy> {}
}
tk::RestoreFocusGrab $w $focus
return $Priv(button)
}

654
windowsAgent/dist/tk/entry.tcl vendored Normal file
View File

@ -0,0 +1,654 @@
# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# 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
# command to be executed.
# mouseMoved - Non-zero means the mouse has moved a significant
# amount since the button went down (so, for example,
# start dragging out a selection).
# pressX - X-coordinate at which the mouse button was pressed.
# selectMode - The style of selection currently underway:
# char, word, or line.
# x, y - Last known mouse coordinates for scanning
# and auto-scanning.
# data - Used for Cut and Copy
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
bind Entry <<Cut>> {
if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
%W delete sel.first sel.last
unset tk::Priv(data)
}
}
bind Entry <<Copy>> {
if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
unset tk::Priv(data)
}
}
bind Entry <<Paste>> {
catch {
if {[tk windowingsystem] ne "x11"} {
catch {
%W delete sel.first sel.last
}
}
%W insert insert [::tk::GetSelection %W CLIPBOARD]
tk::EntrySeeInsert %W
}
}
bind Entry <<Clear>> {
# ignore if there is no selection
catch { %W delete sel.first sel.last }
}
bind Entry <<PasteSelection>> {
if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
|| !$tk::Priv(mouseMoved)} {
tk::EntryPaste %W %x
}
}
bind Entry <<TraverseIn>> {
%W selection range 0 end
%W icursor end
}
# Standard Motif bindings:
bind Entry <1> {
tk::EntryButton1 %W %x
%W selection clear
}
bind Entry <B1-Motion> {
set tk::Priv(x) %x
tk::EntryMouseSelect %W %x
}
bind Entry <Double-1> {
set tk::Priv(selectMode) word
tk::EntryMouseSelect %W %x
catch {%W icursor sel.last}
}
bind Entry <Triple-1> {
set tk::Priv(selectMode) line
tk::EntryMouseSelect %W %x
catch {%W icursor sel.last}
}
bind Entry <Shift-1> {
set tk::Priv(selectMode) char
%W selection adjust @%x
}
bind Entry <Double-Shift-1> {
set tk::Priv(selectMode) word
tk::EntryMouseSelect %W %x
}
bind Entry <Triple-Shift-1> {
set tk::Priv(selectMode) line
tk::EntryMouseSelect %W %x
}
bind Entry <B1-Leave> {
set tk::Priv(x) %x
tk::EntryAutoScan %W
}
bind Entry <B1-Enter> {
tk::CancelRepeat
}
bind Entry <ButtonRelease-1> {
tk::CancelRepeat
}
bind Entry <Control-1> {
%W icursor @%x
}
bind Entry <<PrevChar>> {
tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
}
bind Entry <<NextChar>> {
tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
}
bind Entry <<SelectPrevChar>> {
tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
tk::EntrySeeInsert %W
}
bind Entry <<SelectNextChar>> {
tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
tk::EntrySeeInsert %W
}
bind Entry <<PrevWord>> {
tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
}
bind Entry <<NextWord>> {
tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
}
bind Entry <<SelectPrevWord>> {
tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
tk::EntrySeeInsert %W
}
bind Entry <<SelectNextWord>> {
tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
tk::EntrySeeInsert %W
}
bind Entry <<LineStart>> {
tk::EntrySetCursor %W 0
}
bind Entry <<SelectLineStart>> {
tk::EntryKeySelect %W 0
tk::EntrySeeInsert %W
}
bind Entry <<LineEnd>> {
tk::EntrySetCursor %W end
}
bind Entry <<SelectLineEnd>> {
tk::EntryKeySelect %W end
tk::EntrySeeInsert %W
}
bind Entry <Delete> {
if {[%W selection present]} {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind Entry <BackSpace> {
tk::EntryBackspace %W
}
bind Entry <Control-space> {
%W selection from insert
}
bind Entry <Select> {
%W selection from insert
}
bind Entry <Control-Shift-space> {
%W selection adjust insert
}
bind Entry <Shift-Select> {
%W selection adjust insert
}
bind Entry <<SelectAll>> {
%W selection range 0 end
}
bind Entry <<SelectNone>> {
%W selection clear
}
bind Entry <KeyPress> {
tk::CancelRepeat
tk::EntryInsert %W %A
}
# 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, Return, and Tab.
bind Entry <Alt-KeyPress> {# nothing}
bind Entry <Meta-KeyPress> {# nothing}
bind Entry <Control-KeyPress> {# nothing}
bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
bind Entry <Prior> {# nothing}
bind Entry <Next> {# nothing}
if {[tk windowingsystem] eq "aqua"} {
bind Entry <Command-KeyPress> {# nothing}
}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind Entry <<NextLine>> {# nothing}
bind Entry <<PrevLine>> {# nothing}
# On Windows, paste is done using Shift-Insert. Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[tk windowingsystem] ne "win32"} {
bind Entry <Insert> {
catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
}
}
# Additional emacs-like bindings:
bind Entry <Control-d> {
if {!$tk_strictMotif} {
%W delete insert
}
}
bind Entry <Control-h> {
if {!$tk_strictMotif} {
tk::EntryBackspace %W
}
}
bind Entry <Control-k> {
if {!$tk_strictMotif} {
%W delete insert end
}
}
bind Entry <Control-t> {
if {!$tk_strictMotif} {
tk::EntryTranspose %W
}
}
bind Entry <Meta-b> {
if {!$tk_strictMotif} {
tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
}
}
bind Entry <Meta-d> {
if {!$tk_strictMotif} {
%W delete insert [tk::EntryNextWord %W insert]
}
}
bind Entry <Meta-f> {
if {!$tk_strictMotif} {
tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
}
}
bind Entry <Meta-BackSpace> {
if {!$tk_strictMotif} {
%W delete [tk::EntryPreviousWord %W insert] insert
}
}
bind Entry <Meta-Delete> {
if {!$tk_strictMotif} {
%W delete [tk::EntryPreviousWord %W insert] insert
}
}
# A few additional bindings of my own.
bind Entry <2> {
if {!$tk_strictMotif} {
::tk::EntryScanMark %W %x
}
}
bind Entry <B2-Motion> {
if {!$tk_strictMotif} {
::tk::EntryScanDrag %W %x
}
}
# ::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.
#
# Arguments:
# w - The entry window.
# x - X-coordinate within the window.
proc ::tk::EntryClosestGap {w x} {
set pos [$w index @$x]
set bbox [$w bbox $pos]
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
return $pos
}
incr pos
}
# ::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.
#
# Arguments:
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the button press.
proc ::tk::EntryButton1 {w x} {
variable ::tk::Priv
set Priv(selectMode) char
set Priv(mouseMoved) 0
set Priv(pressX) $x
$w icursor [EntryClosestGap $w $x]
$w selection from insert
if {"disabled" ne [$w cget -state]} {
focus $w
}
}
# ::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
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the mouse.
proc ::tk::EntryMouseSelect {w x} {
variable ::tk::Priv
set cur [EntryClosestGap $w $x]
set anchor [$w index anchor]
if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
set Priv(mouseMoved) 1
}
switch $Priv(selectMode) {
char {
if {$Priv(mouseMoved)} {
if {$cur < $anchor} {
$w selection range $cur $anchor
} elseif {$cur > $anchor} {
$w selection range $anchor $cur
} else {
$w selection clear
}
}
}
word {
if {$cur < $anchor} {
set before [tcl_wordBreakBefore [$w get] $cur]
set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
} elseif {$cur > $anchor} {
set before [tcl_wordBreakBefore [$w get] $anchor]
set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
} else {
if {[$w index @$Priv(pressX)] < $anchor} {
incr anchor -1
}
set before [tcl_wordBreakBefore [$w get] $anchor]
set after [tcl_wordBreakAfter [$w get] $anchor]
}
if {$before < 0} {
set before 0
}
if {$after < 0} {
set after end
}
$w selection range $before $after
}
line {
$w selection range 0 end
}
}
if {$Priv(mouseMoved)} {
$w icursor $cur
}
update idletasks
}
# ::tk::EntryPaste --
# This procedure sets the insertion cursor to the current mouse position,
# pastes the selection there, and sets the focus to the window.
#
# Arguments:
# w - The entry window.
# x - X position of the mouse.
proc ::tk::EntryPaste {w x} {
$w icursor [EntryClosestGap $w $x]
catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
if {"disabled" ne [$w cget -state]} {
focus $w
}
}
# ::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
# "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 entry window.
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
EntryMouseSelect $w $x
} elseif {$x < 0} {
$w xview scroll -2 units
EntryMouseSelect $w $x
}
set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
}
# ::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.
#
# Arguments:
# w - The entry window.
# new - A new position for the insertion cursor (the cursor hasn't
# actually been moved to this position yet).
proc ::tk::EntryKeySelect {w new} {
if {![$w selection present]} {
$w selection from insert
$w selection to $new
} else {
$w selection adjust $new
}
$w icursor $new
}
# ::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.
#
# Arguments:
# w - The entry window in which to insert the string
# s - The string to insert (usually just a single character)
proc ::tk::EntryInsert {w s} {
if {$s eq ""} {
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
EntrySeeInsert $w
}
# ::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.
#
# Arguments:
# w - The entry window in which to backspace.
proc ::tk::EntryBackspace 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::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 ::tk::EntrySeeInsert w {
set c [$w index insert]
if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
$w xview $c
}
}
# ::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.
#
# Arguments:
# w - The entry window.
# pos - The desired new position for the cursor in the window.
proc ::tk::EntrySetCursor {w pos} {
$w icursor $pos
$w selection clear
EntrySeeInsert $w
}
# ::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
# 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 entry window.
proc ::tk::EntryTranspose 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
EntrySeeInsert $w
}
# ::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
# end-of-word position.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
if {[tk windowingsystem] eq "win32"} {
proc ::tk::EntryNextWord {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::EntryNextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos < 0} {
return end
}
return $pos
}
}
# ::tk::EntryPreviousWord --
#
# Returns the index of the previous word position before a given
# position in the entry.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
proc ::tk::EntryPreviousWord {w start} {
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0
}
return $pos
}
# ::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 ::tk::EntryGetSelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
[expr {[$w index sel.last] - 1}]]
if {[$w cget -show] ne ""} {
return [string repeat [string index [$w cget -show] 0] \
[string length $entryString]]
}
return $entryString
}

178
windowsAgent/dist/tk/focus.tcl vendored Normal file
View File

@ -0,0 +1,178 @@
# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ::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
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings. The "-takefocus" options
# on windows determine whether or not they should be skipped.
#
# Arguments:
# w - Name of a window.
proc ::tk_focusNext w {
set cur $w
while {1} {
# Descend to just before the first child of the current widget.
set parent $cur
set children [winfo children $cur]
set i -1
# Look for the next sibling that isn't a top-level.
while {1} {
incr i
if {$i < [llength $children]} {
set cur [lindex $children $i]
if {[winfo toplevel $cur] eq $cur} {
continue
} else {
break
}
}
# No more siblings, so go to the current widget's parent.
# If it's a top-level, break out of the loop, otherwise
# look for its next sibling.
set cur $parent
if {[winfo toplevel $cur] eq $cur} {
break
}
set parent [winfo parent $parent]
set children [winfo children $parent]
set i [lsearch -exact $children $cur]
}
if {$w eq $cur || [tk::FocusOK $cur]} {
return $cur
}
}
}
# ::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
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings. The "-takefocus" options
# on windows determine whether or not they should be skipped.
#
# Arguments:
# w - Name of a window.
proc ::tk_focusPrev w {
set cur $w
while {1} {
# Collect information about the current window's position
# among its siblings. Also, if the window is a top-level,
# then reposition to just after the last child of the window.
if {[winfo toplevel $cur] eq $cur} {
set parent $cur
set children [winfo children $cur]
set i [llength $children]
} else {
set parent [winfo parent $cur]
set children [winfo children $parent]
set i [lsearch -exact $children $cur]
}
# Go to the previous sibling, then descend to its last descendant
# (highest in stacking order. While doing this, ignore top-levels
# and their descendants. When we run out of descendants, go up
# one level to the parent.
while {$i > 0} {
incr i -1
set cur [lindex $children $i]
if {[winfo toplevel $cur] eq $cur} {
continue
}
set parent $cur
set children [winfo children $parent]
set i [llength $children]
}
set cur $parent
if {$w eq $cur || [tk::FocusOK $cur]} {
return $cur
}
}
}
# ::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,
# 0 if it's not OK. The code first checks whether the window is
# viewable. If not, then it never focuses on the window. Then it
# checks the -takefocus option for the window and uses it if it's
# set. If there's no -takefocus option, the procedure checks to
# see if (a) the widget isn't disabled, and (b) it has some key
# bindings. If all of these are true, then 1 is returned.
#
# Arguments:
# w - Name of a window.
proc ::tk::FocusOK w {
set code [catch {$w cget -takefocus} value]
if {($code == 0) && ($value ne "")} {
if {$value == 0} {
return 0
} elseif {$value == 1} {
return [winfo viewable $w]
} else {
set value [uplevel #0 $value [list $w]]
if {$value ne ""} {
return $value
}
}
}
if {![winfo viewable $w]} {
return 0
}
set code [catch {$w cget -state} value]
if {($code == 0) && $value eq "disabled"} {
return 0
}
regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}
# ::tk_focusFollowsMouse --
#
# If this procedure is invoked, Tk will enter "focus-follows-mouse"
# mode, where the focus is always on whatever window contains the
# mouse. If this procedure isn't invoked, then the user typically
# has to click on a window to give it the focus.
#
# Arguments:
# None.
proc ::tk_focusFollowsMouse {} {
set old [bind all <Enter>]
set script {
if {"%d" eq "NotifyAncestor" || "%d" eq "NotifyNonlinear" \
|| "%d" eq "NotifyInferior"} {
if {[tk::FocusOK %W]} {
focus %W
}
}
}
if {$old ne ""} {
bind all <Enter> "$old; $script"
} else {
bind all <Enter> $script
}
}

452
windowsAgent/dist/tk/fontchooser.tcl vendored Normal file
View File

@ -0,0 +1,452 @@
# fontchooser.tcl -
#
# A themeable Tk font selection dialog. See TIP #324.
#
# Copyright (C) 2008 Keith Vetter
# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
namespace eval ::tk::fontchooser {
variable S
set S(W) .__tk__fontchooser
set S(fonts) [lsort -dictionary [font families]]
set S(styles) [list \
[::msgcat::mc "Regular"] \
[::msgcat::mc "Italic"] \
[::msgcat::mc "Bold"] \
[::msgcat::mc "Bold Italic"] \
]
set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72}
set S(strike) 0
set S(under) 0
set S(first) 1
set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
set S(-parent) .
set S(-title) [::msgcat::mc "Font"]
set S(-command) ""
set S(-font) TkDefaultFont
}
proc ::tk::fontchooser::Setup {} {
variable S
# Canonical versions of font families, styles, etc. for easier searching
set S(fonts,lcase) {}
foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]}
set S(styles,lcase) {}
foreach style $S(styles) { lappend S(styles,lcase) [string tolower $style]}
set S(sizes,lcase) $S(sizes)
::ttk::style layout FontchooserFrame {
Entry.field -sticky news -border true -children {
FontchooserFrame.padding -sticky news
}
}
bind [winfo class .] <<ThemeChanged>> \
[list +ttk::style layout FontchooserFrame \
[ttk::style layout FontchooserFrame]]
namespace ensemble create -map {
show ::tk::fontchooser::Show
hide ::tk::fontchooser::Hide
configure ::tk::fontchooser::Configure
}
}
::tk::fontchooser::Setup
proc ::tk::fontchooser::Show {} {
variable S
if {![winfo exists $S(W)]} {
Create
wm transient $S(W) [winfo toplevel $S(-parent)]
tk::PlaceWindow $S(W) widget $S(-parent)
}
set S(fonts) [lsort -dictionary [font families]]
set S(fonts,lcase) {}
foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]}
wm deiconify $S(W)
}
proc ::tk::fontchooser::Hide {} {
variable S
wm withdraw $S(W)
}
proc ::tk::fontchooser::Configure {args} {
variable S
set specs {
{-parent "" "" . }
{-title "" "" ""}
{-font "" "" ""}
{-command "" "" ""}
}
if {[llength $args] == 0} {
set result {}
foreach spec $specs {
foreach {name xx yy default} $spec break
lappend result $name \
[expr {[info exists S($name)] ? $S($name) : $default}]
}
lappend result -visible \
[expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
return $result
}
if {[llength $args] == 1} {
set option [lindex $args 0]
if {[string equal $option "-visible"]} {
return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
} elseif {[info exists S($option)]} {
return $S($option)
}
return -code error -errorcode [list TK LOOKUP OPTION $option] \
"bad option \"$option\": must be\
-command, -font, -parent, -title or -visible"
}
set cache [dict create -parent $S(-parent) -title $S(-title) \
-font $S(-font) -command $S(-command)]
set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args]
if {![winfo exists $S(-parent)]} {
set code [list TK LOOKUP WINDOW $S(-parent)]
set err "bad window path name \"$S(-parent)\""
array set S $cache
return -code error -errorcode $code $err
}
if {[string trim $S(-title)] eq ""} {
set S(-title) [::msgcat::mc "Font"]
}
if {[winfo exists $S(W)] && [lsearch $args -font] != -1} {
Init $S(-font)
event generate $S(-parent) <<TkFontchooserFontChanged>>
}
return $r
}
proc ::tk::fontchooser::Create {} {
variable S
set windowName __tk__fontchooser
if {$S(-parent) eq "."} {
set S(W) .$windowName
} else {
set S(W) $S(-parent).$windowName
}
# Now build the dialog
if {![winfo exists $S(W)]} {
toplevel $S(W) -class TkFontDialog
if {[package provide tcltest] ne {}} {set ::tk_dialog $S(W)}
wm withdraw $S(W)
wm title $S(W) $S(-title)
wm transient $S(W) [winfo toplevel $S(-parent)]
set outer [::ttk::frame $S(W).outer -padding {10 10}]
::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"]
::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"]
::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"]
ttk::entry $S(W).efont -width 18 \
-textvariable [namespace which -variable S](font)
ttk::entry $S(W).estyle -width 10 \
-textvariable [namespace which -variable S](style)
ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \
-width 3 -validate key -validatecommand {string is double %P}
ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \
-selectmode browse -activestyle none \
-listvariable [namespace which -variable S](fonts)
ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \
-selectmode browse -activestyle none \
-listvariable [namespace which -variable S](styles)
ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \
-selectmode browse -activestyle none \
-listvariable [namespace which -variable S](sizes)
set WE $S(W).effects
::ttk::labelframe $WE -text [::msgcat::mc "Effects"]
::tk::AmpWidget ::ttk::checkbutton $WE.strike \
-variable [namespace which -variable S](strike) \
-text [::msgcat::mc "Stri&keout"] \
-command [namespace code [list Click strike]]
::tk::AmpWidget ::ttk::checkbutton $WE.under \
-variable [namespace which -variable S](under) \
-text [::msgcat::mc "&Underline"] \
-command [namespace code [list Click under]]
set bbox [::ttk::frame $S(W).bbox]
::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\
-command [namespace code [list Done 1]]
::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \
-command [namespace code [list Done 0]]
::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \
-command [namespace code [list Apply]]
wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]]
# Calculate minimum sizes
ttk::scrollbar $S(W).tmpvs
set scroll_width [winfo reqwidth $S(W).tmpvs]
destroy $S(W).tmpvs
set minsize(gap) 10
set minsize(bbox) [winfo reqwidth $S(W).ok]
set minsize(fonts) \
[expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}]
set minsize(styles) \
[expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}]
set minsize(sizes) \
[expr {[font measure TkDefaultFont "-99"] + $scroll_width}]
set min [expr {$minsize(gap) * 4}]
foreach {what width} [array get minsize] { incr min $width }
wm minsize $S(W) $min 260
bind $S(W) <Return> [namespace code [list Done 1]]
bind $S(W) <Escape> [namespace code [list Done 0]]
bind $S(W) <Map> [namespace code [list Visibility %W 1]]
bind $S(W) <Unmap> [namespace code [list Visibility %W 0]]
bind $S(W) <Destroy> [namespace code [list Visibility %W 0]]
bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]]
bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]]
bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]]
bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A]
bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont]
bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle]
bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize]
bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]]
bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke]
bind $WE.under <<AltUnderlined>> [list $WE.under invoke]
set WS $S(W).sample
::ttk::labelframe $WS -text [::msgcat::mc "Sample"]
::ttk::label $WS.sample -relief sunken -anchor center \
-textvariable [namespace which -variable S](sampletext)
set S(sample) $WS.sample
grid $WS.sample -sticky news -padx 6 -pady 4
grid rowconfigure $WS 0 -weight 1
grid columnconfigure $WS 0 -weight 1
grid propagate $WS 0
grid $S(W).ok -in $bbox -sticky new -pady {0 2}
grid $S(W).cancel -in $bbox -sticky new -pady 2
if {$S(-command) ne ""} {
grid $S(W).apply -in $bbox -sticky new -pady 2
}
grid columnconfigure $bbox 0 -weight 1
grid $WE.strike -sticky w -padx 10
grid $WE.under -sticky w -padx 10 -pady {0 30}
grid columnconfigure $WE 1 -weight 1
grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w
grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew
grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news
grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30}
grid configure $bbox -sticky n
grid columnconfigure $outer {1 3 5} -minsize $minsize(gap)
grid columnconfigure $outer {0 2 4} -weight 1
grid columnconfigure $outer 0 -minsize $minsize(fonts)
grid columnconfigure $outer 2 -minsize $minsize(styles)
grid columnconfigure $outer 4 -minsize $minsize(sizes)
grid columnconfigure $outer 6 -minsize $minsize(bbox)
grid $outer -sticky news
grid rowconfigure $S(W) 0 -weight 1
grid columnconfigure $S(W) 0 -weight 1
Init $S(-font)
trace add variable [namespace which -variable S](size) \
write [namespace code [list Tracer]]
trace add variable [namespace which -variable S](style) \
write [namespace code [list Tracer]]
trace add variable [namespace which -variable S](font) \
write [namespace code [list Tracer]]
} else {
Init $S(-font)
}
return
}
# ::tk::fontchooser::Done --
#
# Handles teardown of the dialog, calling -command if needed
#
# Arguments:
# ok true if user pressed OK
#
proc ::tk::::fontchooser::Done {ok} {
variable S
if {! $ok} {
set S(result) ""
}
trace vdelete S(size) w [namespace code [list Tracer]]
trace vdelete S(style) w [namespace code [list Tracer]]
trace vdelete S(font) w [namespace code [list Tracer]]
destroy $S(W)
if {$ok && $S(-command) ne ""} {
uplevel #0 $S(-command) [list $S(result)]
}
}
# ::tk::fontchooser::Apply --
#
# Call the -command procedure appending the current font
# Errors are reported via the background error mechanism
#
proc ::tk::fontchooser::Apply {} {
variable S
if {$S(-command) ne ""} {
if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} {
::bgerror $err
}
}
event generate $S(-parent) <<TkFontchooserFontChanged>>
}
# ::tk::fontchooser::Init --
#
# Initializes dialog to a default font
#
# Arguments:
# defaultFont font to use as the default
#
proc ::tk::fontchooser::Init {{defaultFont ""}} {
variable S
if {$S(first) || $defaultFont ne ""} {
if {$defaultFont eq ""} {
set defaultFont [[entry .___e] cget -font]
destroy .___e
}
array set F [font actual $defaultFont]
set S(font) $F(-family)
set S(size) $F(-size)
set S(strike) $F(-overstrike)
set S(under) $F(-underline)
set S(style) "Regular"
if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} {
set S(style) "Bold Italic"
} elseif {$F(-weight) eq "bold"} {
set S(style) "Bold"
} elseif {$F(-slant) eq "italic"} {
set S(style) "Italic"
}
set S(first) 0
}
Tracer a b c
Update
}
# ::tk::fontchooser::Click --
#
# Handles all button clicks, updating the appropriate widgets
#
# Arguments:
# who which widget got pressed
#
proc ::tk::fontchooser::Click {who} {
variable S
if {$who eq "font"} {
set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]]
} elseif {$who eq "style"} {
set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]]
} elseif {$who eq "size"} {
set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]]
}
Update
}
# ::tk::fontchooser::Tracer --
#
# Handles traces on key variables, updating the appropriate widgets
#
# Arguments:
# standard trace arguments (not used)
#
proc ::tk::fontchooser::Tracer {var1 var2 op} {
variable S
set bad 0
set nstate normal
# Make selection in each listbox
foreach var {font style size} {
set value [string tolower $S($var)]
$S(W).l${var}s selection clear 0 end
set n [lsearch -exact $S(${var}s,lcase) $value]
$S(W).l${var}s selection set $n
if {$n != -1} {
set S($var) [lindex $S(${var}s) $n]
$S(W).e$var icursor end
$S(W).e$var selection clear
} else { ;# No match, try prefix
# Size is weird: valid numbers are legal but don't display
# unless in the font size list
set n [lsearch -glob $S(${var}s,lcase) "$value*"]
set bad 1
if {$var ne "size" || ! [string is double -strict $value]} {
set nstate disabled
}
}
$S(W).l${var}s see $n
}
if {!$bad} { Update }
$S(W).ok configure -state $nstate
}
# ::tk::fontchooser::Update --
#
# Shows a sample of the currently selected font
#
proc ::tk::fontchooser::Update {} {
variable S
set S(result) [list $S(font) $S(size)]
if {$S(style) eq "Bold"} { lappend S(result) bold }
if {$S(style) eq "Italic"} { lappend S(result) italic }
if {$S(style) eq "Bold Italic"} { lappend S(result) bold italic}
if {$S(strike)} { lappend S(result) overstrike}
if {$S(under)} { lappend S(result) underline}
$S(sample) configure -font $S(result)
}
# ::tk::fontchooser::Visibility --
#
# Notify the parent when the dialog visibility changes
#
proc ::tk::fontchooser::Visibility {w visible} {
variable S
if {$w eq $S(W)} {
event generate $S(-parent) <<TkFontchooserVisibility>>
}
}
# ::tk::fontchooser::ttk_listbox --
#
# Create a properly themed scrolled listbox.
# This is exactly right on XP but may need adjusting on other platforms.
#
proc ::tk::fontchooser::ttk_slistbox {w args} {
set f [ttk::frame $w -style FontchooserFrame -padding 2]
if {[catch {
listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args
ttk::scrollbar $f.vs -command [list $f.list yview]
$f.list configure -yscrollcommand [list $f.vs set]
grid $f.list $f.vs -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
interp hide {} $w
interp alias {} $w {} $f.list
} err opt]} {
destroy $f
return -options $opt $err
}
return $w
}

696
windowsAgent/dist/tk/iconlist.tcl vendored Normal file
View File

@ -0,0 +1,696 @@
# iconlist.tcl
#
# Implements the icon-list megawidget used in the "Tk" standard file
# selection dialog boxes.
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
# Copyright (c) 2009 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# API Summary:
# tk::IconList <path> ?<option> <value>? ...
# <path> add <imageName> <itemList>
# <path> cget <option>
# <path> configure ?<option>? ?<value>? ...
# <path> deleteall
# <path> destroy
# <path> get <itemIndex>
# <path> index <index>
# <path> invoke
# <path> see <index>
# <path> selection anchor ?<int>?
# <path> selection clear <first> ?<last>?
# <path> selection get
# <path> selection includes <item>
# <path> selection set <first> ?<last>?
package require Tk 8.6
::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget {
variable w canvas sbar accel accelCB fill font index \
itemList itemsPerColumn list maxIH maxIW maxTH maxTW noScroll \
numItems oldX oldY options rect selected selection textList
constructor args {
next {*}$args
set accelCB {}
}
destructor {
my Reset
next
}
method GetSpecs {} {
concat [next] {
{-command "" "" ""}
{-font "" "" "TkIconFont"}
{-multiple "" "" "0"}
}
}
# ----------------------------------------------------------------------
method index i {
if {![info exist list]} {
set list {}
}
switch -regexp -- $i {
"^-?[0-9]+$" {
if {$i < 0} {
set i 0
}
if {$i >= [llength $list]} {
set i [expr {[llength $list] - 1}]
}
return $i
}
"^anchor$" {
return $index(anchor)
}
"^end$" {
return [llength $list]
}
"@-?[0-9]+,-?[0-9]+" {
scan $i "@%d,%d" x y
set item [$canvas find closest \
[$canvas canvasx $x] [$canvas canvasy $y]]
return [lindex [$canvas itemcget $item -tags] 1]
}
}
}
method selection {op args} {
switch -exact -- $op {
anchor {
if {[llength $args] == 1} {
set index(anchor) [$w index [lindex $args 0]]
} else {
return $index(anchor)
}
}
clear {
switch [llength $args] {
2 {
lassign $args first last
}
1 {
set first [set last [lindex $args 0]]
}
default {
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be\
\"[lrange [info level 0] 0 1] first ?last?\""
}
}
set first [$w index $first]
set last [$w index $last]
if {$first > $last} {
set tmp $first
set first $last
set last $tmp
}
set ind 0
foreach item $selection {
if {$item >= $first} {
set first $ind
break
}
incr ind
}
set ind [expr {[llength $selection] - 1}]
for {} {$ind >= 0} {incr ind -1} {
set item [lindex $selection $ind]
if {$item <= $last} {
set last $ind
break
}
}
if {$first > $last} {
return
}
set selection [lreplace $selection $first $last]
event generate $w <<ListboxSelect>>
my DrawSelection
}
get {
return $selection
}
includes {
return [expr {[lindex $args 0] in $selection}]
}
set {
switch [llength $args] {
2 {
lassign $args first last
}
1 {
set first [set last [lindex $args 0]]
}
default {
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be\
\"[lrange [info level 0] 0 1] first ?last?\""
}
}
set first [$w index $first]
set last [$w index $last]
if {$first > $last} {
set tmp $first
set first $last
set last $tmp
}
for {set i $first} {$i <= $last} {incr i} {
lappend selection $i
}
set selection [lsort -integer -unique $selection]
event generate $w <<ListboxSelect>>
my DrawSelection
}
}
}
method get item {
set rTag [lindex $list $item 2]
lassign $itemList($rTag) iTag tTag text serial
return $text
}
# Deletes all the items inside the canvas subwidget and reset the
# iconList's state.
#
method deleteall {} {
$canvas delete all
unset -nocomplain selected rect list itemList
set maxIW 1
set maxIH 1
set maxTW 1
set maxTH 1
set numItems 0
set noScroll 1
set selection {}
set index(anchor) ""
$sbar set 0.0 1.0
$canvas xview moveto 0
}
# Adds an icon into the IconList with the designated image and text
#
method add {image items} {
foreach text $items {
set iID item$numItems
set iTag [$canvas create image 0 0 -image $image -anchor nw \
-tags [list icon $numItems $iID]]
set tTag [$canvas create text 0 0 -text $text -anchor nw \
-font $options(-font) -fill $fill \
-tags [list text $numItems $iID]]
set rTag [$canvas create rect 0 0 0 0 -fill "" -outline "" \
-tags [list rect $numItems $iID]]
lassign [$canvas bbox $iTag] x1 y1 x2 y2
set iW [expr {$x2 - $x1}]
set iH [expr {$y2 - $y1}]
if {$maxIW < $iW} {
set maxIW $iW
}
if {$maxIH < $iH} {
set maxIH $iH
}
lassign [$canvas bbox $tTag] x1 y1 x2 y2
set tW [expr {$x2 - $x1}]
set tH [expr {$y2 - $y1}]
if {$maxTW < $tW} {
set maxTW $tW
}
if {$maxTH < $tH} {
set maxTH $tH
}
lappend list [list $iTag $tTag $rTag $iW $iH $tW $tH $numItems]
set itemList($rTag) [list $iTag $tTag $text $numItems]
set textList($numItems) [string tolower $text]
incr numItems
}
my WhenIdle Arrange
return
}
# Gets called when the user invokes the IconList (usually by
# double-clicking or pressing the Return key).
#
method invoke {} {
if {$options(-command) ne "" && [llength $selection]} {
uplevel #0 $options(-command)
}
}
# If the item is not (completely) visible, scroll the canvas so that it
# becomes visible.
#
method see rTag {
if {$noScroll} {
return
}
set sRegion [$canvas cget -scrollregion]
if {$sRegion eq ""} {
return
}
if {$rTag < 0 || $rTag >= [llength $list]} {
return
}
set bbox [$canvas bbox item$rTag]
set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}]
set x1 [lindex $bbox 0]
set x2 [lindex $bbox 2]
incr x1 [expr {$pad * -2}]
incr x2 [expr {$pad * -1}]
set cW [expr {[winfo width $canvas] - $pad*2}]
set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}]
set oldDispX $dispX
# check if out of the right edge
#
if {($x2 - $dispX) >= $cW} {
set dispX [expr {$x2 - $cW}]
}
# check if out of the left edge
#
if {($x1 - $dispX) < 0} {
set dispX $x1
}
if {$oldDispX ne $dispX} {
set fraction [expr {double($dispX) / double($scrollW)}]
$canvas xview moveto $fraction
}
}
# ----------------------------------------------------------------------
# Places the icons in a column-major arrangement.
#
method Arrange {} {
if {![info exists list]} {
if {[info exists canvas] && [winfo exists $canvas]} {
set noScroll 1
$sbar configure -command ""
}
return
}
set W [winfo width $canvas]
set H [winfo height $canvas]
set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}]
if {$pad < 2} {
set pad 2
}
incr W [expr {$pad*-2}]
incr H [expr {$pad*-2}]
set dx [expr {$maxIW + $maxTW + 8}]
if {$maxTH > $maxIH} {
set dy $maxTH
} else {
set dy $maxIH
}
incr dy 2
set shift [expr {$maxIW + 4}]
set x [expr {$pad * 2}]
set y [expr {$pad * 1}] ; # Why * 1 ?
set usedColumn 0
foreach sublist $list {
set usedColumn 1
lassign $sublist iTag tTag rTag iW iH tW tH
set i_dy [expr {($dy - $iH)/2}]
set t_dy [expr {($dy - $tH)/2}]
$canvas coords $iTag $x [expr {$y + $i_dy}]
$canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
$canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
incr y $dy
if {($y + $dy) > $H} {
set y [expr {$pad * 1}] ; # *1 ?
incr x $dx
set usedColumn 0
}
}
if {$usedColumn} {
set sW [expr {$x + $dx}]
} else {
set sW $x
}
if {$sW < $W} {
$canvas configure -scrollregion [list $pad $pad $sW $H]
$sbar configure -command ""
$canvas xview moveto 0
set noScroll 1
} else {
$canvas configure -scrollregion [list $pad $pad $sW $H]
$sbar configure -command [list $canvas xview]
set noScroll 0
}
set itemsPerColumn [expr {($H-$pad) / $dy}]
if {$itemsPerColumn < 1} {
set itemsPerColumn 1
}
my DrawSelection
}
method DrawSelection {} {
$canvas delete selection
$canvas itemconfigure selectionText -fill black
$canvas dtag selectionText
set cbg [ttk::style lookup TEntry -selectbackground focus]
set cfg [ttk::style lookup TEntry -selectforeground focus]
foreach item $selection {
set rTag [lindex $list $item 2]
foreach {iTag tTag text serial} $itemList($rTag) {
break
}
set bbox [$canvas bbox $tTag]
$canvas create rect $bbox -fill $cbg -outline $cbg \
-tags selection
$canvas itemconfigure $tTag -fill $cfg -tags selectionText
}
$canvas lower selection
return
}
# Creates an IconList widget by assembling a canvas widget and a
# scrollbar widget. Sets all the bindings necessary for the IconList's
# operations.
#
method Create {} {
variable hull
set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0]
catch {$sbar configure -highlightthickness 0}
set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \
-width 400 -height 120 -background white]
pack $sbar -side bottom -fill x -padx 2 -pady {0 2}
pack $canvas -expand yes -fill both -padx 2 -pady {2 0}
$sbar configure -command [list $canvas xview]
$canvas configure -xscrollcommand [list $sbar set]
# Initializes the max icon/text width and height and other variables
#
set maxIW 1
set maxIH 1
set maxTW 1
set maxTH 1
set numItems 0
set noScroll 1
set selection {}
set index(anchor) ""
set fg [option get $canvas foreground Foreground]
if {$fg eq ""} {
set fill black
} else {
set fill $fg
}
# Creates the event bindings.
#
bind $canvas <Configure> [namespace code {my WhenIdle Arrange}]
bind $canvas <1> [namespace code {my Btn1 %x %y}]
bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}]
bind $canvas <B1-Leave> [namespace code {my Leave1 %x %y}]
bind $canvas <Control-1> [namespace code {my CtrlBtn1 %x %y}]
bind $canvas <Shift-1> [namespace code {my ShiftBtn1 %x %y}]
bind $canvas <B1-Enter> [list tk::CancelRepeat]
bind $canvas <ButtonRelease-1> [list tk::CancelRepeat]
bind $canvas <Double-ButtonRelease-1> \
[namespace code {my Double1 %x %y}]
bind $canvas <Control-B1-Motion> {;}
bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}]
bind $canvas <<PrevLine>> [namespace code {my UpDown -1}]
bind $canvas <<NextLine>> [namespace code {my UpDown 1}]
bind $canvas <<PrevChar>> [namespace code {my LeftRight -1}]
bind $canvas <<NextChar>> [namespace code {my LeftRight 1}]
bind $canvas <Return> [namespace code {my ReturnKey}]
bind $canvas <KeyPress> [namespace code {my KeyPress %A}]
bind $canvas <Control-KeyPress> ";"
bind $canvas <Alt-KeyPress> ";"
bind $canvas <FocusIn> [namespace code {my FocusIn}]
bind $canvas <FocusOut> [namespace code {my FocusOut}]
return $w
}
# 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 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.
#
method AutoScan {} {
if {![winfo exists $w]} return
set x $oldX
set y $oldY
if {$noScroll} {
return
}
if {$x >= [winfo width $canvas]} {
$canvas xview scroll 1 units
} elseif {$x < 0} {
$canvas xview scroll -1 units
} elseif {$y >= [winfo height $canvas]} {
# do nothing
} elseif {$y < 0} {
# do nothing
} else {
return
}
my Motion1 $x $y
set ::tk::Priv(afterId) [after 50 [namespace code {my AutoScan}]]
}
# ----------------------------------------------------------------------
# Event handlers
method Btn1 {x y} {
focus $canvas
set i [$w index @$x,$y]
if {$i eq ""} {
return
}
$w selection clear 0 end
$w selection set $i
$w selection anchor $i
}
method CtrlBtn1 {x y} {
if {$options(-multiple)} {
focus $canvas
set i [$w index @$x,$y]
if {$i eq ""} {
return
}
if {[$w selection includes $i]} {
$w selection clear $i
} else {
$w selection set $i
$w selection anchor $i
}
}
}
method ShiftBtn1 {x y} {
if {$options(-multiple)} {
focus $canvas
set i [$w index @$x,$y]
if {$i eq ""} {
return
}
if {[$w index anchor] eq ""} {
$w selection anchor $i
}
$w selection clear 0 end
$w selection set anchor $i
}
}
# Gets called on button-1 motions
#
method Motion1 {x y} {
set oldX $x
set oldY $y
set i [$w index @$x,$y]
if {$i eq ""} {
return
}
$w selection clear 0 end
$w selection set $i
}
method ShiftMotion1 {x y} {
set oldX $x
set oldY $y
set i [$w index @$x,$y]
if {$i eq ""} {
return
}
$w selection clear 0 end
$w selection set anchor $i
}
method Double1 {x y} {
if {[llength $selection]} {
$w invoke
}
}
method ReturnKey {} {
$w invoke
}
method Leave1 {x y} {
set oldX $x
set oldY $y
my AutoScan
}
method FocusIn {} {
$w state focus
if {![info exists list]} {
return
}
if {[llength $selection]} {
my DrawSelection
}
}
method FocusOut {} {
$w state !focus
$w selection clear 0 end
}
# Moves the active element up or down by one element
#
# Arguments:
# amount - +1 to move down one item, -1 to move back one item.
#
method UpDown amount {
if {![info exists list]} {
return
}
set curr [$w selection get]
if {[llength $curr] == 0} {
set i 0
} else {
set i [$w index anchor]
if {$i eq ""} {
return
}
incr i $amount
}
$w selection clear 0 end
$w selection set $i
$w selection anchor $i
$w see $i
}
# Moves the active element left or right by one column
#
# Arguments:
# amount - +1 to move right one column, -1 to move left one
# column
#
method LeftRight amount {
if {![info exists list]} {
return
}
set curr [$w selection get]
if {[llength $curr] == 0} {
set i 0
} else {
set i [$w index anchor]
if {$i eq ""} {
return
}
incr i [expr {$amount * $itemsPerColumn}]
}
$w selection clear 0 end
$w selection set $i
$w selection anchor $i
$w see $i
}
# Gets called when user enters an arbitrary key in the listbox.
#
method KeyPress key {
append accel $key
my Goto $accel
after cancel $accelCB
set accelCB [after 500 [namespace code {my Reset}]]
}
method Goto text {
if {![info exists list]} {
return
}
if {$text eq "" || $numItems == 0} {
return
}
if {[llength [$w selection get]]} {
set start [$w index anchor]
} else {
set start 0
}
set theIndex -1
set less 0
set len [string length $text]
set len0 [expr {$len - 1}]
set i $start
# Search forward until we find a filename whose prefix is a
# case-insensitive match with $text
while {1} {
if {[string equal -nocase -length $len0 $textList($i) $text]} {
set theIndex $i
break
}
incr i
if {$i == $numItems} {
set i 0
}
if {$i == $start} {
break
}
}
if {$theIndex > -1} {
$w selection clear 0 end
$w selection set $theIndex
$w selection anchor $theIndex
$w see $theIndex
}
}
method Reset {} {
unset -nocomplain accel
}
}
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:

153
windowsAgent/dist/tk/icons.tcl vendored Normal file
View File

@ -0,0 +1,153 @@
# icons.tcl --
#
# A set of stock icons for use in Tk dialogs. The icons used here
# were provided by the Tango Desktop project which provides a
# unified set of high quality icons licensed under the
# Creative Commons Attribution Share-Alike license
# (http://creativecommons.org/licenses/by-sa/3.0/)
#
# See http://tango.freedesktop.org/Tango_Desktop_Project
#
# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::icons {}
image create photo ::tk::icons::warning -data {
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABSZJREFU
WIXll1toVEcYgL+Zc87u2Yu7MYmrWRuTJuvdiMuqiJd4yYKXgMQKVkSjFR80kFIVJfWCWlvpg4h9
8sXGWGof8iKNICYSo6JgkCBEJRG8ImYThNrNxmaTeM7pQ5IlJkabi0/9YZhhZv7///4z/8zPgf+7
KCNRLgdlJijXwRyuDTlcxV9hbzv8nQmxMjg+XDtiOEplkG9PSfkztGmTgmFQd+FCVzwa3fYN/PHZ
AcpBaReicW5xcbb64IEQqko8Lc26d/58cxS+/BY6hmJvyEfQBoUpwWCmW1FErKaGWHU13uRk4QkE
UtxQNFR7QwIoB4eiKD9PWbVKbb10CZmaCqmpxCormRYO26QQx85B0mcD+AeK0xYvHqu1tNDx+DH6
gQM4jh0j3tCA3tGBLyfHLuD7zwJwAcYqun44sHy51nr5MsqsWWj5+djCYdS5c4ldvUr24sU2qarf
lUL6qAN0wqH0vDy7+fAhXZEI+v79CNmt7igpofPVK5SmJvyhkJBwYlQBSiHd7vUWZ86bp8WqqtCW
LkVbuBAhBEIItGAQ2+rVxG7cICMY1KTDsekc5IwagIQTmStXis47dzBiMfR9+xCi+wb39s79+zFi
MczGRjLmzTMlnBoVgLMwyzF+/Cb/lClq2/Xr2AoKUKdPxzAMWltbiUajmKaJkpGBY8sW3tbW4g8E
VNXrXVEKK0YMoMKp7Px8K15Tg2VZOHbvBiASiRAMBgkGg0QiEYQQOIuLsRSFrnv3yJo/HxVOW594
7D4KUAa57qysvNSUFOVtbS32rVuRfj9CCFwuV2Kfy+VCCIFMScFVVET7/fukJidLm883rQy+HhaA
BUII8cvUNWt4W1WFcLvRd+5MnHl/AOjOB+eOHchx44jX1ZEdCqkSTpaDbcgA5+GrpNmzc9ymKdvr
67Hv2oVMSko4cjgcKIqCoijoup64EdLpxLV3Lx1PnuCVUrgmTfK9hV1DAjgKqlSUk1PCYdl25QrS
70cvLEw4SWS+04nT6XxvXgiBc8MGtKlTaa+rIysnR1Ok/OF38PxngAzY4VuwYKL99WvR8fQpjj17
kLqeiL6393g8eDyeAWBSVfEcOkRXczOOaBRvVpZuDPJEDwD4DVyKrv+UlZurxSorUWfMQC8oGOBc
CDHgC/Rdc4TD2BctIl5fT+bkyTahaXvOw8RPApiwd2Ju7hjZ2EhXSwvOkhKQcoADgIqKCioqKgYc
QW9LOnIEIxZDbWpiXCCABT9+FKAUxtm83pKMUEiLVVejLVqEtmTJB50LIdi2bRuFPbnRd7232efM
wbVuHR2PHjHR77dJXS8sg5mDAihweFJenmrevYvR1oazpGTQ6IQQaJqG7ClI/dd655IOHsSyLMSL
F6QFAib9nugEQClk2Xy+orTsbK3t1i3sa9ei5eQMGr0QgvLyci5evDiocyEEtsxMPNu30/nsGRO8
XlVzu8NlkNvrV+0T/fHMZcusrtu3MeNx9PXrobUVq8cYQrw3TrRub1h9+v573Bs3Ej1zBvP5c/zp
6dbLhoaTwPy+ANKCfF92thq7dg2A6JYt/fNlxGK8eUNSerryHEJHQT8K8V4A5ztojty8OeaLzZul
1DSwLCzDANPEMozusWFgmWZ33288YK3/nGlixuM0v3xpWfDX0Z4i1VupXEWwIgRnJfhGPfQ+YsLr
+7DzNFwCuvqWyiRg7DSYoIBu9smPkYqEd4AwIN4ITUAL0A4Da7UC6ICdEfy2fUBMoAvo7GnWKNoe
mfwLcAuinuFNL7QAAAAASUVORK5CYII=
}
image create photo ::tk::icons::error -data {
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABiRJREFU
WIXFl11sHFcVgL97Z/bX693sbtd2ipOqCU7sQKukFYUigQgv/a+hoZGoqipvfQKpAsEDD0hIvCHE
j/pQ3sIDUdOiIqUyqXioEFSUhqit7cRJFJpEruxs1mt77Z3d2Z259/KwM5vZXTtOERJXOrozZ+6e
852fuXcW/s9D3O3Cs1Bow1Nx234BKQ9qpYpK6yFLSseScsVoveApdUrAzNOw9j8DOAMTtmX9RsM3
SqOjevcXDqUzu8dI5AvEc8O0axu4q6s4yzdZvnCxUSmXLWHMXzxjXpmGq/81wGmIZ6T8NXDi8w8d
id//+GPS8j1YWQXHgVYbfA/sGCRiMDQExTzKtvn3zDv6k9m5FsacXNT6+y+D95kAZqCEEO/cMzIy
9eBLLybjyodrN6DpDqw1/dfpFNw3TtuSfPz7P7irlZUL2pjHn4GVuwJ4G/JCiLl9U1OjB58/ZnP5
Mqxv3NGpMWZAz64cHNzHlTf/5N9YuHzTMeaLx6HW78+K3pwGKynEu/snJycOHPuWzdw81BuDUQZO
dfQ+MmvAuC1MdY3i178izUo15VZXj07DyTf6OGX0Jivlz0vFwgMTz3/bNnMXO0ZCo8b0iIk4C0WF
zsP1TRc1e4l9x56N5YuFwxkpf9afgW4J/gi7M1IuHH3lezm5uAQbmwOpjc79ujArA2uMgWwGMz7K
P377u/WW1pPTUB7IQFrKXx44NJWRbQ9d2+hGqbeRMEoTZEQFJdERfVgmvVFH+D57Jw9k4lL+YqAE
pyGnjZm+95knLHVjcVvHA6WIPgtLE+hVH4i6vsS9T3zTVsY8NwPZHoAUPFUs5JVQCt1q9zqORKm3
iLKrF6IjkfSHOiUlqu0hhCSXHdYePNYDEBPiu6MT+zOquo6JGNGhESkxUnYNmkCnLQtjWRgpMRG9
CtZ3JdD7axsU9+3N2EK8EALYQcNMpvfuQTcaXUMIAa+/Hi0Xgs9weASjefx4p5mFQDdbpD63G/HR
hakeAA2l+EgJU652iIMMyO2sRoYxBq1191oIgZQSITqooT0A7fnEirswUAp/LwG0MZlYIY9WqpPa
IHU7Da01Sqluo4UQSil830dr3emVsBeMIZbLoI0Z7gGQQtTbjoOOxW/XewcApVQ38jsBNs6fx6tW
O70Si+GWKwghNsM1NoCAW81KJTeUjKNbrR2N7uS4B7TRwJ+fR6TTxO4fxzUeAio9AMCl+tVrE0NH
DmM2nU4DAu6JE53UGoNfLuNdv45xnO4OF/ZKz+4X2T179I6D5To0NupouNgD4Btzqjx/8WjpS0cy
PU1Tr6MqFfylpc4bss1W26/rBwyfybECtcvXNrUxp3oAXJjZ2Kxb7cVP8P61gDGgWy2M624Z5d1E
3wNkDDKdwMQkjtuygbMhgAQ4DjUhxFvL/5z15X1jeLUaynW7p1u484WiuL3V9m/NoV6F50Ogjx3Y
Q/mDBV8a3piGzR4AAFfrHy4vlesmm0bks7edRQ6aAafcPoZVH2AUXOYzkI5TvbVa9+FHREYX4Bgs
I8RrV9/9oJF4eBKTjO8YvdoCJgqujcGkEqQemmDxb7OOFOLV6FHcAwBQ1/onTtOd/fTvH3rJRx/A
pBIDqd0q+p5sRaInnWDoywdZem+u7bbaH9W1/il9Y2Brfwt22TBfKOVHxr92JOacv4S/UuttuC06
PKoHsEs5hg7vZ/m9eW+zWltuwoNbfRNuebacgXsEnE2lkof2Hn04ZRouzQvXUU5z29cwFGs4TWpy
HJGK8+lfP256bnuuDU8+B9WtfG17uL0GsTF4VQrxYn60kBh55JDEbdG6uYq/7qDdFtpTELOQyQRW
Lk1sLI+MW9w6d8Wv3Vrz2nDyJPzgDDS287MVgAAywBCQ+Q5MTsOPs/BIMpVQ2bFCKlnMYg+nsYeS
eE6TVq1Be3WD9ZtrTc9tWetw7k341dtwBagDTmTeESAdAAxH5z0w9iQ8ehi+moWxBGRsiPvguVBf
h8qH8P6f4dxSp9PrdN73cN6k859R3U0J0nS+28JMpIM5FUgCiNP5X2ECox7gAk06KQ8ldLzZ7/xO
ANHnscBhCkgGjuOB3gb8CEAbaAWO3UA34DQ6/gPnmhBFs5mqXAAAAABJRU5ErkJggg==
}
image create photo ::tk::icons::information -data {
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gUdFDM4pWaDogAABwNJREFUWMPFlltsVNcVhv+199ln
bh7PjAdfMGNDcA04EKMkJlIsBVJVbRqlEVUrqyW0QAtFTVWpjVpFfamUF6K+tCTKQyXn0jaiShOr
bRqRoHJpEEoIEBucENuk2OViPB5f5j5zrvuc3YcMFQ8FPBFVj7S0paN91v+tf1/OAv7PD9UzeeCp
p0KRCrYyHtymoPrgySYAANdyBBr2Peu1agP+NrR/v3nHAb6/52d7wfivWlet11NdvZG21laEwzo0
RvA9F4uLi7h08bxxaWLUVp78xSsv/XrwjgAMDDyjRxPWUGOy5Uu9/VsjEA3I5KvIVQ240gHIh9CA
5YkwelIJRATw94NvGpnpK0fL+eDA0NAzzq3ya7cDjCbsoWWr1j+y4f4vB/41Z8JTeaxqE7hndSNi
EeELzn3LkapQdfzJTE5JV/GBb28LHz327lcnzp4ZAvB1AOpmAvyWtv/g6R9GW1c+uf6Bx0Kfzpjo
TmnYtDaKtkTAj4aEFBqTnJPUOfciIeG3N4XVQtmyzl/JuY8/fH9wOjO/smvVmuy5s+8P1w2wa9dP
46SLN3sf2ha7uiixaU0Qna06NA6PMXIZQRJBMiIXRBKABygv3hBQV+bK1dmcoR7d3Bc5c/pk/8YN
fYOjo6es/6bDbgbAdLa9uXNj2PYF2pOEloQGAiRIuUTkME42J7IZweYES+NkckZWWNfseEPAKJtO
oWxLu69/c5jpbPtNdW7qPwvsbO1cF8pVLKxs0+HD94gpl0AOQTlEsDkjizFmMk4WESyNM4NzMgOC
VYI6q17OlIp9992ngek769+EvtfVEI3jWqaKgAgAIAlFLuOwGZHDiTnElGQgF4DvM1LKV7Bdz2NE
xaCuhQpVm1Y0p5qhvNV1AyjlRTWhwVM2TMdzgkJzieAQyGGMbMZgfwZBEiBPA3xX+VSouAvBAFeM
yDddD7rgpHw/WjcAMa0EZScZk5heqFrxiO4BzCGCzYgsBrI4I5sYcxlBKl/5WdOdd6S0gxoLEZEi
Iq4AnzGq1r0HiPhYuZRFU1R3FgqWkS1aZQA2gWzOyGQcJudkaAwVR3qz8yXzvCXlzJoViaagrlWC
jJnLm8Jarli2GNMm6wbwPPO31y6Ollc2N3pcI+fyYjW/8a5EKqQTz5WtdLHsTi1W7Im5vDlcMdxx
wVk2Ys9/pTI3+WhAaIauM+MLbYnlH46MVKVyX6v7Hhg9e2ps3doN32ld0Rlrb1nmmK4stCdCSCUj
Le1NwW6uXJ08m/t2OarBXh0ie0syHu0plKtTFGw8n4o33q1z1XngD7+X3C/uHBkZces7hoAi1946
fPSvtpDlYFdLPDI8mR03HC87frXwFpgqLYuFuzrbkg8m49EeDsqDa+cizXcNpppia5ui+sYXnn+O
29LbOTg4aHzun9GOPT/pDemhf3xzx25DicjkiqaAIs4zhumMRUJaPhzgJZ0LQ5C7gXjQL1kS0YD+
o337nhWlYvHJV178zZ9vlZ/dDuDVl57/2HWt755894hINoYSmZx11TYKCUZKCs4cnQuDmGtfvDiR
dD3n04aA6J4YHzeLhfLg7cSXBAAA5NPpufS1WFjwkFSelZ6ZLWfn0kliTDJdue8dO9qenp2d1DVR
4cTarlyZJgV5dim5lwTw8sv7c1L6H89cm6FlDcHVhlOJffThsa9d+ud72y5+cnTn2PjJJ1avjOoE
SnBiPadOfRDTGT5YSm5tqR2R7Zp7//L6gRPf27NjVaolqS9MCzh28W6mgDXdKxCNRb/oOlV18O3D
1xzXGXpx8LnZO94Tbt/x+MFYouexh7dsQU/PWjRGI+BcAyMgm1vAO28fxvj4xOX5jL7u0KEX7Dvq
AAC0Nucf2rLZhq8Y3njjT8gulOBKDw0NAQjNQT435eQWL3iHDk3YS81ZF0B6psI/GbuAXbu+gQf7
H4ArPeQWC5jLZKCUhQvjWb2QD3bVk5PVM9nz5LML8waOH38fekBHIhFDqqMFXd0pnDhxGmMTU3Bd
9/X/GQDntO/eezswMPBjaFwAABxH4sKFq+jt7cX6ni6EQuJbdeWsZ3J3d/PTmqaEYUyhXDZBTEOh
WIIQwOi5jzA1eRnZXPFSPO7/bmbGlLfqhus5BVotRH9/x7rGxtBeIQJPACrMOYNSPpRiUIpnlTIO
nzmT+eX8fLH8WZMKF4Csje7ncUAHEKhFcHq6ZE5OZoc7O3tlc3N33+7dP9c2bXoE09NlO52uHDhy
ZOTVatUWte+otsTXg2pQSwagG6r/jwsAQul0erqjo+OesbGx1tHRUT+fz48dP378j57neQD8mtB1
B1TtnV9zo64loJqoXhtFDUQHEGhvb2/2fZ9nMpliTcAFYNdC1sIBYN1sCeq5Ca9bqtWcu9Fe3FDl
9Uqvu3HLjfhvTUo85WzjhogAAAAASUVORK5CYII=
}
image create photo ::tk::icons::question -data {
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAACG5JREFU
WIXFl3twVdUVxn97n3Nubm7euZcghEdeBBICEQUFIgVECqIo1uJMp3WodqyjMzpjZ7TTh20cK31N
/2jL2FYdKXaqRcbnDKGpoBFaAY1BHgHMgyRKQkJy87yv3Nyzd/84594k1RlppzPumTXn3Dl3r/Wd
b31rrbPhS17iSv+4bl2t2ZFhrRGI7QKxRkMAyHEfjwgYEOgjNnpfcXjiSENDbeL/AqBoW22uGE/7
MYL7yubN4MYVpVkrquaKqwJZ+LPTARgcjdIbHKOx+aI+9EH7WGvnZdA8q9PGf9b5eu3w/wygaPPO
h6Uhntxcsyj9/q+vtMrnBa6Is7ZPgzzzyvGJ/YfPRpWWj3fWff93/xWAonW1Xu3z/nVx6cxNTz74
1YzK4gIQjuN/nfyEEx9fIjgaYXAkhhAQyE3Hn5PBsvJZrF46l5I5+QB83NnP40+/FT7d1ltPOPrN
zoba2BcCWLy91hMOp72/bX1VxU/u3+BJ91i0fhrkuTcaaTzbjTQkhpQIIZBSIBApL1prtNYsryhk
xy1XUzonn1g8wVPPvh1/5dDpcz5f7LrmfbXxqfGM6eG1yCw+9uq2G6tW7nxoU5plGrzecJYnnnub
SwMhTNPAmmKmYWCaBoYpMQyJaRhIQ3IpGOKt4+1k+dKoLJ7BjStKjb6hcN7JloFrhlsO7oUnPh9A
8Rbvo6uuLrr3N4/ckm4Ykt/vPcqe/R9hGAamaWJZbnDL+W2axqRJA8NlxzAkAI3newhF4lxbMZs1
y4rNM+19c0PZ++NDLQff+0wKCu/Y6c/UVsubv/12/ryZubxUf5Ln3vgQ0zKnvK1kadkMlpQUUFEU
oCDPR25WOuPxBH2DYZpa+qg/3kEoGsdWCttWJGzF3ZuXcuf6Ci5eHmXrw7sHR4mXd7/2w+A0Bvyl
N+265/bl19+8eqE8c6GPn+85jGkYWC4Ay3Luf/3AV1g038+MXB8+rwfDkKR5TPKyvCyan8+qqtmc
au8nFrcdnQCn2vuoLptJSWEeE7bynDjdXTDUcvBNAAmweF1tpmXKu+65bYWh0Ty97zhSyGkUO0BM
hBAI4RAXTyjiCYWUEukKMz/Ly/b1C7EsE49lYlkmhjTYvf8jNHD3lmsM0zTuWryuNhPABIj4vFvW
Xl0s87PTOdXWS8snQTwec4ro3DSYBglbcfx8P+8199I7FMEQgg3L53N7TWkKXOV8Px7LJCFtXKx0
dA9zrnOAyqIAa68tkQePtm4BXpaO9vWOm65b4EPAkY+6HDEZTt4NN/dJML946QSv/fMCA6PjpHks
LI/F2a5BtNYpMUtJirGpLL7f3A3AxpXlPiHFjhQDaJZVlc0EoPWT4DQ1m8ZkKizTJDRuY1mmC04i
pWDNksJUD9Bac7E/jGUZrmuN1qCU5sKlIQAqSwrQWi+bBCDwF+RnAk5fl27wqeYAkZM9wLWaxVex
qnJmKritFO+e7sMyDdBOc1JKYxiSkdA4CMGM3Aw02j+VAfLcwTIWibuiEpNApJMSw208ydJcu3QW
axZPCW7bHGjspmcwimkYTmAlMWzHTyTmDMiczLRU/ctkNxgajboPvUghppuUGFJMY6O6OJ/ViwIo
pVBKYds2dR9e4uPuMbc7Tm9MUgqyM70AjITHUy1IAghNsH8oDEAgz4cQOIqWjkkpEC4rSYfXL/Sn
giulONYyRFd/1GXKAZxkUrgvkp/tAAgORxAQnAQg5InmC5cBWDgv4NS5EAhAINzyIlVmUgiy040U
9Uop2voiKYakEAiRvDp7EYKS2XkAnOvsR0h5IqUBrfWeQ8fb1t2xvtJXs3QuB462TfZokbxMGZxC
8If6DtI8Fh6PhcdjojSpBuXin7Kc3csXzQLgrWOtEWWrPSkAvkis7kjTBTU8FqOypIAF8/x09Y6Q
FGjyTdHJstLsWDsnNZIBXj7Wj1LKYSS5B412nRTNymHBnHxGQ+O8836r8kVidakUNDfUhhIJtfcv
dU22AO69dRlCCNeZU8fJe6U0ylZYBlgGmNKx+ESCiYRNwlYoWzn/UxqtHOB3ra8AAX/7x0nbttXe
5oba0GQVAPGE9dju1z4Y7u4fY9F8P9/YWOUEV06O7eTVnXBTBaiUIj4xwcSETSJhk7BtbNtOPdta
U0ZpYS59wRB/2ndsOBa3HkvGTU3D0fb6aE7ZBt3RM1yzuabcqiwKEI5N0N495ChaSKcihJPRa0pz
sbUmYTugPmgbJmErB4DLxETC5oYlhWxdXUrCVvxgV32krav/qa4Djx76D4kllxalt/7q9e2bqjf9
9Lsb0oQQHGrsYO+hc0gp3emW/Bhxm5NbZlqD0g79CTcFt60u4YYlhWhg5/MN4y/WNdW3vfnoNhD6
Mww46wlmV9/w6snzA1sHRqKBVUvnGQvm+qkuKyA4GqVvKOJAdrcn8zz14yNh2ywozOVbGyuoKg4w
PmHzyxcOx1+sazqTlhbZ3H92vT29Pj5nzVn1SLqVH3ipunzOxqceutlX6n7lXrw8yqn2flq7hxgL
TzAWiyOFICfTS44vjbLCXKqK/cwOOHOl49IwP9r192hT84V3e4+9cF90sC0IRL8QAOADsgvXfu9B
b3bgkTs3LPN+52srzPlX5V7RUerTy6M8/0Zj4uUDH45Hg13PdB/9425gzLUhQH0RgDQgC8hKLyid
7a/c9oCV4d9WVTpLbF5TmX5tRaGYkecjJ8MLAkZD4wyMRGg636PrDjfHzrT26NhYT33w1Kt/Hh/u
6XUDh4BBIHwlDIBTohlANpBhWb6s7PKNK30FCzZa6dnVYORoIX2OExVF26Px8NCZSN/5d0bb3mlK
JGIhHLpDwLAL4jPnxSs9nBqABXhddrw4XdRygSrABuKuxYBx9/6KDqlf2vo3PYe56vmkuwMAAAAA
SUVORK5CYII=
}

7
windowsAgent/dist/tk/images/README vendored Normal file
View File

@ -0,0 +1,7 @@
README - images directory
This directory includes images for the Tcl Logo and the Tcl Powered
Logo. Please feel free to use the Tcl Powered Logo on any of your
products that employ the use of Tcl or Tk. The Tcl logo may also be
used to promote Tcl in your product documentation, web site or other
places you so desire.

2091
windowsAgent/dist/tk/images/logo.eps vendored Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
windowsAgent/dist/tk/images/logo100.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.3 KiB

BIN
windowsAgent/dist/tk/images/logo64.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
windowsAgent/dist/tk/images/logoLarge.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 11 KiB

BIN
windowsAgent/dist/tk/images/logoMed.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.8 KiB

1897
windowsAgent/dist/tk/images/pwrdLogo.eps vendored Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
windowsAgent/dist/tk/images/pwrdLogo100.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
windowsAgent/dist/tk/images/pwrdLogo150.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.4 KiB

BIN
windowsAgent/dist/tk/images/pwrdLogo175.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.9 KiB

BIN
windowsAgent/dist/tk/images/pwrdLogo200.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.4 KiB

BIN
windowsAgent/dist/tk/images/pwrdLogo75.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
windowsAgent/dist/tk/images/tai-ku.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.3 KiB

40
windowsAgent/dist/tk/license.terms vendored Normal file
View File

@ -0,0 +1,40 @@
This software is copyrighted by the Regents of the University of
California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
Corporation, Apple Inc. and other parties. The following terms apply to
all files associated with the software unless explicitly disclaimed in
individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.
GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (b) (3) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.

552
windowsAgent/dist/tk/listbox.tcl vendored Normal file
View File

@ -0,0 +1,552 @@
# listbox.tcl --
#
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#--------------------------------------------------------------------------
# tk::Priv elements used in this file:
#
# afterId - Token returned by "after" for autoscanning.
# listboxPrev - The last element to be selected or deselected
# during a selection operation.
# listboxSelection - All of the items that were selected before the
# current selection operation (such as a mouse
# drag) started; used to cancel an operation.
#--------------------------------------------------------------------------
#-------------------------------------------------------------------------
# The code below creates the default class bindings for listboxes.
#-------------------------------------------------------------------------
# Note: the check for existence of %W below is because this binding
# is sometimes invoked after a window has been deleted (e.g. because
# there is a double-click binding on the widget that deletes it). Users
# can put "break"s in their bindings to avoid the error, but this check
# makes that unnecessary.
bind Listbox <1> {
if {[winfo exists %W]} {
tk::ListboxBeginSelect %W [%W index @%x,%y] 1
}
}
# Ignore double clicks so that users can define their own behaviors.
# Among other things, this prevents errors if the user deletes the
# listbox on a double click.
bind Listbox <Double-1> {
# Empty script
}
bind Listbox <B1-Motion> {
set tk::Priv(x) %x
set tk::Priv(y) %y
tk::ListboxMotion %W [%W index @%x,%y]
}
bind Listbox <ButtonRelease-1> {
tk::CancelRepeat
%W activate @%x,%y
}
bind Listbox <Shift-1> {
tk::ListboxBeginExtend %W [%W index @%x,%y]
}
bind Listbox <Control-1> {
tk::ListboxBeginToggle %W [%W index @%x,%y]
}
bind Listbox <B1-Leave> {
set tk::Priv(x) %x
set tk::Priv(y) %y
tk::ListboxAutoScan %W
}
bind Listbox <B1-Enter> {
tk::CancelRepeat
}
bind Listbox <<PrevLine>> {
tk::ListboxUpDown %W -1
}
bind Listbox <<SelectPrevLine>> {
tk::ListboxExtendUpDown %W -1
}
bind Listbox <<NextLine>> {
tk::ListboxUpDown %W 1
}
bind Listbox <<SelectNextLine>> {
tk::ListboxExtendUpDown %W 1
}
bind Listbox <<PrevChar>> {
%W xview scroll -1 units
}
bind Listbox <<PrevWord>> {
%W xview scroll -1 pages
}
bind Listbox <<NextChar>> {
%W xview scroll 1 units
}
bind Listbox <<NextWord>> {
%W xview scroll 1 pages
}
bind Listbox <Prior> {
%W yview scroll -1 pages
%W activate @0,0
}
bind Listbox <Next> {
%W yview scroll 1 pages
%W activate @0,0
}
bind Listbox <Control-Prior> {
%W xview scroll -1 pages
}
bind Listbox <Control-Next> {
%W xview scroll 1 pages
}
bind Listbox <<LineStart>> {
%W xview moveto 0
}
bind Listbox <<LineEnd>> {
%W xview moveto 1
}
bind Listbox <Control-Home> {
%W activate 0
%W see 0
%W selection clear 0 end
%W selection set 0
tk::FireListboxSelectEvent %W
}
bind Listbox <Control-Shift-Home> {
tk::ListboxDataExtend %W 0
}
bind Listbox <Control-End> {
%W activate end
%W see end
%W selection clear 0 end
%W selection set end
tk::FireListboxSelectEvent %W
}
bind Listbox <Control-Shift-End> {
tk::ListboxDataExtend %W [%W index end]
}
bind Listbox <<Copy>> {
if {[selection own -displayof %W] eq "%W"} {
clipboard clear -displayof %W
clipboard append -displayof %W [selection get -displayof %W]
}
}
bind Listbox <space> {
tk::ListboxBeginSelect %W [%W index active]
}
bind Listbox <<Invoke>> {
tk::ListboxBeginSelect %W [%W index active]
}
bind Listbox <Select> {
tk::ListboxBeginSelect %W [%W index active]
}
bind Listbox <Control-Shift-space> {
tk::ListboxBeginExtend %W [%W index active]
}
bind Listbox <Shift-Select> {
tk::ListboxBeginExtend %W [%W index active]
}
bind Listbox <Escape> {
tk::ListboxCancel %W
}
bind Listbox <<SelectAll>> {
tk::ListboxSelectAll %W
}
bind Listbox <<SelectNone>> {
if {[%W cget -selectmode] ne "browse"} {
%W selection clear 0 end
tk::FireListboxSelectEvent %W
}
}
# Additional Tk bindings that aren't part of the Motif look and feel:
bind Listbox <2> {
%W scan mark %x %y
}
bind Listbox <B2-Motion> {
%W scan dragto %x %y
}
# The MouseWheel will typically only fire on Windows and Mac OS X.
# However, someone could use the "event generate" command to produce
# one on other platforms.
if {[tk windowingsystem] eq "aqua"} {
bind Listbox <MouseWheel> {
%W yview scroll [expr {- (%D)}] units
}
bind Listbox <Option-MouseWheel> {
%W yview scroll [expr {-10 * (%D)}] units
}
bind Listbox <Shift-MouseWheel> {
%W xview scroll [expr {- (%D)}] units
}
bind Listbox <Shift-Option-MouseWheel> {
%W xview scroll [expr {-10 * (%D)}] units
}
} else {
bind Listbox <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 4}] units
}
bind Listbox <Shift-MouseWheel> {
%W xview scroll [expr {- (%D / 120) * 4}] units
}
}
if {"x11" eq [tk windowingsystem]} {
# Support for mousewheels on Linux/Unix commonly comes through mapping
# the wheel to the extended buttons. If you have a mousewheel, find
# Linux configuration info at:
# http://linuxreviews.org/howtos/xfree/mouse/
bind Listbox <4> {
if {!$tk_strictMotif} {
%W yview scroll -5 units
}
}
bind Listbox <Shift-4> {
if {!$tk_strictMotif} {
%W xview scroll -5 units
}
}
bind Listbox <5> {
if {!$tk_strictMotif} {
%W yview scroll 5 units
}
}
bind Listbox <Shift-5> {
if {!$tk_strictMotif} {
%W xview scroll 5 units
}
}
}
# ::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
# depends on the selection mode currently in effect for the listbox;
# see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
proc ::tk::ListboxBeginSelect {w el {focus 1}} {
variable ::tk::Priv
if {[$w cget -selectmode] eq "multiple"} {
if {[$w selection includes $el]} {
$w selection clear $el
} else {
$w selection set $el
}
} else {
$w selection clear 0 end
$w selection set $el
$w selection anchor $el
set Priv(listboxSelection) {}
set Priv(listboxPrev) $el
}
tk::FireListboxSelectEvent $w
# check existence as ListboxSelect may destroy us
if {$focus && [winfo exists $w] && [$w cget -state] eq "normal"} {
focus $w
}
}
# ::tk::ListboxMotion --
#
# This procedure is called to process mouse motion events while
# button 1 is down. It may move or extend the selection, depending
# on the listbox's selection mode.
#
# Arguments:
# w - The listbox widget.
# el - The element under the pointer (must be a number).
proc ::tk::ListboxMotion {w el} {
variable ::tk::Priv
if {$el == $Priv(listboxPrev)} {
return
}
set anchor [$w index anchor]
switch [$w cget -selectmode] {
browse {
$w selection clear 0 end
$w selection set $el
set Priv(listboxPrev) $el
tk::FireListboxSelectEvent $w
}
extended {
set i $Priv(listboxPrev)
if {$i eq ""} {
set i $el
$w selection set $el
}
if {[$w selection includes anchor]} {
$w selection clear $i $el
$w selection set anchor $el
} else {
$w selection clear $i $el
$w selection clear anchor $el
}
if {![info exists Priv(listboxSelection)]} {
set Priv(listboxSelection) [$w curselection]
}
while {($i < $el) && ($i < $anchor)} {
if {[lsearch $Priv(listboxSelection) $i] >= 0} {
$w selection set $i
}
incr i
}
while {($i > $el) && ($i > $anchor)} {
if {[lsearch $Priv(listboxSelection) $i] >= 0} {
$w selection set $i
}
incr i -1
}
set Priv(listboxPrev) $el
tk::FireListboxSelectEvent $w
}
}
}
# ::tk::ListboxBeginExtend --
#
# This procedure is typically invoked on shift-button-1 presses. It
# begins the process of extending a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
proc ::tk::ListboxBeginExtend {w el} {
if {[$w cget -selectmode] eq "extended"} {
if {[$w selection includes anchor]} {
ListboxMotion $w $el
} else {
# No selection yet; simulate the begin-select operation.
ListboxBeginSelect $w $el
}
}
}
# ::tk::ListboxBeginToggle --
#
# This procedure is typically invoked on control-button-1 presses. It
# begins the process of toggling a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
proc ::tk::ListboxBeginToggle {w el} {
variable ::tk::Priv
if {[$w cget -selectmode] eq "extended"} {
set Priv(listboxSelection) [$w curselection]
set Priv(listboxPrev) $el
$w selection anchor $el
if {[$w selection includes $el]} {
$w selection clear $el
} else {
$w selection set $el
}
tk::FireListboxSelectEvent $w
}
}
# ::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
# 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 entry window.
proc ::tk::ListboxAutoScan {w} {
variable ::tk::Priv
if {![winfo exists $w]} return
set x $Priv(x)
set y $Priv(y)
if {$y >= [winfo height $w]} {
$w yview scroll 1 units
} elseif {$y < 0} {
$w yview scroll -1 units
} elseif {$x >= [winfo width $w]} {
$w xview scroll 2 units
} elseif {$x < 0} {
$w xview scroll -2 units
} else {
return
}
ListboxMotion $w [$w index @$x,$y]
set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
}
# ::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
# mode.
#
# Arguments:
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
proc ::tk::ListboxUpDown {w amount} {
variable ::tk::Priv
$w activate [expr {[$w index active] + $amount}]
$w see active
switch [$w cget -selectmode] {
browse {
$w selection clear 0 end
$w selection set active
tk::FireListboxSelectEvent $w
}
extended {
$w selection clear 0 end
$w selection set active
$w selection anchor active
set Priv(listboxPrev) [$w index active]
set Priv(listboxSelection) {}
tk::FireListboxSelectEvent $w
}
}
}
# ::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
# one element, and extends the selection to that point.
#
# Arguments:
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
proc ::tk::ListboxExtendUpDown {w amount} {
variable ::tk::Priv
if {[$w cget -selectmode] ne "extended"} {
return
}
set active [$w index active]
if {![info exists Priv(listboxSelection)]} {
$w selection set $active
set Priv(listboxSelection) [$w curselection]
}
$w activate [expr {$active + $amount}]
$w see active
ListboxMotion $w [$w index active]
}
# ::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.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
#
# Arguments:
# w - The listbox widget.
# el - An integer element number.
proc ::tk::ListboxDataExtend {w el} {
set mode [$w cget -selectmode]
if {$mode eq "extended"} {
$w activate $el
$w see $el
if {[$w selection includes anchor]} {
ListboxMotion $w $el
}
} elseif {$mode eq "multiple"} {
$w activate $el
$w see $el
}
}
# ::tk::ListboxCancel
#
# This procedure is invoked to cancel an extended selection in
# progress. If there is an extended selection in progress, it
# restores all of the items between the active one and the anchor
# to their previous selection state.
#
# Arguments:
# w - The listbox widget.
proc ::tk::ListboxCancel w {
variable ::tk::Priv
if {[$w cget -selectmode] ne "extended"} {
return
}
set first [$w index anchor]
set last $Priv(listboxPrev)
if {$last eq ""} {
# Not actually doing any selection right now
return
}
if {$first > $last} {
set tmp $first
set first $last
set last $tmp
}
$w selection clear $first $last
while {$first <= $last} {
if {[lsearch $Priv(listboxSelection) $first] >= 0} {
$w selection set $first
}
incr first
}
tk::FireListboxSelectEvent $w
}
# ::tk::ListboxSelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w - The listbox widget.
proc ::tk::ListboxSelectAll w {
set mode [$w cget -selectmode]
if {$mode eq "single" || $mode eq "browse"} {
$w selection clear 0 end
$w selection set active
} else {
$w selection set 0 end
}
tk::FireListboxSelectEvent $w
}
# ::tk::FireListboxSelectEvent
#
# Fire the <<ListboxSelect>> event if the listbox is not in disabled
# state.
#
# Arguments:
# w - The listbox widget.
proc ::tk::FireListboxSelectEvent w {
if {[$w cget -state] eq "normal"} {
event generate $w <<ListboxSelect>>
}
}

297
windowsAgent/dist/tk/megawidget.tcl vendored Normal file
View File

@ -0,0 +1,297 @@
# megawidget.tcl
#
# Basic megawidget support classes. Experimental for any use other than
# the ::tk::IconList megawdget, which is itself only designed for use in
# the Unix file dialogs.
#
# Copyright (c) 2009-2010 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
package require Tk 8.6
::oo::class create ::tk::Megawidget {
superclass ::oo::class
method unknown {w args} {
if {[string match .* $w]} {
[self] create $w {*}$args
return $w
}
next $w {*}$args
}
unexport new unknown
self method create {name superclasses body} {
next $name [list \
superclass ::tk::MegawidgetClass {*}$superclasses]\;$body
}
}
::oo::class create ::tk::MegawidgetClass {
variable w hull options IdleCallbacks
constructor args {
# Extract the "widget name" from the object name
set w [namespace tail [self]]
# Configure things
tclParseConfigSpec [my varname options] [my GetSpecs] "" $args
# Move the object out of the way of the hull widget
rename [self] _tmp
# Make the hull widget(s)
my CreateHull
bind $hull <Destroy> [list [namespace which my] destroy]
# Rename things into their final places
rename ::$w theWidget
rename [self] ::$w
# Make the contents
my Create
}
destructor {
foreach {name cb} [array get IdleCallbacks] {
after cancel $cb
unset IdleCallbacks($name)
}
if {[winfo exists $w]} {
bind $hull <Destroy> {}
destroy $w
}
}
####################################################################
#
# MegawidgetClass::configure --
#
# Implementation of 'configure' for megawidgets. Emulates the operation
# of the standard Tk configure method fairly closely, which makes things
# substantially more complex than they otherwise would be.
#
# This method assumes that the 'GetSpecs' method returns a description
# of all the specifications of the options (i.e., as Tk returns except
# with the actual values removed). It also assumes that the 'options'
# array in the class holds all options; it is up to subclasses to set
# traces on that array if they want to respond to configuration changes.
#
# TODO: allow unambiguous abbreviations.
#
method configure args {
# Configure behaves differently depending on the number of arguments
set argc [llength $args]
if {$argc == 0} {
return [lmap spec [my GetSpecs] {
lappend spec $options([lindex $spec 0])
}]
} elseif {$argc == 1} {
set opt [lindex $args 0]
if {[info exists options($opt)]} {
set spec [lsearch -inline -index 0 -exact [my GetSpecs] $opt]
return [linsert $spec end $options($opt)]
}
} elseif {$argc == 2} {
# Special case for where we're setting a single option. This
# avoids some of the costly operations. We still do the [array
# get] as this gives a sufficiently-consistent trace.
set opt [lindex $args 0]
if {[dict exists [array get options] $opt]} {
# Actually set the new value of the option. Use a catch to
# allow a megawidget user to throw an error from a write trace
# on the options array to reject invalid values.
try {
array set options $args
} on error {ret info} {
# Rethrow the error to get a clean stack trace
return -code error -errorcode [dict get $info -errorcode] $ret
}
return
}
} elseif {$argc % 2 == 0} {
# Check that all specified options exist. Any unknown option will
# cause the merged dictionary to be bigger than the options array
set merge [dict merge [array get options] $args]
if {[dict size $merge] == [array size options]} {
# Actually set the new values of the options. Use a catch to
# allow a megawidget user to throw an error from a write trace
# on the options array to reject invalid values
try {
array set options $args
} on error {ret info} {
# Rethrow the error to get a clean stack trace
return -code error -errorcode [dict get $info -errorcode] $ret
}
return
}
# Due to the order of the merge, the unknown options will be at
# the end of the dict. This makes the first unknown option easy to
# find.
set opt [lindex [dict keys $merge] [array size options]]
} else {
set opt [lindex $args end]
return -code error -errorcode [list TK VALUE_MISSING] \
"value for \"$opt\" missing"
}
return -code error -errorcode [list TK LOOKUP OPTION $opt] \
"bad option \"$opt\": must be [tclListValidFlags options]"
}
####################################################################
#
# MegawidgetClass::cget --
#
# Implementation of 'cget' for megawidgets. Emulates the operation of
# the standard Tk cget method fairly closely.
#
# This method assumes that the 'options' array in the class holds all
# options; it is up to subclasses to set traces on that array if they
# want to respond to configuration reads.
#
# TODO: allow unambiguous abbreviations.
#
method cget option {
return $options($option)
}
####################################################################
#
# MegawidgetClass::TraceOption --
#
# Sets up the tracing of an element of the options variable.
#
method TraceOption {option method args} {
set callback [list my $method {*}$args]
trace add variable options($option) write [namespace code $callback]
}
####################################################################
#
# MegawidgetClass::GetSpecs --
#
# Return a list of descriptions of options supported by this
# megawidget. Each option is described by the 4-tuple list, consisting
# of the name of the option, the "option database" name, the "option
# database" class-name, and the default value of the option. These are
# the same values returned by calling the configure method of a widget,
# except without the current values of the options.
#
method GetSpecs {} {
return {
{-takefocus takeFocus TakeFocus {}}
}
}
####################################################################
#
# MegawidgetClass::CreateHull --
#
# Creates the real main widget of the megawidget. This is often a frame
# or toplevel widget, but isn't always (lightweight megawidgets might
# use a content widget directly).
#
# The name of the hull widget is given by the 'w' instance variable. The
# name should be written into the 'hull' instance variable. The command
# created by this method will be renamed.
#
method CreateHull {} {
return -code error -errorcode {TCL OO ABSTRACT_METHOD} \
"method must be overridden"
}
####################################################################
#
# MegawidgetClass::Create --
#
# Creates the content of the megawidget. The name of the widget to
# create the content in will be in the 'hull' instance variable.
#
method Create {} {
return -code error -errorcode {TCL OO ABSTRACT_METHOD} \
"method must be overridden"
}
####################################################################
#
# MegawidgetClass::WhenIdle --
#
# Arrange for a method to be called on the current instance when Tk is
# idle. Only one such method call per method will be queued; subsequent
# queuing actions before the callback fires will be silently ignored.
# The additional args will be passed to the callback, and the callbacks
# will be properly cancelled if the widget is destroyed.
#
method WhenIdle {method args} {
if {![info exists IdleCallbacks($method)]} {
set IdleCallbacks($method) [after idle [list \
[namespace which my] DoWhenIdle $method $args]]
}
}
method DoWhenIdle {method arguments} {
unset IdleCallbacks($method)
tailcall my $method {*}$arguments
}
}
####################################################################
#
# tk::SimpleWidget --
#
# Simple megawidget class that makes it easy create widgets that behave
# like a ttk widget. It creates the hull as a ttk::frame and maps the
# state manipulation methods of the overall megawidget to the equivalent
# operations on the ttk::frame.
#
::tk::Megawidget create ::tk::SimpleWidget {} {
variable w hull options
method GetSpecs {} {
return {
{-cursor cursor Cursor {}}
{-takefocus takeFocus TakeFocus {}}
}
}
method CreateHull {} {
set hull [::ttk::frame $w -cursor $options(-cursor)]
my TraceOption -cursor UpdateCursorOption
}
method UpdateCursorOption args {
$hull configure -cursor $options(-cursor)
}
# Not fixed names, so can't forward
method state args {
tailcall $hull state {*}$args
}
method instate args {
tailcall $hull instate {*}$args
}
}
####################################################################
#
# tk::FocusableWidget --
#
# Simple megawidget class that makes a ttk-like widget that has a focus
# ring.
#
::tk::Megawidget create ::tk::FocusableWidget ::tk::SimpleWidget {
variable w hull options
method GetSpecs {} {
return {
{-cursor cursor Cursor {}}
{-takefocus takeFocus TakeFocus ::ttk::takefocus}
}
}
method CreateHull {} {
ttk::frame $w
set hull [ttk::entry $w.cHull -takefocus 0 -cursor $options(-cursor)]
pack $hull -expand yes -fill both -ipadx 2 -ipady 2
my TraceOption -cursor UpdateCursorOption
}
}
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:

1356
windowsAgent/dist/tk/menu.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

1488
windowsAgent/dist/tk/mkpsenc.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

430
windowsAgent/dist/tk/msgbox.tcl vendored Normal file
View File

@ -0,0 +1,430 @@
# msgbox.tcl --
#
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Ensure existence of ::tk::dialog namespace
#
namespace eval ::tk::dialog {}
image create bitmap ::tk::dialog::b1 -foreground black \
-data "#define b1_width 32\n#define b1_height 32
static unsigned char q1_bits[] = {
0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::b2 -foreground white \
-data "#define b2_width 32\n#define b2_height 32
static unsigned char b2_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::q -foreground blue \
-data "#define q_width 32\n#define q_height 32
static unsigned char q_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::i -foreground blue \
-data "#define i_width 32\n#define i_height 32
static unsigned char i_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::w1 -foreground black \
-data "#define w1_width 32\n#define w1_height 32
static unsigned char w1_bits[] = {
0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::w2 -foreground yellow \
-data "#define w2_width 32\n#define w2_height 32
static unsigned char w2_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
image create bitmap ::tk::dialog::w3 -foreground black \
-data "#define w3_width 32\n#define w3_height 32
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, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
# ::tk::MessageBox --
#
# Pops up a messagebox with an application-supplied message with
# an icon and a list of buttons. This procedure will be called
# by tk_messageBox if the platform does not have native
# messagebox support, or if the particular type of messagebox is
# not supported natively.
#
# Color icons are used on Unix displays that have a color
# depth of 4 or more and $tk_strictMotif is not on.
#
# This procedure is a private procedure shouldn't be called
# directly. Call tk_messageBox instead.
#
# See the user documentation for details on what tk_messageBox does.
#
proc ::tk::MessageBox {args} {
global tk_strictMotif
variable ::tk::Priv
set w ::tk::PrivMsgBox
upvar $w data
#
# The default value of the title is space (" ") not the empty string
# because for some window managers, a
# wm title .foo ""
# causes the window title to be "foo" instead of the empty string.
#
set specs {
{-default "" "" ""}
{-detail "" "" ""}
{-icon "" "" "info"}
{-message "" "" ""}
{-parent "" "" .}
{-title "" "" " "}
{-type "" "" "ok"}
}
tclParseConfigSpec $w $specs "" $args
if {$data(-icon) ni {info warning error question}} {
return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \
"bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
switch -- $data(-icon) {
"error" {set data(-icon) "stop"}
"warning" {set data(-icon) "caution"}
"info" {set data(-icon) "note"}
}
option add *Dialog*background systemDialogBackgroundActive widgetDefault
option add *Dialog*Button.highlightBackground \
systemDialogBackgroundActive widgetDefault
}
if {![winfo exists $data(-parent)]} {
return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
"bad window path name \"$data(-parent)\""
}
switch -- $data(-type) {
abortretryignore {
set names [list abort retry ignore]
set labels [list &Abort &Retry &Ignore]
set cancel abort
}
ok {
set names [list ok]
set labels {&OK}
set cancel ok
}
okcancel {
set names [list ok cancel]
set labels [list &OK &Cancel]
set cancel cancel
}
retrycancel {
set names [list retry cancel]
set labels [list &Retry &Cancel]
set cancel cancel
}
yesno {
set names [list yes no]
set labels [list &Yes &No]
set cancel no
}
yesnocancel {
set names [list yes no cancel]
set labels [list &Yes &No &Cancel]
set cancel cancel
}
default {
return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \
"bad -type value \"$data(-type)\": must be\
abortretryignore, ok, okcancel, retrycancel,\
yesno, or yesnocancel"
}
}
set buttons {}
foreach name $names lab $labels {
lappend buttons [list $name -text [mc $lab]]
}
# If no default button was specified, the default default is the
# first button (Bug: 2218).
if {$data(-default) eq ""} {
set data(-default) [lindex [lindex $buttons 0] 0]
}
set valid 0
foreach btn $buttons {
if {[lindex $btn 0] eq $data(-default)} {
set valid 1
break
}
}
if {!$valid} {
return -code error -errorcode {TK MSGBOX DEFAULT} \
"bad -default value \"$data(-default)\": must be\
abort, retry, ignore, ok, cancel, no, or yes"
}
# 2. Set the dialog to be a child window of $parent
#
#
if {$data(-parent) ne "."} {
set w $data(-parent).__tk__messagebox
} else {
set w .__tk__messagebox
}
# There is only one background colour for the whole dialog
set bg [ttk::style lookup . -background]
# 3. Create the top-level window and divide it into top
# and bottom parts.
catch {destroy $w}
toplevel $w -class Dialog -bg $bg
wm title $w $data(-title)
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW [list $w.$cancel invoke]
# Message boxes should be transient with respect to their parent so that
# they always stay on top of the parent window. But some window managers
# will simply create the child window as withdrawn if the parent is not
# viewable (because it is withdrawn or iconified). This is not good for
# "grab"bed windows. So only make the message box transient if the parent
# is viewable.
#
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
}
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
} elseif {$windowingsystem eq "x11"} {
wm attributes $w -type dialog
}
ttk::frame $w.bot
grid anchor $w.bot center
pack $w.bot -side bottom -fill both
ttk::frame $w.top
pack $w.top -side top -fill both -expand 1
# 4. Fill the top part with bitmap, message and detail (use the
# option database for -wraplength and -font so that they can be
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
option add *Dialog.dtl.wrapLength 3i widgetDefault
option add *Dialog.msg.font TkCaptionFont widgetDefault
option add *Dialog.dtl.font TkDefaultFont widgetDefault
ttk::label $w.msg -anchor nw -justify left -text $data(-message)
if {$data(-detail) ne ""} {
ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
}
if {$data(-icon) ne ""} {
if {([winfo depth $w] < 4) || $tk_strictMotif} {
# ttk::label has no -bitmap option
label $w.bitmap -bitmap $data(-icon) -background $bg
} else {
switch $data(-icon) {
error {
ttk::label $w.bitmap -image ::tk::icons::error
}
info {
ttk::label $w.bitmap -image ::tk::icons::information
}
question {
ttk::label $w.bitmap -image ::tk::icons::question
}
default {
ttk::label $w.bitmap -image ::tk::icons::warning
}
}
}
}
grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
grid configure $w.bitmap -sticky nw
grid columnconfigure $w.top 1 -weight 1
if {$data(-detail) ne ""} {
grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
grid rowconfigure $w.top 1 -weight 1
} else {
grid rowconfigure $w.top 0 -weight 1
}
# 5. Create a row of buttons at the bottom of the dialog.
set i 0
foreach but $buttons {
set name [lindex $but 0]
set opts [lrange $but 1 end]
if {![llength $opts]} {
# Capitalize the first letter of $name
set capName [string toupper $name 0]
set opts [list -text $capName]
}
eval [list tk::AmpWidget ttk::button $w.$name] $opts \
[list -command [list set tk::Priv(button) $name]]
if {$name eq $data(-default)} {
$w.$name configure -default active
} else {
$w.$name configure -default normal
}
grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
grid columnconfigure $w.bot $i -uniform buttons
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
set tmp [string tolower $name]
if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
$tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
$tmp eq "ignore"} {
grid columnconfigure $w.bot $i -minsize 90
}
grid configure $w.$name -pady 7
}
incr i
# create the binding for the key accelerator, based on the underline
#
# set underIdx [$w.$name cget -under]
# if {$underIdx >= 0} {
# set key [string index [$w.$name cget -text] $underIdx]
# bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
# bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
# }
}
bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
if {$data(-default) ne ""} {
bind $w <FocusIn> {
if {[winfo class %W] in "Button TButton"} {
%W configure -default active
}
}
bind $w <FocusOut> {
if {[winfo class %W] in "Button TButton"} {
%W configure -default normal
}
}
}
# 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
bind $w <Return> {
if {[winfo class %W] in "Button TButton"} {
%W invoke
}
}
# Invoke the designated cancelling operation
bind $w <Escape> [list $w.$cancel invoke]
# At <Destroy> the buttons have vanished, so must do this directly.
bind $w.msg <Destroy> [list set tk::Priv(button) $cancel]
# 7. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w widget $data(-parent)
# 8. Set a grab and claim the focus too.
if {$data(-default) ne ""} {
set focus $w.$data(-default)
} else {
set focus $w
}
::tk::SetFocusGrab $w $focus
# 9. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(button)
# Copy the result now so any <Destroy> that happens won't cause
# trouble
set result $Priv(button)
::tk::RestoreFocusGrab $w $focus
return $result
}

77
windowsAgent/dist/tk/msgs/cs.msg vendored Normal file
View File

@ -0,0 +1,77 @@
namespace eval ::tk {
::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 "Bold Italic"
::msgcat::mcset cs "&Blue" "&Modr\341"
::msgcat::mcset cs "Cancel" "Zru\u0161it"
::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 "Cl&ear" "Sma&zat"
::msgcat::mcset cs "&Clear Console" "&Smazat konzolu"
::msgcat::mcset cs "Color" "Barva"
::msgcat::mcset cs "Console" "Konzole"
::msgcat::mcset cs "&Copy" "&Kop\355rovat"
::msgcat::mcset cs "Cu&t" "V&y\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 "&Edit" "&\332pravy"
::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s"
::msgcat::mcset cs "E&xit" "&Konec"
::msgcat::mcset cs "&File" "&Soubor"
::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\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n"
::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 "Fi&les:" "Sou&bory:"
::msgcat::mcset cs "&Filter" "&Filtr"
::msgcat::mcset cs "Fil&ter:" "Fil&tr:"
::msgcat::mcset cs "Font st&yle:"
::msgcat::mcset cs "&Green" "Ze&len\341"
::msgcat::mcset cs "&Help" "&N\341pov\u011bda"
::msgcat::mcset cs "Hi" "Ahoj"
::msgcat::mcset cs "&Hide Console" "&Schovat Konzolu"
::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 "Ok"
::msgcat::mcset cs "Open" "Otev\u0159\355t"
::msgcat::mcset cs "&Open" "&Otev\u0159\355t"
::msgcat::mcset cs "Open Multiple Files" "Otev\u0159\355t v\355ce soubor\u016f"
::msgcat::mcset cs "P&aste" "&Vlo\u017eit"
::msgcat::mcset cs "&Quit" "&Ukon\u010dit"
::msgcat::mcset cs "&Red" "\u010ce&rven\341"
::msgcat::mcset cs "Replace existing file?" "Nahradit st\341vaj\355c\355 soubor?"
::msgcat::mcset cs "&Retry" "Z&novu"
::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..." "&Zdroj..."
::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 "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"
}

78
windowsAgent/dist/tk/msgs/da.msg vendored Normal file
View File

@ -0,0 +1,78 @@
namespace eval ::tk {
::msgcat::mcset da "&Abort" "&Afbryd"
::msgcat::mcset da "&About..." "&Om..."
::msgcat::mcset da "All Files" "Alle filer"
::msgcat::mcset da "Application Error" "Programfejl"
::msgcat::mcset da "&Blue" "&Bl\u00E5"
::msgcat::mcset da "Cancel" "Annuller"
::msgcat::mcset da "&Cancel" "&Annuller"
::msgcat::mcset da "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ikke skifte til katalog \"%1\$s\".\nIngen rettigheder."
::msgcat::mcset da "Choose Directory" "V\u00E6lg katalog"
::msgcat::mcset da "Cl&ear" "&Ryd"
::msgcat::mcset da "&Clear Console" "&Ryd konsolen"
::msgcat::mcset da "Color" "Farve"
::msgcat::mcset da "Console" "Konsol"
::msgcat::mcset da "&Copy" "&Kopier"
::msgcat::mcset da "Cu&t" "Kli&p"
::msgcat::mcset da "&Delete" "&Slet"
::msgcat::mcset da "Details >>" "Detailer"
::msgcat::mcset da "Directory \"%1\$s\" does not exist." "Katalog \"%1\$s\" findes ikke."
::msgcat::mcset da "&Directory:" "&Katalog:"
::msgcat::mcset da "&Edit" "&Rediger"
::msgcat::mcset da "Error: %1\$s" "Fejl: %1\$s"
::msgcat::mcset da "E&xit" "&Afslut"
::msgcat::mcset da "&File" "&Fil"
::msgcat::mcset da "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Filen \"%1\$s\" findes allerede.\nSkal den overskrives?"
::msgcat::mcset da "File \"%1\$s\" already exists.\n\n" "Filen \"%1\$s\" findes allerede.\n\n"
::msgcat::mcset da "File \"%1\$s\" does not exist." "Filen \"%1\$s\" findes ikke."
::msgcat::mcset da "File &name:" "Fil&navn:"
::msgcat::mcset da "File &names:" "Fil&navne:"
::msgcat::mcset da "Files of &type:" "Fil&typer:"
::msgcat::mcset da "Fi&les:" "Fi&ler:"
::msgcat::mcset da "&Filter"
::msgcat::mcset da "Fil&ter:"
::msgcat::mcset da "&Green" "&Gr\u00F8n"
::msgcat::mcset da "&Help" "&Hj\u00E6lp"
::msgcat::mcset da "Hi" "Hej"
::msgcat::mcset da "&Hide Console" "Skjul &konsol"
::msgcat::mcset da "&Ignore" "&Ignorer"
::msgcat::mcset da "Invalid file name \"%1\$s\"." "Ugyldig fil navn \"%1\$s\"."
::msgcat::mcset da "Log Files" "Logfiler"
::msgcat::mcset da "&No" "&Nej"
::msgcat::mcset da "&OK" "&O.K."
::msgcat::mcset da "OK" "O.K."
::msgcat::mcset da "Ok"
::msgcat::mcset da "Open" "\u00C5bn"
::msgcat::mcset da "&Open" "&\u00C5bn"
::msgcat::mcset da "Open Multiple Files" "\u00C5bn flere filer"
::msgcat::mcset da "P&aste" "&Inds\u00E6t"
::msgcat::mcset da "&Quit" "&Afslut"
::msgcat::mcset da "&Red" "&R\u00F8d"
::msgcat::mcset da "Replace existing file?" "Erstat eksisterende fil?"
::msgcat::mcset da "&Retry" "&Gentag"
::msgcat::mcset da "&Save" "&Gem"
::msgcat::mcset da "Save As" "Gem som"
::msgcat::mcset da "Save To Log" "Gem i log"
::msgcat::mcset da "Select Log File" "V\u00E6lg logfil"
::msgcat::mcset da "Select a file to source" "V\u00E6lg k\u00F8rbar fil"
::msgcat::mcset da "&Selection:" "&Udvalg:"
::msgcat::mcset da "Show &Hidden Directories" "Vis &skjulte kataloger"
::msgcat::mcset da "Show &Hidden Files and Directories" "Vis &skjulte filer og kataloger"
::msgcat::mcset da "Skip Messages" "Overspring beskeder"
::msgcat::mcset da "&Source..." "&K\u00F8r..."
::msgcat::mcset da "Tcl Scripts" "Tcl-Skripter"
::msgcat::mcset da "Tcl for Windows" "Tcl for Windows"
::msgcat::mcset da "Text Files" "Tekstfiler"
::msgcat::mcset da "&Yes" "&Ja"
::msgcat::mcset da "abort" "afbryd"
::msgcat::mcset da "blue" "bl\u00E5"
::msgcat::mcset da "cancel" "afbryd"
::msgcat::mcset da "extension"
::msgcat::mcset da "extensions"
::msgcat::mcset da "green" "gr\u00F8n"
::msgcat::mcset da "ignore" "ignorer"
::msgcat::mcset da "ok"
::msgcat::mcset da "red" "r\u00F8d"
::msgcat::mcset da "retry" "gentag"
::msgcat::mcset da "yes" "ja"
}

91
windowsAgent/dist/tk/msgs/de.msg vendored Normal file
View File

@ -0,0 +1,91 @@
namespace eval ::tk {
::msgcat::mcset de "&Abort" "&Abbruch"
::msgcat::mcset de "&About..." "&\u00dcber..."
::msgcat::mcset de "All Files" "Alle Dateien"
::msgcat::mcset de "Application Error" "Applikationsfehler"
::msgcat::mcset de "&Apply" "&Anwenden"
::msgcat::mcset de "Bold" "Fett"
::msgcat::mcset de "Bold Italic" "Fett kursiv"
::msgcat::mcset de "&Blue" "&Blau"
::msgcat::mcset de "Cancel" "Abbruch"
::msgcat::mcset de "&Cancel" "&Abbruch"
::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden."
::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis"
::msgcat::mcset de "Cl&ear" "&R\u00fccksetzen"
::msgcat::mcset de "&Clear Console" "&Konsole l\u00f6schen"
::msgcat::mcset de "Color" "Farbe"
::msgcat::mcset de "Console" "Konsole"
::msgcat::mcset de "&Copy" "&Kopieren"
::msgcat::mcset de "Cu&t" "Aus&schneiden"
::msgcat::mcset de "&Delete" "&L\u00f6schen"
::msgcat::mcset de "Details >>"
::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht."
::msgcat::mcset de "&Directory:" "&Verzeichnis:"
::msgcat::mcset de "&Edit" "&Bearbeiten"
::msgcat::mcset de "Effects" "Effekte"
::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s"
::msgcat::mcset de "E&xit" "&Ende"
::msgcat::mcset de "&File" "&Datei"
::msgcat::mcset de "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Die Datei \"%1\$s\" ist bereits vorhanden.\nWollen sie diese Datei \u00fcberschreiben ?"
::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:" "Datei&name:"
::msgcat::mcset de "File &names:" "Datei&namen:"
::msgcat::mcset de "Files of &type:" "Dateien des &Typs:"
::msgcat::mcset de "Fi&les:" "Dat&eien:"
::msgcat::mcset de "&Filter"
::msgcat::mcset de "Fil&ter:"
::msgcat::mcset de "Font" "Schriftart"
::msgcat::mcset de "&Font:" "Schriftart:"
::msgcat::mcset de "Font st&yle:" "Schriftschnitt:"
::msgcat::mcset de "&Green" "&Gr\u00fcn"
::msgcat::mcset de "&Help" "&Hilfe"
::msgcat::mcset de "Hi" "Hallo"
::msgcat::mcset de "&Hide Console" "&Konsole unsichtbar machen"
::msgcat::mcset de "&Ignore" "&Ignorieren"
::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ung\u00fcltiger Dateiname \"%1\$s\"."
::msgcat::mcset de "Italic" "Kursiv"
::msgcat::mcset de "Log Files" "Protokolldatei"
::msgcat::mcset de "&No" "&Nein"
::msgcat::mcset de "&OK"
::msgcat::mcset de "OK"
::msgcat::mcset de "Ok"
::msgcat::mcset de "Open" "\u00d6ffnen"
::msgcat::mcset de "&Open" "\u00d6&ffnen"
::msgcat::mcset de "Open Multiple Files" "Mehrere Dateien \u00F6ffnen"
::msgcat::mcset de "P&aste" "E&inf\u00fcgen"
::msgcat::mcset de "&Quit" "&Beenden"
::msgcat::mcset de "&Red" "&Rot"
::msgcat::mcset de "Regular" "Standard"
::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?"
::msgcat::mcset de "&Retry" "&Wiederholen"
::msgcat::mcset de "Sample" "Beispiel"
::msgcat::mcset de "&Save" "&Speichern"
::msgcat::mcset de "Save As" "Speichern unter"
::msgcat::mcset de "Save To Log" "In Protokoll speichern"
::msgcat::mcset de "Select Log File" "Protokolldatei ausw\u00e4hlen"
::msgcat::mcset de "Select a file to source" "Auszuf\u00fchrende Datei ausw\u00e4hlen"
::msgcat::mcset de "&Selection:" "Auswah&l:"
::msgcat::mcset de "&Size:" "Schriftgrad:"
::msgcat::mcset de "Show &Hidden Directories" "Zeige versteckte Dateien"
::msgcat::mcset de "Show &Hidden Files and Directories" "Zeige versteckte Dateien und Verzeichnisse"
::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen"
::msgcat::mcset de "&Source..." "&Ausf\u00fchren..."
::msgcat::mcset de "Stri&keout" "&Durchgestrichen"
::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 "&Underline" "&Unterstrichen"
::msgcat::mcset de "&Yes" "&Ja"
::msgcat::mcset de "abort" "abbrechen"
::msgcat::mcset de "blue" "blau"
::msgcat::mcset de "cancel" "abbrechen"
::msgcat::mcset de "extension" "Erweiterung"
::msgcat::mcset de "extensions" "Erweiterungen"
::msgcat::mcset de "green" "gr\u00fcn"
::msgcat::mcset de "ignore" "ignorieren"
::msgcat::mcset de "ok"
::msgcat::mcset de "red" "rot"
::msgcat::mcset de "retry" "wiederholen"
::msgcat::mcset de "yes" "ja"
}

86
windowsAgent/dist/tk/msgs/el.msg vendored Normal file
View File

@ -0,0 +1,86 @@
## Messages for the Greek (Hellenic - "el") language.
## Please report any changes/suggestions to:
## petasis@iit.demokritos.gr
namespace eval ::tk {
::msgcat::mcset el "&Abort" "\u03a4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2"
::msgcat::mcset el "About..." "\u03a3\u03c7\u03b5\u03c4\u03b9\u03ba\u03ac..."
::msgcat::mcset el "All Files" "\u038c\u03bb\u03b1 \u03c4\u03b1 \u0391\u03c1\u03c7\u03b5\u03af\u03b1"
::msgcat::mcset el "Application Error" "\u039b\u03ac\u03b8\u03bf\u03c2 \u0395\u03c6\u03b1\u03c1\u03bc\u03bf\u03b3\u03ae\u03c2"
::msgcat::mcset el "&Blue" "\u039c\u03c0\u03bb\u03b5"
::msgcat::mcset el "&Cancel" "\u0391\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7"
::msgcat::mcset el \
"Cannot change to the directory \"%1\$s\".\nPermission denied." \
"\u0394\u03b5\u03bd \u03b5\u03af\u03bd\u03b1\u03b9 \u03b4\u03c5\u03bd\u03b1\u03c4\u03ae \u03b7 \u03b1\u03bb\u03bb\u03b1\u03b3\u03ae \u03ba\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5 \u03c3\u03b5 \"%1\$s\".\n\u0397 \u03c0\u03c1\u03cc\u03c3\u03b2\u03b1\u03c3\u03b7 \u03b4\u03b5\u03bd \u03b5\u03c0\u03b9\u03c4\u03c1\u03ad\u03c0\u03b5\u03c4\u03b1\u03b9."
::msgcat::mcset el "Choose Directory" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u039a\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5"
::msgcat::mcset el "Clear" "\u039a\u03b1\u03b8\u03b1\u03c1\u03b9\u03c3\u03bc\u03cc\u03c2"
::msgcat::mcset el "Color" "\u03a7\u03c1\u03ce\u03bc\u03b1"
::msgcat::mcset el "Console" "\u039a\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1"
::msgcat::mcset el "Copy" "\u0391\u03bd\u03c4\u03b9\u03b3\u03c1\u03b1\u03c6\u03ae"
::msgcat::mcset el "Cut" "\u0391\u03c0\u03bf\u03ba\u03bf\u03c0\u03ae"
::msgcat::mcset el "Delete" "\u0394\u03b9\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae"
::msgcat::mcset el "Details >>" "\u039b\u03b5\u03c0\u03c4\u03bf\u03bc\u03ad\u03c1\u03b5\u03b9\u03b5\u03c2 >>"
::msgcat::mcset el "Directory \"%1\$s\" does not exist." \
"\u039f \u03ba\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2 \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9."
::msgcat::mcset el "&Directory:" "&\u039a\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2:"
::msgcat::mcset el "Error: %1\$s" "\u039b\u03ac\u03b8\u03bf\u03c2: %1\$s"
::msgcat::mcset el "Exit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2"
::msgcat::mcset el \
"File \"%1\$s\" already exists.\nDo you want to overwrite it?" \
"\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\u0398\u03ad\u03bb\u03b5\u03c4\u03b5 \u03bd\u03b1 \u03b5\u03c0\u03b9\u03ba\u03b1\u03bb\u03c5\u03c6\u03b8\u03b5\u03af;"
::msgcat::mcset el "File \"%1\$s\" already exists.\n\n" \
"\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\n"
::msgcat::mcset el "File \"%1\$s\" does not exist." \
"\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9."
::msgcat::mcset el "File &name:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5:"
::msgcat::mcset el "File &names:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd:"
::msgcat::mcset el "Files of &type:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u03c4\u03bf\u03c5 &\u03c4\u03cd\u03c0\u03bf\u03c5:"
::msgcat::mcset el "Fi&les:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1:"
::msgcat::mcset el "&Filter" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf"
::msgcat::mcset el "Fil&ter:" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf:"
::msgcat::mcset el "&Green" "\u03a0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf"
::msgcat::mcset el "Hi" "\u0393\u03b5\u03b9\u03b1"
::msgcat::mcset el "Hide Console" "\u0391\u03c0\u03cc\u03ba\u03c1\u03c5\u03c8\u03b7 \u03ba\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1\u03c2"
::msgcat::mcset el "&Ignore" "\u0391\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7"
::msgcat::mcset el "Invalid file name \"%1\$s\"." \
"\u0386\u03ba\u03c5\u03c1\u03bf \u03cc\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \"%1\$s\"."
::msgcat::mcset el "Log Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
::msgcat::mcset el "&No" "\u038c\u03c7\u03b9"
::msgcat::mcset el "&OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
::msgcat::mcset el "OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
::msgcat::mcset el "Ok" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
::msgcat::mcset el "Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1"
::msgcat::mcset el "&Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1"
::msgcat::mcset el "Open Multiple Files" \
"\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1 \u03c0\u03bf\u03bb\u03bb\u03b1\u03c0\u03bb\u03ce\u03bd \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd"
::msgcat::mcset el "P&aste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7"
::msgcat::mcset el "Quit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2"
::msgcat::mcset el "&Red" "\u039a\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf"
::msgcat::mcset el "Replace existing file?" \
"\u0395\u03c0\u03b9\u03ba\u03ac\u03bb\u03c5\u03c8\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03bf\u03bd\u03c4\u03bf\u03c2 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5;"
::msgcat::mcset el "&Retry" "\u03a0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac"
::msgcat::mcset el "&Save" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7"
::msgcat::mcset el "Save As" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03b1\u03bd"
::msgcat::mcset el "Save To Log" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03c4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
::msgcat::mcset el "Select Log File" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
::msgcat::mcset el "Select a file to source" \
"\u0395\u03c0\u03b9\u03bb\u03ad\u03be\u03c4\u03b5 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03b3\u03b9\u03b1 \u03b5\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7"
::msgcat::mcset el "&Selection:" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae:"
::msgcat::mcset el "Skip Messages" "\u0391\u03c0\u03bf\u03c6\u03c5\u03b3\u03ae\u03bc\u03b7\u03bd\u03c5\u03bc\u03ac\u03c4\u03c9\u03bd"
::msgcat::mcset el "&Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..."
::msgcat::mcset el "Tcl Scripts" "Tcl Scripts"
::msgcat::mcset el "Tcl for Windows" "Tcl \u03b3\u03b9\u03b1 Windows"
::msgcat::mcset el "Text Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b5\u03b9\u03bc\u03ad\u03bd\u03bf\u03c5"
::msgcat::mcset el "&Yes" "\u039d\u03b1\u03b9"
::msgcat::mcset el "abort" "\u03c4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2"
::msgcat::mcset el "blue" "\u03bc\u03c0\u03bb\u03b5"
::msgcat::mcset el "cancel" "\u03b1\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7"
::msgcat::mcset el "extension" "\u03b5\u03c0\u03ad\u03ba\u03c4\u03b1\u03c3\u03b7"
::msgcat::mcset el "extensions" "\u03b5\u03c0\u03b5\u03ba\u03c4\u03ac\u03c3\u03b5\u03b9\u03c2"
::msgcat::mcset el "green" "\u03c0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf"
::msgcat::mcset el "ignore" "\u03b1\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7"
::msgcat::mcset el "ok" "\u03b5\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
::msgcat::mcset el "red" "\u03ba\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf"
::msgcat::mcset el "retry" "\u03c0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac"
::msgcat::mcset el "yes" "\u03bd\u03b1\u03b9"
}

91
windowsAgent/dist/tk/msgs/en.msg vendored Normal file
View File

@ -0,0 +1,91 @@
namespace eval ::tk {
::msgcat::mcset en "&Abort"
::msgcat::mcset en "&About..."
::msgcat::mcset en "All Files"
::msgcat::mcset en "Application Error"
::msgcat::mcset en "&Apply"
::msgcat::mcset en "Bold"
::msgcat::mcset en "Bold Italic"
::msgcat::mcset en "&Blue"
::msgcat::mcset en "Cancel"
::msgcat::mcset en "&Cancel"
::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied."
::msgcat::mcset en "Choose Directory"
::msgcat::mcset en "Cl&ear"
::msgcat::mcset en "&Clear Console"
::msgcat::mcset en "Color"
::msgcat::mcset en "Console"
::msgcat::mcset en "&Copy"
::msgcat::mcset en "Cu&t"
::msgcat::mcset en "&Delete"
::msgcat::mcset en "Details >>"
::msgcat::mcset en "Directory \"%1\$s\" does not exist."
::msgcat::mcset en "&Directory:"
::msgcat::mcset en "&Edit"
::msgcat::mcset en "Effects"
::msgcat::mcset en "Error: %1\$s"
::msgcat::mcset en "E&xit"
::msgcat::mcset en "&File"
::msgcat::mcset en "File \"%1\$s\" already exists.\nDo you want to overwrite it?"
::msgcat::mcset en "File \"%1\$s\" already exists.\n\n"
::msgcat::mcset en "File \"%1\$s\" does not exist."
::msgcat::mcset en "File &name:"
::msgcat::mcset en "File &names:"
::msgcat::mcset en "Files of &type:"
::msgcat::mcset en "Fi&les:"
::msgcat::mcset en "&Filter"
::msgcat::mcset en "Fil&ter:"
::msgcat::mcset en "Font"
::msgcat::mcset en "&Font:"
::msgcat::mcset en "Font st&yle:"
::msgcat::mcset en "&Green"
::msgcat::mcset en "&Help"
::msgcat::mcset en "Hi"
::msgcat::mcset en "&Hide Console"
::msgcat::mcset en "&Ignore"
::msgcat::mcset en "Invalid file name \"%1\$s\"."
::msgcat::mcset en "Italic"
::msgcat::mcset en "Log Files"
::msgcat::mcset en "&No"
::msgcat::mcset en "&OK"
::msgcat::mcset en "OK"
::msgcat::mcset en "Ok"
::msgcat::mcset en "Open"
::msgcat::mcset en "&Open"
::msgcat::mcset en "Open Multiple Files"
::msgcat::mcset en "P&aste"
::msgcat::mcset en "&Quit"
::msgcat::mcset en "&Red"
::msgcat::mcset en "Regular"
::msgcat::mcset en "Replace existing file?"
::msgcat::mcset en "&Retry"
::msgcat::mcset en "Sample"
::msgcat::mcset en "&Save"
::msgcat::mcset en "Save As"
::msgcat::mcset en "Save To Log"
::msgcat::mcset en "Select Log File"
::msgcat::mcset en "Select a file to source"
::msgcat::mcset en "&Selection:"
::msgcat::mcset en "&Size:"
::msgcat::mcset en "Show &Hidden Directories"
::msgcat::mcset en "Show &Hidden Files and Directories"
::msgcat::mcset en "Skip Messages"
::msgcat::mcset en "&Source..."
::msgcat::mcset en "Stri&keout"
::msgcat::mcset en "Tcl Scripts"
::msgcat::mcset en "Tcl for Windows"
::msgcat::mcset en "Text Files"
::msgcat::mcset en "&Underline"
::msgcat::mcset en "&Yes"
::msgcat::mcset en "abort"
::msgcat::mcset en "blue"
::msgcat::mcset en "cancel"
::msgcat::mcset en "extension"
::msgcat::mcset en "extensions"
::msgcat::mcset en "green"
::msgcat::mcset en "ignore"
::msgcat::mcset en "ok"
::msgcat::mcset en "red"
::msgcat::mcset en "retry"
::msgcat::mcset en "yes"
}

3
windowsAgent/dist/tk/msgs/en_gb.msg vendored Normal file
View File

@ -0,0 +1,3 @@
namespace eval ::tk {
::msgcat::mcset en_gb Color Colour
}

75
windowsAgent/dist/tk/msgs/eo.msg vendored Normal file
View File

@ -0,0 +1,75 @@
namespace eval ::tk {
::msgcat::mcset eo "&Abort" "&\u0108esigo"
::msgcat::mcset eo "&About..." "Pri..."
::msgcat::mcset eo "All Files" "\u0108ioj dosieroj"
::msgcat::mcset eo "Application Error" "Aplikoerraro"
::msgcat::mcset eo "&Blue" "&Blua"
::msgcat::mcset eo "Cancel" "Rezignu"
::msgcat::mcset eo "&Cancel" "&Rezignu"
::msgcat::mcset eo "Cannot change to the directory \"%1\$s\".\nPermission denied." "Neeble \u0109angi al dosierulon \"%1\$s\".\nVi ne rajtas tion."
::msgcat::mcset eo "Choose Directory" "Elektu Dosierujo"
::msgcat::mcset eo "Cl&ear" "&Klaru"
::msgcat::mcset eo "&Clear Console" "&Klaru konzolon"
::msgcat::mcset eo "Color" "Farbo"
::msgcat::mcset eo "Console" "Konzolo"
::msgcat::mcset eo "&Copy" "&Kopiu"
::msgcat::mcset eo "Cu&t" "&Enpo\u015digu"
::msgcat::mcset eo "&Delete" "&Forprenu"
::msgcat::mcset eo "Details >>" "Detaloj >>"
::msgcat::mcset eo "Directory \"%1\$s\" does not exist." "La dosierujo \"%1\$s\" ne ekzistas."
::msgcat::mcset eo "&Directory:" "&Dosierujo:"
::msgcat::mcset eo "&Edit" "&Redaktu"
::msgcat::mcset eo "Error: %1\$s" "Eraro: %1\$s"
::msgcat::mcset eo "E&xit" "&Eliru"
::msgcat::mcset eo "&File" "&Dosiero"
::msgcat::mcset eo "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "La dosiero \"%1\$s\" jam ekzistas.\n\u0108u vi volas anstata\u00fbigi la dosieron?"
::msgcat::mcset eo "File \"%1\$s\" already exists.\n\n" "La dosiero \"%1\$s\" jam egzistas. \n\n"
::msgcat::mcset eo "File \"%1\$s\" does not exist." "La dosierp \"%1\$s\" ne estas."
::msgcat::mcset eo "File &name:" "Dosiero&nomo:"
::msgcat::mcset eo "File &names:" "Dosiero&nomoj:"
::msgcat::mcset eo "Files of &type:" "Dosieroj de &Typo:"
::msgcat::mcset eo "Fi&les:" "Do&sieroj:"
::msgcat::mcset eo "&Filter" "&Filtrilo"
::msgcat::mcset eo "Fil&ter:" "&Filtrilo:"
::msgcat::mcset eo "&Green" "&Verda"
::msgcat::mcset eo "&Help" "&Helpu"
::msgcat::mcset eo "Hi" "Saluton"
::msgcat::mcset eo "&Hide Console" "&Ka\u015du konzolon"
::msgcat::mcset eo "&Ignore" "&Ignoru"
::msgcat::mcset eo "Invalid file name \"%1\$s\"." "Malvalida dosieronomo \"%1\$s\"."
::msgcat::mcset eo "Log Files" "Protokolo"
::msgcat::mcset eo "&No" "&Ne"
::msgcat::mcset eo "&OK"
::msgcat::mcset eo "OK"
::msgcat::mcset eo "Ok"
::msgcat::mcset eo "Open" "Malfermu"
::msgcat::mcset eo "&Open" "&Malfermu"
::msgcat::mcset eo "Open Multiple Files" "Melfermu multan dosierojn"
::msgcat::mcset eo "P&aste" "&Elpo\u015digi"
::msgcat::mcset eo "&Quit" "&Finigu"
::msgcat::mcset eo "&Red" "&Rosa"
::msgcat::mcset eo "Replace existing file?" "\u0108u anstata\u00fbu ekzistantan dosieron?"
::msgcat::mcset eo "&Retry" "&Ripetu"
::msgcat::mcset eo "&Save" "&Savu"
::msgcat::mcset eo "Save As" "Savu kiel"
::msgcat::mcset eo "Save To Log" "Savu en protokolon"
::msgcat::mcset eo "Select Log File" "Elektu prokolodosieron"
::msgcat::mcset eo "Select a file to source" "Elektu dosieron por interpreti"
::msgcat::mcset eo "&Selection:" "&Elekto:"
::msgcat::mcset eo "Skip Messages" "transsaltu pluajn mesa\u011dojn"
::msgcat::mcset eo "&Source..." "&Fontoprogramo..."
::msgcat::mcset eo "Tcl Scripts" "Tcl-skriptoj"
::msgcat::mcset eo "Tcl for Windows" "Tcl por vindoso"
::msgcat::mcset eo "Text Files" "Tekstodosierojn"
::msgcat::mcset eo "&Yes" "&Jes"
::msgcat::mcset eo "abort" "\u0109esigo"
::msgcat::mcset eo "blue" "blua"
::msgcat::mcset eo "cancel" "rezignu"
::msgcat::mcset eo "extension" "ekspansio"
::msgcat::mcset eo "extensions" "ekspansioj"
::msgcat::mcset eo "green" "verda"
::msgcat::mcset eo "ignore" "ignorieren"
::msgcat::mcset eo "red" "ru\u011da"
::msgcat::mcset eo "retry" "ripetu"
::msgcat::mcset eo "yes" "jes"
}

76
windowsAgent/dist/tk/msgs/es.msg vendored Normal file
View File

@ -0,0 +1,76 @@
namespace eval ::tk {
::msgcat::mcset es "&Abort" "&Abortar"
::msgcat::mcset es "&About..." "&Acerca de ..."
::msgcat::mcset es "All Files" "Todos los archivos"
::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n"
::msgcat::mcset es "&Blue" "&Azul"
::msgcat::mcset es "Cancel" "Cancelar"
::msgcat::mcset es "&Cancel" "&Cancelar"
::msgcat::mcset es "Cannot change to the directory \"%1\$s\".\nPermission denied." "No es posible acceder al directorio \"%1\$s\".\nPermiso denegado."
::msgcat::mcset es "Choose Directory" "Elegir directorio"
::msgcat::mcset es "Cl&ear" "&Borrar"
::msgcat::mcset es "&Clear Console" "&Borrar consola"
::msgcat::mcset es "Color"
::msgcat::mcset es "Console" "Consola"
::msgcat::mcset es "&Copy" "&Copiar"
::msgcat::mcset es "Cu&t" "Cor&tar"
::msgcat::mcset es "&Delete" "&Borrar"
::msgcat::mcset es "Details >>" "Detalles >>"
::msgcat::mcset es "Directory \"%1\$s\" does not exist." "El directorio \"%1\$s\" no existe."
::msgcat::mcset es "&Directory:" "&Directorio:"
::msgcat::mcset es "&Edit" "&Editar"
::msgcat::mcset es "Error: %1\$s"
::msgcat::mcset es "E&xit" "Salir"
::msgcat::mcset es "&File" "&Archivo"
::msgcat::mcset es "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "El archivo \"%1\$s\" ya existe.\n\u00bfDesea sobreescribirlo?"
::msgcat::mcset es "File \"%1\$s\" already exists.\n\n" "El archivo \"%1\$s\" ya existe.\n\n"
::msgcat::mcset es "File \"%1\$s\" does not exist." "El archivo \"%1\$s\" no existe."
::msgcat::mcset es "File &name:" "&Nombre de archivo:"
::msgcat::mcset es "File &names:" "&Nombres de archivo:"
::msgcat::mcset es "Files of &type:" "Archivos de &tipo:"
::msgcat::mcset es "Fi&les:" "&Archivos:"
::msgcat::mcset es "&Filter" "&Filtro"
::msgcat::mcset es "Fil&ter:" "Fil&tro:"
::msgcat::mcset es "&Green" "&Verde"
::msgcat::mcset es "&Help" "&Ayuda"
::msgcat::mcset es "Hi" "Hola"
::msgcat::mcset es "&Hide Console" "&Esconder la consola"
::msgcat::mcset es "&Ignore" "&Ignorar"
::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inv\u00e1lido \"%1\$s\"."
::msgcat::mcset es "Log Files" "Ficheros de traza"
::msgcat::mcset es "&No"
::msgcat::mcset es "&OK"
::msgcat::mcset es "OK"
::msgcat::mcset es "Ok"
::msgcat::mcset es "Open" "Abrir"
::msgcat::mcset es "&Open" "&Abrir"
::msgcat::mcset es "Open Multiple Files" "Abrir m\u00faltiples archivos"
::msgcat::mcset es "P&aste" "Peg&ar"
::msgcat::mcset es "&Quit" "&Abandonar"
::msgcat::mcset es "&Red" "&Rojo"
::msgcat::mcset es "Replace existing file?" "\u00bfReemplazar el archivo existente?"
::msgcat::mcset es "&Retry" "&Reintentar"
::msgcat::mcset es "&Save" "&Guardar"
::msgcat::mcset es "Save As" "Guardar como"
::msgcat::mcset es "Save To Log" "Guardar al archivo de traza"
::msgcat::mcset es "Select Log File" "Elegir un archivo de traza"
::msgcat::mcset es "Select a file to source" "Seleccionar un archivo a evaluar"
::msgcat::mcset es "&Selection:" "&Selecci\u00f3n:"
::msgcat::mcset es "Skip Messages" "Omitir los mensajes"
::msgcat::mcset es "&Source..." "E&valuar..."
::msgcat::mcset es "Tcl Scripts" "Scripts Tcl"
::msgcat::mcset es "Tcl for Windows" "Tcl para Windows"
::msgcat::mcset es "Text Files" "Archivos de texto"
::msgcat::mcset es "&Yes" "&S\u00ed"
::msgcat::mcset es "abort" "abortar"
::msgcat::mcset es "blue" "azul"
::msgcat::mcset es "cancel" "cancelar"
::msgcat::mcset es "extension" "extensi\u00f3n"
::msgcat::mcset es "extensions" "extensiones"
::msgcat::mcset es "green" "verde"
::msgcat::mcset es "ignore" "ignorar"
::msgcat::mcset es "ok"
::msgcat::mcset es "red" "rojo"
::msgcat::mcset es "retry" "reintentar"
::msgcat::mcset es "yes" "s\u00ed"
}

72
windowsAgent/dist/tk/msgs/fr.msg vendored Normal file
View File

@ -0,0 +1,72 @@
namespace eval ::tk {
::msgcat::mcset fr "&Abort" "&Annuler"
::msgcat::mcset fr "About..." "\u00c0 propos..."
::msgcat::mcset fr "All Files" "Tous les fichiers"
::msgcat::mcset fr "Application Error" "Erreur d'application"
::msgcat::mcset fr "&Blue" "&Bleu"
::msgcat::mcset fr "Cancel" "Annuler"
::msgcat::mcset fr "&Cancel" "&Annuler"
::msgcat::mcset fr "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossible d'acc\u00e9der au r\u00e9pertoire \"%1\$s\".\nPermission refus\u00e9e."
::msgcat::mcset fr "Choose Directory" "Choisir r\u00e9pertoire"
::msgcat::mcset fr "Cl&ear" "Effacer"
::msgcat::mcset fr "Color" "Couleur"
::msgcat::mcset fr "Console"
::msgcat::mcset fr "Copy" "Copier"
::msgcat::mcset fr "Cu&t" "Couper"
::msgcat::mcset fr "Delete" "Effacer"
::msgcat::mcset fr "Details >>" "D\u00e9tails >>"
::msgcat::mcset fr "Directory \"%1\$s\" does not exist." "Le r\u00e9pertoire \"%1\$s\" n'existe pas."
::msgcat::mcset fr "&Directory:" "&R\u00e9pertoire:"
::msgcat::mcset fr "Error: %1\$s" "Erreur: %1\$s"
::msgcat::mcset fr "E&xit" "Quitter"
::msgcat::mcset fr "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\nVoulez-vous l'\u00e9craser?"
::msgcat::mcset fr "File \"%1\$s\" already exists.\n\n" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\n\n"
::msgcat::mcset fr "File \"%1\$s\" does not exist." "Le fichier \"%1\$s\" n'existe pas."
::msgcat::mcset fr "File &name:" "&Nom de fichier:"
::msgcat::mcset fr "File &names:" "&Noms de fichiers:"
::msgcat::mcset fr "Files of &type:" "&Type de fichiers:"
::msgcat::mcset fr "Fi&les:" "Fich&iers:"
::msgcat::mcset fr "&Filter" "&Filtre"
::msgcat::mcset fr "Fil&ter:" "Fil&tre:"
::msgcat::mcset fr "&Green" "&Vert"
::msgcat::mcset fr "Hi" "Salut"
::msgcat::mcset fr "&Hide Console" "Cacher la Console"
::msgcat::mcset fr "&Ignore" "&Ignorer"
::msgcat::mcset fr "Invalid file name \"%1\$s\"." "Nom de fichier invalide \"%1\$s\"."
::msgcat::mcset fr "Log Files" "Fichiers de trace"
::msgcat::mcset fr "&No" "&Non"
::msgcat::mcset fr "&OK"
::msgcat::mcset fr "OK"
::msgcat::mcset fr "Ok"
::msgcat::mcset fr "Open" "Ouvrir"
::msgcat::mcset fr "&Open" "&Ouvrir"
::msgcat::mcset fr "Open Multiple Files" "Ouvrir plusieurs fichiers"
::msgcat::mcset fr "P&aste" "Coller"
::msgcat::mcset fr "&Quit" "&Quitter"
::msgcat::mcset fr "&Red" "&Rouge"
::msgcat::mcset fr "Replace existing file?" "Remplacer le fichier existant?"
::msgcat::mcset fr "&Retry" "&R\u00e9-essayer"
::msgcat::mcset fr "&Save" "&Sauvegarder"
::msgcat::mcset fr "Save As" "Sauvegarder sous"
::msgcat::mcset fr "Save To Log" "Sauvegarde au fichier de trace"
::msgcat::mcset fr "Select Log File" "Choisir un fichier de trace"
::msgcat::mcset fr "Select a file to source" "Choisir un fichier \u00e0 \u00e9valuer"
::msgcat::mcset fr "&Selection:" "&S\u00e9lection:"
::msgcat::mcset fr "Skip Messages" "Omettre les messages"
::msgcat::mcset fr "&Source..." "\u00c9valuer..."
::msgcat::mcset fr "Tcl Scripts" "Scripts Tcl"
::msgcat::mcset fr "Tcl for Windows" "Tcl pour Windows"
::msgcat::mcset fr "Text Files" "Fichiers texte"
::msgcat::mcset fr "&Yes" "&Oui"
::msgcat::mcset fr "abort" "abandonner"
::msgcat::mcset fr "blue" "bleu"
::msgcat::mcset fr "cancel" "annuler"
::msgcat::mcset fr "extension"
::msgcat::mcset fr "extensions"
::msgcat::mcset fr "green" "vert"
::msgcat::mcset fr "ignore" "ignorer"
::msgcat::mcset fr "ok"
::msgcat::mcset fr "red" "rouge"
::msgcat::mcset fr "retry" "r\u00e9essayer"
::msgcat::mcset fr "yes" "oui"
}

78
windowsAgent/dist/tk/msgs/hu.msg vendored Normal file
View File

@ -0,0 +1,78 @@
namespace eval ::tk {
::msgcat::mcset hu "&Abort" "&Megszak\u00edt\u00e1s"
::msgcat::mcset hu "&About..." "N\u00e9vjegy..."
::msgcat::mcset hu "All Files" "Minden f\u00e1jl"
::msgcat::mcset hu "Application Error" "Alkalmaz\u00e1s hiba"
::msgcat::mcset hu "&Blue" "&K\u00e9k"
::msgcat::mcset hu "Cancel" "M\u00e9gsem"
::msgcat::mcset hu "&Cancel" "M\u00e9g&sem"
::msgcat::mcset hu "Cannot change to the directory \"%1\$s\".\nPermission denied." "A k\u00f6nyvt\u00e1rv\u00e1lt\u00e1s nem siker\u00fclt: \"%1\$s\".\nHozz\u00e1f\u00e9r\u00e9s megtagadva."
::msgcat::mcset hu "Choose Directory" "K\u00f6nyvt\u00e1r kiv\u00e1laszt\u00e1sa"
::msgcat::mcset hu "Cl&ear" "T\u00f6rl\u00e9s"
::msgcat::mcset hu "&Clear Console" "&T\u00f6rl\u00e9s Konzol"
::msgcat::mcset hu "Color" "Sz\u00edn"
::msgcat::mcset hu "Console" "Konzol"
::msgcat::mcset hu "&Copy" "&M\u00e1sol\u00e1s"
::msgcat::mcset hu "Cu&t" "&Kiv\u00e1g\u00e1s"
::msgcat::mcset hu "&Delete" "&T\u00f6rl\u00e9s"
::msgcat::mcset hu "Details >>" "R\u00e9szletek >>"
::msgcat::mcset hu "Directory \"%1\$s\" does not exist." "\"%1\$s\" k\u00f6nyvt\u00e1r nem l\u00e9tezik."
::msgcat::mcset hu "&Directory:" "&K\u00f6nyvt\u00e1r:"
#::msgcat::mcset hu "&Edit"
::msgcat::mcset hu "Error: %1\$s" "Hiba: %1\$s"
::msgcat::mcset hu "E&xit" "Kil\u00e9p\u00e9s"
::msgcat::mcset hu "&File" "&F\u00e1jl"
::msgcat::mcset hu "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "\"%1\$s\" f\u00e1jl m\u00e1r l\u00e9tezik.\nFel\u00fcl\u00edrjam?"
::msgcat::mcset hu "File \"%1\$s\" already exists.\n\n" "\"%1\$s\" f\u00e1jl m\u00e1r l\u00e9tezik.\n\n"
::msgcat::mcset hu "File \"%1\$s\" does not exist." "\"%1\$s\" f\u00e1jl nem l\u00e9tezik."
::msgcat::mcset hu "File &name:" "F\u00e1jl &neve:"
::msgcat::mcset hu "File &names:" "F\u00e1jlok &nevei:"
::msgcat::mcset hu "Files of &type:" "F\u00e1jlok &t\u00edpusa:"
::msgcat::mcset hu "Fi&les:" "F\u00e1j&lok:"
::msgcat::mcset hu "&Filter" "&Sz\u0171r\u0151"
::msgcat::mcset hu "Fil&ter:" "S&z\u0171r\u0151:"
::msgcat::mcset hu "&Green" "&Z\u00f6ld"
#::msgcat::mcset hu "&Help"
::msgcat::mcset hu "Hi" "\u00dcdv"
::msgcat::mcset hu "&Hide Console" "Konzol &elrejt\u00e9se"
::msgcat::mcset hu "&Ignore" "K&ihagy\u00e1s"
::msgcat::mcset hu "Invalid file name \"%1\$s\"." "\u00c9rv\u00e9nytelen f\u00e1jln\u00e9v: \"%1\$s\"."
::msgcat::mcset hu "Log Files" "Log f\u00e1jlok"
::msgcat::mcset hu "&No" "&Nem"
::msgcat::mcset hu "&OK"
::msgcat::mcset hu "OK"
::msgcat::mcset hu "Ok"
::msgcat::mcset hu "Open" "Megnyit\u00e1s"
::msgcat::mcset hu "&Open" "&Megnyit\u00e1s"
::msgcat::mcset hu "Open Multiple Files" "T\u00f6bb f\u00e1jl megnyit\u00e1sa"
::msgcat::mcset hu "P&aste" "&Beilleszt\u00e9s"
::msgcat::mcset hu "&Quit" "&Kil\u00e9p\u00e9s"
::msgcat::mcset hu "&Red" "&V\u00f6r\u00f6s"
::msgcat::mcset hu "Replace existing file?" "Megl\u00e9v\u0151 f\u00e1jl cser\u00e9je?"
::msgcat::mcset hu "&Retry" "\u00daj&ra"
::msgcat::mcset hu "&Save" "&Ment\u00e9s"
::msgcat::mcset hu "Save As" "Ment\u00e9s m\u00e1sk\u00e9nt"
::msgcat::mcset hu "Save To Log" "Ment\u00e9s log f\u00e1jlba"
::msgcat::mcset hu "Select Log File" "Log f\u00e1jl kiv\u00e1laszt\u00e1sa"
::msgcat::mcset hu "Select a file to source" "Forr\u00e1sf\u00e1jl kiv\u00e1laszt\u00e1sa"
::msgcat::mcset hu "&Selection:" "&Kijel\u00f6l\u00e9s:"
::msgcat::mcset hu "Show &Hidden Directories" "&Rejtett k\u00f6nyvt\u00e1rak megjelen\u00edt\u00e9se"
::msgcat::mcset hu "Show &Hidden Files and Directories" "&Rejtett f\u00e1jlok \u00e9s k\u00f6nyvt\u00e1rak megjelen\u00edt\u00e9se"
::msgcat::mcset hu "Skip Messages" "\u00dczenetek kihagy\u00e1sa"
::msgcat::mcset hu "&Source..." "&Forr\u00e1s..."
::msgcat::mcset hu "Tcl Scripts" "Tcl scriptek"
::msgcat::mcset hu "Tcl for Windows" "Tcl Windows-hoz"
::msgcat::mcset hu "Text Files" "Sz\u00f6vegf\u00e1jlok"
::msgcat::mcset hu "&Yes" "&Igen"
::msgcat::mcset hu "abort" "megszak\u00edt\u00e1s"
::msgcat::mcset hu "blue" "k\u00e9k"
::msgcat::mcset hu "cancel" "m\u00e9gsem"
::msgcat::mcset hu "extension" "kiterjeszt\u00e9s"
::msgcat::mcset hu "extensions" "kiterjeszt\u00e9sek"
::msgcat::mcset hu "green" "z\u00f6ld"
::msgcat::mcset hu "ignore" "ignorer"
::msgcat::mcset hu "ok"
::msgcat::mcset hu "red" "v\u00f6r\u00f6s"
::msgcat::mcset hu "retry" "\u00fajra"
::msgcat::mcset hu "yes" "igen"
}

73
windowsAgent/dist/tk/msgs/it.msg vendored Normal file
View File

@ -0,0 +1,73 @@
namespace eval ::tk {
::msgcat::mcset it "&Abort" "&Interrompi"
::msgcat::mcset it "&About..." "Informazioni..."
::msgcat::mcset it "All Files" "Tutti i file"
::msgcat::mcset it "Application Error" "Errore dell' applicazione"
::msgcat::mcset it "&Blue" "&Blu"
::msgcat::mcset it "Cancel" "Annulla"
::msgcat::mcset it "&Cancel" "&Annulla"
::msgcat::mcset it "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossibile accedere alla directory \"%1\$s\".\nPermesso negato."
::msgcat::mcset it "Choose Directory" "Scegli una directory"
::msgcat::mcset it "Cl&ear" "Azzera"
::msgcat::mcset it "&Clear Console" "Azzera Console"
::msgcat::mcset it "Color" "Colore"
::msgcat::mcset it "Console"
::msgcat::mcset it "&Copy" "Copia"
::msgcat::mcset it "Cu&t" "Taglia"
::msgcat::mcset it "Delete" "Cancella"
::msgcat::mcset it "Details >>" "Dettagli >>"
::msgcat::mcset it "Directory \"%1\$s\" does not exist." "La directory \"%1\$s\" non esiste."
::msgcat::mcset it "&Directory:"
::msgcat::mcset it "Error: %1\$s" "Errore: %1\$s"
::msgcat::mcset it "E&xit" "Esci"
::msgcat::mcset it "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Il file \"%1\$s\" esiste gi\u00e0.\nVuoi sovrascriverlo?"
::msgcat::mcset it "File \"%1\$s\" already exists.\n\n" "Il file \"%1\$s\" esiste gi\u00e0.\n\n"
::msgcat::mcset it "File \"%1\$s\" does not exist." "Il file \"%1\$s\" non esiste."
::msgcat::mcset it "File &name:" "&Nome del file:"
::msgcat::mcset it "File &names:" "&Nomi dei file:"
::msgcat::mcset it "Files of &type:" "File di &tipo:"
::msgcat::mcset it "Fi&les:" "Fi&le:"
::msgcat::mcset it "&Filter" "&Filtro"
::msgcat::mcset it "Fil&ter:" "Fil&tro:"
::msgcat::mcset it "&Green" "&Verde"
::msgcat::mcset it "Hi" "Salve"
::msgcat::mcset it "&Hide Console" "Nascondi la console"
::msgcat::mcset it "&Ignore" "&Ignora"
::msgcat::mcset it "Invalid file name \"%1\$s\"." "Nome di file non valido \"%1\$s\"."
::msgcat::mcset it "Log Files" "File di log"
::msgcat::mcset it "&No"
::msgcat::mcset it "&OK"
::msgcat::mcset it "OK"
::msgcat::mcset it "Ok"
::msgcat::mcset it "Open" "Apri"
::msgcat::mcset it "&Open" "A&pri"
::msgcat::mcset it "Open Multiple Files" "Apri file multipli"
::msgcat::mcset it "P&aste" "Incolla"
::msgcat::mcset it "&Quit" "Esci"
::msgcat::mcset it "&Red" "&Rosso"
::msgcat::mcset it "Replace existing file?" "Sostituisci il file esistente?"
::msgcat::mcset it "&Retry" "&Riprova"
::msgcat::mcset it "&Save" "&Salva"
::msgcat::mcset it "Save As" "Salva come"
::msgcat::mcset it "Save To Log" "Salva il log"
::msgcat::mcset it "Select Log File" "Scegli un file di log"
::msgcat::mcset it "Select a file to source" "Scegli un file da eseguire"
::msgcat::mcset it "&Selection:" "&Selezione:"
::msgcat::mcset it "Skip Messages" "Salta i messaggi"
::msgcat::mcset it "Source..." "Esegui..."
::msgcat::mcset it "Tcl Scripts" "Script Tcl"
::msgcat::mcset it "Tcl for Windows" "Tcl per Windows"
::msgcat::mcset it "Text Files" "File di testo"
::msgcat::mcset it "&Yes" "&S\u00ec"
::msgcat::mcset it "abort" "interrompi"
::msgcat::mcset it "blue" "blu"
::msgcat::mcset it "cancel" "annulla"
::msgcat::mcset it "extension" "estensione"
::msgcat::mcset it "extensions" "estensioni"
::msgcat::mcset it "green" "verde"
::msgcat::mcset it "ignore" "ignora"
::msgcat::mcset it "ok"
::msgcat::mcset it "red" "rosso"
::msgcat::mcset it "retry" "riprova"
::msgcat::mcset it "yes" "s\u00ec"
}

91
windowsAgent/dist/tk/msgs/nl.msg vendored Normal file
View File

@ -0,0 +1,91 @@
namespace eval ::tk {
::msgcat::mcset nl "&Abort" "&Afbreken"
::msgcat::mcset nl "&About..." "Over..."
::msgcat::mcset nl "All Files" "Alle Bestanden"
::msgcat::mcset nl "Application Error" "Toepassingsfout"
::msgcat::mcset nl "&Apply" "Toepassen"
::msgcat::mcset nl "Bold" "Vet"
::msgcat::mcset nl "Bold Italic" "Vet Cursief"
::msgcat::mcset nl "&Blue" "&Blauw"
::msgcat::mcset nl "Cancel" "Annuleren"
::msgcat::mcset nl "&Cancel" "&Annuleren"
::msgcat::mcset nl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan niet naar map \"%1\$s\" gaan.\nU heeft hiervoor geen toestemming."
::msgcat::mcset nl "Choose Directory" "Kies map"
::msgcat::mcset nl "Cl&ear" "Wissen"
::msgcat::mcset nl "&Clear Console" "&Wis Console"
::msgcat::mcset nl "Color" "Kleur"
::msgcat::mcset nl "Console"
::msgcat::mcset nl "&Copy" "Kopi\u00ebren"
::msgcat::mcset nl "Cu&t" "Knippen"
::msgcat::mcset nl "&Delete" "Wissen"
::msgcat::mcset nl "Details >>"
::msgcat::mcset nl "Directory \"%1\$s\" does not exist." "Map \"%1\$s\" bestaat niet."
::msgcat::mcset nl "&Directory:" "&Map:"
::msgcat::mcset nl "&Edit" "Bewerken"
::msgcat::mcset nl "Effects" "Effecten"
::msgcat::mcset nl "Error: %1\$s" "Fout: %1\$s"
::msgcat::mcset nl "E&xit" "Be\u00ebindigen"
::msgcat::mcset nl "&File" "Bestand"
::msgcat::mcset nl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Bestand \"%1\$s\" bestaat al.\nWilt u het overschrijven?"
::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n"
::msgcat::mcset nl "File \"%1\$s\" does not exist." "Bestand \"%1\$s\" bestaat niet."
::msgcat::mcset nl "File &name:" "Bestands&naam:"
::msgcat::mcset nl "File &names:" "Bestands&namen:"
::msgcat::mcset nl "Files of &type:" "Bestanden van het &type:"
::msgcat::mcset nl "Fi&les:" "&Bestanden:"
::msgcat::mcset nl "&Filter"
::msgcat::mcset nl "Fil&ter:"
::msgcat::mcset nl "Font"
::msgcat::mcset nl "&Font:"
::msgcat::mcset nl "Font st&yle:" "Font stijl:"
::msgcat::mcset nl "&Green" "&Groen"
::msgcat::mcset nl "&Help"
::msgcat::mcset nl "Hi" "H\u00e9"
::msgcat::mcset nl "&Hide Console" "Verberg Console"
::msgcat::mcset nl "&Ignore" "&Negeren"
::msgcat::mcset nl "Invalid file name \"%1\$s\"." "Ongeldige bestandsnaam \"%1\$s\"."
::msgcat::mcset nl "Italic" "Cursief"
::msgcat::mcset nl "Log Files" "Log Bestanden"
::msgcat::mcset nl "&No" "&Nee"
::msgcat::mcset nl "&OK"
::msgcat::mcset nl "OK"
::msgcat::mcset nl "Ok"
::msgcat::mcset nl "Open" "Openen"
::msgcat::mcset nl "&Open" "&Openen"
::msgcat::mcset nl "Open Multiple Files" "Open meerdere bestanden"
::msgcat::mcset nl "P&aste" "Pl&akken"
::msgcat::mcset nl "&Quit" "Stoppen"
::msgcat::mcset nl "&Red" "&Rood"
::msgcat::mcset nl "Regular" "Standaard"
::msgcat::mcset nl "Replace existing file?" "Vervang bestaand bestand?"
::msgcat::mcset nl "&Retry" "&Herhalen"
::msgcat::mcset nl "Sample"
::msgcat::mcset nl "&Save" "Op&slaan"
::msgcat::mcset nl "Save As" "Opslaan als"
::msgcat::mcset nl "Save To Log" "Opslaan naar Log"
::msgcat::mcset nl "Select Log File" "Selecteer Log bestand"
::msgcat::mcset nl "Select a file to source" "Selecteer bronbestand"
::msgcat::mcset nl "&Selection:" "&Selectie:"
::msgcat::mcset nl "&Size:" "Grootte"
::msgcat::mcset nl "Show &Hidden Directories" "Laat verborgen mappen zien"
::msgcat::mcset nl "Show &Hidden Files and Directories" "Laat verborgen bestanden mappen zien"
::msgcat::mcset nl "Skip Messages" "Berichten overslaan"
::msgcat::mcset nl "&Source..." "Bron..."
::msgcat::mcset nl "Stri&keout"
::msgcat::mcset nl "Tcl Scripts"
::msgcat::mcset nl "Tcl for Windows" "Tcl voor Windows"
::msgcat::mcset nl "Text Files" "Tekstbestanden"
::msgcat::mcset nl "&Underline" "Onderstreept"
::msgcat::mcset nl "&Yes" "&Ja"
::msgcat::mcset nl "abort" "afbreken"
::msgcat::mcset nl "blue" "blauw"
::msgcat::mcset nl "cancel" "annuleren"
::msgcat::mcset nl "extension"
::msgcat::mcset nl "extensions"
::msgcat::mcset nl "green" "groen"
::msgcat::mcset nl "ignore" "negeren"
::msgcat::mcset nl "ok"
::msgcat::mcset nl "red" "rood"
::msgcat::mcset nl "retry" "opnieuw"
::msgcat::mcset nl "yes" "ja"
}

91
windowsAgent/dist/tk/msgs/pl.msg vendored Normal file
View File

@ -0,0 +1,91 @@
namespace eval ::tk {
::msgcat::mcset pl "&Abort" "&Przerwij"
::msgcat::mcset pl "&About..." "O programie..."
::msgcat::mcset pl "All Files" "Wszystkie pliki"
::msgcat::mcset pl "Application Error" "B\u0142\u0105d w programie"
::msgcat::mcset pl "&Apply" "Zastosuj"
::msgcat::mcset pl "Bold" "Pogrubienie"
::msgcat::mcset pl "Bold Italic" "Pogrubiona kursywa"
::msgcat::mcset pl "&Blue" "&Niebieski"
::msgcat::mcset pl "Cancel" "Anuluj"
::msgcat::mcset pl "&Cancel" "&Anuluj"
::msgcat::mcset pl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nie mo\u017cna otworzy\u0107 katalogu \"%1\$s\".\nOdmowa dost\u0119pu."
::msgcat::mcset pl "Choose Directory" "Wybierz katalog"
::msgcat::mcset pl "Cl&ear" "&Wyczy\u015b\u0107"
::msgcat::mcset pl "&Clear Console" "&Wyczy\u015b\u0107 konsol\u0119"
::msgcat::mcset pl "Color" "Kolor"
::msgcat::mcset pl "Console" "Konsola"
::msgcat::mcset pl "&Copy" "&Kopiuj"
::msgcat::mcset pl "Cu&t" "&Wytnij"
::msgcat::mcset pl "&Delete" "&Usu\u0144"
::msgcat::mcset pl "Details >>" "Szczeg\u00f3\u0142y >>"
::msgcat::mcset pl "Directory \"%1\$s\" does not exist." "Katalog \"%1\$s\" nie istnieje."
::msgcat::mcset pl "&Directory:" "&Katalog:"
::msgcat::mcset pl "&Edit" "&Edytuj"
::msgcat::mcset pl "Effects" "Efekty"
::msgcat::mcset pl "Error: %1\$s" "B\u0142\u0105d: %1\$s"
::msgcat::mcset pl "E&xit" "&Wyjd\u017a"
::msgcat::mcset pl "&File" "&Plik"
::msgcat::mcset pl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Plik \"%1\$s\" ju\u017c istnieje.\nCzy chcesz go nadpisa\u0107?"
::msgcat::mcset pl "File \"%1\$s\" already exists.\n\n" "Plik \"%1\$s\" ju\u017c istnieje.\n\n"
::msgcat::mcset pl "File \"%1\$s\" does not exist." "Plik \"%1\$s\" nie istnieje."
::msgcat::mcset pl "File &name:" "Nazwa &pliku:"
::msgcat::mcset pl "File &names:" "Nazwy &plik\u00f3w:"
::msgcat::mcset pl "Files of &type:" "Pliki &typu:"
::msgcat::mcset pl "Fi&les:" "Pli&ki:"
::msgcat::mcset pl "&Filter" "&Filtr"
::msgcat::mcset pl "Fil&ter:" "&Filtr:"
::msgcat::mcset pl "Font" "Czcionka"
::msgcat::mcset pl "&Font:" "Czcio&nka:"
::msgcat::mcset pl "Font st&yle:" "&Styl czcionki:"
::msgcat::mcset pl "&Green" "&Zielony"
::msgcat::mcset pl "&Help" "&Pomoc"
::msgcat::mcset pl "Hi" "Witaj"
::msgcat::mcset pl "&Hide Console" "&Ukryj konsol\u0119"
::msgcat::mcset pl "&Ignore" "&Ignoruj"
::msgcat::mcset pl "Invalid file name \"%1\$s\"." "Niew\u0142a\u015bciwa nazwa pliku \"%1\$s\"."
::msgcat::mcset pl "Italic" "Kursywa"
::msgcat::mcset pl "Log Files" "Pliki dziennika"
::msgcat::mcset pl "&No" "&Nie"
::msgcat::mcset pl "&OK"
::msgcat::mcset pl "OK"
::msgcat::mcset pl "Ok"
::msgcat::mcset pl "Open" "Otw\u00f3rz"
::msgcat::mcset pl "&Open" "&Otw\u00f3rz"
::msgcat::mcset pl "Open Multiple Files" "Otw\u00f3rz wiele plik\u00f3w"
::msgcat::mcset pl "P&aste" "&Wklej"
::msgcat::mcset pl "&Quit" "&Zako\u0144cz"
::msgcat::mcset pl "&Red" "&Czerwony"
::msgcat::mcset pl "Regular" "Regularne"
::msgcat::mcset pl "Replace existing file?" "Czy zast\u0105pi\u0107 istniej\u0105cy plik?"
::msgcat::mcset pl "&Retry" "&Pon\u00f3w"
::msgcat::mcset pl "Sample" "Przyk\u0142ad"
::msgcat::mcset pl "&Save" "&Zapisz"
::msgcat::mcset pl "Save As" "Zapisz jako"
::msgcat::mcset pl "Save To Log" "Wpisz do dziennika"
::msgcat::mcset pl "Select Log File" "Wybierz plik dziennika"
::msgcat::mcset pl "Select a file to source" "Wybierz plik do wykonania"
::msgcat::mcset pl "&Selection:" "&Wyb\u00f3r:"
::msgcat::mcset pl "&Size:" "&Rozmiar:"
::msgcat::mcset pl "Show &Hidden Directories" "Poka\u017c &ukryte katalogi"
::msgcat::mcset pl "Show &Hidden Files and Directories" "Poka\u017c &ukryte pliki i katalogi"
::msgcat::mcset pl "Skip Messages" "Pomi\u0144 pozosta\u0142e komunikaty"
::msgcat::mcset pl "&Source..." "&Kod \u017ar\u00f3d\u0142owy..."
::msgcat::mcset pl "Stri&keout" "&Przekre\u015blenie"
::msgcat::mcset pl "Tcl Scripts" "Skrypty Tcl"
::msgcat::mcset pl "Tcl for Windows" "Tcl dla Windows"
::msgcat::mcset pl "Text Files" "Pliki tekstowe"
::msgcat::mcset pl "&Underline" "Po&dkre\u015blenie"
::msgcat::mcset pl "&Yes" "&Tak"
::msgcat::mcset pl "abort" "przerwij"
::msgcat::mcset pl "blue" "niebieski"
::msgcat::mcset pl "cancel" "anuluj"
::msgcat::mcset pl "extension" "rozszerzenie"
::msgcat::mcset pl "extensions" "rozszerzenia"
::msgcat::mcset pl "green" "zielony"
::msgcat::mcset pl "ignore" "ignoruj"
::msgcat::mcset pl "ok"
::msgcat::mcset pl "red" "czerwony"
::msgcat::mcset pl "retry" "pon\u00f3w"
::msgcat::mcset pl "yes" "tak"
}

74
windowsAgent/dist/tk/msgs/pt.msg vendored Normal file
View File

@ -0,0 +1,74 @@
namespace eval ::tk {
::msgcat::mcset pt "&Abort" "&Abortar"
::msgcat::mcset pt "About..." "Sobre ..."
::msgcat::mcset pt "All Files" "Todos os arquivos"
::msgcat::mcset pt "Application Error" "Erro de aplica\u00e7\u00e3o"
::msgcat::mcset pt "&Blue" "&Azul"
::msgcat::mcset pt "Cancel" "Cancelar"
::msgcat::mcset pt "&Cancel" "&Cancelar"
::msgcat::mcset pt "Cannot change to the directory \"%1\$s\".\nPermission denied." "N\u00e3o foi poss\u00edvel mudar para o diret\u00f3rio \"%1\$s\".\nPermiss\u00e3o negada."
::msgcat::mcset pt "Choose Directory" "Escolha um diret\u00f3rio"
::msgcat::mcset pt "Cl&ear" "Apagar"
::msgcat::mcset pt "&Clear Console" "Apagar Console"
::msgcat::mcset pt "Color" "Cor"
::msgcat::mcset pt "Console"
::msgcat::mcset pt "&Copy" "Copiar"
::msgcat::mcset pt "Cu&t" "Recortar"
::msgcat::mcset pt "&Delete" "Excluir"
::msgcat::mcset pt "Details >>" "Detalhes >>"
::msgcat::mcset pt "Directory \"%1\$s\" does not exist." "O diret\u00f3rio \"%1\$s\" n\u00e3o existe."
::msgcat::mcset pt "&Directory:" "&Diret\u00f3rio:"
::msgcat::mcset pt "Error: %1\$s" "Erro: %1\$s"
::msgcat::mcset pt "E&xit" "Sair"
::msgcat::mcset pt "&File" "Arquivo"
::msgcat::mcset pt "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" j\u00e1 existe.\nDeseja sobrescreve-lo?"
::msgcat::mcset pt "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" j\u00e1 existe.\n\n"
::msgcat::mcset pt "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" n\u00e3o existe."
::msgcat::mcset pt "File &name:" "&Nome do arquivo:"
::msgcat::mcset pt "File &names:" "&Nomes dos arquivos:"
::msgcat::mcset pt "Files of &type:" "Arquivos do &tipo:"
::msgcat::mcset pt "Fi&les:" "&Arquivos:"
::msgcat::mcset pt "&Filter" "&Filtro"
::msgcat::mcset pt "Fil&ter:" "Fil&tro:"
::msgcat::mcset pt "&Green" "&Verde"
::msgcat::mcset pt "Hi" "Oi"
::msgcat::mcset pt "&Hide Console" "Ocultar console"
::msgcat::mcset pt "&Ignore" "&Ignorar"
::msgcat::mcset pt "Invalid file name \"%1\$s\"." "O nome do arquivo \u00e9 inv\u00e1lido \"%1\$s\"."
::msgcat::mcset pt "Log Files" "Arquivos de log"
::msgcat::mcset pt "&No" "&N\u00e3o"
::msgcat::mcset pt "&OK"
::msgcat::mcset pt "OK"
::msgcat::mcset pt "Ok"
::msgcat::mcset pt "Open" "Abrir"
::msgcat::mcset pt "&Open" "&Abrir"
::msgcat::mcset pt "Open Multiple Files" "Abrir m\u00faltiplos arquivos"
::msgcat::mcset pt "P&aste" "Col&ar"
::msgcat::mcset pt "Quit" "Encerrar"
::msgcat::mcset pt "&Red" "&Vermelho"
::msgcat::mcset pt "Replace existing file?" "Substituir arquivo existente?"
::msgcat::mcset pt "&Retry" "Tenta&r novamente"
::msgcat::mcset pt "&Save" "&Salvar"
::msgcat::mcset pt "Save As" "Salvar como"
::msgcat::mcset pt "Save To Log" "Salvar arquivo de log"
::msgcat::mcset pt "Select Log File" "Selecionar arquivo de log"
::msgcat::mcset pt "Select a file to source" "Selecione um arquivo como fonte"
::msgcat::mcset pt "&Selection:" "&Sele\u00e7\u00e3o:"
::msgcat::mcset pt "Skip Messages" "Omitir as mensagens"
::msgcat::mcset pt "&Source..." "&Fonte..."
::msgcat::mcset pt "Tcl Scripts" "Scripts Tcl"
::msgcat::mcset pt "Tcl for Windows" "Tcl para Windows"
::msgcat::mcset pt "Text Files" "Arquivos de texto"
::msgcat::mcset pt "&Yes" "&Sim"
::msgcat::mcset pt "abort" "abortar"
::msgcat::mcset pt "blue" "azul"
::msgcat::mcset pt "cancel" "cancelar"
::msgcat::mcset pt "extension" "extens\u00e3o"
::msgcat::mcset pt "extensions" "extens\u00f5es"
::msgcat::mcset pt "green" "verde"
::msgcat::mcset pt "ignore" "ignorar"
::msgcat::mcset pt "ok"
::msgcat::mcset pt "red" "vermelho"
::msgcat::mcset pt "retry" "tentar novamente"
::msgcat::mcset pt "yes" "sim"
}

75
windowsAgent/dist/tk/msgs/ru.msg vendored Normal file
View File

@ -0,0 +1,75 @@
namespace eval ::tk {
::msgcat::mcset ru "&Abort" "&\u041e\u0442\u043c\u0435\u043d\u0438\u0442\u044c"
::msgcat::mcset ru "&About..." "\u041f\u0440\u043e..."
::msgcat::mcset ru "All Files" "\u0412\u0441\u0435 \u0444\u0430\u0439\u043b\u044b"
::msgcat::mcset ru "Application Error" "\u041e\u0448\u0438\u0431\u043a\u0430 \u0432 \u043f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0435"
::msgcat::mcset ru "&Blue" " &\u0413\u043e\u043b\u0443\u0431\u043e\u0439"
::msgcat::mcset ru "Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430"
::msgcat::mcset ru "&Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430"
::msgcat::mcset ru "Cannot change to the directory \"%1\$s\".\nPermission denied." \
"\u041d\u0435 \u043c\u043e\u0433\u0443 \u043f\u0435\u0440\u0435\u0439\u0442\u0438 \u0432 \u043a\u0430\u0442\u0430\u043b\u043e\u0433 \"%1\$s\".\n\u041d\u0435\u0434\u043e\u0441\u0442\u0430\u0442\u043e\u0447\u043d\u043e \u043f\u0440\u0430\u0432 \u0434\u043e\u0441\u0442\u0443\u043f\u0430"
::msgcat::mcset ru "Choose Directory" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u043a\u0430\u0442\u0430\u043b\u043e\u0433"
::msgcat::mcset ru "Cl&ear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c"
::msgcat::mcset ru "Color" "\u0426\u0432\u0435\u0442"
::msgcat::mcset ru "Console" "\u041a\u043e\u043d\u0441\u043e\u043b\u044c"
::msgcat::mcset ru "&Copy" "\u041a\u043e\u043f\u0438\u0440\u043e\u0432\u0430\u0442\u044c"
::msgcat::mcset ru "Cu&t" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c"
::msgcat::mcset ru "&Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\u044c"
::msgcat::mcset ru "Details >>" "\u041f\u043e\u0434\u0440\u043e\u0431\u043d\u0435\u0435 >>"
::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "\u041a\u0430\u0442\u0430\u043b\u043e\u0433\u0430 \"%1\$s\" \u043d\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442."
::msgcat::mcset ru "&Directory:" "&\u041a\u0430\u0442\u0430\u043b\u043e\u0433:"
::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s"
::msgcat::mcset ru "E&xit" "\u0412\u044b\u0445\u043e\u0434"
::msgcat::mcset ru "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \
"\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0435\u0433\u043e?"
::msgcat::mcset ru "File \"%1\$s\" already exists.\n\n" "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\n"
::msgcat::mcset ru "File \"%1\$s\" does not exist." "\u0424\u0430\u0439\u043b \"%1\$s\" \u043d\u0435 \u043d\u0430\u0439\u0434\u0435\u043d."
::msgcat::mcset ru "File &name:" "&\u0418\u043c\u044f \u0444\u0430\u0439\u043b\u0430:"
::msgcat::mcset ru "File &names:" "&\u0418\u043c\u0435\u043d\u0430 \u0444\u0430\u0439\u043b\u043e\u0432:"
::msgcat::mcset ru "Files of &type:" "&\u0422\u0438\u043f \u0444\u0430\u0439\u043b\u043e\u0432:"
::msgcat::mcset ru "Fi&les:" "\u0424\u0430\u0439&\u043b\u044b:"
::msgcat::mcset ru "&Filter" "&\u0424\u0438\u043b\u044c\u0442\u0440"
::msgcat::mcset ru "Fil&ter:" "\u0424\u0438\u043b\u044c&\u0442\u0440:"
::msgcat::mcset ru "&Green" " &\u0417\u0435\u043b\u0435\u043d\u044b\u0439"
::msgcat::mcset ru "Hi" "\u041f\u0440\u0438\u0432\u0435\u0442"
::msgcat::mcset ru "&Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c"
::msgcat::mcset ru "&Ignore" "&\u0418\u0433\u043d\u043e\u0440\u0438\u0440\u043e\u0432\u0430\u0442\u044c"
::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"."
::msgcat::mcset ru "Log Files" "\u0424\u0430\u0439\u043b\u044b \u0436\u0443\u0440\u043d\u0430\u043b\u0430"
::msgcat::mcset ru "&No" "&\u041d\u0435\u0442"
::msgcat::mcset ru "&OK" "&\u041e\u041a"
::msgcat::mcset ru "OK" "\u041e\u041a"
::msgcat::mcset ru "Ok" "\u0414\u0430"
::msgcat::mcset ru "Open" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c"
::msgcat::mcset ru "&Open" "&\u041e\u0442\u043a\u0440\u044b\u0442\u044c"
::msgcat::mcset ru "Open Multiple Files" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c \u043d\u0435\u0441\u043a\u043e\u043b\u044c\u043a\u043e \u0444\u0430\u0439\u043b\u043e\u0432"
::msgcat::mcset ru "P&aste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c"
::msgcat::mcset ru "&Quit" "\u0412\u044b\u0445\u043e\u0434"
::msgcat::mcset ru "&Red" " &\u041a\u0440\u0430\u0441\u043d\u044b\u0439"
::msgcat::mcset ru "Replace existing file?" "\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u044e\u0449\u0438\u0439 \u0444\u0430\u0439\u043b?"
::msgcat::mcset ru "&Retry" "&\u041f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c"
::msgcat::mcset ru "&Save" "&\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c"
::msgcat::mcset ru "Save As" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u043a\u0430\u043a"
::msgcat::mcset ru "Save To Log" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u0432 \u0436\u0443\u0440\u043d\u0430\u043b"
::msgcat::mcset ru "Select Log File" "\u0412\u044b\u0431\u0440\u0430\u0442\u044c \u0436\u0443\u0440\u043d\u0430\u043b"
::msgcat::mcset ru "Select a file to source" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u0444\u0430\u0439\u043b \u0434\u043b\u044f \u0438\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0430\u0446\u0438\u0438"
::msgcat::mcset ru "&Selection:"
::msgcat::mcset ru "Skip Messages" "\u041f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c \u0441\u043e\u043e\u0431\u0449\u0435\u043d\u0438\u044f"
::msgcat::mcset ru "&Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..."
::msgcat::mcset ru "Tcl Scripts" "\u041f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0430 \u043d\u0430 \u044f\u0437\u044b\u043a\u0435 TCL"
::msgcat::mcset ru "Tcl for Windows" "TCL \u0434\u043b\u044f Windows"
::msgcat::mcset ru "Text Files" "\u0422\u0435\u043a\u0441\u0442\u043e\u0432\u044b\u0435 \u0444\u0430\u0439\u043b\u044b"
::msgcat::mcset ru "&Yes" "&\u0414\u0430"
::msgcat::mcset ru "abort" "\u043e\u0442\u043c\u0435\u043d\u0430"
::msgcat::mcset ru "blue" " \u0433\u043e\u043b\u0443\u0431\u043e\u0439"
::msgcat::mcset ru "cancel" "\u043e\u0442\u043c\u0435\u043d\u0430"
::msgcat::mcset ru "extension" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u0435"
::msgcat::mcset ru "extensions" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u044f"
::msgcat::mcset ru "green" " \u0437\u0435\u043b\u0435\u043d\u044b\u0439"
::msgcat::mcset ru "ignore" "\u043f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c"
::msgcat::mcset ru "ok" "\u043e\u043a"
::msgcat::mcset ru "red" " \u043a\u0440\u0430\u0441\u043d\u044b\u0439"
::msgcat::mcset ru "retry" "\u043f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c"
::msgcat::mcset ru "yes" "\u0434\u0430"
}

76
windowsAgent/dist/tk/msgs/sv.msg vendored Normal file
View File

@ -0,0 +1,76 @@
namespace eval ::tk {
::msgcat::mcset sv "&Abort" "&Avsluta"
::msgcat::mcset sv "&About..." "&Om..."
::msgcat::mcset sv "All Files" "Samtliga filer"
::msgcat::mcset sv "Application Error" "Programfel"
::msgcat::mcset sv "&Blue" "&Bl\u00e5"
::msgcat::mcset sv "Cancel" "Avbryt"
::msgcat::mcset sv "&Cancel" "&Avbryt"
::msgcat::mcset sv "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ej n\u00e5 mappen \"%1\$s\".\nSaknar r\u00e4ttigheter."
::msgcat::mcset sv "Choose Directory" "V\u00e4lj mapp"
::msgcat::mcset sv "Cl&ear" "&Radera"
::msgcat::mcset sv "&Clear Console" "&Radera konsollen"
::msgcat::mcset sv "Color" "F\u00e4rg"
::msgcat::mcset sv "Console" "Konsoll"
::msgcat::mcset sv "&Copy" "&Kopiera"
::msgcat::mcset sv "Cu&t" "Klipp u&t"
::msgcat::mcset sv "&Delete" "&Radera"
::msgcat::mcset sv "Details >>" "Detaljer >>"
::msgcat::mcset sv "Directory \"%1\$s\" does not exist." "Mappen \"%1\$s\" finns ej."
::msgcat::mcset sv "&Directory:" "&Mapp:"
::msgcat::mcset sv "&Edit" "R&edigera"
::msgcat::mcset sv "Error: %1\$s" "Fel: %1\$s"
::msgcat::mcset sv "E&xit" "&Avsluta"
::msgcat::mcset sv "&File" "&Fil"
::msgcat::mcset sv "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Filen \"%1\$s\" finns redan.\nVill du skriva \u00f6ver den?"
::msgcat::mcset sv "File \"%1\$s\" already exists.\n\n" "Filen \"%1\$s\" finns redan.\n\n"
::msgcat::mcset sv "File \"%1\$s\" does not exist." "Filen \"%1\$s\" finns ej."
::msgcat::mcset sv "File &name:" "Fil&namn:"
::msgcat::mcset sv "File &names:" "Fil&namn:"
::msgcat::mcset sv "Files of &type:" "Filer av &typ:"
::msgcat::mcset sv "Fi&les:" "Fi&ler:"
::msgcat::mcset sv "&Filter"
::msgcat::mcset sv "Fil&ter:"
::msgcat::mcset sv "&Green" "&Gr\u00f6n"
::msgcat::mcset sv "&Help" "&Hj\u00e4lp"
::msgcat::mcset sv "Hi" "Hej"
::msgcat::mcset sv "&Hide Console" "&G\u00f6m konsollen"
::msgcat::mcset sv "&Ignore" "&Ignorera"
::msgcat::mcset sv "Invalid file name \"%1\$s\"." "Ogiltigt filnamn \"%1\$s\"."
::msgcat::mcset sv "Log Files" "Loggfiler"
::msgcat::mcset sv "&No" "&Nej"
::msgcat::mcset sv "&OK"
::msgcat::mcset sv "OK"
::msgcat::mcset sv "Ok"
::msgcat::mcset sv "Open" "\u00d6ppna"
::msgcat::mcset sv "&Open" "&\u00d6ppna"
::msgcat::mcset sv "Open Multiple Files" "\u00d6ppna flera filer"
::msgcat::mcset sv "P&aste" "&Klistra in"
::msgcat::mcset sv "&Quit" "&Avsluta"
::msgcat::mcset sv "&Red" "&R\u00f6d"
::msgcat::mcset sv "Replace existing file?" "Ers\u00e4tt existerande fil?"
::msgcat::mcset sv "&Retry" "&F\u00f6rs\u00f6k igen"
::msgcat::mcset sv "&Save" "&Spara"
::msgcat::mcset sv "Save As" "Spara som"
::msgcat::mcset sv "Save To Log" "Spara till logg"
::msgcat::mcset sv "Select Log File" "V\u00e4lj loggfil"
::msgcat::mcset sv "Select a file to source" "V\u00e4lj k\u00e4llfil"
::msgcat::mcset sv "&Selection:" "&Val:"
::msgcat::mcset sv "Skip Messages" "Hoppa \u00f6ver meddelanden"
::msgcat::mcset sv "&Source..." "&K\u00e4lla..."
::msgcat::mcset sv "Tcl Scripts" "Tcl skript"
::msgcat::mcset sv "Tcl for Windows" "Tcl f\u00f6r Windows"
::msgcat::mcset sv "Text Files" "Textfiler"
::msgcat::mcset sv "&Yes" "&Ja"
::msgcat::mcset sv "abort" "avbryt"
::msgcat::mcset sv "blue" "bl\u00e5"
::msgcat::mcset sv "cancel" "avbryt"
::msgcat::mcset sv "extension" "utvidgning"
::msgcat::mcset sv "extensions" "utvidgningar"
::msgcat::mcset sv "green" "gr\u00f6n"
::msgcat::mcset sv "ignore" "ignorera"
::msgcat::mcset sv "ok"
::msgcat::mcset sv "red" "r\u00f6d"
::msgcat::mcset sv "retry" "f\u00f6rs\u00f6k igen"
::msgcat::mcset sv "yes" "ja"
}

178
windowsAgent/dist/tk/obsolete.tcl vendored Normal file
View File

@ -0,0 +1,178 @@
# obsolete.tcl --
#
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# The procedures below are here strictly for backward compatibility with
# Tk version 3.6 and earlier. The procedures are no longer needed, so
# they are no-ops. You should not use these procedures anymore, since
# they may be removed in some future release.
proc tk_menuBar args {}
proc tk_bindForTraversal args {}
# ::tk::classic::restore --
#
# Restore the pre-8.5 (Tk classic) look as the widget defaults for classic
# Tk widgets.
#
# The value following an 'option add' call is the new 8.5 value.
#
namespace eval ::tk::classic {
# This may need to be adjusted for some window managers that are
# more aggressive with their own Xdefaults (like KDE and CDE)
variable prio "widgetDefault"
}
proc ::tk::classic::restore {args} {
# Restore classic (8.4) look to classic Tk widgets
variable prio
if {[llength $args]} {
foreach what $args {
::tk::classic::restore_$what
}
} else {
foreach cmd [info procs restore_*] {
$cmd
}
}
}
proc ::tk::classic::restore_font {args} {
# Many widgets were adjusted from hard-coded defaults to using the
# TIP#145 fonts defined in fonts.tcl (eg TkDefaultFont, TkFixedFont, ...)
# For restoring compatibility, we only correct size and weighting changes,
# as the fonts themselves remained mostly the same.
if {[tk windowingsystem] eq "x11"} {
font configure TkDefaultFont -weight bold ; # normal
font configure TkFixedFont -size -12 ; # -10
}
# Add these with prio 21 to override value in dialog/msgbox.tcl
if {[tk windowingsystem] eq "aqua"} {
option add *Dialog.msg.font system 21; # TkCaptionFont
option add *Dialog.dtl.font system 21; # TkCaptionFont
option add *ErrorDialog*Label.font system 21; # TkCaptionFont
} else {
option add *Dialog.msg.font {Times 12} 21; # TkCaptionFont
option add *Dialog.dtl.font {Times 10} 21; # TkCaptionFont
option add *ErrorDialog*Label.font {Times -18} 21; # TkCaptionFont
}
}
proc ::tk::classic::restore_button {args} {
variable prio
if {[tk windowingsystem] eq "x11"} {
foreach cls {Button Radiobutton Checkbutton} {
option add *$cls.borderWidth 2 $prio; # 1
}
}
}
proc ::tk::classic::restore_entry {args} {
variable prio
# Entry and Spinbox share core defaults
foreach cls {Entry Spinbox} {
if {[tk windowingsystem] ne "aqua"} {
option add *$cls.borderWidth 2 $prio; # 1
}
if {[tk windowingsystem] eq "x11"} {
option add *$cls.background "#d9d9d9" $prio; # "white"
option add *$cls.selectBorderWidth 1 $prio; # 0
}
}
}
proc ::tk::classic::restore_listbox {args} {
variable prio
if {[tk windowingsystem] ne "win32"} {
option add *Listbox.background "#d9d9d9" $prio; # "white"
option add *Listbox.activeStyle "underline" $prio; # "dotbox"
}
if {[tk windowingsystem] ne "aqua"} {
option add *Listbox.borderWidth 2 $prio; # 1
}
if {[tk windowingsystem] eq "x11"} {
option add *Listbox.selectBorderWidth 1 $prio; # 0
}
# Remove focus into Listbox added for 8.5
bind Listbox <1> {
if {[winfo exists %W]} {
tk::ListboxBeginSelect %W [%W index @%x,%y]
}
}
}
proc ::tk::classic::restore_menu {args} {
variable prio
if {[tk windowingsystem] eq "x11"} {
option add *Menu.activeBorderWidth 2 $prio; # 1
option add *Menu.borderWidth 2 $prio; # 1
option add *Menu.clickToFocus true $prio
option add *Menu.useMotifHelp true $prio
}
if {[tk windowingsystem] ne "aqua"} {
option add *Menu.font "TkDefaultFont" $prio; # "TkMenuFont"
}
}
proc ::tk::classic::restore_menubutton {args} {
variable prio
option add *Menubutton.borderWidth 2 $prio; # 1
}
proc ::tk::classic::restore_message {args} {
variable prio
option add *Message.borderWidth 2 $prio; # 1
}
proc ::tk::classic::restore_panedwindow {args} {
variable prio
option add *Panedwindow.borderWidth 2 $prio; # 1
option add *Panedwindow.sashWidth 2 $prio; # 3
option add *Panedwindow.sashPad 2 $prio; # 0
option add *Panedwindow.sashRelief raised $prio; # flat
option add *Panedwindow.opaqueResize 0 $prio; # 1
if {[tk windowingsystem] ne "win32"} {
option add *Panedwindow.showHandle 1 $prio; # 0
}
}
proc ::tk::classic::restore_scale {args} {
variable prio
option add *Scale.borderWidth 2 $prio; # 1
if {[tk windowingsystem] eq "x11"} {
option add *Scale.troughColor "#c3c3c3" $prio; # "#b3b3b3"
}
}
proc ::tk::classic::restore_scrollbar {args} {
variable prio
if {[tk windowingsystem] eq "x11"} {
option add *Scrollbar.borderWidth 2 $prio; # 1
option add *Scrollbar.highlightThickness 1 $prio; # 0
option add *Scrollbar.width 15 $prio; # 11
option add *Scrollbar.troughColor "#c3c3c3" $prio; # "#b3b3b3"
}
}
proc ::tk::classic::restore_text {args} {
variable prio
if {[tk windowingsystem] ne "aqua"} {
option add *Text.borderWidth 2 $prio; # 1
}
if {[tk windowingsystem] eq "win32"} {
option add *Text.font "TkDefaultFont" $prio; # "TkFixedFont"
}
if {[tk windowingsystem] eq "x11"} {
option add *Text.background "#d9d9d9" $prio; # white
option add *Text.selectBorderWidth 1 $prio; # 0
}
}

43
windowsAgent/dist/tk/optMenu.tcl vendored Normal file
View File

@ -0,0 +1,43 @@
# optMenu.tcl --
#
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ::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
# appears in the global variable varName, as well as in the text of
# the option menubutton. The name of the menu is returned as the
# procedure's result, so that the caller can use it to change configuration
# options on the menu or otherwise manipulate it.
#
# Arguments:
# w - The name to use for the menubutton.
# varName - Global variable to hold the currently selected value.
# firstValue - First of legal values for option (must be >= 1).
# args - Any number of additional values.
proc ::tk_optionMenu {w varName firstValue args} {
upvar #0 $varName var
if {![info exists var]} {
set var $firstValue
}
menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
-relief raised -highlightthickness 1 -anchor c \
-direction flush
menu $w.menu -tearoff 0
$w.menu add radiobutton -label $firstValue -variable $varName
foreach i $args {
$w.menu add radiobutton -label $i -variable $varName
}
return $w.menu
}

244
windowsAgent/dist/tk/palette.tcl vendored Normal file
View File

@ -0,0 +1,244 @@
# palette.tcl --
#
# This file contains procedures that change the color palette used
# by Tk.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ::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.
#
# Arguments:
# The arguments consist of either a single color name, which
# will be used as the new background color (all other colors will
# be computed from this) or an even number of values consisting of
# 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} {
if {[winfo depth .] == 1} {
# Just return on monochrome displays, otherwise errors will occur
return
}
# Create an array that has the complete new palette. If some colors
# aren't specified, compute them from other colors that are specified.
if {[llength $args] == 1} {
set new(background) [lindex $args 0]
} else {
array set new $args
}
if {![info exists new(background)]} {
return -code error -errorcode {TK SET_PALETTE BACKGROUND} \
"must specify a background color"
}
set bg [winfo rgb . $new(background)]
if {![info exists new(foreground)]} {
# 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
}
}
lassign [winfo rgb . $new(foreground)] fg_r fg_g fg_b
lassign $bg bg_r bg_g bg_b
set darkerBg [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \
[expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]]
foreach i {activeForeground insertBackground selectForeground \
highlightColor} {
if {![info exists new($i)]} {
set new($i) $new(foreground)
}
}
if {![info exists new(disabledForeground)]} {
set new(disabledForeground) [format #%02x%02x%02x \
[expr {(3*$bg_r + $fg_r)/1024}] \
[expr {(3*$bg_g + $fg_g)/1024}] \
[expr {(3*$bg_b + $fg_b)/1024}]]
}
if {![info exists new(highlightBackground)]} {
set new(highlightBackground) $new(background)
}
if {![info exists new(activeBackground)]} {
# Pick a default active background that islighter than the
# normal background. To do this, round each color component
# up by 15% or 1/3 of the way to full white, whichever is
# greater.
foreach i {0 1 2} color $bg {
set light($i) [expr {$color/256}]
set inc1 [expr {($light($i)*15)/100}]
set inc2 [expr {(255-$light($i))/3}]
if {$inc1 > $inc2} {
incr light($i) $inc1
} else {
incr light($i) $inc2
}
if {$light($i) > 255} {
set light($i) 255
}
}
set new(activeBackground) [format #%02x%02x%02x $light(0) \
$light(1) $light(2)]
}
if {![info exists new(selectBackground)]} {
set new(selectBackground) $darkerBg
}
if {![info exists new(troughColor)]} {
set new(troughColor) $darkerBg
}
# let's make one of each of the widgets so we know what the
# defaults are currently for this platform.
toplevel .___tk_set_palette
wm withdraw .___tk_set_palette
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, ::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
# relying on the widgets we've created above to do the work
# because different extensions may provide other kinds
# of widgets that we don't currently know about, so we'll
# walk the whole hierarchy just in case.
eval [tk::RecolorTree . new]
destroy .___tk_set_palette
# Change the option database so that future windows will get the
# same colors.
foreach option [array names new] {
option add *$option $new($option) widgetDefault
}
# Save the options in the variable ::tk::Palette, for use the
# next time we change the options.
array set ::tk::Palette [array get new]
}
# ::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
# database, if it exists, and if not, then it looks at the default
# value of the widget itself.
#
# Arguments:
# w - The name of a window. This window and all its
# descendants are recolored.
# colors - The name of an array variable in the caller,
# which contains color information. Each element
# is named after a widget configuration option, and
# each value is the value for that option.
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 configure $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 $class]
if {$defaultcolor eq "" || \
([info exists prototype] && \
[$prototype cget $option] ne "$defaultcolor")} {
set defaultcolor [lindex $value 3]
}
if {$defaultcolor ne ""} {
set defaultcolor [winfo rgb . $defaultcolor]
}
set chosencolor [lindex $value 4]
if {$chosencolor ne ""} {
set chosencolor [winfo rgb . $chosencolor]
}
if {[string match $defaultcolor $chosencolor]} {
# Change the option database so that future windows will get
# the same colors.
append result ";\noption add [list \
*[winfo class $w].$dbOption $c($dbOption) 60]"
$w configure $option $c($dbOption)
}
}
}
foreach child [winfo children $w] {
append result ";\n[::tk::RecolorTree $child c]"
}
return $result
}
# ::tk::Darken --
# Given a color name, computes a new color value that darkens (or
# brightens) the given color by a given percent.
#
# Arguments:
# color - Name of starting color.
# percent - Integer telling how much to brighten or darken as a
# percent: 50 means darken by 50%, 110 means brighten
# by 10%.
proc ::tk::Darken {color percent} {
if {$percent < 0} {
return #000000
} elseif {$percent > 200} {
return #ffffff
} elseif {$percent <= 100} {
lassign [winfo rgb . $color] r g b
set r [expr {($r/256)*$percent/100}]
set g [expr {($g/256)*$percent/100}]
set b [expr {($b/256)*$percent/100}]
} elseif {$percent > 100} {
lassign [winfo rgb . $color] r g b
set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}]
set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}]
set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}]
}
return [format #%02x%02x%02x $r $g $b]
}
# ::tk_bisque --
# Reset the Tk color palette to the old "bisque" colors.
#
# Arguments:
# None.
proc ::tk_bisque {} {
tk_setPalette activeBackground #e6ceb1 activeForeground black \
background #ffe4c4 disabledForeground #b0b0b0 foreground black \
highlightBackground #ffe4c4 highlightColor black \
insertBackground black \
selectBackground #e6ceb1 selectForeground black \
troughColor #cdb79e
}

194
windowsAgent/dist/tk/panedwindow.tcl vendored Normal file
View File

@ -0,0 +1,194 @@
# panedwindow.tcl --
#
# This file defines the default bindings for Tk panedwindow widgets and
# provides procedures that help in implementing those bindings.
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} {
variable ::tk::Priv
if {[$w cget -opaqueresize]} {
set proxy 0
}
set what [$w identify $x $y]
if { [llength $what] == 2 } {
lassign $what index which
if {!$::tk_strictMotif || $which eq "handle"} {
if {!$proxy} {
$w sash mark $index $x $y
}
set Priv(sash) $index
lassign [$w sash coord $index] sx sy
set Priv(dx) [expr {$sx-$x}]
set Priv(dy) [expr {$sy-$y}]
# Do this to init the proxy location
DragSash $w $x $y $proxy
}
}
}
# ::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} {
variable ::tk::Priv
if {[$w cget -opaqueresize]} {
set proxy 0
}
if {[info exists Priv(sash)]} {
if {$proxy} {
$w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
} else {
$w sash place $Priv(sash) \
[expr {$x+$Priv(dx)}] [expr {$y+$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} {
variable ::tk::Priv
if {[$w cget -opaqueresize]} {
set proxy 0
}
if {[info exists Priv(sash)]} {
if {$proxy} {
lassign [$w proxy coord] x y
$w sash place $Priv(sash) $x $y
$w proxy forget
}
unset Priv(sash) Priv(dx) 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 || [lindex $id 1] eq "handle")} {
if {![info exists Priv($w,panecursor)]} {
set Priv($w,panecursor) [$w cget -cursor]
if {[$w cget -sashcursor] ne ""} {
$w configure -cursor [$w cget -sashcursor]
} elseif {[$w cget -orient] eq "horizontal"} {
$w configure -cursor sb_h_double_arrow
} else {
$w configure -cursor sb_v_double_arrow
}
if {[info exists Priv($w,pwAfterId)]} {
after cancel $Priv($w,pwAfterId)
}
set Priv($w,pwAfterId) [after 150 \
[list ::tk::panedwindow::Cursor $w]]
}
return
}
if {[info exists Priv($w,panecursor)]} {
$w configure -cursor $Priv($w,panecursor)
unset Priv($w,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
# Make sure to check window existence in case it is destroyed.
if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
set Priv($w,pwAfterId) [after 150 \
[list ::tk::panedwindow::Cursor $w]]
} else {
$w configure -cursor $Priv($w,panecursor)
unset Priv($w,panecursor)
if {[info exists Priv($w,pwAfterId)]} {
after cancel $Priv($w,pwAfterId)
unset Priv($w,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} {
variable ::tk::Priv
if {[info exists Priv($w,panecursor)]} {
$w configure -cursor $Priv($w,panecursor)
unset Priv($w,panecursor)
}
}

7
windowsAgent/dist/tk/pkgIndex.tcl vendored Normal file
View File

@ -0,0 +1,7 @@
if {[catch {package present Tcl 8.6.0}]} { return }
if {($::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)]
|| ([info exists ::argv] && ("-display" in $::argv)))} {
package ifneeded Tk 8.6.9 [list load [file join $dir .. .. bin libtk8.6.dll] Tk]
} else {
package ifneeded Tk 8.6.9 [list load [file join $dir .. .. bin tk86t.dll] Tk]
}

262
windowsAgent/dist/tk/safetk.tcl vendored Normal file
View File

@ -0,0 +1,262 @@
# safetk.tcl --
#
# Support procs to use Tk in safe interpreters.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# see safetk.n for documentation
#
#
# Note: It is now ok to let untrusted code being executed
# between the creation of the interp and the actual loading
# of Tk in that interp because the C side Tk_Init will
# now look up the master interp and ask its safe::TkInit
# for the actual parameters to use for it's initialization (if allowed),
# not relying on the slave state.
#
# We use opt (optional arguments parsing)
package require opt 0.4.1;
namespace eval ::safe {
# counter for safe toplevels
variable tkSafeId 0
}
#
# tkInterpInit : prepare the slave interpreter for tk loading
# most of the real job is done by loadTk
# returns the slave name (tkInterpInit does)
#
proc ::safe::tkInterpInit {slave argv} {
global env tk_library
# We have to make sure that the tk_library variable is normalized.
set tk_library [file normalize $tk_library]
# Clear Tk's access for that interp (path).
allowTk $slave $argv
# Ensure tk_library and subdirs (eg, ttk) are on the access path
::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
foreach subdir [::safe::AddSubDirs [list $tk_library]] {
::safe::interpAddToAccessPath $slave $subdir
}
return $slave
}
# tkInterpLoadTk:
# Do additional configuration as needed (calling tkInterpInit)
# and actually load Tk into the slave.
#
# Either contained in the specified windowId (-use) or
# creating a decorated toplevel for it.
# empty definition for auto_mkIndex
proc ::safe::loadTk {} {}
::tcl::OptProc ::safe::loadTk {
{slave -interp "name of the slave interpreter"}
{-use -windowId {} "window Id to use (new toplevel otherwise)"}
{-display -displayName {} "display name to use (current one otherwise)"}
} {
set displayGiven [::tcl::OptProcArgGiven "-display"]
if {!$displayGiven} {
# Try to get the current display from "."
# (which might not exist if the master is tk-less)
if {[catch {set display [winfo screen .]}]} {
if {[info exists ::env(DISPLAY)]} {
set display $::env(DISPLAY)
} else {
Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
set display ":0.0"
}
}
}
# Get state for access to the cleanupHook.
namespace upvar ::safe S$slave state
if {![::tcl::OptProcArgGiven "-use"]} {
# create a decorated toplevel
lassign [tkTopLevel $slave $display] w use
# set our delete hook (slave arg is added by interpDelete)
# to clean up both window related code and tkInit(slave)
set state(cleanupHook) [list tkDelete {} $w]
} else {
# set our delete hook (slave arg is added by interpDelete)
# to clean up tkInit(slave)
set state(cleanupHook) [list disallowTk]
# Let's be nice and also accept tk window names instead of ids
if {[string match ".*" $use]} {
set windowName $use
set use [winfo id $windowName]
set nDisplay [winfo screen $windowName]
} else {
# Check for a better -display value
# (works only for multi screens on single host, but not
# cross hosts, for that a tk window name would be better
# but embeding is also usefull for non tk names)
if {![catch {winfo pathname $use} name]} {
set nDisplay [winfo screen $name]
} else {
# Can't have a better one
set nDisplay $display
}
}
if {$nDisplay ne $display} {
if {$displayGiven} {
return -code error -errorcode {TK DISPLAY SAFE} \
"conflicting -display $display and -use $use -> $nDisplay"
} else {
set display $nDisplay
}
}
}
# Prepares the slave for tk with those parameters
tkInterpInit $slave [list "-use" $use "-display" $display]
load {} Tk $slave
return $slave
}
proc ::safe::TkInit {interpPath} {
variable tkInit
if {[info exists tkInit($interpPath)]} {
set value $tkInit($interpPath)
Log $interpPath "TkInit called, returning \"$value\"" NOTICE
return $value
} else {
Log $interpPath "TkInit called for interp with clearance:\
preventing Tk init" ERROR
return -code error -errorcode {TK SAFE PERMISSION} "not allowed"
}
}
# safe::allowTk --
#
# Set tkInit(interpPath) to allow Tk to be initialized in
# safe::TkInit.
#
# Arguments:
# interpPath slave interpreter handle
# argv arguments passed to safe::TkInterpInit
#
# Results:
# none.
proc ::safe::allowTk {interpPath argv} {
variable tkInit
set tkInit($interpPath) $argv
return
}
# safe::disallowTk --
#
# Unset tkInit(interpPath) to disallow Tk from getting initialized
# in safe::TkInit.
#
# Arguments:
# interpPath slave interpreter handle
#
# Results:
# none.
proc ::safe::disallowTk {interpPath} {
variable tkInit
# This can already be deleted by the DeleteHook of the interp
if {[info exists tkInit($interpPath)]} {
unset tkInit($interpPath)
}
return
}
# safe::tkDelete --
#
# Clean up the window associated with the interp being deleted.
#
# Arguments:
# interpPath slave interpreter handle
#
# Results:
# none.
proc ::safe::tkDelete {W window slave} {
# we are going to be called for each widget... skip untill it's
# top level
Log $slave "Called tkDelete $W $window" NOTICE
if {[::interp exists $slave]} {
if {[catch {::safe::interpDelete $slave} msg]} {
Log $slave "Deletion error : $msg"
}
}
if {[winfo exists $window]} {
Log $slave "Destroy toplevel $window" NOTICE
destroy $window
}
# clean up tkInit(slave)
disallowTk $slave
return
}
proc ::safe::tkTopLevel {slave display} {
variable tkSafeId
incr tkSafeId
set w ".safe$tkSafeId"
if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
return -code error -errorcode {TK TOPLEVEL SAFE} \
"Unable to create toplevel for safe slave \"$slave\" ($msg)"
}
Log $slave "New toplevel $w" NOTICE
set msg "Untrusted Tcl applet ($slave)"
wm title $w $msg
# Control frame (we must create a style for it)
ttk::style layout TWarningFrame {WarningFrame.border -sticky nswe}
ttk::style configure TWarningFrame -background red
set wc $w.fc
ttk::frame $wc -relief ridge -borderwidth 4 -style TWarningFrame
# We will destroy the interp when the window is destroyed
bindtags $wc [concat Safe$wc [bindtags $wc]]
bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]
ttk::label $wc.l -text $msg -anchor w
# We want the button to be the last visible item
# (so be packed first) and at the right and not resizing horizontally
# frame the button so it does not expand horizontally
# but still have the default background instead of red one from the parent
ttk::frame $wc.fb -borderwidth 0
ttk::button $wc.fb.b -text "Delete" \
-command [list ::safe::tkDelete $w $w $slave]
pack $wc.fb.b -side right -fill both
pack $wc.fb -side right -fill both -expand 1
pack $wc.l -side left -fill both -expand 1 -ipady 2
pack $wc -side bottom -fill x
# Container frame
frame $w.c -container 1
pack $w.c -fill both -expand 1
# return both the toplevel window name and the id to use for embedding
list $w [winfo id $w.c]
}

290
windowsAgent/dist/tk/scale.tcl vendored Normal file
View File

@ -0,0 +1,290 @@
# scale.tcl --
#
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
# Standard Motif bindings:
bind Scale <Enter> {
if {$tk_strictMotif} {
set tk::Priv(activeBg) [%W cget -activebackground]
%W configure -activebackground [%W cget -background]
}
tk::ScaleActivate %W %x %y
}
bind Scale <Motion> {
tk::ScaleActivate %W %x %y
}
bind Scale <Leave> {
if {$tk_strictMotif} {
%W configure -activebackground $tk::Priv(activeBg)
}
if {[%W cget -state] eq "active"} {
%W configure -state normal
}
}
bind Scale <1> {
tk::ScaleButtonDown %W %x %y
}
bind Scale <B1-Motion> {
tk::ScaleDrag %W %x %y
}
bind Scale <B1-Leave> { }
bind Scale <B1-Enter> { }
bind Scale <ButtonRelease-1> {
tk::CancelRepeat
tk::ScaleEndDrag %W
tk::ScaleActivate %W %x %y
}
bind Scale <2> {
tk::ScaleButton2Down %W %x %y
}
bind Scale <B2-Motion> {
tk::ScaleDrag %W %x %y
}
bind Scale <B2-Leave> { }
bind Scale <B2-Enter> { }
bind Scale <ButtonRelease-2> {
tk::CancelRepeat
tk::ScaleEndDrag %W
tk::ScaleActivate %W %x %y
}
if {[tk windowingsystem] eq "win32"} {
# 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> {
tk::ScaleControlPress %W %x %y
}
bind Scale <<PrevLine>> {
tk::ScaleIncrement %W up little noRepeat
}
bind Scale <<NextLine>> {
tk::ScaleIncrement %W down little noRepeat
}
bind Scale <<PrevChar>> {
tk::ScaleIncrement %W up little noRepeat
}
bind Scale <<NextChar>> {
tk::ScaleIncrement %W down little noRepeat
}
bind Scale <<PrevPara>> {
tk::ScaleIncrement %W up big noRepeat
}
bind Scale <<NextPara>> {
tk::ScaleIncrement %W down big noRepeat
}
bind Scale <<PrevWord>> {
tk::ScaleIncrement %W up big noRepeat
}
bind Scale <<NextWord>> {
tk::ScaleIncrement %W down big noRepeat
}
bind Scale <<LineStart>> {
%W set [%W cget -from]
}
bind Scale <<LineEnd>> {
%W set [%W cget -to]
}
# ::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.
#
# Arguments:
# w - The scale widget.
# x, y - Mouse coordinates.
proc ::tk::ScaleActivate {w x y} {
if {[$w cget -state] eq "disabled"} {
return
}
if {[$w identify $x $y] eq "slider"} {
set state active
} else {
set state normal
}
if {[$w cget -state] ne $state} {
$w configure -state $state
}
}
# ::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.
#
# Arguments:
# w - The scale widget.
# x, y - Mouse coordinates of button press.
proc ::tk::ScaleButtonDown {w x y} {
variable ::tk::Priv
set Priv(dragging) 0
set el [$w identify $x $y]
# save the relief
set Priv($w,relief) [$w cget -sliderrelief]
if {$el eq "trough1"} {
ScaleIncrement $w up little initial
} elseif {$el eq "trough2"} {
ScaleIncrement $w down little initial
} elseif {$el eq "slider"} {
set Priv(dragging) 1
set Priv(initValue) [$w get]
set coords [$w coords]
set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
switch -exact -- $Priv($w,relief) {
"raised" { $w configure -sliderrelief sunken }
"ridge" { $w configure -sliderrelief groove }
}
}
}
# ::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
# to reflect the mouse's position.
#
# Arguments:
# w - The scale widget.
# x, y - Mouse coordinates.
proc ::tk::ScaleDrag {w x y} {
variable ::tk::Priv
if {!$Priv(dragging)} {
return
}
$w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
}
# ::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 ::tk::ScaleEndDrag {w} {
variable ::tk::Priv
set Priv(dragging) 0
if {[info exists Priv($w,relief)]} {
$w configure -sliderrelief $Priv($w,relief)
unset Priv($w,relief)
}
}
# ::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"
# arguments.
#
# Arguments:
# w - The scale widget.
# dir - "up" means move value towards -from, "down" means
# move towards -to.
# big - Size of increments: "big" or "little".
# repeat - Whether and how to auto-repeat the action: "noRepeat"
# means don't auto-repeat, "initial" means this is the
# first action in an auto-repeat sequence, and "again"
# means this is the second repetition or later.
proc ::tk::ScaleIncrement {w dir big repeat} {
variable ::tk::Priv
if {![winfo exists $w]} return
if {$big eq "big"} {
set inc [$w cget -bigincrement]
if {$inc == 0} {
set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
}
if {$inc < [$w cget -resolution]} {
set inc [$w cget -resolution]
}
} else {
set inc [$w cget -resolution]
}
if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} {
if {$inc > 0} {
set inc [expr {-$inc}]
}
} else {
if {$inc < 0} {
set inc [expr {-$inc}]
}
}
$w set [expr {[$w get] + $inc}]
if {$repeat eq "again"} {
set Priv(afterId) [after [$w cget -repeatinterval] \
[list tk::ScaleIncrement $w $dir $big again]]
} elseif {$repeat eq "initial"} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set Priv(afterId) [after $delay \
[list tk::ScaleIncrement $w $dir $big again]]
}
}
}
# ::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.
#
# Arguments:
# w - The scale widget.
# x, y - Mouse coordinates where the button was pressed.
proc ::tk::ScaleControlPress {w x y} {
set el [$w identify $x $y]
if {$el eq "trough1"} {
$w set [$w cget -from]
} elseif {$el eq "trough2"} {
$w set [$w cget -to]
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# x, y - Mouse coordinates within the widget.
proc ::tk::ScaleButton2Down {w x y} {
variable ::tk::Priv
if {[$w cget -state] eq "disabled"} {
return
}
$w configure -state active
$w set [$w get $x $y]
set Priv(dragging) 1
set Priv(initValue) [$w get]
set Priv($w,relief) [$w cget -sliderrelief]
set coords "$x $y"
set Priv(deltaX) 0
set Priv(deltaY) 0
}

454
windowsAgent/dist/tk/scrlbar.tcl vendored Normal file
View File

@ -0,0 +1,454 @@
# scrlbar.tcl --
#
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# The code below creates the default class bindings for scrollbars.
#-------------------------------------------------------------------------
# Standard Motif bindings:
if {[tk windowingsystem] eq "x11" || [tk windowingsystem] eq "aqua"} {
bind Scrollbar <Enter> {
if {$tk_strictMotif} {
set tk::Priv(activeBg) [%W cget -activebackground]
%W configure -activebackground [%W cget -background]
}
%W activate [%W identify %x %y]
}
bind Scrollbar <Motion> {
%W activate [%W identify %x %y]
}
# The "info exists" command in the following binding handles the
# situation where a Leave event occurs for a scrollbar without the Enter
# event. This seems to happen on some systems (such as Solaris 2.4) for
# unknown reasons.
bind Scrollbar <Leave> {
if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} {
%W configure -activebackground $tk::Priv(activeBg)
}
%W activate {}
}
bind Scrollbar <1> {
tk::ScrollButtonDown %W %x %y
}
bind Scrollbar <B1-Motion> {
tk::ScrollDrag %W %x %y
}
bind Scrollbar <B1-B2-Motion> {
tk::ScrollDrag %W %x %y
}
bind Scrollbar <ButtonRelease-1> {
tk::ScrollButtonUp %W %x %y
}
bind Scrollbar <B1-Leave> {
# Prevents <Leave> binding from being invoked.
}
bind Scrollbar <B1-Enter> {
# Prevents <Enter> binding from being invoked.
}
bind Scrollbar <2> {
tk::ScrollButton2Down %W %x %y
}
bind Scrollbar <B1-2> {
# Do nothing, since button 1 is already down.
}
bind Scrollbar <B2-1> {
# Do nothing, since button 2 is already down.
}
bind Scrollbar <B2-Motion> {
tk::ScrollDrag %W %x %y
}
bind Scrollbar <ButtonRelease-2> {
tk::ScrollButtonUp %W %x %y
}
bind Scrollbar <B1-ButtonRelease-2> {
# Do nothing: B1 release will handle it.
}
bind Scrollbar <B2-ButtonRelease-1> {
# Do nothing: B2 release will handle it.
}
bind Scrollbar <B2-Leave> {
# Prevents <Leave> binding from being invoked.
}
bind Scrollbar <B2-Enter> {
# Prevents <Enter> binding from being invoked.
}
bind Scrollbar <Control-1> {
tk::ScrollTopBottom %W %x %y
}
bind Scrollbar <Control-2> {
tk::ScrollTopBottom %W %x %y
}
bind Scrollbar <<PrevLine>> {
tk::ScrollByUnits %W v -1
}
bind Scrollbar <<NextLine>> {
tk::ScrollByUnits %W v 1
}
bind Scrollbar <<PrevPara>> {
tk::ScrollByPages %W v -1
}
bind Scrollbar <<NextPara>> {
tk::ScrollByPages %W v 1
}
bind Scrollbar <<PrevChar>> {
tk::ScrollByUnits %W h -1
}
bind Scrollbar <<NextChar>> {
tk::ScrollByUnits %W h 1
}
bind Scrollbar <<PrevWord>> {
tk::ScrollByPages %W h -1
}
bind Scrollbar <<NextWord>> {
tk::ScrollByPages %W h 1
}
bind Scrollbar <Prior> {
tk::ScrollByPages %W hv -1
}
bind Scrollbar <Next> {
tk::ScrollByPages %W hv 1
}
bind Scrollbar <<LineStart>> {
tk::ScrollToPos %W 0
}
bind Scrollbar <<LineEnd>> {
tk::ScrollToPos %W 1
}
}
switch [tk windowingsystem] {
"aqua" {
bind Scrollbar <MouseWheel> {
tk::ScrollByUnits %W v [expr {- (%D)}]
}
bind Scrollbar <Option-MouseWheel> {
tk::ScrollByUnits %W v [expr {-10 * (%D)}]
}
bind Scrollbar <Shift-MouseWheel> {
tk::ScrollByUnits %W h [expr {- (%D)}]
}
bind Scrollbar <Shift-Option-MouseWheel> {
tk::ScrollByUnits %W h [expr {-10 * (%D)}]
}
}
"win32" {
bind Scrollbar <MouseWheel> {
tk::ScrollByUnits %W v [expr {- (%D / 120) * 4}]
}
bind Scrollbar <Shift-MouseWheel> {
tk::ScrollByUnits %W h [expr {- (%D / 120) * 4}]
}
}
"x11" {
bind Scrollbar <MouseWheel> {
tk::ScrollByUnits %W v [expr {- (%D /120 ) * 4}]
}
bind Scrollbar <Shift-MouseWheel> {
tk::ScrollByUnits %W h [expr {- (%D /120 ) * 4}]
}
bind Scrollbar <4> {tk::ScrollByUnits %W v -5}
bind Scrollbar <5> {tk::ScrollByUnits %W v 5}
bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5}
bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5}
}
}
# 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.
#
# Arguments:
# w - The scrollbar widget.
# x, y - Mouse coordinates.
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 {$element eq "slider"} {
ScrollStartDrag $w $x $y
} else {
ScrollSelect $w $element initial
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# x, y - Mouse coordinates.
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 $Priv(relief)
ScrollEndDrag $w $x $y
$w activate [$w identify $x $y]
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# element - The element of the scrollbar that was selected, such
# as "arrow1" or "trough2". Shouldn't be "slider".
# repeat - Whether and how to auto-repeat the action: "noRepeat"
# means don't auto-repeat, "initial" means this is the
# first action in an auto-repeat sequence, and "again"
# means this is the second repetition or later.
proc ::tk::ScrollSelect {w element repeat} {
variable ::tk::Priv
if {![winfo exists $w]} return
switch -- $element {
"arrow1" {ScrollByUnits $w hv -1}
"trough1" {ScrollByPages $w hv -1}
"trough2" {ScrollByPages $w hv 1}
"arrow2" {ScrollByUnits $w hv 1}
default {return}
}
if {$repeat eq "again"} {
set Priv(afterId) [after [$w cget -repeatinterval] \
[list tk::ScrollSelect $w $element again]]
} elseif {$repeat eq "initial"} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set Priv(afterId) [after $delay \
[list tk::ScrollSelect $w $element again]]
}
}
}
# ::tk::ScrollStartDrag --
# This procedure is called to initiate a drag of the slider. It just
# remembers the starting position of the mouse and slider.
#
# Arguments:
# w - The scrollbar widget.
# x, y - The mouse position at the start of the drag operation.
proc ::tk::ScrollStartDrag {w x y} {
variable ::tk::Priv
if {[$w cget -command] eq ""} {
return
}
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 Priv(initPos) 0.0
} else {
set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \
/ [lindex $Priv(initValues) 0]}]
}
}
# ::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
# scrolling.
#
# Arguments:
# w - The scrollbar widget.
# x, y - The current mouse position.
proc ::tk::ScrollDrag {w x y} {
variable ::tk::Priv
if {$Priv(initPos) eq ""} {
return
}
set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]]
if {[$w cget -jump]} {
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 $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 {
ScrollToPos $w [expr {$Priv(initPos) + $delta}]
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# x, y - The mouse position at the end of the drag operation.
proc ::tk::ScrollEndDrag {w x y} {
variable ::tk::Priv
if {$Priv(initPos) eq ""} {
return
}
if {[$w cget -jump]} {
set delta [$w delta [expr {$x - $Priv(pressX)}] \
[expr {$y - $Priv(pressY)}]]
ScrollToPos $w [expr {$Priv(initPos) + $delta}]
}
set Priv(initPos) ""
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# orient - Which kinds of scrollbars this applies to: "h" for
# horizontal, "v" for vertical, "hv" for both.
# amount - How many units to scroll: typically 1 or -1.
proc ::tk::ScrollByUnits {w orient amount} {
set cmd [$w cget -command]
if {$cmd eq "" || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount units
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# orient - Which kinds of scrollbars this applies to: "h" for
# horizontal, "v" for vertical, "hv" for both.
# amount - How many screens to scroll: typically 1 or -1.
proc ::tk::ScrollByPages {w orient amount} {
set cmd [$w cget -command]
if {$cmd eq "" || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount pages
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
}
}
# ::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.
#
# Arguments:
# w - The scrollbar widget.
# pos - A fraction between 0 and 1 indicating a desired position
# in the document.
proc ::tk::ScrollToPos {w pos} {
set cmd [$w cget -command]
if {$cmd eq ""} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd moveto $pos
} else {
uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]
}
}
# ::tk::ScrollTopBottom
# Scroll to the top or bottom of the document, depending on the mouse
# position.
#
# Arguments:
# w - The scrollbar widget.
# x, y - Mouse coordinates within the widget.
proc ::tk::ScrollTopBottom {w x y} {
variable ::tk::Priv
set element [$w identify $x $y]
if {[string match *1 $element]} {
ScrollToPos $w 0
} elseif {[string match *2 $element]} {
ScrollToPos $w 1
}
# Set Priv(relief), since it's needed by tk::ScrollButtonUp.
set Priv(relief) [$w cget -activerelief]
}
# ::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
# behaves the same as button 1.
#
# Arguments:
# w - The scrollbar widget.
# x, y - Mouse coordinates within the widget.
proc ::tk::ScrollButton2Down {w x y} {
variable ::tk::Priv
if {![winfo exists $w]} {
return
}
set element [$w identify $x $y]
if {[string match {arrow[12]} $element]} {
ScrollButtonDown $w $x $y
return
}
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
# slider drag.
update idletasks
if {[winfo exists $w]} {
$w configure -activerelief sunken
$w activate slider
ScrollStartDrag $w $x $y
}
}

580
windowsAgent/dist/tk/spinbox.tcl vendored Normal file
View File

@ -0,0 +1,580 @@
# spinbox.tcl --
#
# This file defines the default bindings for Tk spinbox widgets and provides
# procedures that help in implementing those bindings. The spinbox builds
# off the entry widget, so it can reuse Entry bindings and procedures.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1999-2000 Jeffrey Hobbs
# Copyright (c) 2000 Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# 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
# command to be executed.
# mouseMoved - Non-zero means the mouse has moved a significant
# amount since the button went down (so, for example,
# start dragging out a selection).
# pressX - X-coordinate at which the mouse button was pressed.
# selectMode - The style of selection currently underway:
# char, word, or line.
# x, y - Last known mouse coordinates for scanning
# and auto-scanning.
# data - Used for Cut and Copy
#-------------------------------------------------------------------------
# Initialize namespace
namespace eval ::tk::spinbox {}
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
bind Spinbox <<Cut>> {
if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
%W delete sel.first sel.last
unset tk::Priv(data)
}
}
bind Spinbox <<Copy>> {
if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
unset tk::Priv(data)
}
}
bind Spinbox <<Paste>> {
catch {
if {[tk windowingsystem] ne "x11"} {
catch {
%W delete sel.first sel.last
}
}
%W insert insert [::tk::GetSelection %W CLIPBOARD]
::tk::EntrySeeInsert %W
}
}
bind Spinbox <<Clear>> {
%W delete sel.first sel.last
}
bind Spinbox <<PasteSelection>> {
if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
|| !$tk::Priv(mouseMoved)} {
::tk::spinbox::Paste %W %x
}
}
bind Spinbox <<TraverseIn>> {
%W selection range 0 end
%W icursor end
}
# Standard Motif bindings:
bind Spinbox <1> {
::tk::spinbox::ButtonDown %W %x %y
}
bind Spinbox <B1-Motion> {
::tk::spinbox::Motion %W %x %y
}
bind Spinbox <Double-1> {
::tk::spinbox::ArrowPress %W %x %y
set tk::Priv(selectMode) word
::tk::spinbox::MouseSelect %W %x sel.first
}
bind Spinbox <Triple-1> {
::tk::spinbox::ArrowPress %W %x %y
set tk::Priv(selectMode) line
::tk::spinbox::MouseSelect %W %x 0
}
bind Spinbox <Shift-1> {
set tk::Priv(selectMode) char
%W selection adjust @%x
}
bind Spinbox <Double-Shift-1> {
set tk::Priv(selectMode) word
::tk::spinbox::MouseSelect %W %x
}
bind Spinbox <Triple-Shift-1> {
set tk::Priv(selectMode) line
::tk::spinbox::MouseSelect %W %x
}
bind Spinbox <B1-Leave> {
set tk::Priv(x) %x
::tk::spinbox::AutoScan %W
}
bind Spinbox <B1-Enter> {
tk::CancelRepeat
}
bind Spinbox <ButtonRelease-1> {
::tk::spinbox::ButtonUp %W %x %y
}
bind Spinbox <Control-1> {
%W icursor @%x
}
bind Spinbox <<PrevLine>> {
%W invoke buttonup
}
bind Spinbox <<NextLine>> {
%W invoke buttondown
}
bind Spinbox <<PrevChar>> {
::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
}
bind Spinbox <<NextChar>> {
::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
}
bind Spinbox <<SelectPrevChar>> {
::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
::tk::EntrySeeInsert %W
}
bind Spinbox <<SelectNextChar>> {
::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
::tk::EntrySeeInsert %W
}
bind Spinbox <<PrevWord>> {
::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
}
bind Spinbox <<NextWord>> {
::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
}
bind Spinbox <<SelectPrevWord>> {
::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
::tk::EntrySeeInsert %W
}
bind Spinbox <<SelectNextWord>> {
::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
::tk::EntrySeeInsert %W
}
bind Spinbox <<LineStart>> {
::tk::EntrySetCursor %W 0
}
bind Spinbox <<SelectLineStart>> {
::tk::EntryKeySelect %W 0
::tk::EntrySeeInsert %W
}
bind Spinbox <<LineEnd>> {
::tk::EntrySetCursor %W end
}
bind Spinbox <<SelectLineEnd>> {
::tk::EntryKeySelect %W end
::tk::EntrySeeInsert %W
}
bind Spinbox <Delete> {
if {[%W selection present]} {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind Spinbox <BackSpace> {
::tk::EntryBackspace %W
}
bind Spinbox <Control-space> {
%W selection from insert
}
bind Spinbox <Select> {
%W selection from insert
}
bind Spinbox <Control-Shift-space> {
%W selection adjust insert
}
bind Spinbox <Shift-Select> {
%W selection adjust insert
}
bind Spinbox <<SelectAll>> {
%W selection range 0 end
}
bind Spinbox <<SelectNone>> {
%W selection clear
}
bind Spinbox <KeyPress> {
::tk::EntryInsert %W %A
}
# 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, Return, and Tab.
bind Spinbox <Alt-KeyPress> {# nothing}
bind Spinbox <Meta-KeyPress> {# nothing}
bind Spinbox <Control-KeyPress> {# nothing}
bind Spinbox <Escape> {# nothing}
bind Spinbox <Return> {# nothing}
bind Spinbox <KP_Enter> {# nothing}
bind Spinbox <Tab> {# nothing}
bind Spinbox <Prior> {# nothing}
bind Spinbox <Next> {# nothing}
if {[tk windowingsystem] eq "aqua"} {
bind Spinbox <Command-KeyPress> {# nothing}
}
# On Windows, paste is done using Shift-Insert. Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[tk windowingsystem] ne "win32"} {
bind Spinbox <Insert> {
catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
}
}
# Additional emacs-like bindings:
bind Spinbox <Control-d> {
if {!$tk_strictMotif} {
%W delete insert
}
}
bind Spinbox <Control-h> {
if {!$tk_strictMotif} {
::tk::EntryBackspace %W
}
}
bind Spinbox <Control-k> {
if {!$tk_strictMotif} {
%W delete insert end
}
}
bind Spinbox <Control-t> {
if {!$tk_strictMotif} {
::tk::EntryTranspose %W
}
}
bind Spinbox <Meta-b> {
if {!$tk_strictMotif} {
::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
}
}
bind Spinbox <Meta-d> {
if {!$tk_strictMotif} {
%W delete insert [::tk::EntryNextWord %W insert]
}
}
bind Spinbox <Meta-f> {
if {!$tk_strictMotif} {
::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
}
}
bind Spinbox <Meta-BackSpace> {
if {!$tk_strictMotif} {
%W delete [::tk::EntryPreviousWord %W insert] insert
}
}
bind Spinbox <Meta-Delete> {
if {!$tk_strictMotif} {
%W delete [::tk::EntryPreviousWord %W insert] insert
}
}
# A few additional bindings of my own.
bind Spinbox <2> {
if {!$tk_strictMotif} {
::tk::EntryScanMark %W %x
}
}
bind Spinbox <B2-Motion> {
if {!$tk_strictMotif} {
::tk::EntryScanDrag %W %x
}
}
# ::tk::spinbox::Invoke --
# Invoke an element of the spinbox
#
# Arguments:
# w - The spinbox window.
# elem - Element to invoke
proc ::tk::spinbox::Invoke {w elem} {
variable ::tk::Priv
if {![winfo exists $w]} {
return
}
if {![info exists Priv(outsideElement)]} {
$w invoke $elem
incr Priv(repeated)
}
set delay [$w cget -repeatinterval]
if {$delay > 0} {
set Priv(afterId) [after $delay \
[list ::tk::spinbox::Invoke $w $elem]]
}
}
# ::tk::spinbox::ClosestGap --
# 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.
#
# Arguments:
# w - The spinbox window.
# x - X-coordinate within the window.
proc ::tk::spinbox::ClosestGap {w x} {
set pos [$w index @$x]
set bbox [$w bbox $pos]
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
return $pos
}
incr pos
}
# ::tk::spinbox::ArrowPress --
# This procedure is invoked to handle button-1 presses in buttonup
# or buttondown elements of spinbox widgets.
#
# Arguments:
# w - The spinbox window in which the button was pressed.
# x - The x-coordinate of the button press.
# y - The y-coordinate of the button press.
proc ::tk::spinbox::ArrowPress {w x y} {
variable ::tk::Priv
if {[$w cget -state] ne "disabled" && \
[string match "button*" $Priv(element)]} {
$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 Priv(afterId) [after $delay \
[list ::tk::spinbox::Invoke $w $Priv(element)]]
}
if {[info exists Priv(outsideElement)]} {
unset Priv(outsideElement)
}
}
}
# ::tk::spinbox::ButtonDown --
# This procedure is invoked to handle button-1 presses in spinbox
# widgets. It moves the insertion cursor, sets the selection anchor,
# and claims the input focus.
#
# Arguments:
# w - The spinbox window in which the button was pressed.
# x - The x-coordinate of the button press.
# y - The y-coordinate of the button press.
proc ::tk::spinbox::ButtonDown {w x y} {
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 Priv(element) [$w identify $x $y]
if {$Priv(element) eq ""} {
set Priv(element) "entry"
}
switch -exact $Priv(element) {
"buttonup" - "buttondown" {
::tk::spinbox::ArrowPress $w $x $y
}
"entry" {
set Priv(selectMode) char
set Priv(mouseMoved) 0
set Priv(pressX) $x
$w icursor [::tk::spinbox::ClosestGap $w $x]
$w selection from insert
if {"disabled" ne [$w cget -state]} {focus $w}
$w selection clear
}
default {
return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \
"unknown spinbox element \"$Priv(element)\""
}
}
}
# ::tk::spinbox::ButtonUp --
# This procedure is invoked to handle button-1 releases in spinbox
# widgets.
#
# Arguments:
# w - The spinbox window in which the button was pressed.
# x - The x-coordinate of the button press.
# y - The y-coordinate of the button press.
proc ::tk::spinbox::ButtonUp {w x y} {
variable ::tk::Priv
::tk::CancelRepeat
# Priv(relief) may not exist if the ButtonUp is not paired with
# a preceding ButtonDown
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 -$Priv(element)relief $Priv(relief)
$w selection element none
}
}
# ::tk::spinbox::MouseSelect --
# 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
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w - The spinbox window in which the button was pressed.
# x - The x-coordinate of the mouse.
# cursor - optional place to set cursor.
proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
variable ::tk::Priv
if {$Priv(element) ne "entry"} {
# The ButtonUp command triggered by ButtonRelease-1 handles
# invoking one of the spinbuttons.
return
}
set cur [::tk::spinbox::ClosestGap $w $x]
set anchor [$w index anchor]
if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
set Priv(mouseMoved) 1
}
switch $Priv(selectMode) {
char {
if {$Priv(mouseMoved)} {
if {$cur < $anchor} {
$w selection range $cur $anchor
} elseif {$cur > $anchor} {
$w selection range $anchor $cur
} else {
$w selection clear
}
}
}
word {
if {$cur < [$w index anchor]} {
set before [tcl_wordBreakBefore [$w get] $cur]
set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
} else {
set before [tcl_wordBreakBefore [$w get] $anchor]
set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
}
if {$before < 0} {
set before 0
}
if {$after < 0} {
set after end
}
$w selection range $before $after
}
line {
$w selection range 0 end
}
}
if {$cursor ne {} && $cursor ne "ignore"} {
catch {$w icursor $cursor}
}
update idletasks
}
# ::tk::spinbox::Paste --
# This procedure sets the insertion cursor to the current mouse position,
# pastes the selection there, and sets the focus to the window.
#
# Arguments:
# w - The spinbox window.
# x - X position of the mouse.
proc ::tk::spinbox::Paste {w x} {
$w icursor [::tk::spinbox::ClosestGap $w $x]
catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
if {"disabled" eq [$w cget -state]} {
focus $w
}
}
# ::tk::spinbox::Motion --
# This procedure is invoked when the mouse moves in a spinbox window
# with button 1 down.
#
# Arguments:
# w - The spinbox window.
# x - The x-coordinate of the mouse.
# y - The y-coordinate of the mouse.
proc ::tk::spinbox::Motion {w x y} {
variable ::tk::Priv
if {![info exists Priv(element)]} {
set Priv(element) [$w identify $x $y]
}
set Priv(x) $x
if {"entry" eq $Priv(element)} {
::tk::spinbox::MouseSelect $w $x ignore
} elseif {[$w identify $x $y] ne $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 Priv(outsideElement) ""
$w selection element none
}
} elseif {[info exists Priv(outsideElement)]} {
unset Priv(outsideElement)
$w selection element $Priv(element)
}
}
# ::tk::spinbox::AutoScan --
# This procedure is invoked when the mouse leaves an spinbox window
# with button 1 down. It scrolls the window left or right,
# depending on where the mouse is, 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 spinbox window.
proc ::tk::spinbox::AutoScan {w} {
variable ::tk::Priv
set x $Priv(x)
if {$x >= [winfo width $w]} {
$w xview scroll 2 units
::tk::spinbox::MouseSelect $w $x ignore
} elseif {$x < 0} {
$w xview scroll -2 units
::tk::spinbox::MouseSelect $w $x ignore
}
set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
}
# ::tk::spinbox::GetSelection --
#
# 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
proc ::tk::spinbox::GetSelection {w} {
return [string range [$w get] [$w index sel.first] \
[expr {[$w index sel.last] - 1}]]
}

253
windowsAgent/dist/tk/tclIndex vendored Normal file
View File

@ -0,0 +1,253 @@
# Tcl autoload index file, version 2.0
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands. Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.
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::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(::tk::dialog::error::bgerror) [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(::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::IconList) [list source [file join $dir iconlist.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::Megawidget) [list source [file join $dir megawidget.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(::tk::GenerateMenuSelect) [list source [file join $dir menu.tcl]]
set auto_index(tk_popup) [list source [file join $dir menu.tcl]]
set auto_index(::tk::ensure_psenc_is_loaded) [list source [file join $dir mkpsenc.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::classic::restore) [list source [file join $dir obsolete.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(::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(::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(::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::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(::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]]
set auto_index(::tk::dialog::file::OkCmd) [list source [file join $dir tkfbox.tcl]]
set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbox.tcl]]
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(::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]]
set auto_index(::tk::fontchooser) [list source [file join $dir fontchooser.tcl]]

180
windowsAgent/dist/tk/tearoff.tcl vendored Normal file
View File

@ -0,0 +1,180 @@
# tearoff.tcl --
#
# This file contains procedures that implement tear-off menus.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ::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
# window manager. The return value is the name of the new menu.
# The window is created at the point specified by x and y
#
# Arguments:
# w - The menu to be torn-off (duplicated).
# x - x coordinate where window is created
# y - y coordinate where window is created
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
# menu will be on the same screen as the original menu. By making
# it a child of the ancestor, rather than a child of the menu, it
# can continue to live even if the menu is deleted; it will go
# away when the toplevel goes away.
if {$x == 0} {
set x [winfo rootx $w]
}
if {$y == 0} {
set y [winfo rooty $w]
if {[tk windowingsystem] eq "aqua"} {
# Shift by height of tearoff entry minus height of window titlebar
catch {incr y [expr {[$w yposition 1] - 16}]}
# Avoid the native menu bar which sits on top of everything.
if {$y < 22} { set y 22 }
}
}
set parent [winfo parent $w]
while {[winfo toplevel $parent] ne $parent \
|| [winfo class $parent] eq "Menu"} {
set parent [winfo parent $parent]
}
if {$parent eq "."} {
set parent ""
}
for {set i 1} 1 {incr i} {
set menu $parent.tearoff$i
if {![winfo exists $menu]} {
break
}
}
$w clone $menu tearoff
# Pick a title for the new menu by looking at the parent of the
# original: if the parent is a menu, then use the text of the active
# entry. If it's a menubutton then use its text.
set parent [winfo parent $w]
if {[$menu cget -title] ne ""} {
wm title $menu [$menu cget -title]
} else {
switch -- [winfo class $parent] {
Menubutton {
wm title $menu [$parent cget -text]
}
Menu {
wm title $menu [$parent entrycget active -label]
}
}
}
if {[tk windowingsystem] eq "win32"} {
# [Bug 3181181]: Find the toplevel window for the menu
set parent [winfo toplevel $parent]
while {[winfo class $parent] eq "Menu"} {
set parent [winfo toplevel [winfo parent $parent]]
}
wm transient $menu [winfo toplevel $parent]
wm attributes $menu -toolwindow 1
}
$menu post $x $y
if {[winfo exists $menu] == 0} {
return ""
}
# 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 tk::Priv(focus) %W
}
# If there is a -tearoffcommand option for the menu, invoke it
# now.
set cmd [$w cget -tearoffcommand]
if {$cmd ne ""} {
uplevel #0 $cmd [list $w $menu]
}
return $menu
}
# ::tk::MenuDup --
# Given a menu (hierarchy), create a duplicate menu (hierarchy)
# in a given window.
#
# Arguments:
# src - Source window. Must be a menu. It and its
# menu descendants will be duplicated at dst.
# dst - Name to use for topmost menu in duplicate
# hierarchy.
proc ::tk::MenuDup {src dst type} {
set cmd [list menu $dst -type $type]
foreach option [$src configure] {
if {[llength $option] == 2} {
continue
}
if {[lindex $option 0] eq "-type"} {
continue
}
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
set last [$src index last]
if {$last eq "none"} {
return
}
for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
set cmd [list $dst add [$src type $i]]
foreach option [$src entryconfigure $i] {
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
}
# Duplicate the binding tags and bindings from the source menu.
set tags [bindtags $src]
set srcLen [string length $src]
# Copy tags to x, replacing each substring of src with dst.
while {[set index [string first $src $tags]] != -1} {
append x [string range $tags 0 [expr {$index - 1}]]$dst
set tags [string range $tags [expr {$index + $srcLen}] end]
}
append x $tags
bindtags $dst $x
foreach event [bind $src] {
unset x
set script [bind $src $event]
set eventLen [string length $event]
# Copy script to x, replacing each substring of event with dst.
while {[set index [string first $event $script]] != -1} {
append x [string range $script 0 [expr {$index - 1}]]
append x $dst
set script [string range $script [expr {$index + $eventLen}] end]
}
append x $script
bind $dst $event $x
}
}

1207
windowsAgent/dist/tk/text.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

695
windowsAgent/dist/tk/tk.tcl vendored Normal file
View File

@ -0,0 +1,695 @@
# tk.tcl --
#
# Initialization script normally executed in the interpreter for each Tk-based
# application. Arranges class bindings for widgets.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# Verify that we have Tk binary and script components from the same release
package require -exact Tk 8.6.9
# Create a ::tk namespace
namespace eval ::tk {
# Set up the msgcat commands
namespace eval msgcat {
namespace export mc mcmax
if {[interp issafe] || [catch {package require msgcat}]} {
# The msgcat package is not available. Supply our own
# minimal replacement.
proc mc {src args} {
return [format $src {*}$args]
}
proc mcmax {args} {
set max 0
foreach string $args {
set len [string length $string]
if {$len>$max} {
set max $len
}
}
return $max
}
} else {
# Get the commands from the msgcat package that Tk uses.
namespace import ::msgcat::mc
namespace import ::msgcat::mcmax
::msgcat::mcload [file join $::tk_library msgs]
}
}
namespace import ::tk::msgcat::*
}
# and a ::ttk namespace
namespace eval ::ttk {
if {$::tk_library ne ""} {
# avoid file join to work in safe interps, but this is also x-plat ok
variable library $::tk_library/ttk
}
}
# Add Ttk & 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] && ($::tk_library ne "")
&& ($::tk_library ni $::auto_path)
} then {
lappend ::auto_path $::tk_library $::ttk::library
}
# Turn off strict Motif look and feel as a default.
set ::tk_strictMotif 0
# Turn on useinputmethods (X Input Methods) by default.
# We catch this because safe interpreters may not allow the call.
catch {tk useinputmethods 1}
# ::tk::PlaceWindow --
# place a toplevel at a particular position
# Arguments:
# toplevel name of toplevel window
# ?placement? pointer ?center? ; places $w centered on the pointer
# widget widgetPath ; centers $w over widget_name
# defaults to placing toplevel in the middle of the screen
# ?anchor? center or widgetPath
# Results:
# Returns nothing
#
proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
wm withdraw $w
update idletasks
set checkBounds 1
if {$place eq ""} {
set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
set checkBounds 0
} elseif {[string equal -length [string length $place] $place "pointer"]} {
## place at POINTER (centered if $anchor == center)
if {[string equal -length [string length $anchor] $anchor "center"]} {
set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
} else {
set x [winfo pointerx $w]
set y [winfo pointery $w]
}
} elseif {[string equal -length [string length $place] $place "widget"] && \
[winfo exists $anchor] && [winfo ismapped $anchor]} {
## center about WIDGET $anchor, widget must be mapped
set x [expr {[winfo rootx $anchor] + \
([winfo width $anchor]-[winfo reqwidth $w])/2}]
set y [expr {[winfo rooty $anchor] + \
([winfo height $anchor]-[winfo reqheight $w])/2}]
} else {
set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
set checkBounds 0
}
if {$checkBounds} {
if {$x < [winfo vrootx $w]} {
set x [winfo vrootx $w]
} elseif {$x > ([winfo vrootx $w]+[winfo vrootwidth $w]-[winfo reqwidth $w])} {
set x [expr {[winfo vrootx $w]+[winfo vrootwidth $w]-[winfo reqwidth $w]}]
}
if {$y < [winfo vrooty $w]} {
set y [winfo vrooty $w]
} elseif {$y > ([winfo vrooty $w]+[winfo vrootheight $w]-[winfo reqheight $w])} {
set y [expr {[winfo vrooty $w]+[winfo vrootheight $w]-[winfo reqheight $w]}]
}
if {[tk windowingsystem] eq "aqua"} {
# Avoid the native menu bar which sits on top of everything.
if {$y < 22} {
set y 22
}
}
}
wm maxsize $w [winfo vrootwidth $w] [winfo vrootheight $w]
wm geometry $w +$x+$y
wm deiconify $w
}
# ::tk::SetFocusGrab --
# swap out current focus and grab temporarily (for dialogs)
# Arguments:
# grab new window to grab
# focus window to give focus to
# Results:
# Returns nothing
#
proc ::tk::SetFocusGrab {grab {focus {}}} {
set index "$grab,$focus"
upvar ::tk::FocusGrab($index) data
lappend data [focus]
set oldGrab [grab current $grab]
lappend data $oldGrab
if {[winfo exists $oldGrab]} {
lappend data [grab status $oldGrab]
}
# The "grab" command will fail if another application
# already holds the grab. So catch it.
catch {grab $grab}
if {[winfo exists $focus]} {
focus $focus
}
}
# ::tk::RestoreFocusGrab --
# restore old focus and grab (for dialogs)
# Arguments:
# grab window that had taken grab
# focus window that had taken focus
# destroy destroy|withdraw - how to handle the old grabbed window
# Results:
# Returns nothing
#
proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
set index "$grab,$focus"
if {[info exists ::tk::FocusGrab($index)]} {
foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
unset ::tk::FocusGrab($index)
} else {
set oldGrab ""
}
catch {focus $oldFocus}
grab release $grab
if {$destroy eq "withdraw"} {
wm withdraw $grab
} else {
destroy $grab
}
if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
if {$oldStatus eq "global"} {
grab -global $oldGrab
} else {
grab $oldGrab
}
}
}
# ::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 {[tk windowingsystem] ne "win32"} {
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]} then {
return -code error -errorcode {TK SELECTION NONE} \
"could not find default selection"
} else {
return $txt
}
}
} else {
proc ::tk::GetSelection {w {sel PRIMARY}} {
if {[catch {
selection get -displayof $w -selection $sel
} txt]} then {
return -code error -errorcode {TK SELECTION NONE} \
"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 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 ::tk::ScreenChanged screen {
# Extract the display name.
set disp [string range $screen 0 [string last . $screen]-1]
# Ensure that namespace separators never occur in the display name (as
# they cause problems in variable names). Double-colons exist in some VNC
# display names. [Bug 2912473]
set disp [string map {:: _doublecolon_} $disp]
uplevel #0 [list upvar #0 ::tk::Priv.$disp ::tk::Priv]
variable ::tk::Priv
if {[info exists Priv]} {
set Priv(screen) $screen
return
}
array set Priv {
activeMenu {}
activeItem {}
afterId {}
buttons 0
buttonWindow {}
dragging 0
focus {}
grab {}
initPos {}
inMenubutton {}
listboxPrev {}
menuBar {}
mouseMoved 0
oldGrab {}
popup {}
postedMb {}
pressX 0
pressY 0
prevPos 0
selectMode char
}
set Priv(screen) $screen
set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
set Priv(window) {}
}
# 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).
tk::ScreenChanged [winfo screen .]
# ::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").
proc ::tk::EventMotifBindings {n1 dummy dummy} {
upvar $n1 name
if {$name} {
set op delete
} else {
set op add
}
event $op <<Cut>> <Control-Key-w> <Control-Lock-Key-W> <Shift-Key-Delete>
event $op <<Copy>> <Meta-Key-w> <Meta-Lock-Key-W> <Control-Key-Insert>
event $op <<Paste>> <Control-Key-y> <Control-Lock-Key-Y> <Shift-Key-Insert>
event $op <<PrevChar>> <Control-Key-b> <Control-Lock-Key-B>
event $op <<NextChar>> <Control-Key-f> <Control-Lock-Key-F>
event $op <<PrevLine>> <Control-Key-p> <Control-Lock-Key-P>
event $op <<NextLine>> <Control-Key-n> <Control-Lock-Key-N>
event $op <<LineStart>> <Control-Key-a> <Control-Lock-Key-A>
event $op <<LineEnd>> <Control-Key-e> <Control-Lock-Key-E>
event $op <<SelectPrevChar>> <Control-Key-B> <Control-Lock-Key-b>
event $op <<SelectNextChar>> <Control-Key-F> <Control-Lock-Key-f>
event $op <<SelectPrevLine>> <Control-Key-P> <Control-Lock-Key-p>
event $op <<SelectNextLine>> <Control-Key-N> <Control-Lock-Key-n>
event $op <<SelectLineStart>> <Control-Key-A> <Control-Lock-Key-a>
event $op <<SelectLineEnd>> <Control-Key-E> <Control-Lock-Key-e>
}
#----------------------------------------------------------------------
# Define common dialogs on platforms where they are not implemented
# using compiled code.
#----------------------------------------------------------------------
if {![llength [info commands tk_chooseColor]]} {
proc ::tk_chooseColor {args} {
return [::tk::dialog::color:: {*}$args]
}
}
if {![llength [info commands tk_getOpenFile]]} {
proc ::tk_getOpenFile {args} {
if {$::tk_strictMotif} {
return [::tk::MotifFDialog open {*}$args]
} else {
return [::tk::dialog::file:: open {*}$args]
}
}
}
if {![llength [info commands tk_getSaveFile]]} {
proc ::tk_getSaveFile {args} {
if {$::tk_strictMotif} {
return [::tk::MotifFDialog save {*}$args]
} else {
return [::tk::dialog::file:: save {*}$args]
}
}
}
if {![llength [info commands tk_messageBox]]} {
proc ::tk_messageBox {args} {
return [::tk::MessageBox {*}$args]
}
}
if {![llength [info command tk_chooseDirectory]]} {
proc ::tk_chooseDirectory {args} {
return [::tk::dialog::file::chooseDir:: {*}$args]
}
}
#----------------------------------------------------------------------
# Define the set of common virtual events.
#----------------------------------------------------------------------
switch -exact -- [tk windowingsystem] {
"x11" {
event add <<Cut>> <Control-Key-x> <Key-F20> <Control-Lock-Key-X>
event add <<Copy>> <Control-Key-c> <Key-F16> <Control-Lock-Key-C>
event add <<Paste>> <Control-Key-v> <Key-F18> <Control-Lock-Key-V>
event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z>
event add <<Redo>> <Control-Key-Z> <Control-Lock-Key-z>
event add <<ContextMenu>> <Button-3>
# On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent
# XQuartz as the X server, they are 1,2,3; other X servers may differ.
event add <<SelectAll>> <Control-Key-slash>
event add <<SelectNone>> <Control-Key-backslash>
event add <<NextChar>> <Right>
event add <<SelectNextChar>> <Shift-Right>
event add <<PrevChar>> <Left>
event add <<SelectPrevChar>> <Shift-Left>
event add <<NextWord>> <Control-Right>
event add <<SelectNextWord>> <Control-Shift-Right>
event add <<PrevWord>> <Control-Left>
event add <<SelectPrevWord>> <Control-Shift-Left>
event add <<LineStart>> <Home>
event add <<SelectLineStart>> <Shift-Home>
event add <<LineEnd>> <End>
event add <<SelectLineEnd>> <Shift-End>
event add <<PrevLine>> <Up>
event add <<NextLine>> <Down>
event add <<SelectPrevLine>> <Shift-Up>
event add <<SelectNextLine>> <Shift-Down>
event add <<PrevPara>> <Control-Up>
event add <<NextPara>> <Control-Down>
event add <<SelectPrevPara>> <Control-Shift-Up>
event add <<SelectNextPara>> <Control-Shift-Down>
event add <<ToggleSelection>> <Control-ButtonPress-1>
# 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 PrevWindow
# event. We use catch just in case the keysym isn't recognized.
# This is needed for XFree86 systems
catch { event add <<PrevWindow>> <ISO_Left_Tab> }
# This seems to be correct on *some* HP systems.
catch { event add <<PrevWindow>> <hpBackTab> }
trace add variable ::tk_strictMotif write ::tk::EventMotifBindings
set ::tk_strictMotif $::tk_strictMotif
# On unix, we want to always display entry/text selection,
# regardless of which window has focus
set ::tk::AlwaysShowSelection 1
}
"win32" {
event add <<Cut>> <Control-Key-x> <Shift-Key-Delete> <Control-Lock-Key-X>
event add <<Copy>> <Control-Key-c> <Control-Key-Insert> <Control-Lock-Key-C>
event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> <Control-Lock-Key-V>
event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z>
event add <<Redo>> <Control-Key-y> <Control-Lock-Key-Y>
event add <<ContextMenu>> <Button-3>
event add <<SelectAll>> <Control-Key-slash> <Control-Key-a> <Control-Lock-Key-A>
event add <<SelectNone>> <Control-Key-backslash>
event add <<NextChar>> <Right>
event add <<SelectNextChar>> <Shift-Right>
event add <<PrevChar>> <Left>
event add <<SelectPrevChar>> <Shift-Left>
event add <<NextWord>> <Control-Right>
event add <<SelectNextWord>> <Control-Shift-Right>
event add <<PrevWord>> <Control-Left>
event add <<SelectPrevWord>> <Control-Shift-Left>
event add <<LineStart>> <Home>
event add <<SelectLineStart>> <Shift-Home>
event add <<LineEnd>> <End>
event add <<SelectLineEnd>> <Shift-End>
event add <<PrevLine>> <Up>
event add <<NextLine>> <Down>
event add <<SelectPrevLine>> <Shift-Up>
event add <<SelectNextLine>> <Shift-Down>
event add <<PrevPara>> <Control-Up>
event add <<NextPara>> <Control-Down>
event add <<SelectPrevPara>> <Control-Shift-Up>
event add <<SelectNextPara>> <Control-Shift-Down>
event add <<ToggleSelection>> <Control-ButtonPress-1>
}
"aqua" {
event add <<Cut>> <Command-Key-x> <Key-F2> <Command-Lock-Key-X>
event add <<Copy>> <Command-Key-c> <Key-F3> <Command-Lock-Key-C>
event add <<Paste>> <Command-Key-v> <Key-F4> <Command-Lock-Key-V>
event add <<PasteSelection>> <ButtonRelease-3>
event add <<Clear>> <Clear>
event add <<ContextMenu>> <Button-2>
# Official bindings
# See http://support.apple.com/kb/HT1343
event add <<SelectAll>> <Command-Key-a>
event add <<SelectNone>> <Option-Command-Key-a>
event add <<Undo>> <Command-Key-z> <Command-Lock-Key-Z>
event add <<Redo>> <Shift-Command-Key-z> <Shift-Command-Lock-Key-z>
event add <<NextChar>> <Right> <Control-Key-f> <Control-Lock-Key-F>
event add <<SelectNextChar>> <Shift-Right> <Shift-Control-Key-F> <Shift-Control-Lock-Key-F>
event add <<PrevChar>> <Left> <Control-Key-b> <Control-Lock-Key-B>
event add <<SelectPrevChar>> <Shift-Left> <Shift-Control-Key-B> <Shift-Control-Lock-Key-B>
event add <<NextWord>> <Option-Right>
event add <<SelectNextWord>> <Shift-Option-Right>
event add <<PrevWord>> <Option-Left>
event add <<SelectPrevWord>> <Shift-Option-Left>
event add <<LineStart>> <Home> <Command-Left> <Control-Key-a> <Control-Lock-Key-A>
event add <<SelectLineStart>> <Shift-Home> <Shift-Command-Left> <Shift-Control-Key-A> <Shift-Control-Lock-Key-A>
event add <<LineEnd>> <End> <Command-Right> <Control-Key-e> <Control-Lock-Key-E>
event add <<SelectLineEnd>> <Shift-End> <Shift-Command-Right> <Shift-Control-Key-E> <Shift-Control-Lock-Key-E>
event add <<PrevLine>> <Up> <Control-Key-p> <Control-Lock-Key-P>
event add <<SelectPrevLine>> <Shift-Up> <Shift-Control-Key-P> <Shift-Control-Lock-Key-P>
event add <<NextLine>> <Down> <Control-Key-n> <Control-Lock-Key-N>
event add <<SelectNextLine>> <Shift-Down> <Shift-Control-Key-N> <Shift-Control-Lock-Key-N>
# Not official, but logical extensions of above. Also derived from
# bindings present in MS Word on OSX.
event add <<PrevPara>> <Option-Up>
event add <<NextPara>> <Option-Down>
event add <<SelectPrevPara>> <Shift-Option-Up>
event add <<SelectNextPara>> <Shift-Option-Down>
event add <<ToggleSelection>> <Command-ButtonPress-1>
}
}
# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------
if {$::tk_library ne ""} {
proc ::tk::SourceLibFile {file} {
namespace eval :: [list source [file join $::tk_library $file.tcl]]
}
namespace eval ::tk {
SourceLibFile icons
SourceLibFile button
SourceLibFile entry
SourceLibFile listbox
SourceLibFile menu
SourceLibFile panedwindow
SourceLibFile scale
SourceLibFile scrlbar
SourceLibFile spinbox
SourceLibFile text
}
}
# ----------------------------------------------------------------------
# Default bindings for keyboard traversal.
# ----------------------------------------------------------------------
event add <<PrevWindow>> <Shift-Tab>
event add <<NextWindow>> <Tab>
bind all <<NextWindow>> {tk::TabToWindow [tk_focusNext %W]}
bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
# ::tk::CancelRepeat --
# This procedure is invoked to cancel an auto-repeat action described
# 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 ::tk::CancelRepeat {} {
variable ::tk::Priv
after cancel $Priv(afterId)
set Priv(afterId) {}
}
# ::tk::TabToWindow --
# This procedure moves the focus to the given widget.
# It sends a <<TraverseOut>> virtual event to the previous focus window,
# if any, before changing the focus, and a <<TraverseIn>> event
# to the new focus window afterwards.
#
# Arguments:
# w - Window to which focus should be set.
proc ::tk::TabToWindow {w} {
set focus [focus]
if {$focus ne ""} {
event generate $focus <<TraverseOut>>
}
focus $w
event generate $w <<TraverseIn>>
}
# ::tk::UnderlineAmpersand --
# This procedure takes some text with ampersand and returns text w/o
# ampersand and position of the ampersand. Double ampersands are
# converted to single ones. Position returned is -1 when there is no
# ampersand.
#
proc ::tk::UnderlineAmpersand {text} {
set s [string map {&& & & \ufeff} $text]
set idx [string first \ufeff $s]
return [list [string map {\ufeff {}} $s] $idx]
}
# ::tk::SetAmpText --
# Given widget path and text with "magic ampersands", sets -text and
# -underline options for the widget
#
proc ::tk::SetAmpText {widget text} {
lassign [UnderlineAmpersand $text] newtext under
$widget configure -text $newtext -underline $under
}
# ::tk::AmpWidget --
# Creates new widget, turning -text option into -text and -underline
# options, returned by ::tk::UnderlineAmpersand.
#
proc ::tk::AmpWidget {class path args} {
set options {}
foreach {opt val} $args {
if {$opt eq "-text"} {
lassign [UnderlineAmpersand $val] newtext under
lappend options -text $newtext -underline $under
} else {
lappend options $opt $val
}
}
set result [$class $path {*}$options]
if {[string match "*button" $class]} {
bind $path <<AltUnderlined>> [list $path invoke]
}
return $result
}
# ::tk::AmpMenuArgs --
# Processes arguments for a menu entry, turning -label option into
# -label and -underline options, returned by ::tk::UnderlineAmpersand.
# The cmd argument is supposed to be either "add" or "entryconfigure"
#
proc ::tk::AmpMenuArgs {widget cmd type args} {
set options {}
foreach {opt val} $args {
if {$opt eq "-label"} {
lassign [UnderlineAmpersand $val] newlabel under
lappend options -label $newlabel -underline $under
} else {
lappend options $opt $val
}
}
$widget $cmd $type {*}$options
}
# ::tk::FindAltKeyTarget --
# Search recursively through the hierarchy of visible widgets to find
# button or label which has $char as underlined character.
#
proc ::tk::FindAltKeyTarget {path char} {
set class [winfo class $path]
if {$class in {
Button Checkbutton Label Radiobutton
TButton TCheckbutton TLabel TRadiobutton
} && [string equal -nocase $char \
[string index [$path cget -text] [$path cget -underline]]]} {
return $path
}
set subwins [concat [grid slaves $path] [pack slaves $path] \
[place slaves $path]]
if {$class eq "Canvas"} {
foreach item [$path find all] {
if {[$path type $item] eq "window"} {
set w [$path itemcget $item -window]
if {$w ne ""} {lappend subwins $w}
}
}
} elseif {$class eq "Text"} {
lappend subwins {*}[$path window names]
}
foreach child $subwins {
set target [FindAltKeyTarget $child $char]
if {$target ne ""} {
return $target
}
}
}
# ::tk::AltKeyInDialog --
# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>>
# to button or label which has appropriate underlined character.
#
proc ::tk::AltKeyInDialog {path key} {
set target [FindAltKeyTarget $path $key]
if {$target ne ""} {
event generate $target <<AltUnderlined>>
}
}
# ::tk::mcmaxamp --
# Replacement for mcmax, used for texts with "magic ampersand" in it.
#
proc ::tk::mcmaxamp {args} {
set maxlen 0
foreach arg $args {
# Should we run [mc] in caller's namespace?
lassign [UnderlineAmpersand [mc $arg]] msg
set length [string length $msg]
if {$length > $maxlen} {
set maxlen $length
}
}
return $maxlen
}
# For now, turn off the custom mdef proc for the mac:
if {[tk windowingsystem] eq "aqua"} {
namespace eval ::tk::mac {
set useCustomMDEF 0
}
}
# Run the Ttk themed widget set initialization
if {$::ttk::library ne ""} {
uplevel \#0 [list source $::ttk::library/ttk.tcl]
}
# Local Variables:
# mode: tcl
# fill-column: 78
# End:

1240
windowsAgent/dist/tk/tkfbox.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

111
windowsAgent/dist/tk/ttk/altTheme.tcl vendored Normal file
View File

@ -0,0 +1,111 @@
#
# Ttk widget set: Alternate theme
#
namespace eval ttk::theme::alt {
variable colors
array set colors {
-frame "#d9d9d9"
-window "#ffffff"
-darker "#c3c3c3"
-border "#414141"
-activebg "#ececec"
-disabledfg "#a3a3a3"
-selectbg "#4a6984"
-selectfg "#ffffff"
-altindicator "#aaaaaa"
}
ttk::style theme settings alt {
ttk::style configure "." \
-background $colors(-frame) \
-foreground black \
-troughcolor $colors(-darker) \
-bordercolor $colors(-border) \
-selectbackground $colors(-selectbg) \
-selectforeground $colors(-selectfg) \
-font TkDefaultFont \
;
ttk::style map "." -background \
[list disabled $colors(-frame) active $colors(-activebg)] ;
ttk::style map "." -foreground [list disabled $colors(-disabledfg)] ;
ttk::style map "." -embossed [list disabled 1] ;
ttk::style configure TButton \
-anchor center -width -11 -padding "1 1" \
-relief raised -shiftrelief 1 \
-highlightthickness 1 -highlightcolor $colors(-frame)
ttk::style map TButton -relief {
{pressed !disabled} sunken
{active !disabled} raised
} -highlightcolor {alternate black}
ttk::style configure TCheckbutton -indicatorcolor "#ffffff" -padding 2
ttk::style configure TRadiobutton -indicatorcolor "#ffffff" -padding 2
ttk::style map TCheckbutton -indicatorcolor \
[list pressed $colors(-frame) \
alternate $colors(-altindicator) \
disabled $colors(-frame)]
ttk::style map TRadiobutton -indicatorcolor \
[list pressed $colors(-frame) \
alternate $colors(-altindicator) \
disabled $colors(-frame)]
ttk::style configure TMenubutton \
-width -11 -padding "3 3" -relief raised
ttk::style configure TEntry -padding 1
ttk::style map TEntry -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)]
ttk::style configure TCombobox -padding 1
ttk::style map TCombobox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure ComboboxPopdownFrame \
-relief solid -borderwidth 1
ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
ttk::style map TSpinbox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure Toolbutton -relief flat -padding 2
ttk::style map Toolbutton -relief \
{disabled flat selected sunken pressed sunken active raised}
ttk::style map Toolbutton -background \
[list pressed $colors(-darker) active $colors(-activebg)]
ttk::style configure TScrollbar -relief raised
ttk::style configure TLabelframe -relief groove -borderwidth 2
ttk::style configure TNotebook -tabmargins {2 2 1 0}
ttk::style configure TNotebook.Tab \
-padding {4 2} -background $colors(-darker)
ttk::style map TNotebook.Tab \
-background [list selected $colors(-frame)] \
-expand [list selected {2 2 1 0}] \
;
# Treeview:
ttk::style configure Heading -font TkHeadingFont -relief raised
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
{!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
{!disabled !selected} black \
selected $colors(-selectfg)]
ttk::style configure TScale \
-groovewidth 4 -troughrelief sunken \
-sliderwidth raised -borderwidth 2
ttk::style configure TProgressbar \
-background $colors(-selectbg) -borderwidth 0
}
}

64
windowsAgent/dist/tk/ttk/aquaTheme.tcl vendored Normal file
View File

@ -0,0 +1,64 @@
#
# Aqua theme (OSX native look and feel)
#
namespace eval ttk::theme::aqua {
ttk::style theme settings aqua {
ttk::style configure . \
-font TkDefaultFont \
-background systemWindowBody \
-foreground systemModelessDialogActiveText \
-selectbackground systemHighlight \
-selectforeground systemModelessDialogActiveText \
-selectborderwidth 0 \
-insertwidth 1
ttk::style map . \
-foreground {disabled systemModelessDialogInactiveText
background systemModelessDialogInactiveText} \
-selectbackground {background systemHighlightSecondary
!focus systemHighlightSecondary} \
-selectforeground {background systemModelessDialogInactiveText
!focus systemDialogActiveText}
# Workaround for #1100117:
# Actually, on Aqua we probably shouldn't stipple images in
# disabled buttons even if it did work...
ttk::style configure . -stipple {}
ttk::style configure TButton -anchor center -width -6
ttk::style configure Toolbutton -padding 4
ttk::style configure TNotebook -tabmargins {10 0} -tabposition n
ttk::style configure TNotebook -padding {18 8 18 17}
ttk::style configure TNotebook.Tab -padding {12 3 12 2}
# Combobox:
ttk::style configure TCombobox -postoffset {5 -2 -10 0}
# Treeview:
ttk::style configure Heading -font TkHeadingFont
ttk::style configure Treeview -rowheight 18 -background White
ttk::style map Treeview \
-background [list disabled systemDialogBackgroundInactive \
{!disabled !selected} systemWindowBody \
{selected background} systemHighlightSecondary \
selected systemHighlight] \
-foreground [list disabled systemModelessDialogInactiveText \
{!disabled !selected} black \
selected systemModelessDialogActiveText]
# Enable animation for ttk::progressbar widget:
ttk::style configure TProgressbar -period 100 -maxphase 255
# For Aqua, labelframe labels should appear outside the border,
# with a 14 pixel inset and 4 pixels spacing between border and label
# (ref: Apple Human Interface Guidelines / Controls / Grouping Controls)
#
ttk::style configure TLabelframe \
-labeloutside true -labelmargins {14 0 14 4}
# TODO: panedwindow sashes should be 9 pixels (HIG:Controls:Split Views)
}
}

83
windowsAgent/dist/tk/ttk/button.tcl vendored Normal file
View File

@ -0,0 +1,83 @@
#
# Bindings for Buttons, Checkbuttons, and Radiobuttons.
#
# Notes: <Button1-Leave>, <Button1-Enter> only control the "pressed"
# state; widgets remain "active" if the pointer is dragged out.
# This doesn't seem to be conventional, but it's a nice way
# to provide extra feedback while the grab is active.
# (If the button is released off the widget, the grab deactivates and
# we get a <Leave> event then, which turns off the "active" state)
#
# Normally, <ButtonRelease> and <ButtonN-Enter/Leave> events are
# delivered to the widget which received the initial <ButtonPress>
# event. However, Tk [grab]s (#1223103) and menu interactions
# (#1222605) can interfere with this. To guard against spurious
# <Button1-Enter> events, the <Button1-Enter> binding only sets
# the pressed state if the button is currently active.
#
namespace eval ttk::button {}
bind TButton <Enter> { %W instate !disabled {%W state active} }
bind TButton <Leave> { %W state !active }
bind TButton <Key-space> { ttk::button::activate %W }
bind TButton <<Invoke>> { ttk::button::activate %W }
bind TButton <ButtonPress-1> \
{ %W instate !disabled { ttk::clickToFocus %W; %W state pressed } }
bind TButton <ButtonRelease-1> \
{ %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } }
bind TButton <Button1-Leave> \
{ %W state !pressed }
bind TButton <Button1-Enter> \
{ %W instate {active !disabled} { %W state pressed } }
# Checkbuttons and Radiobuttons have the same bindings as Buttons:
#
ttk::copyBindings TButton TCheckbutton
ttk::copyBindings TButton TRadiobutton
# ...plus a few more:
bind TRadiobutton <KeyPress-Up> { ttk::button::RadioTraverse %W -1 }
bind TRadiobutton <KeyPress-Down> { ttk::button::RadioTraverse %W +1 }
# bind TCheckbutton <KeyPress-plus> { %W select }
# bind TCheckbutton <KeyPress-minus> { %W deselect }
# activate --
# Simulate a button press: temporarily set the state to 'pressed',
# then invoke the button.
#
proc ttk::button::activate {w} {
$w instate disabled { return }
set oldState [$w state pressed]
update idletasks; after 100 ;# block event loop to avoid reentrancy
$w state $oldState
$w invoke
}
# RadioTraverse -- up/down keyboard traversal for radiobutton groups.
# Set focus to previous/next radiobutton in a group.
# A radiobutton group consists of all the radiobuttons with
# the same parent and -variable; this is a pretty good heuristic
# that works most of the time.
#
proc ttk::button::RadioTraverse {w dir} {
set group [list]
foreach sibling [winfo children [winfo parent $w]] {
if { [winfo class $sibling] eq "TRadiobutton"
&& [$sibling cget -variable] eq [$w cget -variable]
&& ![$sibling instate disabled]
} {
lappend group $sibling
}
}
if {![llength $group]} { # Shouldn't happen, but can.
return
}
set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}]
tk::TabToWindow [lindex $group $pos]
}

149
windowsAgent/dist/tk/ttk/clamTheme.tcl vendored Normal file
View File

@ -0,0 +1,149 @@
#
# "Clam" theme.
#
# Inspired by the XFCE family of Gnome themes.
#
namespace eval ttk::theme::clam {
variable colors
array set colors {
-disabledfg "#999999"
-frame "#dcdad5"
-window "#ffffff"
-dark "#cfcdc8"
-darker "#bab5ab"
-darkest "#9e9a91"
-lighter "#eeebe7"
-lightest "#ffffff"
-selectbg "#4a6984"
-selectfg "#ffffff"
-altindicator "#5895bc"
-disabledaltindicator "#a0a0a0"
}
ttk::style theme settings clam {
ttk::style configure "." \
-background $colors(-frame) \
-foreground black \
-bordercolor $colors(-darkest) \
-darkcolor $colors(-dark) \
-lightcolor $colors(-lighter) \
-troughcolor $colors(-darker) \
-selectbackground $colors(-selectbg) \
-selectforeground $colors(-selectfg) \
-selectborderwidth 0 \
-font TkDefaultFont \
;
ttk::style map "." \
-background [list disabled $colors(-frame) \
active $colors(-lighter)] \
-foreground [list disabled $colors(-disabledfg)] \
-selectbackground [list !focus $colors(-darkest)] \
-selectforeground [list !focus white] \
;
# -selectbackground [list !focus "#847d73"]
ttk::style configure TButton \
-anchor center -width -11 -padding 5 -relief raised
ttk::style map TButton \
-background [list \
disabled $colors(-frame) \
pressed $colors(-darker) \
active $colors(-lighter)] \
-lightcolor [list pressed $colors(-darker)] \
-darkcolor [list pressed $colors(-darker)] \
-bordercolor [list alternate "#000000"] \
;
ttk::style configure Toolbutton \
-anchor center -padding 2 -relief flat
ttk::style map Toolbutton \
-relief [list \
disabled flat \
selected sunken \
pressed sunken \
active raised] \
-background [list \
disabled $colors(-frame) \
pressed $colors(-darker) \
active $colors(-lighter)] \
-lightcolor [list pressed $colors(-darker)] \
-darkcolor [list pressed $colors(-darker)] \
;
ttk::style configure TCheckbutton \
-indicatorbackground "#ffffff" \
-indicatormargin {1 1 4 1} \
-padding 2 ;
ttk::style configure TRadiobutton \
-indicatorbackground "#ffffff" \
-indicatormargin {1 1 4 1} \
-padding 2 ;
ttk::style map TCheckbutton -indicatorbackground \
[list pressed $colors(-frame) \
{!disabled alternate} $colors(-altindicator) \
{disabled alternate} $colors(-disabledaltindicator) \
disabled $colors(-frame)]
ttk::style map TRadiobutton -indicatorbackground \
[list pressed $colors(-frame) \
{!disabled alternate} $colors(-altindicator) \
{disabled alternate} $colors(-disabledaltindicator) \
disabled $colors(-frame)]
ttk::style configure TMenubutton \
-width -11 -padding 5 -relief raised
ttk::style configure TEntry -padding 1 -insertwidth 1
ttk::style map TEntry \
-background [list readonly $colors(-frame)] \
-bordercolor [list focus $colors(-selectbg)] \
-lightcolor [list focus "#6f9dc6"] \
-darkcolor [list focus "#6f9dc6"] \
;
ttk::style configure TCombobox -padding 1 -insertwidth 1
ttk::style map TCombobox \
-background [list active $colors(-lighter) \
pressed $colors(-lighter)] \
-fieldbackground [list {readonly focus} $colors(-selectbg) \
readonly $colors(-frame)] \
-foreground [list {readonly focus} $colors(-selectfg)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure ComboboxPopdownFrame \
-relief solid -borderwidth 1
ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
ttk::style map TSpinbox \
-background [list readonly $colors(-frame)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure TNotebook.Tab -padding {6 2 6 2}
ttk::style map TNotebook.Tab \
-padding [list selected {6 4 6 2}] \
-background [list selected $colors(-frame) {} $colors(-darker)] \
-lightcolor [list selected $colors(-lighter) {} $colors(-dark)] \
;
# Treeview:
ttk::style configure Heading \
-font TkHeadingFont -relief raised -padding {3}
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
{!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
{!disabled !selected} black \
selected $colors(-selectfg)]
ttk::style configure TLabelframe \
-labeloutside true -labelmargins {0 0 0 4} \
-borderwidth 2 -relief raised
ttk::style configure TProgressbar -background $colors(-frame)
ttk::style configure Sash -sashthickness 6 -gripcount 10
}
}

117
windowsAgent/dist/tk/ttk/classicTheme.tcl vendored Normal file
View File

@ -0,0 +1,117 @@
#
# "classic" Tk theme.
#
# Implements Tk's traditional Motif-like look and feel.
#
namespace eval ttk::theme::classic {
variable colors; array set colors {
-frame "#d9d9d9"
-window "#ffffff"
-activebg "#ececec"
-troughbg "#c3c3c3"
-selectbg "#c3c3c3"
-selectfg "#000000"
-disabledfg "#a3a3a3"
-indicator "#b03060"
-altindicator "#b05e5e"
}
ttk::style theme settings classic {
ttk::style configure "." \
-font TkDefaultFont \
-background $colors(-frame) \
-foreground black \
-selectbackground $colors(-selectbg) \
-selectforeground $colors(-selectfg) \
-troughcolor $colors(-troughbg) \
-indicatorcolor $colors(-frame) \
-highlightcolor $colors(-frame) \
-highlightthickness 1 \
-selectborderwidth 1 \
-insertwidth 2 \
;
# To match pre-Xft X11 appearance, use:
# ttk::style configure . -font {Helvetica 12 bold}
ttk::style map "." -background \
[list disabled $colors(-frame) active $colors(-activebg)]
ttk::style map "." -foreground \
[list disabled $colors(-disabledfg)]
ttk::style map "." -highlightcolor [list focus black]
ttk::style configure TButton \
-anchor center -padding "3m 1m" -relief raised -shiftrelief 1
ttk::style map TButton -relief [list {!disabled pressed} sunken]
ttk::style configure TCheckbutton -indicatorrelief raised
ttk::style map TCheckbutton \
-indicatorcolor [list \
pressed $colors(-frame) \
alternate $colors(-altindicator) \
selected $colors(-indicator)] \
-indicatorrelief {alternate raised selected sunken pressed sunken} \
;
ttk::style configure TRadiobutton -indicatorrelief raised
ttk::style map TRadiobutton \
-indicatorcolor [list \
pressed $colors(-frame) \
alternate $colors(-altindicator) \
selected $colors(-indicator)] \
-indicatorrelief {alternate raised selected sunken pressed sunken} \
;
ttk::style configure TMenubutton -relief raised -padding "3m 1m"
ttk::style configure TEntry -relief sunken -padding 1 -font TkTextFont
ttk::style map TEntry -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)]
ttk::style configure TCombobox -padding 1
ttk::style map TCombobox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)]
ttk::style configure ComboboxPopdownFrame \
-relief solid -borderwidth 1
ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
ttk::style map TSpinbox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)]
ttk::style configure TLabelframe -borderwidth 2 -relief groove
ttk::style configure TScrollbar -relief raised
ttk::style map TScrollbar -relief {{pressed !disabled} sunken}
ttk::style configure TScale -sliderrelief raised
ttk::style map TScale -sliderrelief {{pressed !disabled} sunken}
ttk::style configure TProgressbar -background SteelBlue
ttk::style configure TNotebook.Tab \
-padding {3m 1m} \
-background $colors(-troughbg)
ttk::style map TNotebook.Tab -background [list selected $colors(-frame)]
# Treeview:
ttk::style configure Heading -font TkHeadingFont -relief raised
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
{!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
{!disabled !selected} black \
selected $colors(-selectfg)]
#
# Toolbar buttons:
#
ttk::style configure Toolbutton -padding 2 -relief flat -shiftrelief 2
ttk::style map Toolbutton -relief \
{disabled flat selected sunken pressed sunken active raised}
ttk::style map Toolbutton -background \
[list pressed $colors(-troughbg) active $colors(-activebg)]
}
}

457
windowsAgent/dist/tk/ttk/combobox.tcl vendored Normal file
View File

@ -0,0 +1,457 @@
#
# Combobox bindings.
#
# <<NOTE-WM-TRANSIENT>>:
#
# Need to set [wm transient] just before mapping the popdown
# instead of when it's created, in case a containing frame
# has been reparented [#1818441].
#
# On Windows: setting [wm transient] prevents the parent
# toplevel from becoming inactive when the popdown is posted
# (Tk 8.4.8+)
#
# On X11: WM_TRANSIENT_FOR on override-redirect windows
# may be used by compositing managers and by EWMH-aware
# window managers (even though the older ICCCM spec says
# it's meaningless).
#
# On OSX: [wm transient] does utterly the wrong thing.
# Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"].
# The "noActivates" attribute prevents the parent toplevel
# from deactivating when the popdown is posted, and is also
# necessary for "help" windows to receive mouse events.
# "hideOnSuspend" makes the popdown disappear (resp. reappear)
# when the parent toplevel is deactivated (resp. reactivated).
# (see [#1814778]). Also set [wm resizable 0 0], to prevent
# TkAqua from shrinking the scrollbar to make room for a grow box
# that isn't there.
#
# In order to work around other platform quirks in TkAqua,
# [grab] and [focus] are set in <Map> bindings instead of
# immediately after deiconifying the window.
#
namespace eval ttk::combobox {
variable Values ;# Values($cb) is -listvariable of listbox widget
variable State
set State(entryPress) 0
}
### Combobox bindings.
#
# Duplicate the Entry bindings, override if needed:
#
ttk::copyBindings TEntry TCombobox
bind TCombobox <KeyPress-Down> { ttk::combobox::Post %W }
bind TCombobox <KeyPress-Escape> { ttk::combobox::Unpost %W }
bind TCombobox <ButtonPress-1> { ttk::combobox::Press "" %W %x %y }
bind TCombobox <Shift-ButtonPress-1> { ttk::combobox::Press "s" %W %x %y }
bind TCombobox <Double-ButtonPress-1> { ttk::combobox::Press "2" %W %x %y }
bind TCombobox <Triple-ButtonPress-1> { ttk::combobox::Press "3" %W %x %y }
bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x }
bind TCombobox <Motion> { ttk::combobox::Motion %W %x %y }
ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W]
bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W }
### Combobox listbox bindings.
#
bind ComboboxListbox <ButtonRelease-1> { ttk::combobox::LBSelected %W }
bind ComboboxListbox <KeyPress-Return> { ttk::combobox::LBSelected %W }
bind ComboboxListbox <KeyPress-Escape> { ttk::combobox::LBCancel %W }
bind ComboboxListbox <KeyPress-Tab> { ttk::combobox::LBTab %W next }
bind ComboboxListbox <<PrevWindow>> { ttk::combobox::LBTab %W prev }
bind ComboboxListbox <Destroy> { ttk::combobox::LBCleanup %W }
bind ComboboxListbox <Motion> { ttk::combobox::LBHover %W %x %y }
bind ComboboxListbox <Map> { focus -force %W }
switch -- [tk windowingsystem] {
win32 {
# Dismiss listbox when user switches to a different application.
# NB: *only* do this on Windows (see #1814778)
bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W }
}
}
### Combobox popdown window bindings.
#
bind ComboboxPopdown <Map> { ttk::combobox::MapPopdown %W }
bind ComboboxPopdown <Unmap> { ttk::combobox::UnmapPopdown %W }
bind ComboboxPopdown <ButtonPress> \
{ ttk::combobox::Unpost [winfo parent %W] }
### Option database settings.
#
option add *TCombobox*Listbox.font TkTextFont widgetDefault
option add *TCombobox*Listbox.relief flat widgetDefault
option add *TCombobox*Listbox.highlightThickness 0 widgetDefault
## Platform-specific settings.
#
switch -- [tk windowingsystem] {
x11 {
option add *TCombobox*Listbox.background white widgetDefault
}
aqua {
option add *TCombobox*Listbox.borderWidth 0 widgetDefault
}
}
### Binding procedures.
#
## Press $mode $x $y -- ButtonPress binding for comboboxes.
# Either post/unpost the listbox, or perform Entry widget binding,
# depending on widget state and location of button press.
#
proc ttk::combobox::Press {mode w x y} {
variable State
$w instate disabled { return }
set State(entryPress) [expr {
[$w instate !readonly]
&& [string match *textarea [$w identify element $x $y]]
}]
focus $w
if {$State(entryPress)} {
switch -- $mode {
s { ttk::entry::Shift-Press $w $x ; # Shift }
2 { ttk::entry::Select $w $x word ; # Double click}
3 { ttk::entry::Select $w $x line ; # Triple click }
"" -
default { ttk::entry::Press $w $x }
}
} else {
Post $w
}
}
## Drag -- B1-Motion binding for comboboxes.
# If the initial ButtonPress event was handled by Entry binding,
# perform Entry widget drag binding; otherwise nothing.
#
proc ttk::combobox::Drag {w x} {
variable State
if {$State(entryPress)} {
ttk::entry::Drag $w $x
}
}
## Motion --
# Set cursor.
#
proc ttk::combobox::Motion {w x y} {
if { [$w identify $x $y] eq "textarea"
&& [$w instate {!readonly !disabled}]
} {
ttk::setCursor $w text
} else {
ttk::setCursor $w ""
}
}
## TraverseIn -- receive focus due to keyboard navigation
# For editable comboboxes, set the selection and insert cursor.
#
proc ttk::combobox::TraverseIn {w} {
$w instate {!readonly !disabled} {
$w selection range 0 end
$w icursor end
}
}
## SelectEntry $cb $index --
# Set the combobox selection in response to a user action.
#
proc ttk::combobox::SelectEntry {cb index} {
$cb current $index
$cb selection range 0 end
$cb icursor end
event generate $cb <<ComboboxSelected>> -when mark
}
## Scroll -- Mousewheel binding
#
proc ttk::combobox::Scroll {cb dir} {
$cb instate disabled { return }
set max [llength [$cb cget -values]]
set current [$cb current]
incr current $dir
if {$max != 0 && $current == $current % $max} {
SelectEntry $cb $current
}
}
## LBSelected $lb -- Activation binding for listbox
# Set the combobox value to the currently-selected listbox value
# and unpost the listbox.
#
proc ttk::combobox::LBSelected {lb} {
set cb [LBMaster $lb]
LBSelect $lb
Unpost $cb
focus $cb
}
## LBCancel --
# Unpost the listbox.
#
proc ttk::combobox::LBCancel {lb} {
Unpost [LBMaster $lb]
}
## LBTab -- Tab key binding for combobox listbox.
# Set the selection, and navigate to next/prev widget.
#
proc ttk::combobox::LBTab {lb dir} {
set cb [LBMaster $lb]
switch -- $dir {
next { set newFocus [tk_focusNext $cb] }
prev { set newFocus [tk_focusPrev $cb] }
}
if {$newFocus ne ""} {
LBSelect $lb
Unpost $cb
# The [grab release] call in [Unpost] queues events that later
# re-set the focus (@@@ NOTE: this might not be true anymore).
# Set new focus later:
after 0 [list ttk::traverseTo $newFocus]
}
}
## LBHover -- <Motion> binding for combobox listbox.
# Follow selection on mouseover.
#
proc ttk::combobox::LBHover {w x y} {
$w selection clear 0 end
$w activate @$x,$y
$w selection set @$x,$y
}
## MapPopdown -- <Map> binding for ComboboxPopdown
#
proc ttk::combobox::MapPopdown {w} {
[winfo parent $w] state pressed
ttk::globalGrab $w
}
## UnmapPopdown -- <Unmap> binding for ComboboxPopdown
#
proc ttk::combobox::UnmapPopdown {w} {
[winfo parent $w] state !pressed
ttk::releaseGrab $w
}
###
#
namespace eval ::ttk::combobox {
# @@@ Until we have a proper native scrollbar on Aqua, use
# @@@ the regular Tk one. Use ttk::scrollbar on other platforms.
variable scrollbar ttk::scrollbar
if {[tk windowingsystem] eq "aqua"} {
set scrollbar ::scrollbar
}
}
## PopdownWindow --
# Returns the popdown widget associated with a combobox,
# creating it if necessary.
#
proc ttk::combobox::PopdownWindow {cb} {
variable scrollbar
if {![winfo exists $cb.popdown]} {
set poplevel [PopdownToplevel $cb.popdown]
set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame]
$scrollbar $popdown.sb \
-orient vertical -command [list $popdown.l yview]
listbox $popdown.l \
-listvariable ttk::combobox::Values($cb) \
-yscrollcommand [list $popdown.sb set] \
-exportselection false \
-selectmode browse \
-activestyle none \
;
bindtags $popdown.l \
[list $popdown.l ComboboxListbox Listbox $popdown all]
grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew
grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns
grid columnconfigure $popdown 0 -weight 1
grid rowconfigure $popdown 0 -weight 1
grid $popdown -sticky news -padx 0 -pady 0
grid rowconfigure $poplevel 0 -weight 1
grid columnconfigure $poplevel 0 -weight 1
}
return $cb.popdown
}
## PopdownToplevel -- Create toplevel window for the combobox popdown
#
# See also <<NOTE-WM-TRANSIENT>>
#
proc ttk::combobox::PopdownToplevel {w} {
toplevel $w -class ComboboxPopdown
wm withdraw $w
switch -- [tk windowingsystem] {
default -
x11 {
$w configure -relief flat -borderwidth 0
wm attributes $w -type combo
wm overrideredirect $w true
}
win32 {
$w configure -relief flat -borderwidth 0
wm overrideredirect $w true
wm attributes $w -topmost 1
}
aqua {
$w configure -relief solid -borderwidth 0
tk::unsupported::MacWindowStyle style $w \
help {noActivates hideOnSuspend}
wm resizable $w 0 0
}
}
return $w
}
## ConfigureListbox --
# Set listbox values, selection, height, and scrollbar visibility
# from current combobox values.
#
proc ttk::combobox::ConfigureListbox {cb} {
variable Values
set popdown [PopdownWindow $cb].f
set values [$cb cget -values]
set current [$cb current]
if {$current < 0} {
set current 0 ;# no current entry, highlight first one
}
set Values($cb) $values
$popdown.l selection clear 0 end
$popdown.l selection set $current
$popdown.l activate $current
$popdown.l see $current
set height [llength $values]
if {$height > [$cb cget -height]} {
set height [$cb cget -height]
grid $popdown.sb
grid configure $popdown.l -padx {1 0}
} else {
grid remove $popdown.sb
grid configure $popdown.l -padx 1
}
$popdown.l configure -height $height
}
## PlacePopdown --
# Set popdown window geometry.
#
# @@@TODO: factor with menubutton::PostPosition
#
proc ttk::combobox::PlacePopdown {cb popdown} {
set x [winfo rootx $cb]
set y [winfo rooty $cb]
set w [winfo width $cb]
set h [winfo height $cb]
set style [$cb cget -style]
set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}]
foreach var {x y w h} delta $postoffset {
incr $var $delta
}
set H [winfo reqheight $popdown]
if {$y + $h + $H > [winfo screenheight $popdown]} {
set Y [expr {$y - $H}]
} else {
set Y [expr {$y + $h}]
}
wm geometry $popdown ${w}x${H}+${x}+${Y}
}
## Post $cb --
# Pop down the associated listbox.
#
proc ttk::combobox::Post {cb} {
# Don't do anything if disabled:
#
$cb instate disabled { return }
# ASSERT: ![$cb instate pressed]
# Run -postcommand callback:
#
uplevel #0 [$cb cget -postcommand]
set popdown [PopdownWindow $cb]
ConfigureListbox $cb
update idletasks ;# needed for geometry propagation.
PlacePopdown $cb $popdown
# See <<NOTE-WM-TRANSIENT>>
switch -- [tk windowingsystem] {
x11 - win32 { wm transient $popdown [winfo toplevel $cb] }
}
# Post the listbox:
#
wm attribute $popdown -topmost 1
wm deiconify $popdown
raise $popdown
}
## Unpost $cb --
# Unpost the listbox.
#
proc ttk::combobox::Unpost {cb} {
if {[winfo exists $cb.popdown]} {
wm withdraw $cb.popdown
}
grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190]
}
## LBMaster $lb --
# Return the combobox main widget that owns the listbox.
#
proc ttk::combobox::LBMaster {lb} {
winfo parent [winfo parent [winfo parent $lb]]
}
## LBSelect $lb --
# Transfer listbox selection to combobox value.
#
proc ttk::combobox::LBSelect {lb} {
set cb [LBMaster $lb]
set selection [$lb curselection]
if {[llength $selection] == 1} {
SelectEntry $cb [lindex $selection 0]
}
}
## LBCleanup $lb --
# <Destroy> binding for combobox listboxes.
# Cleans up by unsetting the linked textvariable.
#
# Note: we can't just use { unset [%W cget -listvariable] }
# because the widget command is already gone when this binding fires).
# [winfo parent] still works, fortunately.
#
proc ttk::combobox::LBCleanup {lb} {
variable Values
unset Values([LBMaster $lb])
}
#*EOF*

186
windowsAgent/dist/tk/ttk/cursors.tcl vendored Normal file
View File

@ -0,0 +1,186 @@
#
# Map symbolic cursor names to platform-appropriate cursors.
#
# The following cursors are defined:
#
# standard -- default cursor for most controls
# "" -- inherit cursor from parent window
# none -- no cursor
#
# text -- editable widgets (entry, text)
# link -- hyperlinks within text
# crosshair -- graphic selection, fine control
# busy -- operation in progress
# forbidden -- action not allowed
#
# hresize -- horizontal resizing
# vresize -- vertical resizing
#
# Also resize cursors for each of the compass points,
# {nw,n,ne,w,e,sw,s,se}resize.
#
# Platform notes:
#
# Windows doesn't distinguish resizing at the 8 compass points,
# only horizontal, vertical, and the two diagonals.
#
# OSX doesn't have resize cursors for nw, ne, sw, or se corners.
# We use the Tk-defined X11 fallbacks for these.
#
# X11 doesn't have a "forbidden" cursor (usually a slashed circle);
# "pirate" seems to be the conventional cursor for this purpose.
#
# Windows has an IDC_HELP cursor, but it's not available from Tk.
#
# Tk does not support "none" on Windows.
#
namespace eval ttk {
variable Cursors
# Use X11 cursor names as defaults, since Tk supplies these
# on all platforms.
#
array set Cursors {
"" ""
none none
standard left_ptr
text xterm
link hand2
crosshair crosshair
busy watch
forbidden pirate
hresize sb_h_double_arrow
vresize sb_v_double_arrow
nresize top_side
sresize bottom_side
wresize left_side
eresize right_side
nwresize top_left_corner
neresize top_right_corner
swresize bottom_left_corner
seresize bottom_right_corner
move fleur
}
# Platform-specific overrides for Windows and OSX.
#
switch [tk windowingsystem] {
"win32" {
array set Cursors {
none {}
standard arrow
text ibeam
link hand2
crosshair crosshair
busy wait
forbidden no
vresize size_ns
nresize size_ns
sresize size_ns
wresize size_we
eresize size_we
hresize size_we
nwresize size_nw_se
swresize size_ne_sw
neresize size_ne_sw
seresize size_nw_se
}
}
"aqua" {
if {[package vsatisfies [package provide Tk] 8.5]} {
# appeared 2007-04-23, Tk 8.5a6
array set Cursors {
standard arrow
text ibeam
link pointinghand
crosshair crosshair
busy watch
forbidden notallowed
hresize resizeleftright
vresize resizeupdown
nresize resizeup
sresize resizedown
wresize resizeleft
eresize resizeright
}
}
}
}
}
## ttk::cursor $cursor --
# Return platform-specific cursor for specified symbolic cursor.
#
proc ttk::cursor {name} {
variable Cursors
return $Cursors($name)
}
## ttk::setCursor $w $cursor --
# Set the cursor for specified window.
#
# [ttk::setCursor] should be used in <Motion> bindings
# instead of directly calling [$w configure -cursor ...],
# as the latter always incurs a server round-trip and
# can lead to high CPU load (see [#1184746])
#
proc ttk::setCursor {w name} {
variable Cursors
if {[$w cget -cursor] ne $Cursors($name)} {
$w configure -cursor $Cursors($name)
}
}
## Interactive test harness:
#
proc ttk::CursorSampler {f} {
ttk::frame $f
set r 0
foreach row {
{nwresize nresize neresize}
{ wresize move eresize}
{swresize sresize seresize}
{text link crosshair}
{hresize vresize ""}
{busy forbidden ""}
{none standard ""}
} {
set c 0
foreach cursor $row {
set w $f.${r}${c}
ttk::label $w -text $cursor -cursor [ttk::cursor $cursor] \
-relief solid -borderwidth 1 -padding 3
grid $w -row $r -column $c -sticky nswe
grid columnconfigure $f $c -uniform cols -weight 1
incr c
}
grid rowconfigure $f $r -uniform rows -weight 1
incr r
}
return $f
}
if {[info exists argv0] && $argv0 eq [info script]} {
wm title . "[array size ::ttk::Cursors] cursors"
pack [ttk::CursorSampler .f] -expand true -fill both
bind . <KeyPress-Escape> [list destroy .]
focus .f
}
#*EOF*

145
windowsAgent/dist/tk/ttk/defaults.tcl vendored Normal file
View File

@ -0,0 +1,145 @@
#
# Settings for default theme.
#
namespace eval ttk::theme::default {
variable colors
array set colors {
-frame "#d9d9d9"
-foreground "#000000"
-window "#ffffff"
-text "#000000"
-activebg "#ececec"
-selectbg "#4a6984"
-selectfg "#ffffff"
-darker "#c3c3c3"
-disabledfg "#a3a3a3"
-indicator "#4a6984"
-disabledindicator "#a3a3a3"
-altindicator "#9fbdd8"
-disabledaltindicator "#c0c0c0"
}
ttk::style theme settings default {
ttk::style configure "." \
-borderwidth 1 \
-background $colors(-frame) \
-foreground $colors(-foreground) \
-troughcolor $colors(-darker) \
-font TkDefaultFont \
-selectborderwidth 1 \
-selectbackground $colors(-selectbg) \
-selectforeground $colors(-selectfg) \
-insertwidth 1 \
-indicatordiameter 10 \
;
ttk::style map "." -background \
[list disabled $colors(-frame) active $colors(-activebg)]
ttk::style map "." -foreground \
[list disabled $colors(-disabledfg)]
ttk::style configure TButton \
-anchor center -padding "3 3" -width -9 \
-relief raised -shiftrelief 1
ttk::style map TButton -relief [list {!disabled pressed} sunken]
ttk::style configure TCheckbutton \
-indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
ttk::style map TCheckbutton -indicatorcolor \
[list pressed $colors(-activebg) \
{!disabled alternate} $colors(-altindicator) \
{disabled alternate} $colors(-disabledaltindicator) \
{!disabled selected} $colors(-indicator) \
{disabled selected} $colors(-disabledindicator)]
ttk::style map TCheckbutton -indicatorrelief \
[list alternate raised]
ttk::style configure TRadiobutton \
-indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
ttk::style map TRadiobutton -indicatorcolor \
[list pressed $colors(-activebg) \
{!disabled alternate} $colors(-altindicator) \
{disabled alternate} $colors(-disabledaltindicator) \
{!disabled selected} $colors(-indicator) \
{disabled selected} $colors(-disabledindicator)]
ttk::style map TRadiobutton -indicatorrelief \
[list alternate raised]
ttk::style configure TMenubutton \
-relief raised -padding "10 3"
ttk::style configure TEntry \
-relief sunken -fieldbackground white -padding 1
ttk::style map TEntry -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)]
ttk::style configure TCombobox -arrowsize 12 -padding 1
ttk::style map TCombobox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
ttk::style map TSpinbox -fieldbackground \
[list readonly $colors(-frame) disabled $colors(-frame)] \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure TLabelframe \
-relief groove -borderwidth 2
ttk::style configure TScrollbar \
-width 12 -arrowsize 12
ttk::style map TScrollbar \
-arrowcolor [list disabled $colors(-disabledfg)]
ttk::style configure TScale \
-sliderrelief raised
ttk::style configure TProgressbar \
-background $colors(-selectbg)
ttk::style configure TNotebook.Tab \
-padding {4 2} -background $colors(-darker)
ttk::style map TNotebook.Tab \
-background [list selected $colors(-frame)]
# Treeview.
#
ttk::style configure Heading -font TkHeadingFont -relief raised
ttk::style configure Treeview \
-background $colors(-window) \
-foreground $colors(-text) ;
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
{!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
{!disabled !selected} black \
selected $colors(-selectfg)]
# Combobox popdown frame
ttk::style layout ComboboxPopdownFrame {
ComboboxPopdownFrame.border -sticky nswe
}
ttk::style configure ComboboxPopdownFrame \
-borderwidth 1 -relief solid
#
# Toolbar buttons:
#
ttk::style layout Toolbutton {
Toolbutton.border -children {
Toolbutton.padding -children {
Toolbutton.label
}
}
}
ttk::style configure Toolbutton \
-padding 2 -relief flat
ttk::style map Toolbutton -relief \
[list disabled flat selected sunken pressed sunken active raised]
ttk::style map Toolbutton -background \
[list pressed $colors(-darker) active $colors(-activebg)]
}
}

607
windowsAgent/dist/tk/ttk/entry.tcl vendored Normal file
View File

@ -0,0 +1,607 @@
#
# DERIVED FROM: tk/library/entry.tcl r1.22
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 2004, Joe English
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
namespace eval ttk {
namespace eval entry {
variable State
set State(x) 0
set State(selectMode) none
set State(anchor) 0
set State(scanX) 0
set State(scanIndex) 0
set State(scanMoved) 0
# Button-2 scan speed is (scanNum/scanDen) characters
# per pixel of mouse movement.
# The standard Tk entry widget uses the equivalent of
# scanNum = 10, scanDen = average character width.
# I don't know why that was chosen.
#
set State(scanNum) 1
set State(scanDen) 1
set State(deadband) 3 ;# #pixels for mouse-moved deadband.
}
}
### Option database settings.
#
option add *TEntry.cursor [ttk::cursor text] widgetDefault
### Bindings.
#
# Removed the following standard Tk bindings:
#
# <Control-Key-space>, <Control-Shift-Key-space>,
# <Key-Select>, <Shift-Key-Select>:
# Ttk entry widget doesn't use selection anchor.
# <Key-Insert>:
# Inserts PRIMARY selection (on non-Windows platforms).
# This is inconsistent with typical platform bindings.
# <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>:
# These don't do the right thing to start with.
# <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>,
# <Meta-Key-BackSpace>, <Meta-Key-Delete>:
# Judgment call. If <Meta> happens to be assigned to the Alt key,
# these could conflict with application accelerators.
# (Plus, who has a Meta key these days?)
# <Control-Key-t>:
# Another judgment call. If anyone misses this, let me know
# and I'll put it back.
#
## Clipboard events:
#
bind TEntry <<Cut>> { ttk::entry::Cut %W }
bind TEntry <<Copy>> { ttk::entry::Copy %W }
bind TEntry <<Paste>> { ttk::entry::Paste %W }
bind TEntry <<Clear>> { ttk::entry::Clear %W }
## Button1 bindings:
# Used for selection and navigation.
#
bind TEntry <ButtonPress-1> { ttk::entry::Press %W %x }
bind TEntry <Shift-ButtonPress-1> { ttk::entry::Shift-Press %W %x }
bind TEntry <Double-ButtonPress-1> { ttk::entry::Select %W %x word }
bind TEntry <Triple-ButtonPress-1> { ttk::entry::Select %W %x line }
bind TEntry <B1-Motion> { ttk::entry::Drag %W %x }
bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m }
bind TEntry <B1-Enter> { ttk::entry::DragIn %W }
bind TEntry <ButtonRelease-1> { ttk::entry::Release %W }
bind TEntry <<ToggleSelection>> {
%W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
}
## Button2 bindings:
# Used for scanning and primary transfer.
# Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
#
bind TEntry <ButtonPress-2> { ttk::entry::ScanMark %W %x }
bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x }
bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x }
bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x }
## Keyboard navigation bindings:
#
bind TEntry <<PrevChar>> { ttk::entry::Move %W prevchar }
bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar }
bind TEntry <<PrevWord>> { ttk::entry::Move %W prevword }
bind TEntry <<NextWord>> { ttk::entry::Move %W nextword }
bind TEntry <<LineStart>> { ttk::entry::Move %W home }
bind TEntry <<LineEnd>> { ttk::entry::Move %W end }
bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar }
bind TEntry <<SelectNextChar>> { ttk::entry::Extend %W nextchar }
bind TEntry <<SelectPrevWord>> { ttk::entry::Extend %W prevword }
bind TEntry <<SelectNextWord>> { ttk::entry::Extend %W nextword }
bind TEntry <<SelectLineStart>> { ttk::entry::Extend %W home }
bind TEntry <<SelectLineEnd>> { ttk::entry::Extend %W end }
bind TEntry <<SelectAll>> { %W selection range 0 end }
bind TEntry <<SelectNone>> { %W selection clear }
bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end }
## Edit bindings:
#
bind TEntry <KeyPress> { ttk::entry::Insert %W %A }
bind TEntry <Key-Delete> { ttk::entry::Delete %W }
bind TEntry <Key-BackSpace> { ttk::entry::Backspace %W }
# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, the <KeyPress> class binding will fire and insert the character.
# Ditto for Escape, Return, and Tab.
#
bind TEntry <Alt-KeyPress> {# nothing}
bind TEntry <Meta-KeyPress> {# nothing}
bind TEntry <Control-KeyPress> {# nothing}
bind TEntry <Key-Escape> {# nothing}
bind TEntry <Key-Return> {# nothing}
bind TEntry <Key-KP_Enter> {# nothing}
bind TEntry <Key-Tab> {# nothing}
# Argh. Apparently on Windows, the NumLock modifier is interpreted
# as a Command modifier.
if {[tk windowingsystem] eq "aqua"} {
bind TEntry <Command-KeyPress> {# nothing}
}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind TEntry <<PrevLine>> {# nothing}
bind TEntry <<NextLine>> {# nothing}
## Additional emacs-like bindings:
#
bind TEntry <Control-Key-d> { ttk::entry::Delete %W }
bind TEntry <Control-Key-h> { ttk::entry::Backspace %W }
bind TEntry <Control-Key-k> { %W delete insert end }
### Clipboard procedures.
#
## EntrySelection -- Return the selected text of the entry.
# Raises an error if there is no selection.
#
proc ttk::entry::EntrySelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
[expr {[$w index sel.last] - 1}]]
if {[$w cget -show] ne ""} {
return [string repeat [string index [$w cget -show] 0] \
[string length $entryString]]
}
return $entryString
}
## Paste -- Insert clipboard contents at current insert point.
#
proc ttk::entry::Paste {w} {
catch {
set clipboard [::tk::GetSelection $w CLIPBOARD]
PendingDelete $w
$w insert insert $clipboard
See $w insert
}
}
## Copy -- Copy selection to clipboard.
#
proc ttk::entry::Copy {w} {
if {![catch {EntrySelection $w} selection]} {
clipboard clear -displayof $w
clipboard append -displayof $w $selection
}
}
## Clear -- Delete the selection.
#
proc ttk::entry::Clear {w} {
catch { $w delete sel.first sel.last }
}
## Cut -- Copy selection to clipboard then delete it.
#
proc ttk::entry::Cut {w} {
Copy $w; Clear $w
}
### Navigation procedures.
#
## ClosestGap -- Find closest boundary between characters.
# Returns the index of the character just after the boundary.
#
proc ttk::entry::ClosestGap {w x} {
set pos [$w index @$x]
set bbox [$w bbox $pos]
if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
incr pos
}
return $pos
}
## See $index -- Make sure that the character at $index is visible.
#
proc ttk::entry::See {w {index insert}} {
update idletasks ;# ensure scroll data up-to-date
set c [$w index $index]
# @@@ OR: check [$w index left] / [$w index right]
if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
$w xview $c
}
}
## NextWord -- Find the next word position.
# Note: The "next word position" follows platform conventions:
# either the next end-of-word position, or the start-of-word
# position following the next end-of-word position.
#
set ::ttk::entry::State(startNext) \
[string equal [tk windowingsystem] "win32"]
proc ttk::entry::NextWord {w start} {
variable State
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0 && $State(startNext)} {
set pos [tcl_startOfNextWord [$w get] $pos]
}
if {$pos < 0} {
return end
}
return $pos
}
## PrevWord -- Find the previous word position.
#
proc ttk::entry::PrevWord {w start} {
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0
}
return $pos
}
## RelIndex -- Compute character/word/line-relative index.
#
proc ttk::entry::RelIndex {w where {index insert}} {
switch -- $where {
prevchar { expr {[$w index $index] - 1} }
nextchar { expr {[$w index $index] + 1} }
prevword { PrevWord $w $index }
nextword { NextWord $w $index }
home { return 0 }
end { $w index end }
default { error "Bad relative index $index" }
}
}
## Move -- Move insert cursor to relative location.
# Also clears the selection, if any, and makes sure
# that the insert cursor is visible.
#
proc ttk::entry::Move {w where} {
$w icursor [RelIndex $w $where]
$w selection clear
See $w insert
}
### Selection procedures.
#
## ExtendTo -- Extend the selection to the specified index.
#
# The other end of the selection (the anchor) is determined as follows:
#
# (1) if there is no selection, the anchor is the insert cursor;
# (2) if the index is outside the selection, grow the selection;
# (3) if the insert cursor is at one end of the selection, anchor the other end
# (4) otherwise anchor the start of the selection
#
# The insert cursor is placed at the new end of the selection.
#
# Returns: selection anchor.
#
proc ttk::entry::ExtendTo {w index} {
set index [$w index $index]
set insert [$w index insert]
# Figure out selection anchor:
if {![$w selection present]} {
set anchor $insert
} else {
set selfirst [$w index sel.first]
set sellast [$w index sel.last]
if { ($index < $selfirst)
|| ($insert == $selfirst && $index <= $sellast)
} {
set anchor $sellast
} else {
set anchor $selfirst
}
}
# Extend selection:
if {$anchor < $index} {
$w selection range $anchor $index
} else {
$w selection range $index $anchor
}
$w icursor $index
return $anchor
}
## Extend -- Extend the selection to a relative position, show insert cursor
#
proc ttk::entry::Extend {w where} {
ExtendTo $w [RelIndex $w $where]
See $w
}
### Button 1 binding procedures.
#
# Double-clicking followed by a drag enters "word-select" mode.
# Triple-clicking enters "line-select" mode.
#
## Press -- ButtonPress-1 binding.
# Set the insertion cursor, claim the input focus, set up for
# future drag operations.
#
proc ttk::entry::Press {w x} {
variable State
$w icursor [ClosestGap $w $x]
$w selection clear
$w instate !disabled { focus $w }
# Set up for future drag, double-click, or triple-click.
set State(x) $x
set State(selectMode) char
set State(anchor) [$w index insert]
}
## Shift-Press -- Shift-ButtonPress-1 binding.
# Extends the selection, sets anchor for future drag operations.
#
proc ttk::entry::Shift-Press {w x} {
variable State
focus $w
set anchor [ExtendTo $w @$x]
set State(x) $x
set State(selectMode) char
set State(anchor) $anchor
}
## Select $w $x $mode -- Binding for double- and triple- clicks.
# Selects a word or line (according to mode),
# and sets the selection mode for subsequent drag operations.
#
proc ttk::entry::Select {w x mode} {
variable State
set cur [ClosestGap $w $x]
switch -- $mode {
word { WordSelect $w $cur $cur }
line { LineSelect $w $cur $cur }
char { # no-op }
}
set State(anchor) $cur
set State(selectMode) $mode
}
## Drag -- Button1 motion binding.
#
proc ttk::entry::Drag {w x} {
variable State
set State(x) $x
DragTo $w $x
}
## DragTo $w $x -- Extend selection to $x based on current selection mode.
#
proc ttk::entry::DragTo {w x} {
variable State
set cur [ClosestGap $w $x]
switch $State(selectMode) {
char { CharSelect $w $State(anchor) $cur }
word { WordSelect $w $State(anchor) $cur }
line { LineSelect $w $State(anchor) $cur }
none { # no-op }
}
}
## <B1-Leave> binding:
# Begin autoscroll.
#
proc ttk::entry::DragOut {w mode} {
variable State
if {$State(selectMode) ne "none" && $mode eq "NotifyNormal"} {
ttk::Repeatedly ttk::entry::AutoScroll $w
}
}
## <B1-Enter> binding
# Suspend autoscroll.
#
proc ttk::entry::DragIn {w} {
ttk::CancelRepeat
}
## <ButtonRelease-1> binding
#
proc ttk::entry::Release {w} {
variable State
set State(selectMode) none
ttk::CancelRepeat ;# suspend autoscroll
}
## AutoScroll
# Called repeatedly when the mouse is outside an entry window
# with Button 1 down. Scroll the window left or right,
# depending on where the mouse left the window, and extend
# the selection according to the current selection mode.
#
# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
# TODO: Need a way for Repeat scripts to cancel themselves.
#
proc ttk::entry::AutoScroll {w} {
variable State
if {![winfo exists $w]} return
set x $State(x)
if {$x > [winfo width $w]} {
$w xview scroll 2 units
DragTo $w $x
} elseif {$x < 0} {
$w xview scroll -2 units
DragTo $w $x
}
}
## CharSelect -- select characters between index $from and $to
#
proc ttk::entry::CharSelect {w from to} {
if {$to <= $from} {
$w selection range $to $from
} else {
$w selection range $from $to
}
$w icursor $to
}
## WordSelect -- Select whole words between index $from and $to
#
proc ttk::entry::WordSelect {w from to} {
if {$to < $from} {
set first [WordBack [$w get] $to]
set last [WordForward [$w get] $from]
$w icursor $first
} else {
set first [WordBack [$w get] $from]
set last [WordForward [$w get] $to]
$w icursor $last
}
$w selection range $first $last
}
## WordBack, WordForward -- helper routines for WordSelect.
#
proc ttk::entry::WordBack {text index} {
if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
return $pos
}
proc ttk::entry::WordForward {text index} {
if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
return $pos
}
## LineSelect -- Select the entire line.
#
proc ttk::entry::LineSelect {w _ _} {
variable State
$w selection range 0 end
$w icursor end
}
### Button 2 binding procedures.
#
## ScanMark -- ButtonPress-2 binding.
# Marks the start of a scan or primary transfer operation.
#
proc ttk::entry::ScanMark {w x} {
variable State
set State(scanX) $x
set State(scanIndex) [$w index @0]
set State(scanMoved) 0
}
## ScanDrag -- Button2 motion binding.
#
proc ttk::entry::ScanDrag {w x} {
variable State
set dx [expr {$State(scanX) - $x}]
if {abs($dx) > $State(deadband)} {
set State(scanMoved) 1
}
set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
$w xview $left
if {$left != [set newLeft [$w index @0]]} {
# We've scanned past one end of the entry;
# reset the mark so that the text will start dragging again
# as soon as the mouse reverses direction.
#
set State(scanX) $x
set State(scanIndex) $newLeft
}
}
## ScanRelease -- Button2 release binding.
# Do a primary transfer if the mouse has not moved since the button press.
#
proc ttk::entry::ScanRelease {w x} {
variable State
if {!$State(scanMoved)} {
$w instate {!disabled !readonly} {
$w icursor [ClosestGap $w $x]
catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
}
}
}
### Insertion and deletion procedures.
#
## PendingDelete -- Delete selection prior to insert.
# If the entry currently has a selection, delete it and
# set the insert position to where the selection was.
# Returns: 1 if pending delete occurred, 0 if nothing was selected.
#
proc ttk::entry::PendingDelete {w} {
if {[$w selection present]} {
$w icursor sel.first
$w delete sel.first sel.last
return 1
}
return 0
}
## Insert -- Insert text into the entry widget.
# If a selection is present, the new text replaces it.
# Otherwise, the new text is inserted at the insert cursor.
#
proc ttk::entry::Insert {w s} {
if {$s eq ""} { return }
PendingDelete $w
$w insert insert $s
See $w insert
}
## Backspace -- Backspace over the character just before the insert cursor.
# If there is a selection, delete that instead.
# If the new insert position is offscreen to the left,
# scroll to place the cursor at about the middle of the window.
#
proc ttk::entry::Backspace {w} {
if {[PendingDelete $w]} {
See $w
return
}
set x [expr {[$w index insert] - 1}]
if {$x < 0} { return }
$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}]
}
}
## Delete -- Delete the character after the insert cursor.
# If there is a selection, delete that instead.
#
proc ttk::entry::Delete {w} {
if {![PendingDelete $w]} {
$w delete insert
}
}
#*EOF*

157
windowsAgent/dist/tk/ttk/fonts.tcl vendored Normal file
View File

@ -0,0 +1,157 @@
#
# Font specifications.
#
# This file, [source]d at initialization time, sets up the following
# symbolic fonts based on the current platform:
#
# TkDefaultFont -- default for GUI items not otherwise specified
# TkTextFont -- font for user text (entry, listbox, others)
# TkFixedFont -- standard fixed width font
# TkHeadingFont -- headings (column headings, etc)
# TkCaptionFont -- dialog captions (primary text in alert dialogs, etc.)
# TkTooltipFont -- font to use for tooltip windows
# TkIconFont -- font to use for icon captions
# TkMenuFont -- used to use for menu items
#
# In Tk 8.5, some of these fonts may be provided by the TIP#145 implementation
# (On Windows and Mac OS X as of Oct 2007).
#
# +++ Platform notes:
#
# Windows:
# The default system font changed from "MS Sans Serif" to "Tahoma"
# in Windows XP/Windows 2000.
#
# MS documentation says to use "Tahoma 8" in Windows 2000/XP,
# although many MS programs still use "MS Sans Serif 8"
#
# Should use SystemParametersInfo() instead.
#
# Mac OSX / Aqua:
# Quoth the Apple HIG:
# The _system font_ (Lucida Grande Regular 13 pt) is used for text
# in menus, dialogs, and full-size controls.
# [...] Use the _view font_ (Lucida Grande Regular 12pt) as the default
# font of text in lists and tables.
# [...] Use the _emphasized system font_ (Lucida Grande Bold 13 pt)
# sparingly. It is used for the message text in alerts.
# [...] The _small system font_ (Lucida Grande Regular 11 pt) [...]
# is also the default font for column headings in lists, for help tags,
# and for small controls.
#
# Note that the font for column headings (TkHeadingFont) is
# _smaller_ than the default font.
#
# There does not appear to be any recommendations for fixed-width fonts.
#
# X11:
# Need a way to tell if Xft is enabled or not.
# For now, assume patch #971980 applied.
#
# "Classic" look used Helvetica bold for everything except
# for entry widgets, which use Helvetica medium.
# Most other toolkits use medium weight for all UI elements,
# which is what we do now.
#
# Font size specified in pixels on X11, not points.
# This is Theoretically Wrong, but in practice works better; using
# points leads to huge inconsistencies across different servers.
#
namespace eval ttk {
variable tip145 [catch {font create TkDefaultFont}]
catch {font create TkTextFont}
catch {font create TkHeadingFont}
catch {font create TkCaptionFont}
catch {font create TkTooltipFont}
catch {font create TkFixedFont}
catch {font create TkIconFont}
catch {font create TkMenuFont}
catch {font create TkSmallCaptionFont}
if {!$tip145} {
variable F ;# miscellaneous platform-specific font parameters
switch -- [tk windowingsystem] {
win32 {
# In safe interps there is no osVersion element.
if {[info exists tcl_platform(osVersion)]} {
if {$tcl_platform(osVersion) >= 5.0} {
set F(family) "Tahoma"
} else {
set F(family) "MS Sans Serif"
}
} else {
if {[lsearch -exact [font families] Tahoma] != -1} {
set F(family) "Tahoma"
} else {
set F(family) "MS Sans Serif"
}
}
set F(size) 8
font configure TkDefaultFont -family $F(family) -size $F(size)
font configure TkTextFont -family $F(family) -size $F(size)
font configure TkHeadingFont -family $F(family) -size $F(size)
font configure TkCaptionFont -family $F(family) -size $F(size) \
-weight bold
font configure TkTooltipFont -family $F(family) -size $F(size)
font configure TkFixedFont -family Courier -size 10
font configure TkIconFont -family $F(family) -size $F(size)
font configure TkMenuFont -family $F(family) -size $F(size)
font configure TkSmallCaptionFont -family $F(family) -size $F(size)
}
aqua {
set F(family) "Lucida Grande"
set F(fixed) "Monaco"
set F(menusize) 14
set F(size) 13
set F(viewsize) 12
set F(smallsize) 11
set F(labelsize) 10
set F(fixedsize) 11
font configure TkDefaultFont -family $F(family) -size $F(size)
font configure TkTextFont -family $F(family) -size $F(size)
font configure TkHeadingFont -family $F(family) -size $F(smallsize)
font configure TkCaptionFont -family $F(family) -size $F(size) \
-weight bold
font configure TkTooltipFont -family $F(family) -size $F(smallsize)
font configure TkFixedFont -family $F(fixed) -size $F(fixedsize)
font configure TkIconFont -family $F(family) -size $F(size)
font configure TkMenuFont -family $F(family) -size $F(menusize)
font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize)
}
default -
x11 {
if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} {
set F(family) "sans-serif"
set F(fixed) "monospace"
} else {
set F(family) "Helvetica"
set F(fixed) "courier"
}
set F(size) -12
set F(ttsize) -10
set F(capsize) -14
set F(fixedsize) -12
font configure TkDefaultFont -family $F(family) -size $F(size)
font configure TkTextFont -family $F(family) -size $F(size)
font configure TkHeadingFont -family $F(family) -size $F(size) \
-weight bold
font configure TkCaptionFont -family $F(family) -size $F(capsize) \
-weight bold
font configure TkTooltipFont -family $F(family) -size $F(ttsize)
font configure TkFixedFont -family $F(fixed) -size $F(fixedsize)
font configure TkIconFont -family $F(family) -size $F(size)
font configure TkMenuFont -family $F(family) -size $F(size)
font configure TkSmallCaptionFont -family $F(family) -size $F(ttsize)
}
}
unset -nocomplain F
}
}
#*EOF*

169
windowsAgent/dist/tk/ttk/menubutton.tcl vendored Normal file
View File

@ -0,0 +1,169 @@
#
# Bindings for Menubuttons.
#
# Menubuttons have three interaction modes:
#
# Pulldown: Press menubutton, drag over menu, release to activate menu entry
# Popdown: Click menubutton to post menu
# Keyboard: <Key-space> or accelerator key to post menu
#
# (In addition, when menu system is active, "dropdown" -- menu posts
# on mouse-over. Ttk menubuttons don't implement this).
#
# For keyboard and popdown mode, we hand off to tk_popup and let
# the built-in Tk bindings handle the rest of the interaction.
#
# ON X11:
#
# Standard Tk menubuttons use a global grab on the menubutton.
# This won't work for Ttk menubuttons in pulldown mode,
# since we need to process the final <ButtonRelease> event,
# and this might be delivered to the menu. So instead we
# rely on the passive grab that occurs on <ButtonPress> events,
# and transition to popdown mode when the mouse is released
# or dragged outside the menubutton.
#
# ON WINDOWS:
#
# I'm not sure what the hell is going on here. [$menu post] apparently
# sets up some kind of internal grab for native menus.
# On this platform, just use [tk_popup] for all menu actions.
#
# ON MACOS:
#
# Same probably applies here.
#
namespace eval ttk {
namespace eval menubutton {
variable State
array set State {
pulldown 0
oldcursor {}
}
}
}
bind TMenubutton <Enter> { %W instate !disabled {%W state active } }
bind TMenubutton <Leave> { %W state !active }
bind TMenubutton <Key-space> { ttk::menubutton::Popdown %W }
bind TMenubutton <<Invoke>> { ttk::menubutton::Popdown %W }
if {[tk windowingsystem] eq "x11"} {
bind TMenubutton <ButtonPress-1> { ttk::menubutton::Pulldown %W }
bind TMenubutton <ButtonRelease-1> { ttk::menubutton::TransferGrab %W }
bind TMenubutton <B1-Leave> { ttk::menubutton::TransferGrab %W }
} else {
bind TMenubutton <ButtonPress-1> \
{ %W state pressed ; ttk::menubutton::Popdown %W }
bind TMenubutton <ButtonRelease-1> \
{ if {[winfo exists %W]} { %W state !pressed } }
}
# PostPosition --
# Returns the x and y coordinates where the menu
# should be posted, based on the menubutton and menu size
# and -direction option.
#
# TODO: adjust menu width to be at least as wide as the button
# for -direction above, below.
#
proc ttk::menubutton::PostPosition {mb menu} {
set x [winfo rootx $mb]
set y [winfo rooty $mb]
set dir [$mb cget -direction]
set bw [winfo width $mb]
set bh [winfo height $mb]
set mw [winfo reqwidth $menu]
set mh [winfo reqheight $menu]
set sw [expr {[winfo screenwidth $menu] - $bw - $mw}]
set sh [expr {[winfo screenheight $menu] - $bh - $mh}]
switch -- $dir {
above { if {$y >= $mh} { incr y -$mh } { incr y $bh } }
below { if {$y <= $sh} { incr y $bh } { incr y -$mh } }
left { if {$x >= $mw} { incr x -$mw } { incr x $bw } }
right { if {$x <= $sw} { incr x $bw } { incr x -$mw } }
flush {
# post menu atop menubutton.
# If there's a menu entry whose label matches the
# menubutton -text, assume this is an optionmenu
# and place that entry over the menubutton.
set index [FindMenuEntry $menu [$mb cget -text]]
if {$index ne ""} {
incr y -[$menu yposition $index]
}
}
}
return [list $x $y]
}
# Popdown --
# Post the menu and set a grab on the menu.
#
proc ttk::menubutton::Popdown {mb} {
if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
return
}
foreach {x y} [PostPosition $mb $menu] { break }
tk_popup $menu $x $y
}
# Pulldown (X11 only) --
# Called when Button1 is pressed on a menubutton.
# Posts the menu; a subsequent ButtonRelease
# or Leave event will set a grab on the menu.
#
proc ttk::menubutton::Pulldown {mb} {
variable State
if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
return
}
foreach {x y} [PostPosition $mb $menu] { break }
set State(pulldown) 1
set State(oldcursor) [$mb cget -cursor]
$mb state pressed
$mb configure -cursor [$menu cget -cursor]
$menu post $x $y
tk_menuSetFocus $menu
}
# TransferGrab (X11 only) --
# Switch from pulldown mode (menubutton has an implicit grab)
# to popdown mode (menu has an explicit grab).
#
proc ttk::menubutton::TransferGrab {mb} {
variable State
if {$State(pulldown)} {
$mb configure -cursor $State(oldcursor)
$mb state {!pressed !active}
set State(pulldown) 0
set menu [$mb cget -menu]
tk_popup $menu [winfo rootx $menu] [winfo rooty $menu]
}
}
# FindMenuEntry --
# Hack to support tk_optionMenus.
# Returns the index of the menu entry with a matching -label,
# -1 if not found.
#
proc ttk::menubutton::FindMenuEntry {menu s} {
set last [$menu index last]
if {$last eq "none"} {
return ""
}
for {set i 0} {$i <= $last} {incr i} {
if {![catch {$menu entrycget $i -label} label]
&& ($label eq $s)} {
return $i
}
}
return ""
}
#*EOF*

197
windowsAgent/dist/tk/ttk/notebook.tcl vendored Normal file
View File

@ -0,0 +1,197 @@
#
# Bindings for TNotebook widget
#
namespace eval ttk::notebook {
variable TLNotebooks ;# See enableTraversal
}
bind TNotebook <ButtonPress-1> { ttk::notebook::Press %W %x %y }
bind TNotebook <Key-Right> { ttk::notebook::CycleTab %W 1; break }
bind TNotebook <Key-Left> { ttk::notebook::CycleTab %W -1; break }
bind TNotebook <Control-Key-Tab> { ttk::notebook::CycleTab %W 1; break }
bind TNotebook <Control-Shift-Key-Tab> { ttk::notebook::CycleTab %W -1; break }
catch {
bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break }
}
bind TNotebook <Destroy> { ttk::notebook::Cleanup %W }
# ActivateTab $nb $tab --
# Select the specified tab and set focus.
#
# Desired behavior:
# + take focus when reselecting the currently-selected tab;
# + keep focus if the notebook already has it;
# + otherwise set focus to the first traversable widget
# in the newly-selected tab;
# + do not leave the focus in a deselected tab.
#
proc ttk::notebook::ActivateTab {w tab} {
set oldtab [$w select]
$w select $tab
set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled
if {[focus] eq $w} { return }
if {$newtab eq $oldtab} { focus $w ; return }
update idletasks ;# needed so focus logic sees correct mapped states
if {[set f [ttk::focusFirst $newtab]] ne ""} {
ttk::traverseTo $f
} else {
focus $w
}
}
# Press $nb $x $y --
# ButtonPress-1 binding for notebook widgets.
# Activate the tab under the mouse cursor, if any.
#
proc ttk::notebook::Press {w x y} {
set index [$w index @$x,$y]
if {$index ne ""} {
ActivateTab $w $index
}
}
# CycleTab --
# Select the next/previous tab in the list.
#
proc ttk::notebook::CycleTab {w dir} {
if {[$w index end] != 0} {
set current [$w index current]
set select [expr {($current + $dir) % [$w index end]}]
while {[$w tab $select -state] != "normal" && ($select != $current)} {
set select [expr {($select + $dir) % [$w index end]}]
}
if {$select != $current} {
ActivateTab $w $select
}
}
}
# MnemonicTab $nb $key --
# Scan all tabs in the specified notebook for one with the
# specified mnemonic. If found, returns path name of tab;
# otherwise returns ""
#
proc ttk::notebook::MnemonicTab {nb key} {
set key [string toupper $key]
foreach tab [$nb tabs] {
set label [$nb tab $tab -text]
set underline [$nb tab $tab -underline]
set mnemonic [string toupper [string index $label $underline]]
if {$mnemonic ne "" && $mnemonic eq $key} {
return $tab
}
}
return ""
}
# +++ Toplevel keyboard traversal.
#
# enableTraversal --
# Enable keyboard traversal for a notebook widget
# by adding bindings to the containing toplevel window.
#
# TLNotebooks($top) keeps track of the list of all traversal-enabled
# notebooks contained in the toplevel
#
proc ttk::notebook::enableTraversal {nb} {
variable TLNotebooks
set top [winfo toplevel $nb]
if {![info exists TLNotebooks($top)]} {
# Augment $top bindings:
#
bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1}
bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1}
bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1}
bind $top <Control-Shift-Key-Tab> {+ttk::notebook::TLCycleTab %W -1}
catch {
bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
}
if {[tk windowingsystem] eq "aqua"} {
bind $top <Option-KeyPress> \
+[list ttk::notebook::MnemonicActivation $top %K]
} else {
bind $top <Alt-KeyPress> \
+[list ttk::notebook::MnemonicActivation $top %K]
}
bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
}
lappend TLNotebooks($top) $nb
}
# TLCleanup -- <Destroy> binding for traversal-enabled toplevels
#
proc ttk::notebook::TLCleanup {w} {
variable TLNotebooks
if {$w eq [winfo toplevel $w]} {
unset -nocomplain -please TLNotebooks($w)
}
}
# Cleanup -- <Destroy> binding for notebooks
#
proc ttk::notebook::Cleanup {nb} {
variable TLNotebooks
set top [winfo toplevel $nb]
if {[info exists TLNotebooks($top)]} {
set index [lsearch -exact $TLNotebooks($top) $nb]
set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
}
}
# EnclosingNotebook $w --
# Return the nearest traversal-enabled notebook widget
# that contains $w.
#
# BUGS: this only works properly for tabs that are direct children
# of the notebook widget. This routine should follow the
# geometry manager hierarchy, not window ancestry, but that
# information is not available in Tk.
#
proc ttk::notebook::EnclosingNotebook {w} {
variable TLNotebooks
set top [winfo toplevel $w]
if {![info exists TLNotebooks($top)]} { return }
while {$w ne $top && $w ne ""} {
if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
return $w
}
set w [winfo parent $w]
}
return ""
}
# TLCycleTab --
# toplevel binding procedure for Control-Tab / Control-Shift-Tab
# Select the next/previous tab in the nearest ancestor notebook.
#
proc ttk::notebook::TLCycleTab {w dir} {
set nb [EnclosingNotebook $w]
if {$nb ne ""} {
CycleTab $nb $dir
return -code break
}
}
# MnemonicActivation $nb $key --
# Alt-KeyPress binding procedure for mnemonic activation.
# Scan all notebooks in specified toplevel for a tab with the
# the specified mnemonic. If found, activate it and return TCL_BREAK.
#
proc ttk::notebook::MnemonicActivation {top key} {
variable TLNotebooks
foreach nb $TLNotebooks($top) {
if {[set tab [MnemonicTab $nb $key]] ne ""} {
ActivateTab $nb [$nb index $tab]
return -code break
}
}
}

82
windowsAgent/dist/tk/ttk/panedwindow.tcl vendored Normal file
View File

@ -0,0 +1,82 @@
#
# Bindings for ttk::panedwindow widget.
#
namespace eval ttk::panedwindow {
variable State
array set State {
pressed 0
pressX -
pressY -
sash -
sashPos -
}
}
## Bindings:
#
bind TPanedwindow <ButtonPress-1> { ttk::panedwindow::Press %W %x %y }
bind TPanedwindow <B1-Motion> { ttk::panedwindow::Drag %W %x %y }
bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y }
bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y }
bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y }
bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W }
# See <<NOTE-PW-LEAVE-NOTIFYINFERIOR>>
bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W }
## Sash movement:
#
proc ttk::panedwindow::Press {w x y} {
variable State
set sash [$w identify $x $y]
if {$sash eq ""} {
set State(pressed) 0
return
}
set State(pressed) 1
set State(pressX) $x
set State(pressY) $y
set State(sash) $sash
set State(sashPos) [$w sashpos $sash]
}
proc ttk::panedwindow::Drag {w x y} {
variable State
if {!$State(pressed)} { return }
switch -- [$w cget -orient] {
horizontal { set delta [expr {$x - $State(pressX)}] }
vertical { set delta [expr {$y - $State(pressY)}] }
}
$w sashpos $State(sash) [expr {$State(sashPos) + $delta}]
}
proc ttk::panedwindow::Release {w x y} {
variable State
set State(pressed) 0
SetCursor $w $x $y
}
## Cursor management:
#
proc ttk::panedwindow::ResetCursor {w} {
variable State
if {!$State(pressed)} {
ttk::setCursor $w {}
}
}
proc ttk::panedwindow::SetCursor {w x y} {
set cursor ""
if {[llength [$w identify $x $y]]} {
# Assume we're over a sash.
switch -- [$w cget -orient] {
horizontal { set cursor hresize }
vertical { set cursor vresize }
}
}
ttk::setCursor $w $cursor
}
#*EOF*

49
windowsAgent/dist/tk/ttk/progress.tcl vendored Normal file
View File

@ -0,0 +1,49 @@
#
# Ttk widget set: progress bar utilities.
#
namespace eval ttk::progressbar {
variable Timers ;# Map: widget name -> after ID
}
# Autoincrement --
# Periodic callback procedure for autoincrement mode
#
proc ttk::progressbar::Autoincrement {pb steptime stepsize} {
variable Timers
if {![winfo exists $pb]} {
# widget has been destroyed -- cancel timer
unset -nocomplain Timers($pb)
return
}
set Timers($pb) [after $steptime \
[list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ]
$pb step $stepsize
}
# ttk::progressbar::start --
# Start autoincrement mode. Invoked by [$pb start] widget code.
#
proc ttk::progressbar::start {pb {steptime 50} {stepsize 1}} {
variable Timers
if {![info exists Timers($pb)]} {
Autoincrement $pb $steptime $stepsize
}
}
# ttk::progressbar::stop --
# Cancel autoincrement mode. Invoked by [$pb stop] widget code.
#
proc ttk::progressbar::stop {pb} {
variable Timers
if {[info exists Timers($pb)]} {
after cancel $Timers($pb)
unset Timers($pb)
}
$pb configure -value 0
}

94
windowsAgent/dist/tk/ttk/scale.tcl vendored Normal file
View File

@ -0,0 +1,94 @@
# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Bindings for the TScale widget
namespace eval ttk::scale {
variable State
array set State {
dragging 0
}
}
bind TScale <ButtonPress-1> { ttk::scale::Press %W %x %y }
bind TScale <B1-Motion> { ttk::scale::Drag %W %x %y }
bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
bind TScale <ButtonPress-2> { ttk::scale::Jump %W %x %y }
bind TScale <B2-Motion> { ttk::scale::Drag %W %x %y }
bind TScale <ButtonRelease-2> { ttk::scale::Release %W %x %y }
bind TScale <ButtonPress-3> { ttk::scale::Jump %W %x %y }
bind TScale <B3-Motion> { ttk::scale::Drag %W %x %y }
bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y }
## Keyboard navigation bindings:
#
bind TScale <<LineStart>> { %W set [%W cget -from] }
bind TScale <<LineEnd>> { %W set [%W cget -to] }
bind TScale <<PrevChar>> { ttk::scale::Increment %W -1 }
bind TScale <<PrevLine>> { ttk::scale::Increment %W -1 }
bind TScale <<NextChar>> { ttk::scale::Increment %W 1 }
bind TScale <<NextLine>> { ttk::scale::Increment %W 1 }
bind TScale <<PrevWord>> { ttk::scale::Increment %W -10 }
bind TScale <<PrevPara>> { ttk::scale::Increment %W -10 }
bind TScale <<NextWord>> { ttk::scale::Increment %W 10 }
bind TScale <<NextPara>> { ttk::scale::Increment %W 10 }
proc ttk::scale::Press {w x y} {
variable State
set State(dragging) 0
switch -glob -- [$w identify $x $y] {
*track -
*trough {
set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}]
ttk::Repeatedly Increment $w $inc
}
*slider {
set State(dragging) 1
set State(initial) [$w get]
}
}
}
# scale::Jump -- ButtonPress-2/3 binding for scale acts like
# Press except that clicking in the trough jumps to the
# clicked position.
proc ttk::scale::Jump {w x y} {
variable State
set State(dragging) 0
switch -glob -- [$w identify $x $y] {
*track -
*trough {
$w set [$w get $x $y]
set State(dragging) 1
set State(initial) [$w get]
}
*slider {
Press $w $x $y
}
}
}
proc ttk::scale::Drag {w x y} {
variable State
if {$State(dragging)} {
$w set [$w get $x $y]
}
}
proc ttk::scale::Release {w x y} {
variable State
set State(dragging) 0
ttk::CancelRepeat
}
proc ttk::scale::Increment {w delta} {
if {![winfo exists $w]} return
if {([$w cget -from] > [$w cget -to])} {
set delta [expr {-$delta}]
}
$w set [expr {[$w get] + $delta}]
}

123
windowsAgent/dist/tk/ttk/scrollbar.tcl vendored Normal file
View File

@ -0,0 +1,123 @@
#
# Bindings for TScrollbar widget
#
# Still don't have a working ttk::scrollbar under OSX -
# Swap in a [tk::scrollbar] on that platform,
# unless user specifies -class or -style.
#
if {[tk windowingsystem] eq "aqua"} {
rename ::ttk::scrollbar ::ttk::_scrollbar
proc ttk::scrollbar {w args} {
set constructor ::tk::scrollbar
foreach {option _} $args {
if {$option eq "-class" || $option eq "-style"} {
set constructor ::ttk::_scrollbar
break
}
}
return [$constructor $w {*}$args]
}
}
namespace eval ttk::scrollbar {
variable State
# State(xPress) --
# State(yPress) -- initial position of mouse at start of drag.
# State(first) -- value of -first at start of drag.
}
bind TScrollbar <ButtonPress-1> { ttk::scrollbar::Press %W %x %y }
bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y }
bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y }
bind TScrollbar <ButtonPress-2> { ttk::scrollbar::Jump %W %x %y }
bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y }
bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y }
proc ttk::scrollbar::Scroll {w n units} {
set cmd [$w cget -command]
if {$cmd ne ""} {
uplevel #0 $cmd scroll $n $units
}
}
proc ttk::scrollbar::Moveto {w fraction} {
set cmd [$w cget -command]
if {$cmd ne ""} {
uplevel #0 $cmd moveto $fraction
}
}
proc ttk::scrollbar::Press {w x y} {
variable State
set State(xPress) $x
set State(yPress) $y
switch -glob -- [$w identify $x $y] {
*uparrow -
*leftarrow {
ttk::Repeatedly Scroll $w -1 units
}
*downarrow -
*rightarrow {
ttk::Repeatedly Scroll $w 1 units
}
*thumb {
set State(first) [lindex [$w get] 0]
}
*trough {
set f [$w fraction $x $y]
if {$f < [lindex [$w get] 0]} {
# Clicked in upper/left trough
ttk::Repeatedly Scroll $w -1 pages
} elseif {$f > [lindex [$w get] 1]} {
# Clicked in lower/right trough
ttk::Repeatedly Scroll $w 1 pages
} else {
# Clicked on thumb (???)
set State(first) [lindex [$w get] 0]
}
}
}
}
proc ttk::scrollbar::Drag {w x y} {
variable State
if {![info exists State(first)]} {
# Initial buttonpress was not on the thumb,
# or something screwy has happened. In either case, ignore:
return;
}
set xDelta [expr {$x - $State(xPress)}]
set yDelta [expr {$y - $State(yPress)}]
Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}]
}
proc ttk::scrollbar::Release {w x y} {
variable State
unset -nocomplain State(xPress) State(yPress) State(first)
ttk::CancelRepeat
}
# scrollbar::Jump -- ButtonPress-2 binding for scrollbars.
# Behaves exactly like scrollbar::Press, except that
# clicking in the trough jumps to the the selected position.
#
proc ttk::scrollbar::Jump {w x y} {
variable State
switch -glob -- [$w identify $x $y] {
*thumb -
*trough {
set State(first) [$w fraction $x $y]
Moveto $w $State(first)
set State(xPress) $x
set State(yPress) $y
}
default {
Press $w $x $y
}
}
}

102
windowsAgent/dist/tk/ttk/sizegrip.tcl vendored Normal file
View File

@ -0,0 +1,102 @@
#
# Sizegrip widget bindings.
#
# Dragging a sizegrip widget resizes the containing toplevel.
#
# NOTE: the sizegrip widget must be in the lower right hand corner.
#
switch -- [tk windowingsystem] {
x11 -
win32 {
option add *TSizegrip.cursor [ttk::cursor seresize] widgetDefault
}
aqua {
# Aqua sizegrips use default Arrow cursor.
}
}
namespace eval ttk::sizegrip {
variable State
array set State {
pressed 0
pressX 0
pressY 0
width 0
height 0
widthInc 1
heightInc 1
resizeX 1
resizeY 1
toplevel {}
}
}
bind TSizegrip <ButtonPress-1> { ttk::sizegrip::Press %W %X %Y }
bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y }
bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y }
proc ttk::sizegrip::Press {W X Y} {
variable State
if {[$W instate disabled]} { return }
set top [winfo toplevel $W]
# If the toplevel is not resizable then bail
foreach {State(resizeX) State(resizeY)} [wm resizable $top] break
if {!$State(resizeX) && !$State(resizeY)} {
return
}
# Sanity-checks:
# If a negative X or Y position was specified for [wm geometry],
# just bail out -- there's no way to handle this cleanly.
#
if {[scan [wm geometry $top] "%dx%d+%d+%d" width height x y] != 4} {
return;
}
# Account for gridded geometry:
#
set grid [wm grid $top]
if {[llength $grid]} {
set State(widthInc) [lindex $grid 2]
set State(heightInc) [lindex $grid 3]
} else {
set State(widthInc) [set State(heightInc) 1]
}
set State(toplevel) $top
set State(pressX) $X
set State(pressY) $Y
set State(width) $width
set State(height) $height
set State(x) $x
set State(y) $y
set State(pressed) 1
}
proc ttk::sizegrip::Drag {W X Y} {
variable State
if {!$State(pressed)} { return }
set w $State(width)
set h $State(height)
if {$State(resizeX)} {
set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}]
}
if {$State(resizeY)} {
set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}]
}
if {$w <= 0} { set w 1 }
if {$h <= 0} { set h 1 }
set x $State(x) ; set y $State(y)
wm geometry $State(toplevel) ${w}x${h}+${x}+${y}
}
proc ttk::sizegrip::Release {W X Y} {
variable State
set State(pressed) 0
}
#*EOF*

173
windowsAgent/dist/tk/ttk/spinbox.tcl vendored Normal file
View File

@ -0,0 +1,173 @@
#
# ttk::spinbox bindings
#
namespace eval ttk::spinbox { }
### Spinbox bindings.
#
# Duplicate the Entry bindings, override if needed:
#
ttk::copyBindings TEntry TSpinbox
bind TSpinbox <Motion> { ttk::spinbox::Motion %W %x %y }
bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y }
bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W }
bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y }
bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click
bind TSpinbox <KeyPress-Up> { event generate %W <<Increment>> }
bind TSpinbox <KeyPress-Down> { event generate %W <<Decrement>> }
bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 }
bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 }
ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W]
## Motion --
# Sets cursor.
#
proc ttk::spinbox::Motion {w x y} {
if { [$w identify $x $y] eq "textarea"
&& [$w instate {!readonly !disabled}]
} {
ttk::setCursor $w text
} else {
ttk::setCursor $w ""
}
}
## Press --
#
proc ttk::spinbox::Press {w x y} {
if {[$w instate disabled]} { return }
focus $w
switch -glob -- [$w identify $x $y] {
*textarea { ttk::entry::Press $w $x }
*rightarrow -
*uparrow { ttk::Repeatedly event generate $w <<Increment>> }
*leftarrow -
*downarrow { ttk::Repeatedly event generate $w <<Decrement>> }
*spinbutton {
if {$y * 2 >= [winfo height $w]} {
set event <<Decrement>>
} else {
set event <<Increment>>
}
ttk::Repeatedly event generate $w $event
}
}
}
## DoubleClick --
# Select all if over the text area; otherwise same as Press.
#
proc ttk::spinbox::DoubleClick {w x y} {
if {[$w instate disabled]} { return }
switch -glob -- [$w identify $x $y] {
*textarea { SelectAll $w }
* { Press $w $x $y }
}
}
proc ttk::spinbox::Release {w} {
ttk::CancelRepeat
}
## MouseWheel --
# Mousewheel callback. Turn these into <<Increment>> (-1, up)
# or <<Decrement> (+1, down) events.
#
proc ttk::spinbox::MouseWheel {w dir} {
if {$dir < 0} {
event generate $w <<Increment>>
} else {
event generate $w <<Decrement>>
}
}
## SelectAll --
# Select widget contents.
#
proc ttk::spinbox::SelectAll {w} {
$w selection range 0 end
$w icursor end
}
## Limit --
# Limit $v to lie between $min and $max
#
proc ttk::spinbox::Limit {v min max} {
if {$v < $min} { return $min }
if {$v > $max} { return $max }
return $v
}
## Wrap --
# Adjust $v to lie between $min and $max, wrapping if out of bounds.
#
proc ttk::spinbox::Wrap {v min max} {
if {$v < $min} { return $max }
if {$v > $max} { return $min }
return $v
}
## Adjust --
# Limit or wrap spinbox value depending on -wrap.
#
proc ttk::spinbox::Adjust {w v min max} {
if {[$w cget -wrap]} {
return [Wrap $v $min $max]
} else {
return [Limit $v $min $max]
}
}
## Spin --
# Handle <<Increment>> and <<Decrement>> events.
# If -values is specified, cycle through the list.
# Otherwise cycle through numeric range based on
# -from, -to, and -increment.
#
proc ttk::spinbox::Spin {w dir} {
set nvalues [llength [set values [$w cget -values]]]
set value [$w get]
if {$nvalues} {
set current [lsearch -exact $values $value]
set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
$w set [lindex $values $index]
} else {
if {[catch {
set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
}]} {
set v [$w cget -from]
}
$w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
}
SelectAll $w
uplevel #0 [$w cget -command]
}
## FormatValue --
# Reformat numeric value based on -format.
#
proc ttk::spinbox::FormatValue {w val} {
set fmt [$w cget -format]
if {$fmt eq ""} {
# Try to guess a suitable -format based on -increment.
set delta [expr {abs([$w cget -increment])}]
if {0 < $delta && $delta < 1} {
# NB: This guesses wrong if -increment has more than 1
# significant digit itself, e.g., -increment 0.25
set nsd [expr {int(ceil(-log10($delta)))}]
set fmt "%.${nsd}f"
} else {
set fmt "%.0f"
}
}
return [format $fmt $val]
}
#*EOF*

363
windowsAgent/dist/tk/ttk/treeview.tcl vendored Normal file
View File

@ -0,0 +1,363 @@
#
# ttk::treeview widget bindings and utilities.
#
namespace eval ttk::treeview {
variable State
# Enter/Leave/Motion
#
set State(activeWidget) {}
set State(activeHeading) {}
# Press/drag/release:
#
set State(pressMode) none
set State(pressX) 0
# For pressMode == "resize"
set State(resizeColumn) #0
# For pressmode == "heading"
set State(heading) {}
}
### Widget bindings.
#
bind Treeview <Motion> { ttk::treeview::Motion %W %x %y }
bind Treeview <B1-Leave> { #nothing }
bind Treeview <Leave> { ttk::treeview::ActivateHeading {} {}}
bind Treeview <ButtonPress-1> { ttk::treeview::Press %W %x %y }
bind Treeview <Double-ButtonPress-1> { ttk::treeview::DoubleClick %W %x %y }
bind Treeview <ButtonRelease-1> { ttk::treeview::Release %W %x %y }
bind Treeview <B1-Motion> { ttk::treeview::Drag %W %x %y }
bind Treeview <KeyPress-Up> { ttk::treeview::Keynav %W up }
bind Treeview <KeyPress-Down> { ttk::treeview::Keynav %W down }
bind Treeview <KeyPress-Right> { ttk::treeview::Keynav %W right }
bind Treeview <KeyPress-Left> { ttk::treeview::Keynav %W left }
bind Treeview <KeyPress-Prior> { %W yview scroll -1 pages }
bind Treeview <KeyPress-Next> { %W yview scroll 1 pages }
bind Treeview <KeyPress-Return> { ttk::treeview::ToggleFocus %W }
bind Treeview <KeyPress-space> { ttk::treeview::ToggleFocus %W }
bind Treeview <Shift-ButtonPress-1> \
{ ttk::treeview::Select %W %x %y extend }
bind Treeview <<ToggleSelection>> \
{ ttk::treeview::Select %W %x %y toggle }
ttk::copyBindings TtkScrollable Treeview
### Binding procedures.
#
## Keynav -- Keyboard navigation
#
# @@@ TODO: verify/rewrite up and down code.
#
proc ttk::treeview::Keynav {w dir} {
set focus [$w focus]
if {$focus eq ""} { return }
switch -- $dir {
up {
if {[set up [$w prev $focus]] eq ""} {
set focus [$w parent $focus]
} else {
while {[$w item $up -open] && [llength [$w children $up]]} {
set up [lindex [$w children $up] end]
}
set focus $up
}
}
down {
if {[$w item $focus -open] && [llength [$w children $focus]]} {
set focus [lindex [$w children $focus] 0]
} else {
set up $focus
while {$up ne "" && [set down [$w next $up]] eq ""} {
set up [$w parent $up]
}
set focus $down
}
}
left {
if {[$w item $focus -open] && [llength [$w children $focus]]} {
CloseItem $w $focus
} else {
set focus [$w parent $focus]
}
}
right {
OpenItem $w $focus
}
}
if {$focus != {}} {
SelectOp $w $focus choose
}
}
## Motion -- pointer motion binding.
# Sets cursor, active element ...
#
proc ttk::treeview::Motion {w x y} {
set cursor {}
set activeHeading {}
switch -- [$w identify region $x $y] {
separator { set cursor hresize }
heading { set activeHeading [$w identify column $x $y] }
}
ttk::setCursor $w $cursor
ActivateHeading $w $activeHeading
}
## ActivateHeading -- track active heading element
#
proc ttk::treeview::ActivateHeading {w heading} {
variable State
if {$w != $State(activeWidget) || $heading != $State(activeHeading)} {
if {[winfo exists $State(activeWidget)] && $State(activeHeading) != {}} {
$State(activeWidget) heading $State(activeHeading) state !active
}
if {$heading != {}} {
$w heading $heading state active
}
set State(activeHeading) $heading
set State(activeWidget) $w
}
}
## Select $w $x $y $selectop
# Binding procedure for selection operations.
# See "Selection modes", below.
#
proc ttk::treeview::Select {w x y op} {
if {[set item [$w identify row $x $y]] ne "" } {
SelectOp $w $item $op
}
}
## DoubleClick -- Double-ButtonPress-1 binding.
#
proc ttk::treeview::DoubleClick {w x y} {
if {[set row [$w identify row $x $y]] ne ""} {
Toggle $w $row
} else {
Press $w $x $y ;# perform single-click action
}
}
## Press -- ButtonPress binding.
#
proc ttk::treeview::Press {w x y} {
focus $w
switch -- [$w identify region $x $y] {
nothing { }
heading { heading.press $w $x $y }
separator { resize.press $w $x $y }
tree -
cell {
set item [$w identify item $x $y]
SelectOp $w $item choose
switch -glob -- [$w identify element $x $y] {
*indicator -
*disclosure { Toggle $w $item }
}
}
}
}
## Drag -- B1-Motion binding
#
proc ttk::treeview::Drag {w x y} {
variable State
switch $State(pressMode) {
resize { resize.drag $w $x }
heading { heading.drag $w $x $y }
}
}
proc ttk::treeview::Release {w x y} {
variable State
switch $State(pressMode) {
resize { resize.release $w $x }
heading { heading.release $w }
}
set State(pressMode) none
Motion $w $x $y
}
### Interactive column resizing.
#
proc ttk::treeview::resize.press {w x y} {
variable State
set State(pressMode) "resize"
set State(resizeColumn) [$w identify column $x $y]
}
proc ttk::treeview::resize.drag {w x} {
variable State
$w drag $State(resizeColumn) $x
}
proc ttk::treeview::resize.release {w x} {
# no-op
}
### Heading activation.
#
proc ttk::treeview::heading.press {w x y} {
variable State
set column [$w identify column $x $y]
set State(pressMode) "heading"
set State(heading) $column
$w heading $column state pressed
}
proc ttk::treeview::heading.drag {w x y} {
variable State
if { [$w identify region $x $y] eq "heading"
&& [$w identify column $x $y] eq $State(heading)
} {
$w heading $State(heading) state pressed
} else {
$w heading $State(heading) state !pressed
}
}
proc ttk::treeview::heading.release {w} {
variable State
if {[lsearch -exact [$w heading $State(heading) state] pressed] >= 0} {
after 0 [$w heading $State(heading) -command]
}
$w heading $State(heading) state !pressed
}
### Selection modes.
#
## SelectOp $w $item [ choose | extend | toggle ] --
# Dispatch to appropriate selection operation
# depending on current value of -selectmode.
#
proc ttk::treeview::SelectOp {w item op} {
select.$op.[$w cget -selectmode] $w $item
}
## -selectmode none:
#
proc ttk::treeview::select.choose.none {w item} { $w focus $item }
proc ttk::treeview::select.toggle.none {w item} { $w focus $item }
proc ttk::treeview::select.extend.none {w item} { $w focus $item }
## -selectmode browse:
#
proc ttk::treeview::select.choose.browse {w item} { BrowseTo $w $item }
proc ttk::treeview::select.toggle.browse {w item} { BrowseTo $w $item }
proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item }
## -selectmode multiple:
#
proc ttk::treeview::select.choose.extended {w item} {
BrowseTo $w $item
}
proc ttk::treeview::select.toggle.extended {w item} {
$w selection toggle [list $item]
}
proc ttk::treeview::select.extend.extended {w item} {
if {[set anchor [$w focus]] ne ""} {
$w selection set [between $w $anchor $item]
} else {
BrowseTo $w $item
}
}
### Tree structure utilities.
#
## between $tv $item1 $item2 --
# Returns a list of all items between $item1 and $item2,
# in preorder traversal order. $item1 and $item2 may be
# in either order.
#
# NOTES:
# This routine is O(N) in the size of the tree.
# There's probably a way to do this that's O(N) in the number
# of items returned, but I'm not clever enough to figure it out.
#
proc ttk::treeview::between {tv item1 item2} {
variable between [list]
variable selectingBetween 0
ScanBetween $tv $item1 $item2 {}
return $between
}
## ScanBetween --
# Recursive worker routine for ttk::treeview::between
#
proc ttk::treeview::ScanBetween {tv item1 item2 item} {
variable between
variable selectingBetween
if {$item eq $item1 || $item eq $item2} {
lappend between $item
set selectingBetween [expr {!$selectingBetween}]
} elseif {$selectingBetween} {
lappend between $item
}
foreach child [$tv children $item] {
ScanBetween $tv $item1 $item2 $child
}
}
### User interaction utilities.
#
## OpenItem, CloseItem -- Set the open state of an item, generate event
#
proc ttk::treeview::OpenItem {w item} {
$w focus $item
event generate $w <<TreeviewOpen>>
$w item $item -open true
}
proc ttk::treeview::CloseItem {w item} {
$w item $item -open false
$w focus $item
event generate $w <<TreeviewClose>>
}
## Toggle -- toggle opened/closed state of item
#
proc ttk::treeview::Toggle {w item} {
if {[$w item $item -open]} {
CloseItem $w $item
} else {
OpenItem $w $item
}
}
## ToggleFocus -- toggle opened/closed state of focus item
#
proc ttk::treeview::ToggleFocus {w} {
set item [$w focus]
if {$item ne ""} {
Toggle $w $item
}
}
## BrowseTo -- navigate to specified item; set focus and selection
#
proc ttk::treeview::BrowseTo {w item} {
$w see $item
$w focus $item
$w selection set [list $item]
}
#*EOF*

176
windowsAgent/dist/tk/ttk/ttk.tcl vendored Normal file
View File

@ -0,0 +1,176 @@
#
# Ttk widget set initialization script.
#
### Source library scripts.
#
namespace eval ::ttk {
variable library
if {![info exists library]} {
set library [file dirname [info script]]
}
}
source [file join $::ttk::library fonts.tcl]
source [file join $::ttk::library cursors.tcl]
source [file join $::ttk::library utils.tcl]
## ttk::deprecated $old $new --
# Define $old command as a deprecated alias for $new command
# $old and $new must be fully namespace-qualified.
#
proc ttk::deprecated {old new} {
interp alias {} $old {} ttk::do'deprecate $old $new
}
## do'deprecate --
# Implementation procedure for deprecated commands --
# issue a warning (once), then re-alias old to new.
#
proc ttk::do'deprecate {old new args} {
deprecated'warning $old $new
interp alias {} $old {} $new
uplevel 1 [linsert $args 0 $new]
}
## deprecated'warning --
# Gripe about use of deprecated commands.
#
proc ttk::deprecated'warning {old new} {
puts stderr "$old deprecated -- use $new instead"
}
### Backward-compatibility.
#
#
# Make [package require tile] an effective no-op;
# see SF#3016598 for discussion.
#
package ifneeded tile 0.8.6 { package provide tile 0.8.6 }
# ttk::panedwindow used to be named ttk::paned. Keep the alias for now.
#
::ttk::deprecated ::ttk::paned ::ttk::panedwindow
### ::ttk::ThemeChanged --
# Called from [::ttk::style theme use].
# Sends a <<ThemeChanged>> virtual event to all widgets.
#
proc ::ttk::ThemeChanged {} {
set Q .
while {[llength $Q]} {
set QN [list]
foreach w $Q {
event generate $w <<ThemeChanged>>
foreach child [winfo children $w] {
lappend QN $child
}
}
set Q $QN
}
}
### Public API.
#
proc ::ttk::themes {{ptn *}} {
set themes [list]
foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
lappend themes [namespace tail $pkg]
}
return $themes
}
## ttk::setTheme $theme --
# Set the current theme to $theme, loading it if necessary.
#
proc ::ttk::setTheme {theme} {
variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work
if {$theme ni [::ttk::style theme names]} {
package require ttk::theme::$theme
}
::ttk::style theme use $theme
set currentTheme $theme
}
### Load widget bindings.
#
source [file join $::ttk::library button.tcl]
source [file join $::ttk::library menubutton.tcl]
source [file join $::ttk::library scrollbar.tcl]
source [file join $::ttk::library scale.tcl]
source [file join $::ttk::library progress.tcl]
source [file join $::ttk::library notebook.tcl]
source [file join $::ttk::library panedwindow.tcl]
source [file join $::ttk::library entry.tcl]
source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
source [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl
source [file join $::ttk::library treeview.tcl]
source [file join $::ttk::library sizegrip.tcl]
## Label and Labelframe bindings:
# (not enough to justify their own file...)
#
bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
### Load settings for built-in themes:
#
proc ttk::LoadThemes {} {
variable library
# "default" always present:
uplevel #0 [list source [file join $library defaults.tcl]]
set builtinThemes [style theme names]
foreach {theme scripts} {
classic classicTheme.tcl
alt altTheme.tcl
clam clamTheme.tcl
winnative winTheme.tcl
xpnative {xpTheme.tcl vistaTheme.tcl}
aqua aquaTheme.tcl
} {
if {[lsearch -exact $builtinThemes $theme] >= 0} {
foreach script $scripts {
uplevel #0 [list source [file join $library $script]]
}
}
}
}
ttk::LoadThemes; rename ::ttk::LoadThemes {}
### Select platform-specific default theme:
#
# Notes:
# + On OSX, aqua theme is the default
# + On Windows, xpnative takes precedence over winnative if available.
# + On X11, users can use the X resource database to
# specify a preferred theme (*TkTheme: themeName);
# otherwise "default" is used.
#
proc ttk::DefaultTheme {} {
set preferred [list aqua vista xpnative winnative]
set userTheme [option get . tkTheme TkTheme]
if {$userTheme ne {} && ![catch {
uplevel #0 [list package require ttk::theme::$userTheme]
}]} {
return $userTheme
}
foreach theme $preferred {
if {[package provide ttk::theme::$theme] ne ""} {
return $theme
}
}
return "default"
}
ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
#*EOF*

350
windowsAgent/dist/tk/ttk/utils.tcl vendored Normal file
View File

@ -0,0 +1,350 @@
#
# Utilities for widget implementations.
#
### Focus management.
#
# See also: #1516479
#
## ttk::takefocus --
# This is the default value of the "-takefocus" option
# for ttk::* widgets that participate in keyboard navigation.
#
# NOTES:
# tk::FocusOK (called by tk_focusNext) tests [winfo viewable]
# if -takefocus is 1, empty, or missing; but not if it's a
# script prefix, so we have to check that here as well.
#
#
proc ttk::takefocus {w} {
expr {[$w instate !disabled] && [winfo viewable $w]}
}
## ttk::GuessTakeFocus --
# This routine is called as a fallback for widgets
# with a missing or empty -takefocus option.
#
# It implements the same heuristics as tk::FocusOK.
#
proc ttk::GuessTakeFocus {w} {
# Don't traverse to widgets with '-state disabled':
#
if {![catch {$w cget -state} state] && $state eq "disabled"} {
return 0
}
# Allow traversal to widgets with explicit key or focus bindings:
#
if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} {
return 1;
}
# Default is nontraversable:
#
return 0;
}
## ttk::traverseTo $w --
# Set the keyboard focus to the specified window.
#
proc ttk::traverseTo {w} {
set focus [focus]
if {$focus ne ""} {
event generate $focus <<TraverseOut>>
}
focus $w
event generate $w <<TraverseIn>>
}
## ttk::clickToFocus $w --
# Utility routine, used in <ButtonPress-1> bindings --
# Assign keyboard focus to the specified widget if -takefocus is enabled.
#
proc ttk::clickToFocus {w} {
if {[ttk::takesFocus $w]} { focus $w }
}
## ttk::takesFocus w --
# Test if the widget can take keyboard focus.
#
# See the description of the -takefocus option in options(n)
# for details.
#
proc ttk::takesFocus {w} {
if {![winfo viewable $w]} {
return 0
} elseif {[catch {$w cget -takefocus} takefocus]} {
return [GuessTakeFocus $w]
} else {
switch -- $takefocus {
"" { return [GuessTakeFocus $w] }
0 { return 0 }
1 { return 1 }
default {
return [expr {[uplevel #0 $takefocus [list $w]] == 1}]
}
}
}
}
## ttk::focusFirst $w --
# Return the first descendant of $w, in preorder traversal order,
# that can take keyboard focus, "" if none do.
#
# See also: tk_focusNext
#
proc ttk::focusFirst {w} {
if {[ttk::takesFocus $w]} {
return $w
}
foreach child [winfo children $w] {
if {[set c [ttk::focusFirst $child]] ne ""} {
return $c
}
}
return ""
}
### Grabs.
#
# Rules:
# Each call to [grabWindow $w] or [globalGrab $w] must be
# matched with a call to [releaseGrab $w] in LIFO order.
#
# Do not call [grabWindow $w] for a window that currently
# appears on the grab stack.
#
# See #1239190 and #1411983 for more discussion.
#
namespace eval ttk {
variable Grab ;# map: window name -> grab token
# grab token details:
# Two-element list containing:
# 1) a script to evaluate to restore the previous grab (if any);
# 2) a script to evaluate to restore the focus (if any)
}
## SaveGrab --
# Record current grab and focus windows.
#
proc ttk::SaveGrab {w} {
variable Grab
if {[info exists Grab($w)]} {
# $w is already on the grab stack.
# This should not happen, but bail out in case it does anyway:
#
return
}
set restoreGrab [set restoreFocus ""]
set grabbed [grab current $w]
if {[winfo exists $grabbed]} {
switch [grab status $grabbed] {
global { set restoreGrab [list grab -global $grabbed] }
local { set restoreGrab [list grab $grabbed] }
none { ;# grab window is really in a different interp }
}
}
set focus [focus]
if {$focus ne ""} {
set restoreFocus [list focus -force $focus]
}
set Grab($w) [list $restoreGrab $restoreFocus]
}
## RestoreGrab --
# Restore previous grab and focus windows.
# If called more than once without an intervening [SaveGrab $w],
# does nothing.
#
proc ttk::RestoreGrab {w} {
variable Grab
if {![info exists Grab($w)]} { # Ignore
return;
}
# The previous grab/focus window may have been destroyed,
# unmapped, or some other abnormal condition; ignore any errors.
#
foreach script $Grab($w) {
catch $script
}
unset Grab($w)
}
## ttk::grabWindow $w --
# Records the current focus and grab windows, sets an application-modal
# grab on window $w.
#
proc ttk::grabWindow {w} {
SaveGrab $w
grab $w
}
## ttk::globalGrab $w --
# Same as grabWindow, but sets a global grab on $w.
#
proc ttk::globalGrab {w} {
SaveGrab $w
grab -global $w
}
## ttk::releaseGrab --
# Release the grab previously set by [ttk::grabWindow]
# or [ttk::globalGrab].
#
proc ttk::releaseGrab {w} {
grab release $w
RestoreGrab $w
}
### Auto-repeat.
#
# NOTE: repeating widgets do not have -repeatdelay
# or -repeatinterval resources as in standard Tk;
# instead a single set of settings is applied application-wide.
# (TODO: make this user-configurable)
#
# (@@@ Windows seems to use something like 500/50 milliseconds
# @@@ for -repeatdelay/-repeatinterval)
#
namespace eval ttk {
variable Repeat
array set Repeat {
delay 300
interval 100
timer {}
script {}
}
}
## ttk::Repeatedly --
# Begin auto-repeat.
#
proc ttk::Repeatedly {args} {
variable Repeat
after cancel $Repeat(timer)
set script [uplevel 1 [list namespace code $args]]
set Repeat(script) $script
uplevel #0 $script
set Repeat(timer) [after $Repeat(delay) ttk::Repeat]
}
## Repeat --
# Continue auto-repeat
#
proc ttk::Repeat {} {
variable Repeat
uplevel #0 $Repeat(script)
set Repeat(timer) [after $Repeat(interval) ttk::Repeat]
}
## ttk::CancelRepeat --
# Halt auto-repeat.
#
proc ttk::CancelRepeat {} {
variable Repeat
after cancel $Repeat(timer)
}
### Bindings.
#
## ttk::copyBindings $from $to --
# Utility routine; copies bindings from one bindtag onto another.
#
proc ttk::copyBindings {from to} {
foreach event [bind $from] {
bind $to $event [bind $from $event]
}
}
### Mousewheel bindings.
#
# Platform inconsistencies:
#
# On X11, the server typically maps the mouse wheel to Button4 and Button5.
#
# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
#
# On Windows, %D must be scaled by a factor of 120.
# In addition, Tk redirects mousewheel events to the window with
# keyboard focus instead of sending them to the window under the pointer.
# We do not attempt to fix that here, see also TIP#171.
#
# OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
# and Option+MouseWheel for accelerated scrolling.
#
# The Shift+MouseWheel behavior is not conventional on Windows or most
# X11 toolkits, but it's useful.
#
# MouseWheel scrolling is accelerated on X11, which is conventional
# for Tk and appears to be conventional for other toolkits (although
# Gtk+ and Qt do not appear to use as large a factor).
#
## ttk::bindMouseWheel $bindtag $command...
# Adds basic mousewheel support to $bindtag.
# $command will be passed one additional argument
# specifying the mousewheel direction (-1: up, +1: down).
#
proc ttk::bindMouseWheel {bindtag callback} {
switch -- [tk windowingsystem] {
x11 {
bind $bindtag <ButtonPress-4> "$callback -1"
bind $bindtag <ButtonPress-5> "$callback +1"
}
win32 {
bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}]
}
aqua {
bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
}
}
}
## Mousewheel bindings for standard scrollable widgets.
#
# Usage: [ttk::copyBindings TtkScrollable $bindtag]
#
# $bindtag should be for a widget that supports the
# standard scrollbar protocol.
#
switch -- [tk windowingsystem] {
x11 {
bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units }
bind TtkScrollable <ButtonPress-5> { %W yview scroll 5 units }
bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units }
bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll 5 units }
}
win32 {
bind TtkScrollable <MouseWheel> \
{ %W yview scroll [expr {-(%D/120)}] units }
bind TtkScrollable <Shift-MouseWheel> \
{ %W xview scroll [expr {-(%D/120)}] units }
}
aqua {
bind TtkScrollable <MouseWheel> \
{ %W yview scroll [expr {-(%D)}] units }
bind TtkScrollable <Shift-MouseWheel> \
{ %W xview scroll [expr {-(%D)}] units }
bind TtkScrollable <Option-MouseWheel> \
{ %W yview scroll [expr {-10*(%D)}] units }
bind TtkScrollable <Shift-Option-MouseWheel> \
{ %W xview scroll [expr {-10*(%D)}] units }
}
}
#*EOF*

231
windowsAgent/dist/tk/ttk/vistaTheme.tcl vendored Normal file
View File

@ -0,0 +1,231 @@
#
# Settings for Microsoft Windows Vista and Server 2008
#
# The Vista theme can only be defined on Windows Vista and above. The theme
# is created in C due to the need to assign a theme-enabled function for
# detecting when themeing is disabled. On systems that cannot support the
# Vista theme, there will be no such theme created and we must not
# evaluate this script.
if {"vista" ni [ttk::style theme names]} {
return
}
namespace eval ttk::theme::vista {
ttk::style theme settings vista {
ttk::style configure . \
-background SystemButtonFace \
-foreground SystemWindowText \
-selectforeground SystemHighlightText \
-selectbackground SystemHighlight \
-insertcolor SystemWindowText \
-font TkDefaultFont \
;
ttk::style map "." \
-foreground [list disabled SystemGrayText] \
;
ttk::style configure TButton -anchor center -padding {1 1} -width -11
ttk::style configure TRadiobutton -padding 2
ttk::style configure TCheckbutton -padding 2
ttk::style configure TMenubutton -padding {8 4}
ttk::style element create Menubutton.dropdown vsapi \
TOOLBAR 4 {{selected active} 6 {selected !active} 5
disabled 4 pressed 3 active 2 {} 1} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style configure TNotebook -tabmargins {2 2 2 0}
ttk::style map TNotebook.Tab \
-expand [list selected {2 2 2 2}]
# Treeview:
ttk::style configure Heading -font TkHeadingFont
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
{!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
{!disabled !selected} SystemWindowText \
selected SystemHighlightText]
# Label and Toolbutton
ttk::style configure TLabelframe.Label -foreground SystemButtonText
ttk::style configure Toolbutton -padding {4 4}
# Combobox
ttk::style configure TCombobox -padding 2
ttk::style element create Combobox.border vsapi \
COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1}
ttk::style element create Combobox.background vsapi \
EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1}
ttk::style element create Combobox.rightdownarrow vsapi \
COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style layout TCombobox {
Combobox.border -sticky nswe -border 0 -children {
Combobox.rightdownarrow -side right -sticky ns
Combobox.padding -expand 1 -sticky nswe -children {
Combobox.background -sticky nswe -children {
Combobox.focus -expand 1 -sticky nswe -children {
Combobox.textarea -sticky nswe
}
}
}
}
}
# Vista.Combobox droplist frame
ttk::style element create ComboboxPopdownFrame.background vsapi\
LISTBOX 3 {disabled 4 active 3 focus 2 {} 1}
ttk::style layout ComboboxPopdownFrame {
ComboboxPopdownFrame.background -sticky news -border 1 -children {
ComboboxPopdownFrame.padding -sticky news
}
}
ttk::style map TCombobox \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
-foreground [list \
disabled SystemGrayText \
{readonly focus} SystemHighlightText \
] \
-focusfill [list {readonly focus} SystemHighlight] \
;
# Entry
ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup
ttk::style element create Entry.field vsapi \
EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2}
ttk::style element create Entry.background vsapi \
EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}
ttk::style layout TEntry {
Entry.field -sticky news -border 0 -children {
Entry.background -sticky news -children {
Entry.padding -sticky news -children {
Entry.textarea -sticky news
}
}
}
}
ttk::style map TEntry \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
;
# Spinbox
ttk::style configure TSpinbox -padding 0
ttk::style element create Spinbox.field vsapi \
EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2}
ttk::style element create Spinbox.background vsapi \
EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}
ttk::style element create Spinbox.innerbg vsapi \
EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\
-padding {2 0 15 2}
ttk::style element create Spinbox.uparrow vsapi \
SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \
-padding 1 -halfheight 1 \
-syssize { SM_CXVSCROLL SM_CYVSCROLL }
ttk::style element create Spinbox.downarrow vsapi \
SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \
-padding 1 -halfheight 1 \
-syssize { SM_CXVSCROLL SM_CYVSCROLL }
ttk::style layout TSpinbox {
Spinbox.field -sticky nswe -children {
Spinbox.background -sticky news -children {
Spinbox.padding -sticky news -children {
Spinbox.innerbg -sticky news -children {
Spinbox.textarea -expand 1
}
}
Spinbox.uparrow -side top -sticky ens
Spinbox.downarrow -side bottom -sticky ens
}
}
}
ttk::style map TSpinbox \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
;
# SCROLLBAR elements (Vista includes a state for 'hover')
ttk::style element create Vertical.Scrollbar.uparrow vsapi \
SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style element create Vertical.Scrollbar.downarrow vsapi \
SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style element create Vertical.Scrollbar.trough vsapi \
SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1}
ttk::style element create Vertical.Scrollbar.thumb vsapi \
SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style element create Vertical.Scrollbar.grip vsapi \
SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \
-syssize {SM_CXVSCROLL SM_CYVSCROLL}
ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \
SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \
-syssize {SM_CXHSCROLL SM_CYHSCROLL}
ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \
SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \
-syssize {SM_CXHSCROLL SM_CYHSCROLL}
ttk::style element create Horizontal.Scrollbar.trough vsapi \
SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1}
ttk::style element create Horizontal.Scrollbar.thumb vsapi \
SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \
-syssize {SM_CXHSCROLL SM_CYHSCROLL}
ttk::style element create Horizontal.Scrollbar.grip vsapi \
SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1}
# Progressbar
ttk::style element create Horizontal.Progressbar.pbar vsapi \
PROGRESS 3 {{} 1} -padding 8
ttk::style layout Horizontal.TProgressbar {
Horizontal.Progressbar.trough -sticky nswe -children {
Horizontal.Progressbar.pbar -side left -sticky ns
}
}
ttk::style element create Vertical.Progressbar.pbar vsapi \
PROGRESS 3 {{} 1} -padding 8
ttk::style layout Vertical.TProgressbar {
Vertical.Progressbar.trough -sticky nswe -children {
Vertical.Progressbar.pbar -side bottom -sticky we
}
}
# Scale
ttk::style element create Horizontal.Scale.slider vsapi \
TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \
-width 6 -height 12
ttk::style layout Horizontal.TScale {
Scale.focus -expand 1 -sticky nswe -children {
Horizontal.Scale.trough -expand 1 -sticky nswe -children {
Horizontal.Scale.track -sticky we
Horizontal.Scale.slider -side left -sticky {}
}
}
}
ttk::style element create Vertical.Scale.slider vsapi \
TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \
-width 12 -height 6
ttk::style layout Vertical.TScale {
Scale.focus -expand 1 -sticky nswe -children {
Vertical.Scale.trough -expand 1 -sticky nswe -children {
Vertical.Scale.track -sticky ns
Vertical.Scale.slider -side top -sticky {}
}
}
}
# Treeview
ttk::style configure Item -padding {4 0 0 0}
package provide ttk::theme::vista 1.0
}
}

86
windowsAgent/dist/tk/ttk/winTheme.tcl vendored Normal file
View File

@ -0,0 +1,86 @@
#
# Settings for 'winnative' theme.
#
namespace eval ttk::theme::winnative {
ttk::style theme settings winnative {
ttk::style configure "." \
-background SystemButtonFace \
-foreground SystemWindowText \
-selectforeground SystemHighlightText \
-selectbackground SystemHighlight \
-fieldbackground SystemWindow \
-insertcolor SystemWindowText \
-troughcolor SystemScrollbar \
-font TkDefaultFont \
;
ttk::style map "." -foreground [list disabled SystemGrayText] ;
ttk::style map "." -embossed [list disabled 1] ;
ttk::style configure TButton \
-anchor center -width -11 -relief raised -shiftrelief 1
ttk::style configure TCheckbutton -padding "2 4"
ttk::style configure TRadiobutton -padding "2 4"
ttk::style configure TMenubutton \
-padding "8 4" -arrowsize 3 -relief raised
ttk::style map TButton -relief {{!disabled pressed} sunken}
ttk::style configure TEntry \
-padding 2 -selectborderwidth 0 -insertwidth 1
ttk::style map TEntry \
-fieldbackground \
[list readonly SystemButtonFace disabled SystemButtonFace] \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
;
ttk::style configure TCombobox -padding 2
ttk::style map TCombobox \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
-fieldbackground [list \
readonly SystemButtonFace \
disabled SystemButtonFace] \
-foreground [list \
disabled SystemGrayText \
{readonly focus} SystemHighlightText \
] \
-focusfill [list {readonly focus} SystemHighlight] \
;
ttk::style element create ComboboxPopdownFrame.border from default
ttk::style configure ComboboxPopdownFrame \
-borderwidth 1 -relief solid
ttk::style configure TSpinbox -padding {2 0 16 0}
ttk::style configure TLabelframe -borderwidth 2 -relief groove
ttk::style configure Toolbutton -relief flat -padding {8 4}
ttk::style map Toolbutton -relief \
{disabled flat selected sunken pressed sunken active raised}
ttk::style configure TScale -groovewidth 4
ttk::style configure TNotebook -tabmargins {2 2 2 0}
ttk::style configure TNotebook.Tab -padding {3 1} -borderwidth 1
ttk::style map TNotebook.Tab -expand [list selected {2 2 2 0}]
# Treeview:
ttk::style configure Heading -font TkHeadingFont -relief raised
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
{!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
{!disabled !selected} SystemWindowText \
selected SystemHighlightText]
ttk::style configure TProgressbar \
-background SystemHighlight -borderwidth 0 ;
}
}

76
windowsAgent/dist/tk/ttk/xpTheme.tcl vendored Normal file
View File

@ -0,0 +1,76 @@
#
# Settings for 'xpnative' theme
#
namespace eval ttk::theme::xpnative {
ttk::style theme settings xpnative {
ttk::style configure . \
-background SystemButtonFace \
-foreground SystemWindowText \
-selectforeground SystemHighlightText \
-selectbackground SystemHighlight \
-insertcolor SystemWindowText \
-font TkDefaultFont \
;
ttk::style map "." \
-foreground [list disabled SystemGrayText] \
;
ttk::style configure TButton -anchor center -padding {1 1} -width -11
ttk::style configure TRadiobutton -padding 2
ttk::style configure TCheckbutton -padding 2
ttk::style configure TMenubutton -padding {8 4}
ttk::style configure TNotebook -tabmargins {2 2 2 0}
ttk::style map TNotebook.Tab \
-expand [list selected {2 2 2 2}]
# Treeview:
ttk::style configure Heading -font TkHeadingFont
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list selected SystemHighlight] \
-foreground [list selected SystemHighlightText] ;
ttk::style configure TLabelframe.Label -foreground "#0046d5"
# OR: -padding {3 3 3 6}, which some apps seem to use.
ttk::style configure TEntry -padding {2 2 2 4}
ttk::style map TEntry \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
;
ttk::style configure TCombobox -padding 2
ttk::style map TCombobox \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
-foreground [list \
disabled SystemGrayText \
{readonly focus} SystemHighlightText \
] \
-focusfill [list {readonly focus} SystemHighlight] \
;
ttk::style configure TSpinbox -padding {2 0 14 0}
ttk::style map TSpinbox \
-selectbackground [list !focus SystemWindow] \
-selectforeground [list !focus SystemWindowText] \
;
ttk::style configure Toolbutton -padding {4 4}
# Treeview:
ttk::style configure Heading -font TkHeadingFont -relief raised
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
{!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
{!disabled !selected} SystemWindowText \
selected SystemHighlightText];
}
}

269
windowsAgent/dist/tk/unsupported.tcl vendored Normal file
View File

@ -0,0 +1,269 @@
# unsupported.tcl --
#
# Commands provided by Tk without official support. Use them at your
# own risk. They may change or go away without notice.
#
# 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
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,
# or a glob-style pattern.
#
# 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
set cmds [array get PrivateCommands $cmd]
if {[llength $cmds] == 0} {
return -code error -errorcode {TK EXPOSE_PRIVATE_COMMAND} \
"No compatibility support for \[$cmd]"
}
foreach {old new} $cmds {
namespace eval :: [list interp alias {} $old {}] $new
}
}
# ::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,
# or a glob-style pattern.
#
# 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
set vars [array get PrivateVariables $var]
if {[llength $vars] == 0} {
return -code error -errorcode {TK EXPOSE_PRIVATE_VARIABLE} \
"No compatibility support for \$$var"
}
namespace eval ::tk::mac {}
foreach {old new} $vars {
namespace eval :: [list upvar "#0" $new $old]
}
}

989
windowsAgent/dist/tk/xmfbox.tcl vendored Normal file
View File

@ -0,0 +1,989 @@
# xmfbox.tcl --
#
# Implements the "Motif" style file selection dialog for the
# Unix platform. This implementation is used only if the
# "::tk_strictMotif" flag is set.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {}
# ::tk::MotifFDialog --
#
# Implements a file dialog similar to the standard Motif file
# selection box.
#
# Arguments:
# type "open" or "save"
# args Options parsed by the procedure.
#
# Results:
# When -multiple is set to 0, this returns the absolute pathname
# of the selected file. (NOTE: This is not the same as a single
# element list.)
#
# When -multiple is set to > 0, this returns a Tcl list of absolute
# pathnames. The argument for -multiple is ignored, but for consistency
# with Windows it defines the maximum amount of memory to allocate for
# the returned filenames.
proc ::tk::MotifFDialog {type args} {
variable ::tk::Priv
set dataName __tk_filedialog
upvar ::tk::dialog::file::$dataName data
set w [MotifFDialog_Create $dataName $type $args]
# Set a grab and claim the focus too.
::tk::SetFocusGrab $w $data(sEnt)
$data(sEnt) selection range 0 end
# Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(selectFilePath)
set result $Priv(selectFilePath)
::tk::RestoreFocusGrab $w $data(sEnt) withdraw
return $result
}
# ::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 ::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.
#
# Arguments:
# dataName Name of the global "data" array for the file dialog.
# type "Save" or "Open"
# argList Options parsed by the procedure.
#
# Results:
# Pathname of the file dialog.
proc ::tk::MotifFDialog_Create {dataName type argList} {
upvar ::tk::dialog::file::$dataName data
MotifFDialog_Config $dataName $type $argList
if {$data(-parent) eq "."} {
set w .$dataName
} else {
set w $data(-parent).$dataName
}
# (re)create the dialog box if necessary
#
if {![winfo exists $w]} {
MotifFDialog_BuildUI $w
} elseif {[winfo class $w] ne "TkMotifFDialog"} {
destroy $w
MotifFDialog_BuildUI $w
} else {
set data(fEnt) $w.top.f1.ent
set data(dList) $w.top.f2.a.l
set data(fList) $w.top.f2.b.l
set data(sEnt) $w.top.f3.ent
set data(okBtn) $w.bot.ok
set data(filterBtn) $w.bot.filter
set data(cancelBtn) $w.bot.cancel
}
MotifFDialog_SetListMode $w
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
}
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
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w
wm title $w $data(-title)
return $w
}
# ::tk::MotifFDialog_FileTypes --
#
# Checks the -filetypes option. If present this adds a list of radio-
# buttons to pick the file types from.
#
# Arguments:
# w Pathname of the tk_get*File dialogue.
#
# Results:
# none
proc ::tk::MotifFDialog_FileTypes {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set f $w.top.f3.types
destroy $f
# No file types: use "*" as the filter and display no radio-buttons
if {$data(-filetypes) eq ""} {
set data(filter) *
return
}
# The filetypes radiobuttons
# set data(fileType) $data(-defaulttype)
# Default type to first entry
set initialTypeName [lindex $data(origfiletypes) 0 0]
if {$data(-typevariable) ne ""} {
upvar #0 $data(-typevariable) typeVariable
if {[info exists typeVariable]} {
set initialTypeName $typeVariable
}
}
set ix 0
set data(fileType) 0
foreach fltr $data(origfiletypes) {
set fname [lindex $fltr 0]
if {[string first $initialTypeName $fname] == 0} {
set data(fileType) $ix
break
}
incr ix
}
MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
#don't produce radiobuttons for only one filetype
if {[llength $data(-filetypes)] == 1} {
return
}
frame $f
set cnt 0
if {$data(-filetypes) ne {}} {
foreach type $data(-filetypes) {
set title [lindex $type 0]
set filter [lindex $type 1]
radiobutton $f.b$cnt \
-text $title \
-variable ::tk::dialog::file::[winfo name $w](fileType) \
-value $cnt \
-command [list tk::MotifFDialog_SetFilter $w $type]
pack $f.b$cnt -side left
incr cnt
}
}
$f.b$data(fileType) invoke
pack $f -side bottom -fill both
return
}
# This proc gets called whenever data(filter) is set
#
proc ::tk::MotifFDialog_SetFilter {w type} {
upvar ::tk::dialog::file::[winfo name $w] data
variable ::tk::Priv
set data(filter) [lindex $type 1]
set Priv(selectFileType) [lindex [lindex $type 0] 0]
MotifFDialog_Update $w
}
# ::tk::MotifFDialog_Config --
#
# Iterates over the optional arguments to determine the option
# values for the Motif file dialog; gives default values to
# unspecified options.
#
# Arguments:
# dataName The name of the global variable in which
# data for the file dialog is stored.
# type "Save" or "Open"
# argList Options parsed by the procedure.
proc ::tk::MotifFDialog_Config {dataName type argList} {
upvar ::tk::dialog::file::$dataName data
set data(type) $type
# 1: the configuration specs
#
set specs {
{-defaultextension "" "" ""}
{-filetypes "" "" ""}
{-initialdir "" "" ""}
{-initialfile "" "" ""}
{-parent "" "" "."}
{-title "" "" ""}
{-typevariable "" "" ""}
}
if {$type eq "open"} {
lappend specs {-multiple "" "" "0"}
}
if {$type eq "save"} {
lappend specs {-confirmoverwrite "" "" "1"}
}
set data(-multiple) 0
set data(-confirmoverwrite) 1
# 2: default values depending on the type of the dialog
#
if {![info exists data(selectPath)]} {
# first time the dialog has been popped up
set data(selectPath) [pwd]
set data(selectFile) ""
}
# 3: parse the arguments
#
tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
if {$data(-title) eq ""} {
if {$type eq "open"} {
if {$data(-multiple) != 0} {
set data(-title) "[mc {Open Multiple Files}]"
} else {
set data(-title) [mc "Open"]
}
} else {
set data(-title) [mc "Save As"]
}
}
# 4: set the default directory and selection according to the -initial
# settings
#
if {$data(-initialdir) ne ""} {
if {[file isdirectory $data(-initialdir)]} {
set data(selectPath) [lindex [glob $data(-initialdir)] 0]
} else {
set data(selectPath) [pwd]
}
# Convert the initialdir to an absolute path name.
set old [pwd]
cd $data(selectPath)
set data(selectPath) [pwd]
cd $old
}
set data(selectFile) $data(-initialfile)
# 5. Parse the -filetypes option. It is not used by the motif
# 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(origfiletypes) $data(-filetypes)
set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
if {![info exists data(filter)]} {
set data(filter) *
}
if {![winfo exists $data(-parent)]} {
return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
"bad window path name \"$data(-parent)\""
}
}
# ::tk::MotifFDialog_BuildUI --
#
# Builds the UI components of the Motif file dialog.
#
# Arguments:
# w Pathname of the dialog to build.
#
# Results:
# None.
proc ::tk::MotifFDialog_BuildUI {w} {
set dataName [lindex [split $w .] end]
upvar ::tk::dialog::file::$dataName data
# Create the dialog toplevel and internal frames.
#
toplevel $w -class TkMotifFDialog
set top [frame $w.top -relief raised -bd 1]
set bot [frame $w.bot -relief raised -bd 1]
pack $w.bot -side bottom -fill x
pack $w.top -side top -expand yes -fill both
set f1 [frame $top.f1]
set f2 [frame $top.f2]
set f3 [frame $top.f3]
pack $f1 -side top -fill x
pack $f3 -side bottom -fill x
pack $f2 -expand yes -fill both
set f2a [frame $f2.a]
set f2b [frame $f2.b]
grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
-sticky news
grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
-sticky news
grid rowconfigure $f2 0 -minsize 0 -weight 1
grid columnconfigure $f2 0 -minsize 0 -weight 1
grid columnconfigure $f2 1 -minsize 150 -weight 2
# The Filter box
#
bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
<<AltUnderlined>> [list focus $f1.ent]
entry $f1.ent
pack $f1.lab -side top -fill x -padx 6 -pady 4
pack $f1.ent -side top -fill x -padx 4 -pady 0
set data(fEnt) $f1.ent
# The file and directory lists
#
set data(dList) [MotifFDialog_MakeSList $w $f2a \
[mc "&Directory:"] DList]
set data(fList) [MotifFDialog_MakeSList $w $f2b \
[mc "Fi&les:"] FList]
# The Selection box
#
bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
<<AltUnderlined>> [list focus $f3.ent]
entry $f3.ent
pack $f3.lab -side top -fill x -padx 6 -pady 0
pack $f3.ent -side top -fill x -padx 4 -pady 4
set data(sEnt) $f3.ent
# The buttons
#
set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
-width $maxWidth \
-command [list tk::MotifFDialog_OkCmd $w]]
set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
-width $maxWidth \
-command [list tk::MotifFDialog_FilterCmd $w]]
set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
-width $maxWidth \
-command [list tk::MotifFDialog_CancelCmd $w]]
pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
-side left
# Create the bindings:
#
bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w]
bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}}
wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
}
proc ::tk::MotifFDialog_SetListMode {w} {
upvar ::tk::dialog::file::[winfo name $w] data
if {$data(-multiple) != 0} {
set selectmode extended
} else {
set selectmode browse
}
set f $w.top.f2.b
$f.l configure -selectmode $selectmode
}
# ::tk::MotifFDialog_MakeSList --
#
# Create a scrolled-listbox and set the keyboard accelerator
# bindings so that the list selection follows what the user
# types.
#
# Arguments:
# w Pathname of the dialog box.
# f Frame widget inside which to create the scrolled
# listbox. This frame widget already exists.
# label The string to display on top of the listbox.
# under Sets the -under option of the label.
# cmdPrefix Specifies procedures to call when the listbox is
# browsed or activated.
proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
<<AltUnderlined>> [list focus $f.l]
listbox $f.l -width 12 -height 5 -exportselection 0\
-xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]
scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
-padx 2 -pady 2
grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid rowconfigure $f 0 -weight 0 -minsize 0
grid rowconfigure $f 1 -weight 1 -minsize 0
grid columnconfigure $f 0 -weight 1 -minsize 0
# bindings for the listboxes
#
set list $f.l
bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
bind $list <Double-ButtonRelease-1> \
[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]
ListBoxKeyAccel_Set $list
return $f.l
}
# ::tk::MotifFDialog_InterpFilter --
#
# Interpret the string in the filter entry into two components:
# the directory and the pattern. If the string is a relative
# pathname, give a warning to the user and restore the pattern
# to original.
#
# Arguments:
# w pathname of the dialog box.
#
# Results:
# A list of two elements. The first element is the directory
# specified # by the filter. The second element is the filter
# pattern itself.
proc ::tk::MotifFDialog_InterpFilter {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set text [string trim [$data(fEnt) get]]
# Perform tilde substitution
#
set badTilde 0
if {[string index $text 0] eq "~"} {
set list [file split $text]
set tilde [lindex $list 0]
if {[catch {set tilde [glob $tilde]}]} {
set badTilde 1
} else {
set text [eval file join [concat $tilde [lrange $list 1 end]]]
}
}
# If the string is a relative pathname, combine it
# with the current selectPath.
set relative 0
if {[file pathtype $text] eq "relative"} {
set relative 1
} elseif {$badTilde} {
set relative 1
}
if {$relative} {
tk_messageBox -icon warning -type ok \
-message "\"$text\" must be an absolute pathname"
$data(fEnt) delete 0 end
$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(filter)]
return [list $data(selectPath) $data(filter)]
}
set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
if {[file isdirectory $resolved]} {
set dir $resolved
set fil $data(filter)
} else {
set dir [file dirname $resolved]
set fil [file tail $resolved]
}
return [list $dir $fil]
}
# ::tk::MotifFDialog_Update
#
# Load the files and synchronize the "filter" and "selection" fields
# boxes.
#
# Arguments:
# w pathname of the dialog box.
#
# Results:
# None.
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(sEnt) delete 0 end
$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(selectFile)]
MotifFDialog_LoadFiles $w
}
# ::tk::MotifFDialog_LoadFiles --
#
# Loads the files and directories into the two listboxes according
# to the filter setting.
#
# Arguments:
# w pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_LoadFiles {w} {
upvar ::tk::dialog::file::[winfo name $w] data
$data(dList) delete 0 end
$data(fList) delete 0 end
set appPWD [pwd]
if {[catch {cd $data(selectPath)}]} {
cd $appPWD
$data(dList) insert end ".."
return
}
# Make the dir and file lists
#
# For speed we only have one glob, which reduces the file system
# calls (good for slow NFS networks).
#
# We also do two smaller sorts (files + dirs) instead of one large sort,
# which gives a small speed increase.
#
set top 0
set dlist ""
set flist ""
foreach f [glob -nocomplain .* *] {
if {[file isdir ./$f]} {
lappend dlist $f
} else {
foreach pat $data(filter) {
if {[string match $pat $f]} {
if {[string match .* $f]} {
incr top
}
lappend flist $f
break
}
}
}
}
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
$data(fList) yview $top
cd $appPWD
}
# ::tk::MotifFDialog_BrowseDList --
#
# This procedure is called when the directory list is browsed
# (clicked-over) by the user.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_BrowseDList {w} {
upvar ::tk::dialog::file::[winfo name $w] data
focus $data(dList)
if {[$data(dList) curselection] eq ""} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
if {$subdir eq ""} {
return
}
$data(fList) selection clear 0 end
set list [MotifFDialog_InterpFilter $w]
set data(filter) [lindex $list 1]
switch -- $subdir {
. {
set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
}
.. {
set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
$data(filter)]
}
default {
set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
$data(selectPath) $subdir] $data(filter)]
}
}
$data(fEnt) delete 0 end
$data(fEnt) insert 0 $newSpec
}
# ::tk::MotifFDialog_ActivateDList --
#
# This procedure is called when the directory list is activated
# (double-clicked) by the user.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_ActivateDList {w} {
upvar ::tk::dialog::file::[winfo name $w] data
if {[$data(dList) curselection] eq ""} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
if {$subdir eq ""} {
return
}
$data(fList) selection clear 0 end
switch -- $subdir {
. {
set newDir $data(selectPath)
}
.. {
set newDir [file dirname $data(selectPath)]
}
default {
set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
}
}
set data(selectPath) $newDir
MotifFDialog_Update $w
if {$subdir ne ".."} {
$data(dList) selection set 0
$data(dList) activate 0
} else {
$data(dList) selection set 1
$data(dList) activate 1
}
}
# ::tk::MotifFDialog_BrowseFList --
#
# This procedure is called when the file list is browsed
# (clicked-over) by the user.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_BrowseFList {w} {
upvar ::tk::dialog::file::[winfo name $w] data
focus $data(fList)
set data(selectFile) ""
foreach item [$data(fList) curselection] {
lappend data(selectFile) [$data(fList) get $item]
}
if {[llength $data(selectFile)] == 0} {
return
}
$data(dList) selection clear 0 end
$data(fEnt) delete 0 end
$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(filter)]
$data(fEnt) xview end
# if it's a multiple selection box, just put in the filenames
# otherwise put in the full path as usual
$data(sEnt) delete 0 end
if {$data(-multiple) != 0} {
$data(sEnt) insert 0 $data(selectFile)
} else {
$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
[lindex $data(selectFile) 0]]
}
$data(sEnt) xview end
}
# ::tk::MotifFDialog_ActivateFList --
#
# This procedure is called when the file list is activated
# (double-clicked) by the user.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_ActivateFList {w} {
upvar ::tk::dialog::file::[winfo name $w] data
if {[$data(fList) curselection] eq ""} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
if {$data(selectFile) eq ""} {
return
} else {
MotifFDialog_ActivateSEnt $w
}
}
# ::tk::MotifFDialog_ActivateFEnt --
#
# This procedure is called when the user presses Return inside
# the "filter" entry. It updates the dialog according to the
# text inside the filter entry.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_ActivateFEnt {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set list [MotifFDialog_InterpFilter $w]
set data(selectPath) [lindex $list 0]
set data(filter) [lindex $list 1]
MotifFDialog_Update $w
}
# ::tk::MotifFDialog_ActivateSEnt --
#
# This procedure is called when the user presses Return inside
# the "selection" entry. It sets the ::tk::Priv(selectFilePath)
# variable so that the vwait loop in tk::MotifFDialog will be
# terminated.
#
# Arguments:
# w The pathname of the dialog box.
#
# Results:
# None.
proc ::tk::MotifFDialog_ActivateSEnt {w} {
variable ::tk::Priv
upvar ::tk::dialog::file::[winfo name $w] data
set selectFilePath [string trim [$data(sEnt) get]]
if {$selectFilePath eq ""} {
MotifFDialog_FilterCmd $w
return
}
if {$data(-multiple) == 0} {
set selectFilePath [list $selectFilePath]
}
if {[file isdirectory [lindex $selectFilePath 0]]} {
set data(selectPath) [lindex [glob $selectFilePath] 0]
set data(selectFile) ""
MotifFDialog_Update $w
return
}
set newFileList ""
foreach item $selectFilePath {
if {[file pathtype $item] ne "absolute"} {
set item [file join $data(selectPath) $item]
} elseif {![file exists [file dirname $item]]} {
tk_messageBox -icon warning -type ok \
-message [mc {Directory "%1$s" does not exist.} \
[file dirname $item]]
return
}
if {![file exists $item]} {
if {$data(type) eq "open"} {
tk_messageBox -icon warning -type ok \
-message [mc {File "%1$s" does not exist.} $item]
return
}
} elseif {$data(type) eq "save" && $data(-confirmoverwrite)} {
set message [format %s%s \
[mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \
[mc {Replace existing file?}]]
set answer [tk_messageBox -icon warning -type yesno \
-message $message]
if {$answer eq "no"} {
return
}
}
lappend newFileList $item
}
# Return selected filter
if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
&& [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
upvar #0 $data(-typevariable) typeVariable
set typeVariable [lindex $data(origfiletypes) $data(fileType) 0]
}
if {$data(-multiple) != 0} {
set Priv(selectFilePath) $newFileList
} else {
set Priv(selectFilePath) [lindex $newFileList 0]
}
# Set selectFile and selectPath to first item in list
set Priv(selectFile) [file tail [lindex $newFileList 0]]
set Priv(selectPath) [file dirname [lindex $newFileList 0]]
}
proc ::tk::MotifFDialog_OkCmd {w} {
upvar ::tk::dialog::file::[winfo name $w] data
MotifFDialog_ActivateSEnt $w
}
proc ::tk::MotifFDialog_FilterCmd {w} {
upvar ::tk::dialog::file::[winfo name $w] data
MotifFDialog_ActivateFEnt $w
}
proc ::tk::MotifFDialog_CancelCmd {w} {
variable ::tk::Priv
set Priv(selectFilePath) ""
set Priv(selectFile) ""
set Priv(selectPath) ""
}
proc ::tk::ListBoxKeyAccel_Set {w} {
bind Listbox <Any-KeyPress> ""
bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
}
proc ::tk::ListBoxKeyAccel_Unset {w} {
variable ::tk::Priv
catch {after cancel $Priv(lbAccel,$w,afterId)}
unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId)
}
# ::tk::ListBoxKeyAccel_Key--
#
# This procedure maintains a list of recently entered keystrokes
# over a listbox widget. It arranges an idle event to move the
# selection of the listbox to the entry that begins with the
# keystrokes.
#
# Arguments:
# w The pathname of the listbox.
# key The key which the user just pressed.
#
# Results:
# None.
proc ::tk::ListBoxKeyAccel_Key {w key} {
variable ::tk::Priv
if { $key eq "" } {
return
}
append Priv(lbAccel,$w) $key
ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
catch {
after cancel $Priv(lbAccel,$w,afterId)
}
set Priv(lbAccel,$w,afterId) [after 500 \
[list tk::ListBoxKeyAccel_Reset $w]]
}
proc ::tk::ListBoxKeyAccel_Goto {w string} {
variable ::tk::Priv
set string [string tolower $string]
set end [$w index end]
set theIndex -1
for {set i 0} {$i < $end} {incr i} {
set item [string tolower [$w get $i]]
if {[string compare $string $item] >= 0} {
set theIndex $i
}
if {[string compare $string $item] <= 0} {
set theIndex $i
break
}
}
if {$theIndex >= 0} {
$w selection clear 0 end
$w selection set $theIndex $theIndex
$w activate $theIndex
$w see $theIndex
event generate $w <<ListboxSelect>>
}
}
proc ::tk::ListBoxKeyAccel_Reset {w} {
variable ::tk::Priv
unset -nocomplain Priv(lbAccel,$w)
}
proc ::tk_getFileType {} {
variable ::tk::Priv
return $Priv(selectFileType)
}