Add files via upload
265
windowsAgent/dist/tk/bgerror.tcl
vendored
Normal 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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
180
windowsAgent/dist/tk/dialog.tcl
vendored
Normal 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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
BIN
windowsAgent/dist/tk/images/logo100.gif
vendored
Normal file
After Width: | Height: | Size: 2.3 KiB |
BIN
windowsAgent/dist/tk/images/logo64.gif
vendored
Normal file
After Width: | Height: | Size: 1.6 KiB |
BIN
windowsAgent/dist/tk/images/logoLarge.gif
vendored
Normal file
After Width: | Height: | Size: 11 KiB |
BIN
windowsAgent/dist/tk/images/logoMed.gif
vendored
Normal file
After Width: | Height: | Size: 3.8 KiB |
1897
windowsAgent/dist/tk/images/pwrdLogo.eps
vendored
Normal file
BIN
windowsAgent/dist/tk/images/pwrdLogo100.gif
vendored
Normal file
After Width: | Height: | Size: 1.6 KiB |
BIN
windowsAgent/dist/tk/images/pwrdLogo150.gif
vendored
Normal file
After Width: | Height: | Size: 2.4 KiB |
BIN
windowsAgent/dist/tk/images/pwrdLogo175.gif
vendored
Normal file
After Width: | Height: | Size: 2.9 KiB |
BIN
windowsAgent/dist/tk/images/pwrdLogo200.gif
vendored
Normal file
After Width: | Height: | Size: 3.4 KiB |
BIN
windowsAgent/dist/tk/images/pwrdLogo75.gif
vendored
Normal file
After Width: | Height: | Size: 1.1 KiB |
BIN
windowsAgent/dist/tk/images/tai-ku.gif
vendored
Normal file
After Width: | Height: | Size: 5.3 KiB |
40
windowsAgent/dist/tk/license.terms
vendored
Normal 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
|
@ -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
|
@ -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
1488
windowsAgent/dist/tk/mkpsenc.tcl
vendored
Normal file
430
windowsAgent/dist/tk/msgbox.tcl
vendored
Normal 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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -0,0 +1,3 @@
|
||||||
|
namespace eval ::tk {
|
||||||
|
::msgcat::mcset en_gb Color Colour
|
||||||
|
}
|
75
windowsAgent/dist/tk/msgs/eo.msg
vendored
Normal 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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
695
windowsAgent/dist/tk/tk.tcl
vendored
Normal 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
111
windowsAgent/dist/tk/ttk/altTheme.tcl
vendored
Normal 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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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)
|
||||||
|
}
|
||||||
|
|