diff --git a/windowsAgent/dist/tk/bgerror.tcl b/windowsAgent/dist/tk/bgerror.tcl new file mode 100644 index 0000000..b15387e --- /dev/null +++ b/windowsAgent/dist/tk/bgerror.tcl @@ -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 +# Copyright (c) 2009 Pat Thoyts + +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 {}; # 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 { 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 [namespace code {Return ok 0}] + bind $dlg [namespace code {Return dismiss 1}] + bind $dlg [namespace code {Destroy %W}] + bind $dlg.function [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 +} diff --git a/windowsAgent/dist/tk/button.tcl b/windowsAgent/dist/tk/button.tcl new file mode 100644 index 0000000..80d8bf9 --- /dev/null +++ b/windowsAgent/dist/tk/button.tcl @@ -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 { + tk::ButtonEnter %W + } + bind Radiobutton <1> { + tk::ButtonDown %W + } + bind Radiobutton { + tk::ButtonUp %W + } + bind Checkbutton { + tk::ButtonEnter %W + } + bind Checkbutton <1> { + tk::ButtonDown %W + } + bind Checkbutton { + tk::ButtonUp %W + } + bind Checkbutton { + tk::ButtonLeave %W + } +} +if {"win32" eq [tk windowingsystem]} { + bind Checkbutton { + tk::CheckRadioInvoke %W select + } + bind Checkbutton { + tk::CheckRadioInvoke %W select + } + bind Checkbutton { + tk::CheckRadioInvoke %W deselect + } + bind Checkbutton <1> { + tk::CheckRadioDown %W + } + bind Checkbutton { + tk::ButtonUp %W + } + bind Checkbutton { + tk::CheckRadioEnter %W + } + bind Checkbutton { + tk::ButtonLeave %W + } + + bind Radiobutton <1> { + tk::CheckRadioDown %W + } + bind Radiobutton { + tk::ButtonUp %W + } + bind Radiobutton { + tk::CheckRadioEnter %W + } +} +if {"x11" eq [tk windowingsystem]} { + bind Checkbutton { + if {!$tk_strictMotif} { + tk::CheckInvoke %W + } + } + bind Radiobutton { + if {!$tk_strictMotif} { + tk::CheckRadioInvoke %W + } + } + bind Checkbutton <1> { + tk::CheckInvoke %W + } + bind Radiobutton <1> { + tk::CheckRadioInvoke %W + } + bind Checkbutton { + tk::CheckEnter %W + } + bind Radiobutton { + tk::ButtonEnter %W + } + bind Checkbutton { + tk::CheckLeave %W + } +} + +bind Button { + tk::ButtonInvoke %W +} +bind Checkbutton { + tk::CheckRadioInvoke %W +} +bind Radiobutton { + tk::CheckRadioInvoke %W +} +bind Button <> { + tk::ButtonInvoke %W +} +bind Checkbutton <> { + tk::CheckRadioInvoke %W +} +bind Radiobutton <> { + tk::CheckRadioInvoke %W +} + +bind Button {} +bind Button { + tk::ButtonEnter %W +} +bind Button { + tk::ButtonLeave %W +} +bind Button <1> { + tk::ButtonDown %W +} +bind Button { + tk::ButtonUp %W +} + +bind Checkbutton {} + +bind Radiobutton {} +bind Radiobutton { + 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: diff --git a/windowsAgent/dist/tk/choosedir.tcl b/windowsAgent/dist/tk/choosedir.tcl new file mode 100644 index 0000000..68dd9b0 --- /dev/null +++ b/windowsAgent/dist/tk/choosedir.tcl @@ -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 +} diff --git a/windowsAgent/dist/tk/clrpick.tcl b/windowsAgent/dist/tk/clrpick.tcl new file mode 100644 index 0000000..600be16 --- /dev/null +++ b/windowsAgent/dist/tk/clrpick.tcl @@ -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 <> [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) \ + [list tk::dialog::color::DrawColorScale $w $color 1] + bind $data($color,col) \ + [list tk::dialog::color::EnterColorBar $w $color] + bind $data($color,col) \ + [list tk::dialog::color::LeaveColorBar $w $color] + + bind $data($color,sel) \ + [list tk::dialog::color::EnterColorBar $w $color] + bind $data($color,sel) \ + [list tk::dialog::color::LeaveColorBar $w $color] + + bind $box.entry [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 [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 <> [list focus $ent] + bind $w [list tk::ButtonInvoke $data(cancelBtn)] + bind $w [list tk::AltKeyInDialog $w %A] + + wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w] + bind $lab [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) \ + [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1] + $sel bind $data($c,index) \ + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] + $sel bind $data($c,index) \ + [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 \ + [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] + bind $col \ + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)] + bind $col \ + [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)] + + $sel bind $data($c,clickRegion) \ + [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)] + $sel bind $data($c,clickRegion) \ + [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] + $sel bind $data($c,clickRegion) \ + [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) "" +} diff --git a/windowsAgent/dist/tk/comdlg.tcl b/windowsAgent/dist/tk/comdlg.tcl new file mode 100644 index 0000000..18df8a6 --- /dev/null +++ b/windowsAgent/dist/tk/comdlg.tcl @@ -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 [list tk::FocusGroup_In $t %W %d] + bind $t [list tk::FocusGroup_Out $t %W %d] + bind $t [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 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 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 +} diff --git a/windowsAgent/dist/tk/console.tcl b/windowsAgent/dist/tk/console.tcl new file mode 100644 index 0000000..355a43b --- /dev/null +++ b/windowsAgent/dist/tk/console.tcl @@ -0,0 +1,1150 @@ +# console.tcl -- +# +# This code constructs the console window for an application. It +# can be used by non-unix systems that do not have built-in support +# for shells. +# +# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-2000 Ajuba Solutions. +# Copyright (c) 2007-2008 Daniel A. Steffen +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +# TODO: history - remember partially written command + +namespace eval ::tk::console { + variable blinkTime 500 ; # msecs to blink braced range for + variable blinkRange 1 ; # enable blinking of the entire braced range + variable magicKeys 1 ; # enable brace matching and proc/var recognition + variable maxLines 600 ; # maximum # of lines buffered in console + variable showMatches 1 ; # show multiple expand matches + variable useFontchooser [llength [info command ::tk::fontchooser]] + variable inPlugin [info exists embed_args] + variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used + + if {$inPlugin} { + set defaultPrompt {subst {[history nextid] % }} + } else { + set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }} + } +} + +# simple compat function for tkcon code added for this console +interp alias {} EvalAttached {} consoleinterp eval + +# ::tk::ConsoleInit -- +# This procedure constructs and configures the console windows. +# +# Arguments: +# None. + +proc ::tk::ConsoleInit {} { + if {![consoleinterp eval {set tcl_interactive}]} { + wm withdraw . + } + + if {[tk windowingsystem] eq "aqua"} { + set mod "Cmd" + } else { + set mod "Ctrl" + } + + if {[catch {menu .menubar} err]} { + bgerror "INIT: $err" + } + AmpMenuArgs .menubar add cascade -label [mc &File] -menu .menubar.file + AmpMenuArgs .menubar add cascade -label [mc &Edit] -menu .menubar.edit + + menu .menubar.file -tearoff 0 + AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \ + -command {tk::ConsoleSource} + AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \ + -command {wm withdraw .} + AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \ + -command {.console delete 1.0 "promptEnd linestart"} + if {[tk windowingsystem] ne "aqua"} { + AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit} + } + + menu .menubar.edit -tearoff 0 + AmpMenuArgs .menubar.edit add command -label [mc Cu&t] -accel "$mod+X"\ + -command {event generate .console <>} + AmpMenuArgs .menubar.edit add command -label [mc &Copy] -accel "$mod+C"\ + -command {event generate .console <>} + AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ + -command {event generate .console <>} + + if {[tk windowingsystem] ne "win32"} { + AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ + -command {event generate .console <>} + } else { + AmpMenuArgs .menubar.edit add command -label [mc &Delete] \ + -command {event generate .console <>} -accel "Del" + + AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help + menu .menubar.help -tearoff 0 + AmpMenuArgs .menubar.help add command -label [mc &About...] \ + -command tk::ConsoleAbout + } + + AmpMenuArgs .menubar.edit add separator + if {$::tk::console::useFontchooser} { + if {[tk windowingsystem] eq "aqua"} { + .menubar.edit add command -label tk_choose_font_marker + set index [.menubar.edit index tk_choose_font_marker] + .menubar.edit entryconfigure $index \ + -label [mc "Show Fonts"]\ + -accelerator "$mod-T"\ + -command [list ::tk::console::FontchooserToggle] + bind Console <> \ + [list ::tk::console::FontchooserVisibility $index] + ::tk::console::FontchooserVisibility $index + } else { + AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \ + -command [list ::tk::console::FontchooserToggle] + } + bind Console [list ::tk::console::FontchooserFocus %W 1] + bind Console [list ::tk::console::FontchooserFocus %W 0] + } + AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \ + -accel "$mod++" -command {event generate .console <>} + AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \ + -accel "$mod+-" -command {event generate .console <>} + AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \ + -command {event generate .console <>} + + if {[tk windowingsystem] eq "aqua"} { + .menubar add cascade -label [mc Window] -menu [menu .menubar.window] + .menubar add cascade -label [mc Help] -menu [menu .menubar.help] + } + + . configure -menu .menubar + + # See if we can find a better font than the TkFixedFont + catch {font create TkConsoleFont {*}[font configure TkFixedFont]} + set families [font families] + switch -exact -- [tk windowingsystem] { + aqua { set preferred {Monaco 10} } + win32 { set preferred {ProFontWindows 8 Consolas 8} } + default { set preferred {} } + } + foreach {family size} $preferred { + if {[lsearch -exact $families $family] != -1} { + font configure TkConsoleFont -family $family -size $size + break + } + } + + # Provide the right border for the text widget (platform dependent). + ::ttk::style layout ConsoleFrame { + Entry.field -sticky news -border 1 -children { + ConsoleFrame.padding -sticky news + } + } + ::ttk::frame .consoleframe -style ConsoleFrame + + set con [text .console -yscrollcommand [list .sb set] -setgrid true \ + -borderwidth 0 -highlightthickness 0 -font TkConsoleFont] + if {[tk windowingsystem] eq "aqua"} { + scrollbar .sb -command [list $con yview] + } else { + ::ttk::scrollbar .sb -command [list $con yview] + } + pack .sb -in .consoleframe -fill both -side right -padx 1 -pady 1 + pack $con -in .consoleframe -fill both -expand 1 -side left -padx 1 -pady 1 + pack .consoleframe -fill both -expand 1 -side left + + ConsoleBind $con + + $con tag configure stderr -foreground red + $con tag configure stdin -foreground blue + $con tag configure prompt -foreground \#8F4433 + $con tag configure proc -foreground \#008800 + $con tag configure var -background \#FFC0D0 + $con tag raise sel + $con tag configure blink -background \#FFFF00 + $con tag configure find -background \#FFFF00 + + focus $con + + # Avoid listing this console in [winfo interps] + if {[info command ::send] eq "::send"} {rename ::send {}} + + wm protocol . WM_DELETE_WINDOW { wm withdraw . } + wm title . [mc "Console"] + flush stdout + $con mark set output [$con index "end - 1 char"] + tk::TextSetCursor $con end + $con mark set promptEnd insert + $con mark gravity promptEnd left + + # A variant of ConsolePrompt to avoid a 'puts' call + set w $con + set temp [$w index "end - 1 char"] + $w mark set output end + if {![consoleinterp eval "info exists tcl_prompt1"]} { + set string [EvalAttached $::tk::console::defaultPrompt] + $w insert output $string stdout + } + $w mark set output $temp + ::tk::TextSetCursor $w end + $w mark set promptEnd insert + $w mark gravity promptEnd left + + if {[tk windowingsystem] ne "aqua"} { + # Subtle work-around to erase the '% ' that tclMain.c prints out + after idle [subst -nocommand { + if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output } + }] + } +} + +# ::tk::ConsoleSource -- +# +# Prompts the user for a file to source in the main interpreter. +# +# Arguments: +# None. + +proc ::tk::ConsoleSource {} { + set filename [tk_getOpenFile -defaultextension .tcl -parent . \ + -title [mc "Select a file to source"] \ + -filetypes [list \ + [list [mc "Tcl Scripts"] .tcl] \ + [list [mc "All Files"] *]]] + if {$filename ne ""} { + set cmd [list source $filename] + if {[catch {consoleinterp eval $cmd} result]} { + ConsoleOutput stderr "$result\n" + } + } +} + +# ::tk::ConsoleInvoke -- +# Processes the command line input. If the command is complete it +# is evaled in the main interpreter. Otherwise, the continuation +# prompt is added and more input may be added. +# +# Arguments: +# None. + +proc ::tk::ConsoleInvoke {args} { + set ranges [.console tag ranges input] + set cmd "" + if {[llength $ranges]} { + set pos 0 + while {[lindex $ranges $pos] ne ""} { + set start [lindex $ranges $pos] + set end [lindex $ranges [incr pos]] + append cmd [.console get $start $end] + incr pos + } + } + if {$cmd eq ""} { + ConsolePrompt + } elseif {[info complete $cmd]} { + .console mark set output end + .console tag delete input + set result [consoleinterp record $cmd] + if {$result ne ""} { + puts $result + } + ConsoleHistory reset + ConsolePrompt + } else { + ConsolePrompt partial + } + .console yview -pickplace insert +} + +# ::tk::ConsoleHistory -- +# This procedure implements command line history for the +# console. In general is evals the history command in the +# main interpreter to obtain the history. The variable +# ::tk::HistNum is used to store the current location in the history. +# +# Arguments: +# cmd - Which action to take: prev, next, reset. + +set ::tk::HistNum 1 +proc ::tk::ConsoleHistory {cmd} { + variable HistNum + + switch $cmd { + prev { + incr HistNum -1 + if {$HistNum == 0} { + set cmd {history event [expr {[history nextid] -1}]} + } else { + set cmd "history event $HistNum" + } + if {[catch {consoleinterp eval $cmd} cmd]} { + incr HistNum + return + } + .console delete promptEnd end + .console insert promptEnd $cmd {input stdin} + .console see end + } + next { + incr HistNum + if {$HistNum == 0} { + set cmd {history event [expr {[history nextid] -1}]} + } elseif {$HistNum > 0} { + set cmd "" + set HistNum 1 + } else { + set cmd "history event $HistNum" + } + if {$cmd ne ""} { + catch {consoleinterp eval $cmd} cmd + } + .console delete promptEnd end + .console insert promptEnd $cmd {input stdin} + .console see end + } + reset { + set HistNum 1 + } + } +} + +# ::tk::ConsolePrompt -- +# This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2 +# exists in the main interpreter it will be called to generate the +# prompt. Otherwise, a hard coded default prompt is printed. +# +# Arguments: +# partial - Flag to specify which prompt to print. + +proc ::tk::ConsolePrompt {{partial normal}} { + set w .console + if {$partial eq "normal"} { + set temp [$w index "end - 1 char"] + $w mark set output end + if {[consoleinterp eval "info exists tcl_prompt1"]} { + consoleinterp eval "eval \[set tcl_prompt1\]" + } else { + puts -nonewline [EvalAttached $::tk::console::defaultPrompt] + } + } else { + set temp [$w index output] + $w mark set output end + if {[consoleinterp eval "info exists tcl_prompt2"]} { + consoleinterp eval "eval \[set tcl_prompt2\]" + } else { + puts -nonewline "> " + } + } + flush stdout + $w mark set output $temp + ::tk::TextSetCursor $w end + $w mark set promptEnd insert + $w mark gravity promptEnd left + ::tk::console::ConstrainBuffer $w $::tk::console::maxLines + $w see end +} + +# Copy selected text from the console +proc ::tk::console::Copy {w} { + if {![catch {set data [$w get sel.first sel.last]}]} { + clipboard clear -displayof $w + clipboard append -displayof $w $data + } +} +# Copies selected text. If the selection is within the current active edit +# region then it will be cut, if not it is only copied. +proc ::tk::console::Cut {w} { + if {![catch {set data [$w get sel.first sel.last]}]} { + clipboard clear -displayof $w + clipboard append -displayof $w $data + if {[$w compare sel.first >= output]} { + $w delete sel.first sel.last + } + } +} +# Paste text from the clipboard +proc ::tk::console::Paste {w} { + catch { + set clip [::tk::GetSelection $w CLIPBOARD] + set list [split $clip \n\r] + tk::ConsoleInsert $w [lindex $list 0] + foreach x [lrange $list 1 end] { + $w mark set insert {end - 1c} + tk::ConsoleInsert $w "\n" + tk::ConsoleInvoke + tk::ConsoleInsert $w $x + } + } +} + +# Fit TkConsoleFont to window width +proc ::tk::console::FitScreenWidth {w} { + set width [winfo screenwidth $w] + set cwidth [$w cget -width] + set s -50 + set fit 0 + array set fi [font configure TkConsoleFont] + while {$s < 0} { + set fi(-size) $s + set f [font create {*}[array get fi]] + set c [font measure $f "eM"] + font delete $f + if {$c * $cwidth < 1.667 * $width} { + font configure TkConsoleFont -size $s + break + } + incr s 2 + } +} + +# ::tk::ConsoleBind -- +# This procedure first ensures that the default bindings for the Text +# class have been defined. Then certain bindings are overridden for +# the class. +# +# Arguments: +# None. + +proc ::tk::ConsoleBind {w} { + bindtags $w [list $w Console PostConsole [winfo toplevel $w] all] + + ## Get all Text bindings into Console + foreach ev [bind Text] { + bind Console $ev [bind Text $ev] + } + ## We really didn't want the newline insertion... + bind Console {} + ## ...or any Control-v binding (would block <>) + bind Console {} + + # For the moment, transpose isn't enabled until the console + # gets and overhaul of how it handles input -- hobbs + bind Console {} + + # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. + # Otherwise, if a widget binding for one of these is defined, the + # class binding will also fire and insert the character + # which is wrong. + + bind Console {# nothing } + bind Console {# nothing} + bind Console {# nothing} + + foreach {ev key} { + <> + <> + <> + <> + + <> + <> + <> + <> + <> + <> + <> + <> + <> + + <> + <> + <> + <> + <> + <> + <> + } { + event add $ev $key + bind Console $key {} + } + if {[tk windowingsystem] eq "aqua"} { + foreach {ev key} { + <> + <> + } { + event add $ev $key + bind Console $key {} + } + if {$::tk::console::useFontchooser} { + bind Console [list ::tk::console::FontchooserToggle] + } + } + bind Console <> { + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W + } + } + bind Console <> { + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W path + } + } + bind Console <> { + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W proc + } + } + bind Console <> { + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W var + } + } + bind Console <> { + %W mark set insert {end - 1c} + tk::ConsoleInsert %W "\n" + tk::ConsoleInvoke + break + } + bind Console { + if {{} ne [%W tag nextrange sel 1.0 end] \ + && [%W compare sel.first >= promptEnd]} { + %W delete sel.first sel.last + } elseif {[%W compare insert >= promptEnd]} { + %W delete insert + %W see insert + } + } + bind Console { + if {{} ne [%W tag nextrange sel 1.0 end] \ + && [%W compare sel.first >= promptEnd]} { + %W delete sel.first sel.last + } elseif {[%W compare insert != 1.0] && \ + [%W compare insert > promptEnd]} { + %W delete insert-1c + %W see insert + } + } + bind Console [bind Console ] + + bind Console <> { + if {[%W compare insert < promptEnd]} { + tk::TextSetCursor %W {insert linestart} + } else { + tk::TextSetCursor %W promptEnd + } + } + bind Console <> { + tk::TextSetCursor %W {insert lineend} + } + bind Console { + if {[%W compare insert < promptEnd]} { + break + } + %W delete insert + } + bind Console <> { + if {[%W compare insert < promptEnd]} { + break + } + if {[%W compare insert == {insert lineend}]} { + %W delete insert + } else { + %W delete insert {insert lineend} + } + } + bind Console <> { + ## Clear console display + %W delete 1.0 "promptEnd linestart" + } + bind Console <> { + ## Clear command line (Unix shell staple) + %W delete promptEnd end + } + bind Console { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} + } + } + bind Console { + if {[%W compare {insert -1c wordstart} >= promptEnd]} { + %W delete {insert -1c wordstart} insert + } + } + bind Console { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} + } + } + bind Console { + if {[%W compare {insert -1c wordstart} >= promptEnd]} { + %W delete {insert -1c wordstart} insert + } + } + bind Console { + if {[%W compare insert >= promptEnd]} { + %W delete insert {insert wordend} + } + } + bind Console <> { + tk::ConsoleHistory prev + } + bind Console <> { + tk::ConsoleHistory next + } + bind Console { + catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]} + } + bind Console { + tk::ConsoleInsert %W %A + } + bind Console { + eval destroy [winfo child .] + source [file join $tk_library console.tcl] + } + if {[tk windowingsystem] eq "aqua"} { + bind Console { + exit + } + } + bind Console <> { ::tk::console::Cut %W } + bind Console <> { ::tk::console::Copy %W } + bind Console <> { ::tk::console::Paste %W } + + bind Console <> { + set size [font configure TkConsoleFont -size] + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) + 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } + } + bind Console <> { + set size [font configure TkConsoleFont -size] + if {abs($size) < 2} { return } + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) - 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } + } + bind Console <> { + ::tk::console::FitScreenWidth %W + } + + ## + ## Bindings for doing special things based on certain keys + ## + bind PostConsole { + if {"\\" ne [%W get insert-2c]} { + ::tk::console::MatchPair %W \( \) promptEnd + } + } + bind PostConsole { + if {"\\" ne [%W get insert-2c]} { + ::tk::console::MatchPair %W \[ \] promptEnd + } + } + bind PostConsole { + if {"\\" ne [%W get insert-2c]} { + ::tk::console::MatchPair %W \{ \} promptEnd + } + } + bind PostConsole { + if {"\\" ne [%W get insert-2c]} { + ::tk::console::MatchQuote %W promptEnd + } + } + + bind PostConsole { + if {"%A" ne ""} { + ::tk::console::TagProc %W + } + } +} + +# ::tk::ConsoleInsert -- +# Insert a string into a text at the point of the insertion cursor. +# If there is a selection in the text, and it covers the point of the +# insertion cursor, then delete the selection before inserting. Insertion +# is restricted to the prompt area. +# +# Arguments: +# w - The text window in which to insert the string +# s - The string to insert (usually just a single character) + +proc ::tk::ConsoleInsert {w s} { + if {$s eq ""} { + return + } + catch { + if {[$w compare sel.first <= insert] \ + && [$w compare sel.last >= insert]} { + $w tag remove sel sel.first promptEnd + $w delete sel.first sel.last + } + } + if {[$w compare insert < promptEnd]} { + $w mark set insert end + } + $w insert insert $s {input stdin} + $w see insert +} + +# ::tk::ConsoleOutput -- +# +# This routine is called directly by ConsolePutsCmd to cause a string +# to be displayed in the console. +# +# Arguments: +# dest - The output tag to be used: either "stderr" or "stdout". +# string - The string to be displayed. + +proc ::tk::ConsoleOutput {dest string} { + set w .console + $w insert output $string $dest + ::tk::console::ConstrainBuffer $w $::tk::console::maxLines + $w see insert +} + +# ::tk::ConsoleExit -- +# +# This routine is called by ConsoleEventProc when the main window of +# the application is destroyed. Don't call exit - that probably already +# happened. Just delete our window. +# +# Arguments: +# None. + +proc ::tk::ConsoleExit {} { + destroy . +} + +# ::tk::ConsoleAbout -- +# +# This routine displays an About box to show Tcl/Tk version info. +# +# Arguments: +# None. + +proc ::tk::ConsoleAbout {} { + tk_messageBox -type ok -message "[mc {Tcl for Windows}] + +Tcl $::tcl_patchLevel +Tk $::tk_patchLevel" +} + +# ::tk::console::Fontchooser* -- +# Let the user select the console font (TIP 324). + +proc ::tk::console::FontchooserToggle {} { + if {[tk fontchooser configure -visible]} { + tk fontchooser hide + } else { + tk fontchooser show + } +} +proc ::tk::console::FontchooserVisibility {index} { + if {[tk fontchooser configure -visible]} { + .menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"] + } else { + .menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"] + } +} +proc ::tk::console::FontchooserFocus {w isFocusIn} { + if {$isFocusIn} { + tk fontchooser configure -parent $w -font TkConsoleFont \ + -command [namespace code [list FontchooserApply]] + } else { + tk fontchooser configure -parent $w -font {} -command {} + } +} +proc ::tk::console::FontchooserApply {font args} { + catch {font configure TkConsoleFont {*}[font actual $font]} +} + +# ::tk::console::TagProc -- +# +# Tags a procedure in the console if it's recognized +# This procedure is not perfect. However, making it perfect wastes +# too much CPU time... +# +# Arguments: +# w - console text widget + +proc ::tk::console::TagProc w { + if {!$::tk::console::magicKeys} { + return + } + set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]" + set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c] + if {$i eq ""} { + set i promptEnd + } else { + append i +2c + } + regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c + if {[llength [EvalAttached [list info commands $c]]]} { + $w tag add proc $i "insert-1c wordend" + } else { + $w tag remove proc $i "insert-1c wordend" + } + if {[llength [EvalAttached [list info vars $c]]]} { + $w tag add var $i "insert-1c wordend" + } else { + $w tag remove var $i "insert-1c wordend" + } +} + +# ::tk::console::MatchPair -- +# +# Blinks a matching pair of characters +# c2 is assumed to be at the text index 'insert'. +# This proc is really loopy and took me an hour to figure out given +# all possible combinations with escaping except for escaped \'s. +# It doesn't take into account possible commenting... Oh well. If +# anyone has something better, I'd like to see/use it. This is really +# only efficient for small contexts. +# +# Arguments: +# w - console text widget +# c1 - first char of pair +# c2 - second char of pair +# +# Calls: ::tk::console::Blink + +proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { + if {!$::tk::console::magicKeys} { + return + } + if {{} ne [set ix [$w search -back $c1 insert $lim]]} { + while { + [string match {\\} [$w get $ix-1c]] && + [set ix [$w search -back $c1 $ix-1c $lim]] ne {} + } {} + set i1 insert-1c + while {$ix ne {}} { + set i0 $ix + set j 0 + while {[set i0 [$w search $c2 $i0 $i1]] ne {}} { + append i0 +1c + if {[string match {\\} [$w get $i0-2c]]} { + continue + } + incr j + } + if {!$j} { + break + } + set i1 $ix + while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} { + if {[string match {\\} [$w get $ix-1c]]} { + continue + } + incr j -1 + } + } + if {[string match {} $ix]} { + set ix [$w index $lim] + } + } else { + set ix [$w index $lim] + } + if {$::tk::console::blinkRange} { + Blink $w $ix [$w index insert] + } else { + Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert] + } +} + +# ::tk::console::MatchQuote -- +# +# Blinks between matching quotes. +# Blinks just the quote if it's unmatched, otherwise blinks quoted string +# The quote to match is assumed to be at the text index 'insert'. +# +# Arguments: +# w - console text widget +# +# Calls: ::tk::console::Blink + +proc ::tk::console::MatchQuote {w {lim 1.0}} { + if {!$::tk::console::magicKeys} { + return + } + set i insert-1c + set j 0 + while {[set i [$w search -back \" $i $lim]] ne {}} { + if {[string match {\\} [$w get $i-1c]]} { + continue + } + if {!$j} { + set i0 $i + } + incr j + } + if {$j&1} { + if {$::tk::console::blinkRange} { + Blink $w $i0 [$w index insert] + } else { + Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert] + } + } else { + Blink $w [$w index insert-1c] [$w index insert] + } +} + +# ::tk::console::Blink -- +# +# Blinks between n index pairs for a specified duration. +# +# Arguments: +# w - console text widget +# i1 - start index to blink region +# i2 - end index of blink region +# dur - duration in usecs to blink for +# +# Outputs: +# blinks selected characters in $w + +proc ::tk::console::Blink {w args} { + eval [list $w tag add blink] $args + after $::tk::console::blinkTime [list $w] tag remove blink $args +} + +# ::tk::console::ConstrainBuffer -- +# +# This limits the amount of data in the text widget +# Called by Prompt and ConsoleOutput +# +# Arguments: +# w - console text widget +# size - # of lines to constrain to +# +# Outputs: +# may delete data in console widget + +proc ::tk::console::ConstrainBuffer {w size} { + if {[$w index end] > $size} { + $w delete 1.0 [expr {int([$w index end])-$size}].0 + } +} + +# ::tk::console::Expand -- +# +# Arguments: +# ARGS: w - text widget in which to expand str +# type - type of expansion (path / proc / variable) +# +# Calls: ::tk::console::Expand(Pathname|Procname|Variable) +# +# Outputs: The string to match is expanded to the longest possible match. +# If ::tk::console::showMatches is non-zero and the longest match +# equaled the string to expand, then all possible matches are +# output to stdout. Triggers bell if no matches are found. +# +# Returns: number of matches found + +proc ::tk::console::Expand {w {type ""}} { + set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]" + set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c] + if {$tmp eq ""} { + set tmp promptEnd + } else { + append tmp +2c + } + if {[$w compare $tmp >= insert]} { + return + } + set str [$w get $tmp insert] + switch -glob $type { + path* { + set res [ExpandPathname $str] + } + proc* { + set res [ExpandProcname $str] + } + var* { + set res [ExpandVariable $str] + } + default { + set res {} + foreach t {Pathname Procname Variable} { + if {![catch {Expand$t $str} res] && ($res ne "")} { + break + } + } + } + } + set len [llength $res] + if {$len} { + set repl [lindex $res 0] + $w delete $tmp insert + $w insert $tmp $repl {input stdin} + if {($len > 1) && ($::tk::console::showMatches) && ($repl eq $str)} { + puts stdout [lsort [lreplace $res 0 0]] + } + } else { + bell + } + return [incr len -1] +} + +# ::tk::console::ExpandPathname -- +# +# Expand a file pathname based on $str +# This is based on UNIX file name conventions +# +# Arguments: +# str - partial file pathname to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandPathname str { + set pwd [EvalAttached pwd] + if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { + return -options $opt $err + } + set dir [file tail $str] + ## Check to see if it was known to be a directory and keep the trailing + ## slash if so (file tail cuts it off) + if {[string match */ $str]} { + append dir / + } + if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} { + set match {} + } else { + if {[llength $m] > 1} { + if { $::tcl_platform(platform) eq "windows" } { + ## Windows is screwy because it's case insensitive + set tmp [ExpandBestMatch [string tolower $m] \ + [string tolower $dir]] + ## Don't change case if we haven't changed the word + if {[string length $dir]==[string length $tmp]} { + set tmp $dir + } + } else { + set tmp [ExpandBestMatch $m $dir] + } + if {[string match ?*/* $str]} { + set tmp [file dirname $str]/$tmp + } elseif {[string match /* $str]} { + set tmp /$tmp + } + regsub -all { } $tmp {\\ } tmp + set match [linsert $m 0 $tmp] + } else { + ## This may look goofy, but it handles spaces in path names + eval append match $m + if {[file isdir $match]} { + append match / + } + if {[string match ?*/* $str]} { + set match [file dirname $str]/$match + } elseif {[string match /* $str]} { + set match /$match + } + regsub -all { } $match {\\ } match + ## Why is this one needed and the ones below aren't!! + set match [list $match] + } + } + EvalAttached [list cd $pwd] + return $match +} + +# ::tk::console::ExpandProcname -- +# +# Expand a tcl proc name based on $str +# +# Arguments: +# str - partial proc name to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandProcname str { + set match [EvalAttached [list info commands $str*]] + if {[llength $match] == 0} { + set ns [EvalAttached \ + "namespace children \[namespace current\] [list $str*]"] + if {[llength $ns]==1} { + set match [EvalAttached [list info commands ${ns}::*]] + } else { + set match $ns + } + } + if {[llength $match] > 1} { + regsub -all { } [ExpandBestMatch $match $str] {\\ } str + set match [linsert $match 0 $str] + } else { + regsub -all { } $match {\\ } match + } + return $match +} + +# ::tk::console::ExpandVariable -- +# +# Expand a tcl variable name based on $str +# +# Arguments: +# str - partial tcl var name to expand +# +# Calls: ::tk::console::ExpandBestMatch +# +# Returns: list containing longest unique match followed by all the +# possible further matches + +proc ::tk::console::ExpandVariable str { + if {[regexp {([^\(]*)\((.*)} $str -> ary str]} { + ## Looks like they're trying to expand an array. + set match [EvalAttached [list array names $ary $str*]] + if {[llength $match] > 1} { + set vars $ary\([ExpandBestMatch $match $str] + foreach var $match { + lappend vars $ary\($var\) + } + return $vars + } elseif {[llength $match] == 1} { + set match $ary\($match\) + } + ## Space transformation avoided for array names. + } else { + set match [EvalAttached [list info vars $str*]] + if {[llength $match] > 1} { + regsub -all { } [ExpandBestMatch $match $str] {\\ } str + set match [linsert $match 0 $str] + } else { + regsub -all { } $match {\\ } match + } + } + return $match +} + +# ::tk::console::ExpandBestMatch -- +# +# Finds the best unique match in a list of names. +# The extra $e in this argument allows us to limit the innermost loop a little +# further. This improves speed as $l becomes large or $e becomes long. +# +# Arguments: +# l - list to find best unique match in +# e - currently best known unique match +# +# Returns: longest unique match in the list + +proc ::tk::console::ExpandBestMatch {l {e {}}} { + set ec [lindex $l 0] + if {[llength $l]>1} { + set e [expr {[string length $e] - 1}] + set ei [expr {[string length $ec] - 1}] + foreach l $l { + while {$ei>=$e && [string first $ec $l]} { + set ec [string range $ec 0 [incr ei -1]] + } + } + } + return $ec +} + +# now initialize the console +::tk::ConsoleInit diff --git a/windowsAgent/dist/tk/dialog.tcl b/windowsAgent/dist/tk/dialog.tcl new file mode 100644 index 0000000..c751621 --- /dev/null +++ b/windowsAgent/dist/tk/dialog.tcl @@ -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 on the dialog if there is a + # default button. + # Convention also dictates that if the keyboard focus moves among the + # the buttons that the binding affects the button with the focus. + + if {$default >= 0} { + bind $w [list $w.button$default invoke] + } + bind $w <> [list bind $w {[tk_focusPrev %W] invoke}] + bind $w <> [list bind $w {[tk_focusNext %W] invoke}] + + # 5. Create a 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 {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 {} + } + tk::RestoreFocusGrab $w $focus + return $Priv(button) +} diff --git a/windowsAgent/dist/tk/entry.tcl b/windowsAgent/dist/tk/entry.tcl new file mode 100644 index 0000000..6243d26 --- /dev/null +++ b/windowsAgent/dist/tk/entry.tcl @@ -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 <> { + 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 <> { + 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 <> { + 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 <> { + # ignore if there is no selection + catch { %W delete sel.first sel.last } +} +bind Entry <> { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { + tk::EntryPaste %W %x + } +} + +bind Entry <> { + %W selection range 0 end + %W icursor end +} + +# Standard Motif bindings: + +bind Entry <1> { + tk::EntryButton1 %W %x + %W selection clear +} +bind Entry { + set tk::Priv(x) %x + tk::EntryMouseSelect %W %x +} +bind Entry { + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x + catch {%W icursor sel.last} +} +bind Entry { + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x + catch {%W icursor sel.last} +} +bind Entry { + set tk::Priv(selectMode) char + %W selection adjust @%x +} +bind Entry { + set tk::Priv(selectMode) word + tk::EntryMouseSelect %W %x +} +bind Entry { + set tk::Priv(selectMode) line + tk::EntryMouseSelect %W %x +} +bind Entry { + set tk::Priv(x) %x + tk::EntryAutoScan %W +} +bind Entry { + tk::CancelRepeat +} +bind Entry { + tk::CancelRepeat +} +bind Entry { + %W icursor @%x +} + +bind Entry <> { + tk::EntrySetCursor %W [expr {[%W index insert] - 1}] +} +bind Entry <> { + tk::EntrySetCursor %W [expr {[%W index insert] + 1}] +} +bind Entry <> { + tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + tk::EntrySeeInsert %W +} +bind Entry <> { + tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + tk::EntrySeeInsert %W +} +bind Entry <> { + tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] +} +bind Entry <> { + tk::EntrySetCursor %W [tk::EntryNextWord %W insert] +} +bind Entry <> { + tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert] + tk::EntrySeeInsert %W +} +bind Entry <> { + tk::EntryKeySelect %W [tk::EntryNextWord %W insert] + tk::EntrySeeInsert %W +} +bind Entry <> { + tk::EntrySetCursor %W 0 +} +bind Entry <> { + tk::EntryKeySelect %W 0 + tk::EntrySeeInsert %W +} +bind Entry <> { + tk::EntrySetCursor %W end +} +bind Entry <> { + tk::EntryKeySelect %W end + tk::EntrySeeInsert %W +} + +bind Entry { + if {[%W selection present]} { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Entry { + tk::EntryBackspace %W +} + +bind Entry { + %W selection from insert +} +bind Entry { + tk::ListboxBeginSelect %W [%W index active] +} +bind Listbox { + tk::ListboxBeginExtend %W [%W index active] +} +bind Listbox { + tk::ListboxBeginExtend %W [%W index active] +} +bind Listbox { + tk::ListboxCancel %W +} +bind Listbox <> { + tk::ListboxSelectAll %W +} +bind Listbox <> { + 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 { + %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 { + %W yview scroll [expr {- (%D)}] units + } + bind Listbox { + %W yview scroll [expr {-10 * (%D)}] units + } + bind Listbox { + %W xview scroll [expr {- (%D)}] units + } + bind Listbox { + %W xview scroll [expr {-10 * (%D)}] units + } +} else { + bind Listbox { + %W yview scroll [expr {- (%D / 120) * 4}] units + } + bind Listbox { + %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 { + if {!$tk_strictMotif} { + %W xview scroll -5 units + } + } + bind Listbox <5> { + if {!$tk_strictMotif} { + %W yview scroll 5 units + } + } + bind Listbox { + 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 <> 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 <> + } +} diff --git a/windowsAgent/dist/tk/megawidget.tcl b/windowsAgent/dist/tk/megawidget.tcl new file mode 100644 index 0000000..aeb1263 --- /dev/null +++ b/windowsAgent/dist/tk/megawidget.tcl @@ -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 [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 $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: diff --git a/windowsAgent/dist/tk/menu.tcl b/windowsAgent/dist/tk/menu.tcl new file mode 100644 index 0000000..ba66b92 --- /dev/null +++ b/windowsAgent/dist/tk/menu.tcl @@ -0,0 +1,1356 @@ +# menu.tcl -- +# +# This file defines the default bindings for Tk menus and menubuttons. +# It also implements keyboard traversal of menus and implements a few +# other utility procedures related to menus. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2007 Daniel A. Steffen +# +# 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: +# +# cursor - Saves the -cursor option for the posted menubutton. +# focus - Saves the focus during a menu selection operation. +# Focus gets restored here when the menu is unposted. +# grabGlobal - Used in conjunction with tk::Priv(oldGrab): if +# tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal) +# contains either an empty string or "-global" to +# indicate whether the old grab was a local one or +# a global one. +# inMenubutton - The name of the menubutton widget containing +# the mouse, or an empty string if the mouse is +# not over any menubutton. +# menuBar - The name of the menubar that is the root +# of the cascade hierarchy which is currently +# posted. This is null when there is no menu currently +# being pulled down from a menu bar. +# oldGrab - Window that had the grab before a menu was posted. +# Used to restore the grab state after the menu +# is unposted. Empty string means there was no +# grab previously set. +# popup - If a menu has been popped up via tk_popup, this +# gives the name of the menu. Otherwise this +# value is empty. +# postedMb - Name of the menubutton whose menu is currently +# posted, or an empty string if nothing is posted +# A grab is set on this widget. +# relief - Used to save the original relief of the current +# menubutton. +# window - When the mouse is over a menu, this holds the +# name of the menu; it's cleared when the mouse +# leaves the menu. +# tearoff - Whether the last menu posted was a tearoff or not. +# This is true always for unix, for tearoffs for Mac +# and Windows. +# activeMenu - This is the last active menu for use +# with the <> virtual event. +# activeItem - This is the last active menu item for +# use with the <> virtual event. +#------------------------------------------------------------------------- + +#------------------------------------------------------------------------- +# Overall note: +# This file is tricky because there are five different ways that menus +# can be used: +# +# 1. As a pulldown from a menubutton. In this style, the variable +# tk::Priv(postedMb) identifies the posted menubutton. +# 2. As a torn-off menu copied from some other menu. In this style +# tk::Priv(postedMb) is empty, and menu's type is "tearoff". +# 3. As an option menu, triggered from an option menubutton. In this +# style tk::Priv(postedMb) identifies the posted menubutton. +# 4. As a popup menu. In this style tk::Priv(postedMb) is empty and +# the top-level menu's type is "normal". +# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has +# the owning menubar, and the menu itself is of type "normal". +# +# The various binding procedures use the state described above to +# distinguish the various cases and take different actions in each +# case. +#------------------------------------------------------------------------- + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for menus +# and menubuttons. +#------------------------------------------------------------------------- + +bind Menubutton {} +bind Menubutton { + tk::MbEnter %W +} +bind Menubutton { + tk::MbLeave %W +} +bind Menubutton <1> { + if {$tk::Priv(inMenubutton) ne ""} { + tk::MbPost $tk::Priv(inMenubutton) %X %Y + } +} +bind Menubutton { + tk::MbMotion %W up %X %Y +} +bind Menubutton { + tk::MbMotion %W down %X %Y +} +bind Menubutton { + tk::MbButtonUp %W +} +bind Menubutton { + tk::MbPost %W + tk::MenuFirstEntry [%W cget -menu] +} +bind Menubutton <> { + tk::MbPost %W + tk::MenuFirstEntry [%W cget -menu] +} + +# Must set focus when mouse enters a menu, in order to allow +# mixed-mode processing using both the mouse and the keyboard. +# Don't set the focus if the event comes from a grab release, +# though: such an event can happen after as part of unposting +# a cascaded chain of menus, after the focus has already been +# restored to wherever it was before menu selection started. + +bind Menu {} + +bind Menu { + set tk::Priv(window) %W + if {[%W cget -type] eq "tearoff"} { + if {"%m" ne "NotifyUngrab"} { + if {[tk windowingsystem] eq "x11"} { + tk_menuSetFocus %W + } + } + } + tk::MenuMotion %W %x %y %s +} + +bind Menu { + tk::MenuLeave %W %X %Y %s +} +bind Menu { + tk::MenuMotion %W %x %y %s +} +bind Menu { + tk::MenuButtonDown %W +} +bind Menu { + tk::MenuInvoke %W 1 +} +bind Menu { + tk::MenuInvoke %W 0 +} +bind Menu <> { + tk::MenuInvoke %W 0 +} +bind Menu { + tk::MenuInvoke %W 0 +} +bind Menu { + tk::MenuEscape %W +} +bind Menu <> { + tk::MenuLeftArrow %W +} +bind Menu <> { + tk::MenuRightArrow %W +} +bind Menu <> { + tk::MenuUpArrow %W +} +bind Menu <> { + tk::MenuDownArrow %W +} +bind Menu { + tk::TraverseWithinMenu %W %A + break +} + +# The following bindings apply to all windows, and are used to +# implement keyboard menu traversal. + +if {[tk windowingsystem] eq "x11"} { + bind all { + tk::TraverseToMenu %W %A + } + + bind all { + tk::FirstMenu %W + } +} else { + bind Menubutton { + tk::TraverseToMenu %W %A + } + + bind Menubutton { + tk::FirstMenu %W + } +} + +# ::tk::MbEnter -- +# This procedure is invoked when the mouse enters a menubutton +# widget. It activates the widget unless it is disabled. Note: +# this procedure is only invoked when mouse button 1 is *not* down. +# The procedure ::tk::MbB1Enter is invoked if the button is down. +# +# Arguments: +# w - The name of the widget. + +proc ::tk::MbEnter w { + variable ::tk::Priv + + if {$Priv(inMenubutton) ne ""} { + MbLeave $Priv(inMenubutton) + } + set Priv(inMenubutton) $w + if {[$w cget -state] ne "disabled" && [tk windowingsystem] ne "aqua"} { + $w configure -state active + } +} + +# ::tk::MbLeave -- +# This procedure is invoked when the mouse leaves a menubutton widget. +# It de-activates the widget, if the widget still exists. +# +# Arguments: +# w - The name of the widget. + +proc ::tk::MbLeave w { + variable ::tk::Priv + + set Priv(inMenubutton) {} + if {![winfo exists $w]} { + return + } + if {[$w cget -state] eq "active" && [tk windowingsystem] ne "aqua"} { + $w configure -state normal + } +} + +# ::tk::MbPost -- +# Given a menubutton, this procedure does all the work of posting +# its associated menu and unposting any other menu that is currently +# posted. +# +# Arguments: +# w - The name of the menubutton widget whose menu +# is to be posted. +# x, y - Root coordinates of cursor, used for positioning +# option menus. If not specified, then the center +# of the menubutton is used for an option menu. + +proc ::tk::MbPost {w {x {}} {y {}}} { + global errorInfo + variable ::tk::Priv + + if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { + return + } + set menu [$w cget -menu] + if {$menu eq ""} { + return + } + set tearoff [expr {[tk windowingsystem] eq "x11" \ + || [$menu cget -type] eq "tearoff"}] + if {[string first $w $menu] != 0} { + return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \ + "can't post $menu: it isn't a descendant of $w" + } + set cur $Priv(postedMb) + if {$cur ne ""} { + MenuUnpost {} + } + if {$::tk_strictMotif} { + set Priv(cursor) [$w cget -cursor] + $w configure -cursor arrow + } + if {[tk windowingsystem] ne "aqua"} { + set Priv(relief) [$w cget -relief] + $w configure -relief raised + } else { + $w configure -state active + } + + set Priv(postedMb) $w + set Priv(focus) [focus] + $menu activate none + GenerateMenuSelect $menu + + # If this looks like an option menubutton then post the menu so + # that the current entry is on top of the mouse. Otherwise post + # the menu just below the menubutton, as for a pull-down. + + update idletasks + if {[catch { + switch [$w cget -direction] { + above { + set x [winfo rootx $w] + set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}] + # if we go offscreen to the top, show as 'below' + if {$y < [winfo vrooty $w]} { + set y [expr {[winfo vrooty $w] + [winfo rooty $w] + [winfo reqheight $w]}] + } + PostOverPoint $menu $x $y + } + below { + set x [winfo rootx $w] + set y [expr {[winfo rooty $w] + [winfo height $w]}] + # if we go offscreen to the bottom, show as 'above' + set mh [winfo reqheight $menu] + if {($y + $mh) > ([winfo vrooty $w] + [winfo vrootheight $w])} { + set y [expr {[winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w] - $mh}] + } + PostOverPoint $menu $x $y + } + left { + set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] + set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] + set entry [MenuFindName $menu [$w cget -text]] + if {$entry eq ""} { + set entry 0 + } + if {[$w cget -indicatoron]} { + if {$entry == [$menu index last]} { + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] + } else { + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] + } + } + PostOverPoint $menu $x $y + if {$entry ne "" \ + && [$menu entrycget $entry -state] ne "disabled"} { + $menu activate $entry + GenerateMenuSelect $menu + } + } + right { + set x [expr {[winfo rootx $w] + [winfo width $w]}] + set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] + set entry [MenuFindName $menu [$w cget -text]] + if {$entry eq ""} { + set entry 0 + } + if {[$w cget -indicatoron]} { + if {$entry == [$menu index last]} { + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] + } else { + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] + } + } + PostOverPoint $menu $x $y + if {$entry ne "" \ + && [$menu entrycget $entry -state] ne "disabled"} { + $menu activate $entry + GenerateMenuSelect $menu + } + } + default { + if {[$w cget -indicatoron]} { + if {$y eq ""} { + set x [expr {[winfo rootx $w] + [winfo width $w]/2}] + set y [expr {[winfo rooty $w] + [winfo height $w]/2}] + } + PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]] + } else { + PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] + } + } + } + } msg opt]} { + # Error posting menu (e.g. bogus -postcommand). Unpost it and + # reflect the error. + + MenuUnpost {} + return -options $opt $msg + } + + set Priv(tearoff) $tearoff + if {$tearoff != 0} { + focus $menu + if {[winfo viewable $w]} { + SaveGrabInfo $w + grab -global $w + } + } +} + +# ::tk::MenuUnpost -- +# This procedure unposts a given menu, plus all of its ancestors up +# to (and including) a menubutton, if any. It also restores various +# values to what they were before the menu was posted, and releases +# a grab if there's a menubutton involved. Special notes: +# 1. It's important to unpost all menus before releasing the grab, so +# that any Enter-Leave events (e.g. from menu back to main +# application) have mode NotifyGrab. +# 2. Be sure to enclose various groups of commands in "catch" so that +# the procedure will complete even if the menubutton or the menu +# or the grab window has been deleted. +# +# Arguments: +# menu - Name of a menu to unpost. Ignored if there +# is a posted menubutton. + +proc ::tk::MenuUnpost menu { + variable ::tk::Priv + set mb $Priv(postedMb) + + # Restore focus right away (otherwise X will take focus away when + # the menu is unmapped and under some window managers (e.g. olvwm) + # we'll lose the focus completely). + + catch {focus $Priv(focus)} + set Priv(focus) "" + + # Unpost menu(s) and restore some stuff that's dependent on + # what was posted. + + after cancel [array get Priv menuActivatedTimer] + unset -nocomplain Priv(menuActivated) + after cancel [array get Priv menuDeactivatedTimer] + unset -nocomplain Priv(menuDeactivated) + + catch { + if {$mb ne ""} { + set menu [$mb cget -menu] + $menu unpost + set Priv(postedMb) {} + if {$::tk_strictMotif} { + $mb configure -cursor $Priv(cursor) + } + if {[tk windowingsystem] ne "aqua"} { + $mb configure -relief $Priv(relief) + } else { + $mb configure -state normal + } + } elseif {$Priv(popup) ne ""} { + $Priv(popup) unpost + set Priv(popup) {} + } elseif {[$menu cget -type] ne "menubar" && [$menu cget -type] ne "tearoff"} { + # We're in a cascaded sub-menu from a torn-off menu or popup. + # Unpost all the menus up to the toplevel one (but not + # including the top-level torn-off one) and deactivate the + # top-level torn off menu if there is one. + + while {1} { + set parent [winfo parent $menu] + if {[winfo class $parent] ne "Menu" || ![winfo ismapped $parent]} { + break + } + $parent activate none + $parent postcascade none + GenerateMenuSelect $parent + set type [$parent cget -type] + if {$type eq "menubar" || $type eq "tearoff"} { + break + } + set menu $parent + } + if {[$menu cget -type] ne "menubar"} { + $menu unpost + } + } + } + + if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} { + # Release grab, if any, and restore the previous grab, if there + # was one. + if {$menu ne ""} { + set grab [grab current $menu] + if {$grab ne ""} { + grab release $grab + } + } + RestoreOldGrab + if {$Priv(menuBar) ne ""} { + if {$::tk_strictMotif} { + $Priv(menuBar) configure -cursor $Priv(cursor) + } + set Priv(menuBar) {} + } + if {[tk windowingsystem] ne "x11"} { + set Priv(tearoff) 0 + } + } +} + +# ::tk::MbMotion -- +# This procedure handles mouse motion events inside menubuttons, and +# also outside menubuttons when a menubutton has a grab (e.g. when a +# menu selection operation is in progress). +# +# Arguments: +# w - The name of the menubutton widget. +# upDown - "down" means button 1 is pressed, "up" means +# it isn't. +# rootx, rooty - Coordinates of mouse, in (virtual?) root window. + +proc ::tk::MbMotion {w upDown rootx rooty} { + variable ::tk::Priv + + if {$Priv(inMenubutton) eq $w} { + return + } + set new [winfo containing $rootx $rooty] + if {$new ne $Priv(inMenubutton) \ + && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} { + if {$Priv(inMenubutton) ne ""} { + MbLeave $Priv(inMenubutton) + } + if {$new ne "" \ + && [winfo class $new] eq "Menubutton" \ + && ([$new cget -indicatoron] == 0) \ + && ([$w cget -indicatoron] == 0)} { + if {$upDown eq "down"} { + MbPost $new $rootx $rooty + } else { + MbEnter $new + } + } + } +} + +# ::tk::MbButtonUp -- +# This procedure is invoked to handle button 1 releases for menubuttons. +# If the release happens inside the menubutton then leave its menu +# posted with element 0 activated. Otherwise, unpost the menu. +# +# Arguments: +# w - The name of the menubutton widget. + +proc ::tk::MbButtonUp w { + variable ::tk::Priv + + set menu [$w cget -menu] + set tearoff [expr {[tk windowingsystem] eq "x11" || \ + ($menu ne "" && [$menu cget -type] eq "tearoff")}] + if {($tearoff != 0) && $Priv(postedMb) eq $w \ + && $Priv(inMenubutton) eq $w} { + MenuFirstEntry [$Priv(postedMb) cget -menu] + } else { + MenuUnpost {} + } +} + +# ::tk::MenuMotion -- +# This procedure is called to handle mouse motion events for menus. +# It does two things. First, it resets the active element in the +# menu, if the mouse is over the menu. Second, if a mouse button +# is down, it posts and unposts cascade entries to match the mouse +# position. +# +# Arguments: +# menu - The menu window. +# x - The x position of the mouse. +# y - The y position of the mouse. +# state - Modifier state (tells whether buttons are down). + +proc ::tk::MenuMotion {menu x y state} { + variable ::tk::Priv + if {$menu eq $Priv(window)} { + set activeindex [$menu index active] + if {[$menu cget -type] eq "menubar"} { + if {[info exists Priv(focus)] && $menu ne $Priv(focus)} { + $menu activate @$x,$y + GenerateMenuSelect $menu + } + } else { + $menu activate @$x,$y + GenerateMenuSelect $menu + } + set index [$menu index @$x,$y] + if {[info exists Priv(menuActivated)] \ + && $index ne "none" \ + && $index ne $activeindex} { + set mode [option get $menu clickToFocus ClickToFocus] + if {[string is false $mode]} { + set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}] + if {[$menu type $index] eq "cascade"} { + set Priv(menuActivatedTimer) \ + [after $delay [list $menu postcascade active]] + } else { + set Priv(menuDeactivatedTimer) \ + [after $delay [list $menu postcascade none]] + } + } + } + } +} + +# ::tk::MenuButtonDown -- +# Handles button presses in menus. There are a couple of tricky things +# here: +# 1. Change the posted cascade entry (if any) to match the mouse position. +# 2. If there is a posted menubutton, must grab to the menubutton; this +# overrrides the implicit grab on button press, so that the menu +# button can track mouse motions over other menubuttons and change +# the posted menu. +# 3. If there's no posted menubutton (e.g. because we're a torn-off menu +# or one of its descendants) must grab to the top-level menu so that +# we can track mouse motions across the entire menu hierarchy. +# +# Arguments: +# menu - The menu window. + +proc ::tk::MenuButtonDown menu { + variable ::tk::Priv + + if {![winfo viewable $menu]} { + return + } + if {[$menu index active] eq "none"} { + if {[$menu cget -type] ne "menubar" } { + set Priv(window) {} + } + return + } + $menu postcascade active + if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} { + grab -global $Priv(postedMb) + } else { + while {[$menu cget -type] eq "normal" \ + && [winfo class [winfo parent $menu]] eq "Menu" \ + && [winfo ismapped [winfo parent $menu]]} { + set menu [winfo parent $menu] + } + + if {$Priv(menuBar) eq {}} { + set Priv(menuBar) $menu + if {$::tk_strictMotif} { + set Priv(cursor) [$menu cget -cursor] + $menu configure -cursor arrow + } + if {[$menu type active] eq "cascade"} { + set Priv(menuActivated) 1 + } + } + + # Don't update grab information if the grab window isn't changing. + # Otherwise, we'll get an error when we unpost the menus and + # restore the grab, since the old grab window will not be viewable + # anymore. + + if {$menu ne [grab current $menu]} { + SaveGrabInfo $menu + } + + # Must re-grab even if the grab window hasn't changed, in order + # to release the implicit grab from the button press. + + if {[tk windowingsystem] eq "x11"} { + grab -global $menu + } + } +} + +# ::tk::MenuLeave -- +# This procedure is invoked to handle Leave events for a menu. It +# deactivates everything unless the active element is a cascade element +# and the mouse is now over the submenu. +# +# Arguments: +# menu - The menu window. +# rootx, rooty - Root coordinates of mouse. +# state - Modifier state. + +proc ::tk::MenuLeave {menu rootx rooty state} { + variable ::tk::Priv + set Priv(window) {} + if {[$menu index active] eq "none"} { + return + } + if {[$menu type active] eq "cascade" \ + && [winfo containing $rootx $rooty] eq \ + [$menu entrycget active -menu]} { + return + } + $menu activate none + GenerateMenuSelect $menu +} + +# ::tk::MenuInvoke -- +# This procedure is invoked when button 1 is released over a menu. +# It invokes the appropriate menu action and unposts the menu if +# it came from a menubutton. +# +# Arguments: +# w - Name of the menu widget. +# buttonRelease - 1 means this procedure is called because of +# a button release; 0 means because of keystroke. + +proc ::tk::MenuInvoke {w buttonRelease} { + variable ::tk::Priv + + if {$buttonRelease && $Priv(window) eq ""} { + # Mouse was pressed over a menu without a menu button, then + # dragged off the menu (possibly with a cascade posted) and + # released. Unpost everything and quit. + + $w postcascade none + $w activate none + event generate $w <> + MenuUnpost $w + return + } + if {[$w type active] eq "cascade"} { + $w postcascade active + set menu [$w entrycget active -menu] + MenuFirstEntry $menu + } elseif {[$w type active] eq "tearoff"} { + ::tk::TearOffMenu $w + MenuUnpost $w + } elseif {[$w cget -type] eq "menubar"} { + $w postcascade none + set active [$w index active] + set isCascade [string equal [$w type $active] "cascade"] + + # Only de-activate the active item if it's a cascade; this prevents + # the annoying "activation flicker" you otherwise get with + # checkbuttons/commands/etc. on menubars + + if { $isCascade } { + $w activate none + event generate $w <> + } + + MenuUnpost $w + + # If the active item is not a cascade, invoke it. This enables + # the use of checkbuttons/commands/etc. on menubars (which is legal, + # but not recommended) + + if { !$isCascade } { + uplevel #0 [list $w invoke $active] + } + } else { + set active [$w index active] + if {$Priv(popup) eq "" || $active ne "none"} { + MenuUnpost $w + } + uplevel #0 [list $w invoke active] + } +} + +# ::tk::MenuEscape -- +# This procedure is invoked for the Cancel (or Escape) key. It unposts +# the given menu and, if it is the top-level menu for a menu button, +# unposts the menu button as well. +# +# Arguments: +# menu - Name of the menu window. + +proc ::tk::MenuEscape menu { + set parent [winfo parent $menu] + if {[winfo class $parent] ne "Menu"} { + MenuUnpost $menu + } elseif {[$parent cget -type] eq "menubar"} { + MenuUnpost $menu + RestoreOldGrab + } else { + MenuNextMenu $menu left + } +} + +# The following routines handle arrow keys. Arrow keys behave +# differently depending on whether the menu is a menu bar or not. + +proc ::tk::MenuUpArrow {menu} { + if {[$menu cget -type] eq "menubar"} { + MenuNextMenu $menu left + } else { + MenuNextEntry $menu -1 + } +} + +proc ::tk::MenuDownArrow {menu} { + if {[$menu cget -type] eq "menubar"} { + MenuNextMenu $menu right + } else { + MenuNextEntry $menu 1 + } +} + +proc ::tk::MenuLeftArrow {menu} { + if {[$menu cget -type] eq "menubar"} { + MenuNextEntry $menu -1 + } else { + MenuNextMenu $menu left + } +} + +proc ::tk::MenuRightArrow {menu} { + if {[$menu cget -type] eq "menubar"} { + MenuNextEntry $menu 1 + } else { + MenuNextMenu $menu right + } +} + +# ::tk::MenuNextMenu -- +# This procedure is invoked to handle "left" and "right" traversal +# motions in menus. It traverses to the next menu in a menu bar, +# or into or out of a cascaded menu. +# +# Arguments: +# menu - The menu that received the keyboard +# event. +# direction - Direction in which to move: "left" or "right" + +proc ::tk::MenuNextMenu {menu direction} { + variable ::tk::Priv + + # First handle traversals into and out of cascaded menus. + + if {$direction eq "right"} { + set count 1 + set parent [winfo parent $menu] + set class [winfo class $parent] + if {[$menu type active] eq "cascade"} { + $menu postcascade active + set m2 [$menu entrycget active -menu] + if {$m2 ne ""} { + MenuFirstEntry $m2 + } + return + } else { + set parent [winfo parent $menu] + while {$parent ne "."} { + if {[winfo class $parent] eq "Menu" \ + && [$parent cget -type] eq "menubar"} { + tk_menuSetFocus $parent + MenuNextEntry $parent 1 + return + } + set parent [winfo parent $parent] + } + } + } else { + set count -1 + set m2 [winfo parent $menu] + if {[winfo class $m2] eq "Menu"} { + $menu activate none + GenerateMenuSelect $menu + tk_menuSetFocus $m2 + + $m2 postcascade none + + if {[$m2 cget -type] ne "menubar"} { + return + } + } + } + + # Can't traverse into or out of a cascaded menu. Go to the next + # or previous menubutton, if that makes sense. + + set m2 [winfo parent $menu] + if {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} { + tk_menuSetFocus $m2 + MenuNextEntry $m2 -1 + return + } + + set w $Priv(postedMb) + if {$w eq ""} { + return + } + set buttons [winfo children [winfo parent $w]] + set length [llength $buttons] + set i [expr {[lsearch -exact $buttons $w] + $count}] + while {1} { + while {$i < 0} { + incr i $length + } + while {$i >= $length} { + incr i -$length + } + set mb [lindex $buttons $i] + if {[winfo class $mb] eq "Menubutton" \ + && [$mb cget -state] ne "disabled" \ + && [$mb cget -menu] ne "" \ + && [[$mb cget -menu] index last] ne "none"} { + break + } + if {$mb eq $w} { + return + } + incr i $count + } + MbPost $mb + MenuFirstEntry [$mb cget -menu] +} + +# ::tk::MenuNextEntry -- +# Activate the next higher or lower entry in the posted menu, +# wrapping around at the ends. Disabled entries are skipped. +# +# Arguments: +# menu - Menu window that received the keystroke. +# count - 1 means go to the next lower entry, +# -1 means go to the next higher entry. + +proc ::tk::MenuNextEntry {menu count} { + if {[$menu index last] eq "none"} { + return + } + set length [expr {[$menu index last]+1}] + set quitAfter $length + set active [$menu index active] + if {$active eq "none"} { + set i 0 + } else { + set i [expr {$active + $count}] + } + while {1} { + if {$quitAfter <= 0} { + # We've tried every entry in the menu. Either there are + # none, or they're all disabled. Just give up. + + return + } + while {$i < 0} { + incr i $length + } + while {$i >= $length} { + incr i -$length + } + if {[catch {$menu entrycget $i -state} state] == 0} { + if {$state ne "disabled" && \ + ($i!=0 || [$menu cget -type] ne "tearoff" \ + || [$menu type 0] ne "tearoff")} { + break + } + } + if {$i == $active} { + return + } + incr i $count + incr quitAfter -1 + } + $menu activate $i + GenerateMenuSelect $menu + + if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} { + set cascade [$menu entrycget $i -menu] + if {$cascade ne ""} { + # Here we auto-post a cascade. This is necessary when + # we traverse left/right in the menubar, but undesirable when + # we traverse up/down in a menu. + $menu postcascade $i + MenuFirstEntry $cascade + } + } +} + +# ::tk::MenuFind -- +# This procedure searches the entire window hierarchy under w for +# a menubutton that isn't disabled and whose underlined character +# is "char" or an entry in a menubar that isn't disabled and whose +# underlined character is "char". +# It returns the name of that window, if found, or an +# empty string if no matching window was found. If "char" is an +# empty string then the procedure returns the name of the first +# menubutton found that isn't disabled. +# +# Arguments: +# w - Name of window where key was typed. +# char - Underlined character to search for; +# may be either upper or lower case, and +# will match either upper or lower case. + +proc ::tk::MenuFind {w char} { + set char [string tolower $char] + set windowlist [winfo child $w] + + foreach child $windowlist { + # Don't descend into other toplevels. + if {[winfo toplevel $w] ne [winfo toplevel $child]} { + continue + } + if {[winfo class $child] eq "Menu" && \ + [$child cget -type] eq "menubar"} { + if {$char eq ""} { + return $child + } + set last [$child index last] + for {set i [$child cget -tearoff]} {$i <= $last} {incr i} { + if {[$child type $i] eq "separator"} { + continue + } + set char2 [string index [$child entrycget $i -label] \ + [$child entrycget $i -underline]] + if {$char eq [string tolower $char2] || $char eq ""} { + if {[$child entrycget $i -state] ne "disabled"} { + return $child + } + } + } + } + } + + foreach child $windowlist { + # Don't descend into other toplevels. + if {[winfo toplevel $w] ne [winfo toplevel $child]} { + continue + } + switch -- [winfo class $child] { + Menubutton { + set char2 [string index [$child cget -text] \ + [$child cget -underline]] + if {$char eq [string tolower $char2] || $char eq ""} { + if {[$child cget -state] ne "disabled"} { + return $child + } + } + } + + default { + set match [MenuFind $child $char] + if {$match ne ""} { + return $match + } + } + } + } + return {} +} + +# ::tk::TraverseToMenu -- +# This procedure implements keyboard traversal of menus. Given an +# ASCII character "char", it looks for a menubutton with that character +# underlined. If one is found, it posts the menubutton's menu +# +# Arguments: +# w - Window in which the key was typed (selects +# a toplevel window). +# char - Character that selects a menu. The case +# is ignored. If an empty string, nothing +# happens. + +proc ::tk::TraverseToMenu {w char} { + variable ::tk::Priv + if {![winfo exists $w] || $char eq ""} { + return + } + while {[winfo class $w] eq "Menu"} { + if {[$w cget -type] eq "menubar"} { + break + } elseif {$Priv(postedMb) eq ""} { + return + } + set w [winfo parent $w] + } + set w [MenuFind [winfo toplevel $w] $char] + if {$w ne ""} { + if {[winfo class $w] eq "Menu"} { + tk_menuSetFocus $w + set Priv(window) $w + SaveGrabInfo $w + grab -global $w + TraverseWithinMenu $w $char + } else { + MbPost $w + MenuFirstEntry [$w cget -menu] + } + } +} + +# ::tk::FirstMenu -- +# This procedure traverses to the first menubutton in the toplevel +# for a given window, and posts that menubutton's menu. +# +# Arguments: +# w - Name of a window. Selects which toplevel +# to search for menubuttons. + +proc ::tk::FirstMenu w { + variable ::tk::Priv + set w [MenuFind [winfo toplevel $w] ""] + if {$w ne ""} { + if {[winfo class $w] eq "Menu"} { + tk_menuSetFocus $w + set Priv(window) $w + SaveGrabInfo $w + grab -global $w + MenuFirstEntry $w + } else { + MbPost $w + MenuFirstEntry [$w cget -menu] + } + } +} + +# ::tk::TraverseWithinMenu +# This procedure implements keyboard traversal within a menu. It +# searches for an entry in the menu that has "char" underlined. If +# such an entry is found, it is invoked and the menu is unposted. +# +# Arguments: +# w - The name of the menu widget. +# char - The character to look for; case is +# ignored. If the string is empty then +# nothing happens. + +proc ::tk::TraverseWithinMenu {w char} { + if {$char eq ""} { + return + } + set char [string tolower $char] + set last [$w index last] + if {$last eq "none"} { + return + } + for {set i 0} {$i <= $last} {incr i} { + if {[catch {set char2 [string index \ + [$w entrycget $i -label] [$w entrycget $i -underline]]}]} { + continue + } + if {$char eq [string tolower $char2]} { + if {[$w type $i] eq "cascade"} { + $w activate $i + $w postcascade active + event generate $w <> + set m2 [$w entrycget $i -menu] + if {$m2 ne ""} { + MenuFirstEntry $m2 + } + } else { + MenuUnpost $w + uplevel #0 [list $w invoke $i] + } + return + } + } +} + +# ::tk::MenuFirstEntry -- +# Given a menu, this procedure finds the first entry that isn't +# disabled or a tear-off or separator, and activates that entry. +# However, if there is already an active entry in the menu (e.g., +# because of a previous call to tk::PostOverPoint) then the active +# entry isn't changed. This procedure also sets the input focus +# to the menu. +# +# Arguments: +# menu - Name of the menu window (possibly empty). + +proc ::tk::MenuFirstEntry menu { + if {$menu eq ""} { + return + } + tk_menuSetFocus $menu + if {[$menu index active] ne "none"} { + return + } + set last [$menu index last] + if {$last eq "none"} { + return + } + for {set i 0} {$i <= $last} {incr i} { + if {([catch {set state [$menu entrycget $i -state]}] == 0) \ + && $state ne "disabled" && [$menu type $i] ne "tearoff"} { + $menu activate $i + GenerateMenuSelect $menu + # Only post the cascade if the current menu is a menubar; + # otherwise, if the first entry of the cascade is a cascade, + # we can get an annoying cascading effect resulting in a bunch of + # menus getting posted (bug 676) + if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} { + set cascade [$menu entrycget $i -menu] + if {$cascade ne ""} { + $menu postcascade $i + MenuFirstEntry $cascade + } + } + return + } + } +} + +# ::tk::MenuFindName -- +# Given a menu and a text string, return the index of the menu entry +# that displays the string as its label. If there is no such entry, +# return an empty string. This procedure is tricky because some names +# like "active" have a special meaning in menu commands, so we can't +# always use the "index" widget command. +# +# Arguments: +# menu - Name of the menu widget. +# s - String to look for. + +proc ::tk::MenuFindName {menu s} { + set i "" + if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} { + catch {set i [$menu index $s]} + return $i + } + 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]} { + if {$label eq $s} { + return $i + } + } + } + return "" +} + +# ::tk::PostOverPoint -- +# This procedure posts a given menu such that a given entry in the +# menu is centered over a given point in the root window. It also +# activates the given entry. +# +# Arguments: +# menu - Menu to post. +# x, y - Root coordinates of point. +# entry - Index of entry within menu to center over (x,y). +# If omitted or specified as {}, then the menu's +# upper-left corner goes at (x,y). + +proc ::tk::PostOverPoint {menu x y {entry {}}} { + if {$entry ne ""} { + if {$entry == [$menu index last]} { + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] + } else { + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] + } + incr x [expr {-[winfo reqwidth $menu]/2}] + } + + if {[tk windowingsystem] eq "win32"} { + # osVersion is not available in safe interps + set ver 5 + if {[info exists ::tcl_platform(osVersion)]} { + scan $::tcl_platform(osVersion) %d ver + } + + # We need to fix some problems with menu posting on Windows, + # where, if the menu would overlap top or bottom of screen, + # Windows puts it in the wrong place for us. We must also + # subtract an extra amount for half the height of the current + # entry. To be safe we subtract an extra 10. + # NOTE: this issue appears to have been resolved in the Window + # manager provided with Vista and Windows 7. + if {$ver < 6} { + set yoffset [expr {[winfo screenheight $menu] \ + - $y - [winfo reqheight $menu] - 10}] + if {$yoffset < [winfo vrooty $menu]} { + # The bottom of the menu is offscreen, so adjust upwards + incr y [expr {$yoffset - [winfo vrooty $menu]}] + } + # If we're off the top of the screen (either because we were + # originally or because we just adjusted too far upwards), + # then make the menu popup on the top edge. + if {$y < [winfo vrooty $menu]} { + set y [winfo vrooty $menu] + } + } + } + $menu post $x $y + if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} { + $menu activate $entry + GenerateMenuSelect $menu + } +} + +# ::tk::SaveGrabInfo -- +# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record +# the state of any existing grab on the w's display. +# +# Arguments: +# w - Name of a window; used to select the display +# whose grab information is to be recorded. + +proc tk::SaveGrabInfo w { + variable ::tk::Priv + set Priv(oldGrab) [grab current $w] + if {$Priv(oldGrab) ne ""} { + set Priv(grabStatus) [grab status $Priv(oldGrab)] + } +} + +# ::tk::RestoreOldGrab -- +# Restores the grab to what it was before TkSaveGrabInfo was called. +# + +proc ::tk::RestoreOldGrab {} { + variable ::tk::Priv + + if {$Priv(oldGrab) ne ""} { + # Be careful restoring the old grab, since it's window may not + # be visible anymore. + + catch { + if {$Priv(grabStatus) eq "global"} { + grab set -global $Priv(oldGrab) + } else { + grab set $Priv(oldGrab) + } + } + set Priv(oldGrab) "" + } +} + +proc ::tk_menuSetFocus {menu} { + variable ::tk::Priv + if {![info exists Priv(focus)] || $Priv(focus) eq ""} { + set Priv(focus) [focus] + } + focus $menu +} + +proc ::tk::GenerateMenuSelect {menu} { + variable ::tk::Priv + + if {$Priv(activeMenu) eq $menu \ + && $Priv(activeItem) eq [$menu index active]} { + return + } + + set Priv(activeMenu) $menu + set Priv(activeItem) [$menu index active] + event generate $menu <> +} + +# ::tk_popup -- +# This procedure pops up a menu and sets things up for traversing +# the menu and its submenus. +# +# Arguments: +# menu - Name of the menu to be popped up. +# x, y - Root coordinates at which to pop up the +# menu. +# entry - Index of a menu entry to center over (x,y). +# If omitted or specified as {}, then menu's +# upper-left corner goes at (x,y). + +proc ::tk_popup {menu x y {entry {}}} { + variable ::tk::Priv + if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} { + tk::MenuUnpost {} + } + tk::PostOverPoint $menu $x $y $entry + if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} { + tk::SaveGrabInfo $menu + grab -global $menu + set Priv(popup) $menu + set Priv(window) $menu + set Priv(menuActivated) 1 + tk_menuSetFocus $menu + } +} diff --git a/windowsAgent/dist/tk/mkpsenc.tcl b/windowsAgent/dist/tk/mkpsenc.tcl new file mode 100644 index 0000000..b3fd13d --- /dev/null +++ b/windowsAgent/dist/tk/mkpsenc.tcl @@ -0,0 +1,1488 @@ +# mkpsenc.tcl -- +# +# This file generates the postscript prolog used by Tk. + +namespace eval ::tk { + # Creates Postscript encoding vector for ISO-8859-1 (could theoretically + # handle any 8-bit encoding, but Tk never generates characters outside + # ASCII). + # + proc CreatePostscriptEncoding {} { + variable psglyphs + # Now check for known. Even if it is known, it can be other than we + # need. GhostScript seems to be happy with such approach + set result "\[\n" + for {set i 0} {$i<256} {incr i 8} { + for {set j 0} {$j<8} {incr j} { + set enc [encoding convertfrom "iso8859-1" \ + [format %c [expr {$i+$j}]]] + catch { + set hexcode {} + set hexcode [format %04X [scan $enc %c]] + } + if {[info exists psglyphs($hexcode)]} { + append result "/$psglyphs($hexcode)" + } else { + append result "/space" + } + } + append result "\n" + } + append result "\]" + return $result + } + + # List of adobe glyph names. Converted from glyphlist.txt, downloaded from + # Adobe. + + variable psglyphs + array set psglyphs { + 0020 space + 0021 exclam + 0022 quotedbl + 0023 numbersign + 0024 dollar + 0025 percent + 0026 ampersand + 0027 quotesingle + 0028 parenleft + 0029 parenright + 002A asterisk + 002B plus + 002C comma + 002D hyphen + 002E period + 002F slash + 0030 zero + 0031 one + 0032 two + 0033 three + 0034 four + 0035 five + 0036 six + 0037 seven + 0038 eight + 0039 nine + 003A colon + 003B semicolon + 003C less + 003D equal + 003E greater + 003F question + 0040 at + 0041 A + 0042 B + 0043 C + 0044 D + 0045 E + 0046 F + 0047 G + 0048 H + 0049 I + 004A J + 004B K + 004C L + 004D M + 004E N + 004F O + 0050 P + 0051 Q + 0052 R + 0053 S + 0054 T + 0055 U + 0056 V + 0057 W + 0058 X + 0059 Y + 005A Z + 005B bracketleft + 005C backslash + 005D bracketright + 005E asciicircum + 005F underscore + 0060 grave + 0061 a + 0062 b + 0063 c + 0064 d + 0065 e + 0066 f + 0067 g + 0068 h + 0069 i + 006A j + 006B k + 006C l + 006D m + 006E n + 006F o + 0070 p + 0071 q + 0072 r + 0073 s + 0074 t + 0075 u + 0076 v + 0077 w + 0078 x + 0079 y + 007A z + 007B braceleft + 007C bar + 007D braceright + 007E asciitilde + 00A0 space + 00A1 exclamdown + 00A2 cent + 00A3 sterling + 00A4 currency + 00A5 yen + 00A6 brokenbar + 00A7 section + 00A8 dieresis + 00A9 copyright + 00AA ordfeminine + 00AB guillemotleft + 00AC logicalnot + 00AD hyphen + 00AE registered + 00AF macron + 00B0 degree + 00B1 plusminus + 00B2 twosuperior + 00B3 threesuperior + 00B4 acute + 00B5 mu + 00B6 paragraph + 00B7 periodcentered + 00B8 cedilla + 00B9 onesuperior + 00BA ordmasculine + 00BB guillemotright + 00BC onequarter + 00BD onehalf + 00BE threequarters + 00BF questiondown + 00C0 Agrave + 00C1 Aacute + 00C2 Acircumflex + 00C3 Atilde + 00C4 Adieresis + 00C5 Aring + 00C6 AE + 00C7 Ccedilla + 00C8 Egrave + 00C9 Eacute + 00CA Ecircumflex + 00CB Edieresis + 00CC Igrave + 00CD Iacute + 00CE Icircumflex + 00CF Idieresis + 00D0 Eth + 00D1 Ntilde + 00D2 Ograve + 00D3 Oacute + 00D4 Ocircumflex + 00D5 Otilde + 00D6 Odieresis + 00D7 multiply + 00D8 Oslash + 00D9 Ugrave + 00DA Uacute + 00DB Ucircumflex + 00DC Udieresis + 00DD Yacute + 00DE Thorn + 00DF germandbls + 00E0 agrave + 00E1 aacute + 00E2 acircumflex + 00E3 atilde + 00E4 adieresis + 00E5 aring + 00E6 ae + 00E7 ccedilla + 00E8 egrave + 00E9 eacute + 00EA ecircumflex + 00EB edieresis + 00EC igrave + 00ED iacute + 00EE icircumflex + 00EF idieresis + 00F0 eth + 00F1 ntilde + 00F2 ograve + 00F3 oacute + 00F4 ocircumflex + 00F5 otilde + 00F6 odieresis + 00F7 divide + 00F8 oslash + 00F9 ugrave + 00FA uacute + 00FB ucircumflex + 00FC udieresis + 00FD yacute + 00FE thorn + 00FF ydieresis + 0100 Amacron + 0101 amacron + 0102 Abreve + 0103 abreve + 0104 Aogonek + 0105 aogonek + 0106 Cacute + 0107 cacute + 0108 Ccircumflex + 0109 ccircumflex + 010A Cdotaccent + 010B cdotaccent + 010C Ccaron + 010D ccaron + 010E Dcaron + 010F dcaron + 0110 Dcroat + 0111 dcroat + 0112 Emacron + 0113 emacron + 0114 Ebreve + 0115 ebreve + 0116 Edotaccent + 0117 edotaccent + 0118 Eogonek + 0119 eogonek + 011A Ecaron + 011B ecaron + 011C Gcircumflex + 011D gcircumflex + 011E Gbreve + 011F gbreve + 0120 Gdotaccent + 0121 gdotaccent + 0122 Gcommaaccent + 0123 gcommaaccent + 0124 Hcircumflex + 0125 hcircumflex + 0126 Hbar + 0127 hbar + 0128 Itilde + 0129 itilde + 012A Imacron + 012B imacron + 012C Ibreve + 012D ibreve + 012E Iogonek + 012F iogonek + 0130 Idotaccent + 0131 dotlessi + 0132 IJ + 0133 ij + 0134 Jcircumflex + 0135 jcircumflex + 0136 Kcommaaccent + 0137 kcommaaccent + 0138 kgreenlandic + 0139 Lacute + 013A lacute + 013B Lcommaaccent + 013C lcommaaccent + 013D Lcaron + 013E lcaron + 013F Ldot + 0140 ldot + 0141 Lslash + 0142 lslash + 0143 Nacute + 0144 nacute + 0145 Ncommaaccent + 0146 ncommaaccent + 0147 Ncaron + 0148 ncaron + 0149 napostrophe + 014A Eng + 014B eng + 014C Omacron + 014D omacron + 014E Obreve + 014F obreve + 0150 Ohungarumlaut + 0151 ohungarumlaut + 0152 OE + 0153 oe + 0154 Racute + 0155 racute + 0156 Rcommaaccent + 0157 rcommaaccent + 0158 Rcaron + 0159 rcaron + 015A Sacute + 015B sacute + 015C Scircumflex + 015D scircumflex + 015E Scedilla + 015F scedilla + 0160 Scaron + 0161 scaron + 0162 Tcommaaccent + 0163 tcommaaccent + 0164 Tcaron + 0165 tcaron + 0166 Tbar + 0167 tbar + 0168 Utilde + 0169 utilde + 016A Umacron + 016B umacron + 016C Ubreve + 016D ubreve + 016E Uring + 016F uring + 0170 Uhungarumlaut + 0171 uhungarumlaut + 0172 Uogonek + 0173 uogonek + 0174 Wcircumflex + 0175 wcircumflex + 0176 Ycircumflex + 0177 ycircumflex + 0178 Ydieresis + 0179 Zacute + 017A zacute + 017B Zdotaccent + 017C zdotaccent + 017D Zcaron + 017E zcaron + 017F longs + 0192 florin + 01A0 Ohorn + 01A1 ohorn + 01AF Uhorn + 01B0 uhorn + 01E6 Gcaron + 01E7 gcaron + 01FA Aringacute + 01FB aringacute + 01FC AEacute + 01FD aeacute + 01FE Oslashacute + 01FF oslashacute + 0218 Scommaaccent + 0219 scommaaccent + 021A Tcommaaccent + 021B tcommaaccent + 02BC afii57929 + 02BD afii64937 + 02C6 circumflex + 02C7 caron + 02C9 macron + 02D8 breve + 02D9 dotaccent + 02DA ring + 02DB ogonek + 02DC tilde + 02DD hungarumlaut + 0300 gravecomb + 0301 acutecomb + 0303 tildecomb + 0309 hookabovecomb + 0323 dotbelowcomb + 0384 tonos + 0385 dieresistonos + 0386 Alphatonos + 0387 anoteleia + 0388 Epsilontonos + 0389 Etatonos + 038A Iotatonos + 038C Omicrontonos + 038E Upsilontonos + 038F Omegatonos + 0390 iotadieresistonos + 0391 Alpha + 0392 Beta + 0393 Gamma + 0394 Delta + 0395 Epsilon + 0396 Zeta + 0397 Eta + 0398 Theta + 0399 Iota + 039A Kappa + 039B Lambda + 039C Mu + 039D Nu + 039E Xi + 039F Omicron + 03A0 Pi + 03A1 Rho + 03A3 Sigma + 03A4 Tau + 03A5 Upsilon + 03A6 Phi + 03A7 Chi + 03A8 Psi + 03A9 Omega + 03AA Iotadieresis + 03AB Upsilondieresis + 03AC alphatonos + 03AD epsilontonos + 03AE etatonos + 03AF iotatonos + 03B0 upsilondieresistonos + 03B1 alpha + 03B2 beta + 03B3 gamma + 03B4 delta + 03B5 epsilon + 03B6 zeta + 03B7 eta + 03B8 theta + 03B9 iota + 03BA kappa + 03BB lambda + 03BC mu + 03BD nu + 03BE xi + 03BF omicron + 03C0 pi + 03C1 rho + 03C2 sigma1 + 03C3 sigma + 03C4 tau + 03C5 upsilon + 03C6 phi + 03C7 chi + 03C8 psi + 03C9 omega + 03CA iotadieresis + 03CB upsilondieresis + 03CC omicrontonos + 03CD upsilontonos + 03CE omegatonos + 03D1 theta1 + 03D2 Upsilon1 + 03D5 phi1 + 03D6 omega1 + 0401 afii10023 + 0402 afii10051 + 0403 afii10052 + 0404 afii10053 + 0405 afii10054 + 0406 afii10055 + 0407 afii10056 + 0408 afii10057 + 0409 afii10058 + 040A afii10059 + 040B afii10060 + 040C afii10061 + 040E afii10062 + 040F afii10145 + 0410 afii10017 + 0411 afii10018 + 0412 afii10019 + 0413 afii10020 + 0414 afii10021 + 0415 afii10022 + 0416 afii10024 + 0417 afii10025 + 0418 afii10026 + 0419 afii10027 + 041A afii10028 + 041B afii10029 + 041C afii10030 + 041D afii10031 + 041E afii10032 + 041F afii10033 + 0420 afii10034 + 0421 afii10035 + 0422 afii10036 + 0423 afii10037 + 0424 afii10038 + 0425 afii10039 + 0426 afii10040 + 0427 afii10041 + 0428 afii10042 + 0429 afii10043 + 042A afii10044 + 042B afii10045 + 042C afii10046 + 042D afii10047 + 042E afii10048 + 042F afii10049 + 0430 afii10065 + 0431 afii10066 + 0432 afii10067 + 0433 afii10068 + 0434 afii10069 + 0435 afii10070 + 0436 afii10072 + 0437 afii10073 + 0438 afii10074 + 0439 afii10075 + 043A afii10076 + 043B afii10077 + 043C afii10078 + 043D afii10079 + 043E afii10080 + 043F afii10081 + 0440 afii10082 + 0441 afii10083 + 0442 afii10084 + 0443 afii10085 + 0444 afii10086 + 0445 afii10087 + 0446 afii10088 + 0447 afii10089 + 0448 afii10090 + 0449 afii10091 + 044A afii10092 + 044B afii10093 + 044C afii10094 + 044D afii10095 + 044E afii10096 + 044F afii10097 + 0451 afii10071 + 0452 afii10099 + 0453 afii10100 + 0454 afii10101 + 0455 afii10102 + 0456 afii10103 + 0457 afii10104 + 0458 afii10105 + 0459 afii10106 + 045A afii10107 + 045B afii10108 + 045C afii10109 + 045E afii10110 + 045F afii10193 + 0462 afii10146 + 0463 afii10194 + 0472 afii10147 + 0473 afii10195 + 0474 afii10148 + 0475 afii10196 + 0490 afii10050 + 0491 afii10098 + 04D9 afii10846 + 05B0 afii57799 + 05B1 afii57801 + 05B2 afii57800 + 05B3 afii57802 + 05B4 afii57793 + 05B5 afii57794 + 05B6 afii57795 + 05B7 afii57798 + 05B8 afii57797 + 05B9 afii57806 + 05BB afii57796 + 05BC afii57807 + 05BD afii57839 + 05BE afii57645 + 05BF afii57841 + 05C0 afii57842 + 05C1 afii57804 + 05C2 afii57803 + 05C3 afii57658 + 05D0 afii57664 + 05D1 afii57665 + 05D2 afii57666 + 05D3 afii57667 + 05D4 afii57668 + 05D5 afii57669 + 05D6 afii57670 + 05D7 afii57671 + 05D8 afii57672 + 05D9 afii57673 + 05DA afii57674 + 05DB afii57675 + 05DC afii57676 + 05DD afii57677 + 05DE afii57678 + 05DF afii57679 + 05E0 afii57680 + 05E1 afii57681 + 05E2 afii57682 + 05E3 afii57683 + 05E4 afii57684 + 05E5 afii57685 + 05E6 afii57686 + 05E7 afii57687 + 05E8 afii57688 + 05E9 afii57689 + 05EA afii57690 + 05F0 afii57716 + 05F1 afii57717 + 05F2 afii57718 + 060C afii57388 + 061B afii57403 + 061F afii57407 + 0621 afii57409 + 0622 afii57410 + 0623 afii57411 + 0624 afii57412 + 0625 afii57413 + 0626 afii57414 + 0627 afii57415 + 0628 afii57416 + 0629 afii57417 + 062A afii57418 + 062B afii57419 + 062C afii57420 + 062D afii57421 + 062E afii57422 + 062F afii57423 + 0630 afii57424 + 0631 afii57425 + 0632 afii57426 + 0633 afii57427 + 0634 afii57428 + 0635 afii57429 + 0636 afii57430 + 0637 afii57431 + 0638 afii57432 + 0639 afii57433 + 063A afii57434 + 0640 afii57440 + 0641 afii57441 + 0642 afii57442 + 0643 afii57443 + 0644 afii57444 + 0645 afii57445 + 0646 afii57446 + 0647 afii57470 + 0648 afii57448 + 0649 afii57449 + 064A afii57450 + 064B afii57451 + 064C afii57452 + 064D afii57453 + 064E afii57454 + 064F afii57455 + 0650 afii57456 + 0651 afii57457 + 0652 afii57458 + 0660 afii57392 + 0661 afii57393 + 0662 afii57394 + 0663 afii57395 + 0664 afii57396 + 0665 afii57397 + 0666 afii57398 + 0667 afii57399 + 0668 afii57400 + 0669 afii57401 + 066A afii57381 + 066D afii63167 + 0679 afii57511 + 067E afii57506 + 0686 afii57507 + 0688 afii57512 + 0691 afii57513 + 0698 afii57508 + 06A4 afii57505 + 06AF afii57509 + 06BA afii57514 + 06D2 afii57519 + 06D5 afii57534 + 1E80 Wgrave + 1E81 wgrave + 1E82 Wacute + 1E83 wacute + 1E84 Wdieresis + 1E85 wdieresis + 1EF2 Ygrave + 1EF3 ygrave + 200C afii61664 + 200D afii301 + 200E afii299 + 200F afii300 + 2012 figuredash + 2013 endash + 2014 emdash + 2015 afii00208 + 2017 underscoredbl + 2018 quoteleft + 2019 quoteright + 201A quotesinglbase + 201B quotereversed + 201C quotedblleft + 201D quotedblright + 201E quotedblbase + 2020 dagger + 2021 daggerdbl + 2022 bullet + 2024 onedotenleader + 2025 twodotenleader + 2026 ellipsis + 202C afii61573 + 202D afii61574 + 202E afii61575 + 2030 perthousand + 2032 minute + 2033 second + 2039 guilsinglleft + 203A guilsinglright + 203C exclamdbl + 2044 fraction + 2070 zerosuperior + 2074 foursuperior + 2075 fivesuperior + 2076 sixsuperior + 2077 sevensuperior + 2078 eightsuperior + 2079 ninesuperior + 207D parenleftsuperior + 207E parenrightsuperior + 207F nsuperior + 2080 zeroinferior + 2081 oneinferior + 2082 twoinferior + 2083 threeinferior + 2084 fourinferior + 2085 fiveinferior + 2086 sixinferior + 2087 seveninferior + 2088 eightinferior + 2089 nineinferior + 208D parenleftinferior + 208E parenrightinferior + 20A1 colonmonetary + 20A3 franc + 20A4 lira + 20A7 peseta + 20AA afii57636 + 20AB dong + 20AC Euro + 2105 afii61248 + 2111 Ifraktur + 2113 afii61289 + 2116 afii61352 + 2118 weierstrass + 211C Rfraktur + 211E prescription + 2122 trademark + 2126 Omega + 212E estimated + 2135 aleph + 2153 onethird + 2154 twothirds + 215B oneeighth + 215C threeeighths + 215D fiveeighths + 215E seveneighths + 2190 arrowleft + 2191 arrowup + 2192 arrowright + 2193 arrowdown + 2194 arrowboth + 2195 arrowupdn + 21A8 arrowupdnbse + 21B5 carriagereturn + 21D0 arrowdblleft + 21D1 arrowdblup + 21D2 arrowdblright + 21D3 arrowdbldown + 21D4 arrowdblboth + 2200 universal + 2202 partialdiff + 2203 existential + 2205 emptyset + 2206 Delta + 2207 gradient + 2208 element + 2209 notelement + 220B suchthat + 220F product + 2211 summation + 2212 minus + 2215 fraction + 2217 asteriskmath + 2219 periodcentered + 221A radical + 221D proportional + 221E infinity + 221F orthogonal + 2220 angle + 2227 logicaland + 2228 logicalor + 2229 intersection + 222A union + 222B integral + 2234 therefore + 223C similar + 2245 congruent + 2248 approxequal + 2260 notequal + 2261 equivalence + 2264 lessequal + 2265 greaterequal + 2282 propersubset + 2283 propersuperset + 2284 notsubset + 2286 reflexsubset + 2287 reflexsuperset + 2295 circleplus + 2297 circlemultiply + 22A5 perpendicular + 22C5 dotmath + 2302 house + 2310 revlogicalnot + 2320 integraltp + 2321 integralbt + 2329 angleleft + 232A angleright + 2500 SF100000 + 2502 SF110000 + 250C SF010000 + 2510 SF030000 + 2514 SF020000 + 2518 SF040000 + 251C SF080000 + 2524 SF090000 + 252C SF060000 + 2534 SF070000 + 253C SF050000 + 2550 SF430000 + 2551 SF240000 + 2552 SF510000 + 2553 SF520000 + 2554 SF390000 + 2555 SF220000 + 2556 SF210000 + 2557 SF250000 + 2558 SF500000 + 2559 SF490000 + 255A SF380000 + 255B SF280000 + 255C SF270000 + 255D SF260000 + 255E SF360000 + 255F SF370000 + 2560 SF420000 + 2561 SF190000 + 2562 SF200000 + 2563 SF230000 + 2564 SF470000 + 2565 SF480000 + 2566 SF410000 + 2567 SF450000 + 2568 SF460000 + 2569 SF400000 + 256A SF540000 + 256B SF530000 + 256C SF440000 + 2580 upblock + 2584 dnblock + 2588 block + 258C lfblock + 2590 rtblock + 2591 ltshade + 2592 shade + 2593 dkshade + 25A0 filledbox + 25A1 H22073 + 25AA H18543 + 25AB H18551 + 25AC filledrect + 25B2 triagup + 25BA triagrt + 25BC triagdn + 25C4 triaglf + 25CA lozenge + 25CB circle + 25CF H18533 + 25D8 invbullet + 25D9 invcircle + 25E6 openbullet + 263A smileface + 263B invsmileface + 263C sun + 2640 female + 2642 male + 2660 spade + 2663 club + 2665 heart + 2666 diamond + 266A musicalnote + 266B musicalnotedbl + F6BE dotlessj + F6BF LL + F6C0 ll + F6C1 Scedilla + F6C2 scedilla + F6C3 commaaccent + F6C4 afii10063 + F6C5 afii10064 + F6C6 afii10192 + F6C7 afii10831 + F6C8 afii10832 + F6C9 Acute + F6CA Caron + F6CB Dieresis + F6CC DieresisAcute + F6CD DieresisGrave + F6CE Grave + F6CF Hungarumlaut + F6D0 Macron + F6D1 cyrBreve + F6D2 cyrFlex + F6D3 dblGrave + F6D4 cyrbreve + F6D5 cyrflex + F6D6 dblgrave + F6D7 dieresisacute + F6D8 dieresisgrave + F6D9 copyrightserif + F6DA registerserif + F6DB trademarkserif + F6DC onefitted + F6DD rupiah + F6DE threequartersemdash + F6DF centinferior + F6E0 centsuperior + F6E1 commainferior + F6E2 commasuperior + F6E3 dollarinferior + F6E4 dollarsuperior + F6E5 hypheninferior + F6E6 hyphensuperior + F6E7 periodinferior + F6E8 periodsuperior + F6E9 asuperior + F6EA bsuperior + F6EB dsuperior + F6EC esuperior + F6ED isuperior + F6EE lsuperior + F6EF msuperior + F6F0 osuperior + F6F1 rsuperior + F6F2 ssuperior + F6F3 tsuperior + F6F4 Brevesmall + F6F5 Caronsmall + F6F6 Circumflexsmall + F6F7 Dotaccentsmall + F6F8 Hungarumlautsmall + F6F9 Lslashsmall + F6FA OEsmall + F6FB Ogoneksmall + F6FC Ringsmall + F6FD Scaronsmall + F6FE Tildesmall + F6FF Zcaronsmall + F721 exclamsmall + F724 dollaroldstyle + F726 ampersandsmall + F730 zerooldstyle + F731 oneoldstyle + F732 twooldstyle + F733 threeoldstyle + F734 fouroldstyle + F735 fiveoldstyle + F736 sixoldstyle + F737 sevenoldstyle + F738 eightoldstyle + F739 nineoldstyle + F73F questionsmall + F760 Gravesmall + F761 Asmall + F762 Bsmall + F763 Csmall + F764 Dsmall + F765 Esmall + F766 Fsmall + F767 Gsmall + F768 Hsmall + F769 Ismall + F76A Jsmall + F76B Ksmall + F76C Lsmall + F76D Msmall + F76E Nsmall + F76F Osmall + F770 Psmall + F771 Qsmall + F772 Rsmall + F773 Ssmall + F774 Tsmall + F775 Usmall + F776 Vsmall + F777 Wsmall + F778 Xsmall + F779 Ysmall + F77A Zsmall + F7A1 exclamdownsmall + F7A2 centoldstyle + F7A8 Dieresissmall + F7AF Macronsmall + F7B4 Acutesmall + F7B8 Cedillasmall + F7BF questiondownsmall + F7E0 Agravesmall + F7E1 Aacutesmall + F7E2 Acircumflexsmall + F7E3 Atildesmall + F7E4 Adieresissmall + F7E5 Aringsmall + F7E6 AEsmall + F7E7 Ccedillasmall + F7E8 Egravesmall + F7E9 Eacutesmall + F7EA Ecircumflexsmall + F7EB Edieresissmall + F7EC Igravesmall + F7ED Iacutesmall + F7EE Icircumflexsmall + F7EF Idieresissmall + F7F0 Ethsmall + F7F1 Ntildesmall + F7F2 Ogravesmall + F7F3 Oacutesmall + F7F4 Ocircumflexsmall + F7F5 Otildesmall + F7F6 Odieresissmall + F7F8 Oslashsmall + F7F9 Ugravesmall + F7FA Uacutesmall + F7FB Ucircumflexsmall + F7FC Udieresissmall + F7FD Yacutesmall + F7FE Thornsmall + F7FF Ydieresissmall + F8E5 radicalex + F8E6 arrowvertex + F8E7 arrowhorizex + F8E8 registersans + F8E9 copyrightsans + F8EA trademarksans + F8EB parenlefttp + F8EC parenleftex + F8ED parenleftbt + F8EE bracketlefttp + F8EF bracketleftex + F8F0 bracketleftbt + F8F1 bracelefttp + F8F2 braceleftmid + F8F3 braceleftbt + F8F4 braceex + F8F5 integralex + F8F6 parenrighttp + F8F7 parenrightex + F8F8 parenrightbt + F8F9 bracketrighttp + F8FA bracketrightex + F8FB bracketrightbt + F8FC bracerighttp + F8FD bracerightmid + F8FE bracerightbt + FB00 ff + FB01 fi + FB02 fl + FB03 ffi + FB04 ffl + FB1F afii57705 + FB2A afii57694 + FB2B afii57695 + FB35 afii57723 + FB4B afii57700 + } + + variable ps_preamble {} + + namespace eval ps { + namespace ensemble create + namespace export {[a-z]*} + proc literal {string} { + upvar 0 ::tk::ps_preamble preamble + foreach line [split $string \n] { + set line [string trim $line] + if {$line eq ""} continue + append preamble $line \n + } + return + } + proc variable {name value} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name $value def\n" + return + } + proc function {name body} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name \{" + foreach line [split $body \n] { + set line [string trim $line] + # Strip blank lines and comments from the bodies of functions + if {$line eq "" } continue + if {[string match {[%#]*} $line]} continue + append preamble $line " " + } + append preamble "\} bind def\n" + return + } + } + + ps literal { + %%BeginProlog + % This is a standard prolog for Postscript generated by Tk's canvas + % widget. + } + ps variable CurrentEncoding [CreatePostscriptEncoding] + ps literal {50 dict begin} + + # The definitions below just define all of the variables used in any of + # the procedures here. This is needed for obscure reasons explained on + # p. 716 of the Postscript manual (Section H.2.7, "Initializing + # Variables," in the section on Encapsulated Postscript). + ps variable baseline 0 + ps variable stipimage 0 + ps variable height 0 + ps variable justify 0 + ps variable lineLength 0 + ps variable spacing 0 + ps variable stipple 0 + ps variable strings 0 + ps variable xoffset 0 + ps variable yoffset 0 + ps variable tmpstip null + ps variable baselineSampler "( TXygqPZ)" + # Put an extra-tall character in; done this way to avoid encoding trouble + ps literal {baselineSampler 0 196 put} + + ps function cstringshow { + { + dup type /stringtype eq + { show } { glyphshow } + ifelse + } forall + } + + ps function cstringwidth { + 0 exch 0 exch + { + dup type /stringtype eq + { stringwidth } { + currentfont /Encoding get exch 1 exch put (\001) + stringwidth + } + ifelse + exch 3 1 roll add 3 1 roll add exch + } forall + } + + # font ISOEncode font + # + # This procedure changes the encoding of a font from the default + # Postscript encoding to current system encoding. It's typically invoked + # just before invoking "setfont". The body of this procedure comes from + # Section 5.6.1 of the Postscript book. + ps function ISOEncode { + dup length dict begin + {1 index /FID ne {def} {pop pop} ifelse} forall + /Encoding CurrentEncoding def + currentdict + end + % I'm not sure why it's necessary to use "definefont" on this new + % font, but it seems to be important; just use the name "Temporary" + % for the font. + /Temporary exch definefont + } + + # StrokeClip + # + # This procedure converts the current path into a clip area under the + # assumption of stroking. It's a bit tricky because some Postscript + # interpreters get errors during strokepath for dashed lines. If this + # happens then turn off dashes and try again. + ps function StrokeClip { + {strokepath} stopped { + (This Postscript printer gets limitcheck overflows when) = + (stippling dashed lines; lines will be printed solid instead.) = + [] 0 setdash strokepath} if + clip + } + + # desiredSize EvenPixels closestSize + # + # The procedure below is used for stippling. Given the optimal size of a + # dot in a stipple pattern in the current user coordinate system, compute + # the closest size that is an exact multiple of the device's pixel + # size. This allows stipple patterns to be displayed without aliasing + # effects. + ps function EvenPixels { + % Compute exact number of device pixels per stipple dot. + dup 0 matrix currentmatrix dtransform + dup mul exch dup mul add sqrt + % Round to an integer, make sure the number is at least 1, and + % compute user coord distance corresponding to this. + dup round dup 1 lt {pop 1} if + exch div mul + } + + # width height string StippleFill -- + # + # Given a path already set up and a clipping region generated from it, + # this procedure will fill the clipping region with a stipple pattern. + # "String" contains a proper image description of the stipple pattern and + # "width" and "height" give its dimensions. Each stipple dot is assumed to + # be about one unit across in the current user coordinate system. This + # procedure trashes the graphics state. + ps function StippleFill { + % The following code is needed to work around a NeWSprint bug. + /tmpstip 1 index def + % Change the scaling so that one user unit in user coordinates + % corresponds to the size of one stipple dot. + 1 EvenPixels dup scale + % Compute the bounding box occupied by the path (which is now the + % clipping region), and round the lower coordinates down to the + % nearest starting point for the stipple pattern. Be careful about + % negative numbers, since the rounding works differently on them. + pathbbox + 4 2 roll + 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll + 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll + % Stack now: width height string y1 y2 x1 x2 + % Below is a doubly-nested for loop to iterate across this area + % in units of the stipple pattern size, going up columns then + % across rows, blasting out a stipple-pattern-sized rectangle at + % each position + 6 index exch { + 2 index 5 index 3 index { + % Stack now: width height string y1 y2 x y + gsave + 1 index exch translate + 5 index 5 index true matrix tmpstip imagemask + grestore + } for + pop + } for + pop pop pop pop pop + } + + # -- AdjustColor -- + # + # Given a color value already set for output by the caller, adjusts that + # value to a grayscale or mono value if requested by the CL variable. + ps function AdjustColor { + CL 2 lt { + currentgray + CL 0 eq { + .5 lt {0} {1} ifelse + } if + setgray + } if + } + + # x y strings spacing xoffset yoffset justify stipple DrawText -- + # + # This procedure does all of the real work of drawing text. The color and + # font must already have been set by the caller, and the following + # arguments must be on the stack: + # + # x, y - Coordinates at which to draw text. + # strings - An array of strings, one for each line of the text item, in + # order from top to bottom. + # spacing - Spacing between lines. + # xoffset - Horizontal offset for text bbox relative to x and y: 0 for + # nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. + # yoffset - Vertical offset for text bbox relative to x and y: 0 for + # nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. + # justify - 0 for left justification, 0.5 for center, 1 for right justify. + # stipple - Boolean value indicating whether or not text is to be drawn in + # stippled fashion. If text is stippled, function StippleText + # must have been defined to call StippleFill in the right way. + # + # Also, when this procedure is invoked, the color and font must already + # have been set for the text. + ps function DrawText { + /stipple exch def + /justify exch def + /yoffset exch def + /xoffset exch def + /spacing exch def + /strings exch def + % First scan through all of the text to find the widest line. + /lineLength 0 def + strings { + cstringwidth pop + dup lineLength gt {/lineLength exch def} {pop} ifelse + newpath + } forall + % Compute the baseline offset and the actual font height. + 0 0 moveto baselineSampler false charpath + pathbbox dup /baseline exch def + exch pop exch sub /height exch def pop + newpath + % Translate and rotate coordinates first so that the origin is at + % the upper-left corner of the text's bounding box. Remember that + % angle for rotating, and x and y for positioning are still on the + % stack. + translate + rotate + lineLength xoffset mul + strings length 1 sub spacing mul height add yoffset mul translate + % Now use the baseline and justification information to translate + % so that the origin is at the baseline and positioning point for + % the first line of text. + justify lineLength mul baseline neg translate + % Iterate over each of the lines to output it. For each line, + % compute its width again so it can be properly justified, then + % display it. + strings { + dup cstringwidth pop + justify neg mul 0 moveto + stipple { + % The text is stippled, so turn it into a path and print + % by calling StippledText, which in turn calls + % StippleFill. Unfortunately, many Postscript interpreters + % will get overflow errors if we try to do the whole + % string at once, so do it a character at a time. + gsave + /char (X) def + { + dup type /stringtype eq { + % This segment is a string. + { + char 0 3 -1 roll put + currentpoint + gsave + char true charpath clip StippleText + grestore + char stringwidth translate + moveto + } forall + } { + % This segment is glyph name + % Temporary override + currentfont /Encoding get exch 1 exch put + currentpoint + gsave (\001) true charpath clip StippleText + grestore + (\001) stringwidth translate + moveto + } ifelse + } forall + grestore + } {cstringshow} ifelse + 0 spacing neg translate + } forall + } + + # Define the "TkPhoto" function variants, which are modified versions + # of the original "transparentimage" function posted by ian@five-d.com + # (Ian Kemmish) to comp.lang.postscript. For a monochrome colorLevel + # this is a slightly different version that uses the imagemask command + # instead of image. + + ps function TkPhotoColor { + gsave + 32 dict begin + /tinteger exch def + /transparent 1 string def + transparent 0 tinteger put + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /crpp newdict /Decode get length 2 idiv def + /str w string def + /pix w crpp mul string def + /substrlen 2 w log 2 log div floor exp cvi def + /substrs [ { + substrlen string + 0 1 substrlen 1 sub { + 1 index exch tinteger put + } for + /substrlen substrlen 2 idiv def + substrlen 0 eq {exit} if + } loop ] def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + olddict /DataSource get str readstring pop pop + /tail str def + /x 0 def + olddict /DataSource get pix readstring pop pop + { + tail transparent search dup /done exch not def + {exch pop exch pop} if + /w1 exch length def + w1 0 ne { + newdict /DataSource + pix x crpp mul w1 crpp mul getinterval put + newdict /Width w1 put + mat 4 x neg put + /x x w1 add def + newdict image + /tail tail w1 tail length w1 sub getinterval def + } if + done {exit} if + tail substrs { + anchorsearch {pop} if + } forall + /tail exch def + tail length 0 eq {exit} if + /x w tail length sub def + } loop + } for + end + grestore + } + ps function TkPhotoMono { + gsave + 32 dict begin + /dummyInteger exch def + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /pix w 7 add 8 idiv string def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + 0.000 0.000 0.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + 1.000 1.000 1.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + } for + end + grestore + } + + ps literal %%EndProlog +} + +proc tk::ensure_psenc_is_loaded {} { +} diff --git a/windowsAgent/dist/tk/msgbox.tcl b/windowsAgent/dist/tk/msgbox.tcl new file mode 100644 index 0000000..98603af --- /dev/null +++ b/windowsAgent/dist/tk/msgbox.tcl @@ -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 [list $w.$name invoke] + # bind $w [list $w.$name invoke] + # } + } + bind $w [list ::tk::AltKeyInDialog $w %A] + + if {$data(-default) ne ""} { + bind $w { + if {[winfo class %W] in "Button TButton"} { + %W configure -default active + } + } + bind $w { + if {[winfo class %W] in "Button TButton"} { + %W configure -default normal + } + } + } + + # 6. Create bindings for , and on the dialog + + bind $w { + if {[winfo class %W] in "Button TButton"} { + %W invoke + } + } + + # Invoke the designated cancelling operation + bind $w [list $w.$cancel invoke] + + # At the buttons have vanished, so must do this directly. + bind $w.msg [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 that happens won't cause + # trouble + set result $Priv(button) + + ::tk::RestoreFocusGrab $w $focus + + return $result +} diff --git a/windowsAgent/dist/tk/msgs/cs.msg b/windowsAgent/dist/tk/msgs/cs.msg new file mode 100644 index 0000000..d6be730 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/cs.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/da.msg b/windowsAgent/dist/tk/msgs/da.msg new file mode 100644 index 0000000..c302c79 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/da.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/de.msg b/windowsAgent/dist/tk/msgs/de.msg new file mode 100644 index 0000000..e420f8a --- /dev/null +++ b/windowsAgent/dist/tk/msgs/de.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/el.msg b/windowsAgent/dist/tk/msgs/el.msg new file mode 100644 index 0000000..2e3f236 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/el.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/en.msg b/windowsAgent/dist/tk/msgs/en.msg new file mode 100644 index 0000000..5ad1094 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/en.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/en_gb.msg b/windowsAgent/dist/tk/msgs/en_gb.msg new file mode 100644 index 0000000..efafa38 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/en_gb.msg @@ -0,0 +1,3 @@ +namespace eval ::tk { + ::msgcat::mcset en_gb Color Colour +} diff --git a/windowsAgent/dist/tk/msgs/eo.msg b/windowsAgent/dist/tk/msgs/eo.msg new file mode 100644 index 0000000..3645630 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/eo.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/es.msg b/windowsAgent/dist/tk/msgs/es.msg new file mode 100644 index 0000000..578c52c --- /dev/null +++ b/windowsAgent/dist/tk/msgs/es.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/fr.msg b/windowsAgent/dist/tk/msgs/fr.msg new file mode 100644 index 0000000..7f42aca --- /dev/null +++ b/windowsAgent/dist/tk/msgs/fr.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/hu.msg b/windowsAgent/dist/tk/msgs/hu.msg new file mode 100644 index 0000000..38ef0b8 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/hu.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/it.msg b/windowsAgent/dist/tk/msgs/it.msg new file mode 100644 index 0000000..2e1b4bd --- /dev/null +++ b/windowsAgent/dist/tk/msgs/it.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/nl.msg b/windowsAgent/dist/tk/msgs/nl.msg new file mode 100644 index 0000000..148a9e6 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/nl.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/pl.msg b/windowsAgent/dist/tk/msgs/pl.msg new file mode 100644 index 0000000..c20f41e --- /dev/null +++ b/windowsAgent/dist/tk/msgs/pl.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/pt.msg b/windowsAgent/dist/tk/msgs/pt.msg new file mode 100644 index 0000000..c29e293 --- /dev/null +++ b/windowsAgent/dist/tk/msgs/pt.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/msgs/ru.msg b/windowsAgent/dist/tk/msgs/ru.msg new file mode 100644 index 0000000..2aac5bb --- /dev/null +++ b/windowsAgent/dist/tk/msgs/ru.msg @@ -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" +} + diff --git a/windowsAgent/dist/tk/msgs/sv.msg b/windowsAgent/dist/tk/msgs/sv.msg new file mode 100644 index 0000000..62bfcbd --- /dev/null +++ b/windowsAgent/dist/tk/msgs/sv.msg @@ -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" +} diff --git a/windowsAgent/dist/tk/obsolete.tcl b/windowsAgent/dist/tk/obsolete.tcl new file mode 100644 index 0000000..3ee7f28 --- /dev/null +++ b/windowsAgent/dist/tk/obsolete.tcl @@ -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 + } +} diff --git a/windowsAgent/dist/tk/optMenu.tcl b/windowsAgent/dist/tk/optMenu.tcl new file mode 100644 index 0000000..7cfdaa0 --- /dev/null +++ b/windowsAgent/dist/tk/optMenu.tcl @@ -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 +} diff --git a/windowsAgent/dist/tk/palette.tcl b/windowsAgent/dist/tk/palette.tcl new file mode 100644 index 0000000..42c6a90 --- /dev/null +++ b/windowsAgent/dist/tk/palette.tcl @@ -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 +} diff --git a/windowsAgent/dist/tk/panedwindow.tcl b/windowsAgent/dist/tk/panedwindow.tcl new file mode 100644 index 0000000..d3dfabc --- /dev/null +++ b/windowsAgent/dist/tk/panedwindow.tcl @@ -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 { ::tk::panedwindow::MarkSash %W %x %y 1 } +bind Panedwindow { ::tk::panedwindow::MarkSash %W %x %y 0 } + +bind Panedwindow { ::tk::panedwindow::DragSash %W %x %y 1 } +bind Panedwindow { ::tk::panedwindow::DragSash %W %x %y 0 } + +bind Panedwindow {::tk::panedwindow::ReleaseSash %W 1} +bind Panedwindow {::tk::panedwindow::ReleaseSash %W 0} + +bind Panedwindow { ::tk::panedwindow::Motion %W %x %y } + +bind Panedwindow { ::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) + } +} diff --git a/windowsAgent/dist/tk/pkgIndex.tcl b/windowsAgent/dist/tk/pkgIndex.tcl new file mode 100644 index 0000000..f3acba7 --- /dev/null +++ b/windowsAgent/dist/tk/pkgIndex.tcl @@ -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] +} diff --git a/windowsAgent/dist/tk/safetk.tcl b/windowsAgent/dist/tk/safetk.tcl new file mode 100644 index 0000000..9f8e25d --- /dev/null +++ b/windowsAgent/dist/tk/safetk.tcl @@ -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 [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] +} diff --git a/windowsAgent/dist/tk/scale.tcl b/windowsAgent/dist/tk/scale.tcl new file mode 100644 index 0000000..fb9b81b --- /dev/null +++ b/windowsAgent/dist/tk/scale.tcl @@ -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 { + if {$tk_strictMotif} { + set tk::Priv(activeBg) [%W cget -activebackground] + %W configure -activebackground [%W cget -background] + } + tk::ScaleActivate %W %x %y +} +bind Scale { + tk::ScaleActivate %W %x %y +} +bind Scale { + 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 { + tk::ScaleDrag %W %x %y +} +bind Scale { } +bind Scale { } +bind Scale { + tk::CancelRepeat + tk::ScaleEndDrag %W + tk::ScaleActivate %W %x %y +} +bind Scale <2> { + tk::ScaleButton2Down %W %x %y +} +bind Scale { + tk::ScaleDrag %W %x %y +} +bind Scale { } +bind Scale { } +bind Scale { + 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 [bind Scale ] + bind Scale [bind Scale ] + bind Scale [bind Scale ] + bind Scale [bind Scale ] +} +bind Scale { + tk::ScaleControlPress %W %x %y +} +bind Scale <> { + tk::ScaleIncrement %W up little noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W down little noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W up little noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W down little noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W up big noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W down big noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W up big noRepeat +} +bind Scale <> { + tk::ScaleIncrement %W down big noRepeat +} +bind Scale <> { + %W set [%W cget -from] +} +bind Scale <> { + %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 +} diff --git a/windowsAgent/dist/tk/scrlbar.tcl b/windowsAgent/dist/tk/scrlbar.tcl new file mode 100644 index 0000000..6f1caa2 --- /dev/null +++ b/windowsAgent/dist/tk/scrlbar.tcl @@ -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 { + if {$tk_strictMotif} { + set tk::Priv(activeBg) [%W cget -activebackground] + %W configure -activebackground [%W cget -background] + } + %W activate [%W identify %x %y] +} +bind Scrollbar { + %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 { + 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 { + tk::ScrollDrag %W %x %y +} +bind Scrollbar { + tk::ScrollDrag %W %x %y +} +bind Scrollbar { + tk::ScrollButtonUp %W %x %y +} +bind Scrollbar { + # Prevents binding from being invoked. +} +bind Scrollbar { + # Prevents binding from being invoked. +} +bind Scrollbar <2> { + tk::ScrollButton2Down %W %x %y +} +bind Scrollbar { + # Do nothing, since button 1 is already down. +} +bind Scrollbar { + # Do nothing, since button 2 is already down. +} +bind Scrollbar { + tk::ScrollDrag %W %x %y +} +bind Scrollbar { + tk::ScrollButtonUp %W %x %y +} +bind Scrollbar { + # Do nothing: B1 release will handle it. +} +bind Scrollbar { + # Do nothing: B2 release will handle it. +} +bind Scrollbar { + # Prevents binding from being invoked. +} +bind Scrollbar { + # Prevents binding from being invoked. +} +bind Scrollbar { + tk::ScrollTopBottom %W %x %y +} +bind Scrollbar { + tk::ScrollTopBottom %W %x %y +} + +bind Scrollbar <> { + tk::ScrollByUnits %W v -1 +} +bind Scrollbar <> { + tk::ScrollByUnits %W v 1 +} +bind Scrollbar <> { + tk::ScrollByPages %W v -1 +} +bind Scrollbar <> { + tk::ScrollByPages %W v 1 +} +bind Scrollbar <> { + tk::ScrollByUnits %W h -1 +} +bind Scrollbar <> { + tk::ScrollByUnits %W h 1 +} +bind Scrollbar <> { + tk::ScrollByPages %W h -1 +} +bind Scrollbar <> { + tk::ScrollByPages %W h 1 +} +bind Scrollbar { + tk::ScrollByPages %W hv -1 +} +bind Scrollbar { + tk::ScrollByPages %W hv 1 +} +bind Scrollbar <> { + tk::ScrollToPos %W 0 +} +bind Scrollbar <> { + tk::ScrollToPos %W 1 +} +} +switch [tk windowingsystem] { + "aqua" { + bind Scrollbar { + tk::ScrollByUnits %W v [expr {- (%D)}] + } + bind Scrollbar { + tk::ScrollByUnits %W v [expr {-10 * (%D)}] + } + bind Scrollbar { + tk::ScrollByUnits %W h [expr {- (%D)}] + } + bind Scrollbar { + tk::ScrollByUnits %W h [expr {-10 * (%D)}] + } + } + "win32" { + bind Scrollbar { + tk::ScrollByUnits %W v [expr {- (%D / 120) * 4}] + } + bind Scrollbar { + tk::ScrollByUnits %W h [expr {- (%D / 120) * 4}] + } + } + "x11" { + bind Scrollbar { + tk::ScrollByUnits %W v [expr {- (%D /120 ) * 4}] + } + bind Scrollbar { + 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 {tk::ScrollByUnits %W h -5} + bind Scrollbar {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 + } +} diff --git a/windowsAgent/dist/tk/spinbox.tcl b/windowsAgent/dist/tk/spinbox.tcl new file mode 100644 index 0000000..1965ed8 --- /dev/null +++ b/windowsAgent/dist/tk/spinbox.tcl @@ -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 <> { + 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 <> { + 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 <> { + 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 <> { + %W delete sel.first sel.last +} +bind Spinbox <> { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { + ::tk::spinbox::Paste %W %x + } +} + +bind Spinbox <> { + %W selection range 0 end + %W icursor end +} + +# Standard Motif bindings: + +bind Spinbox <1> { + ::tk::spinbox::ButtonDown %W %x %y +} +bind Spinbox { + ::tk::spinbox::Motion %W %x %y +} +bind Spinbox { + ::tk::spinbox::ArrowPress %W %x %y + set tk::Priv(selectMode) word + ::tk::spinbox::MouseSelect %W %x sel.first +} +bind Spinbox { + ::tk::spinbox::ArrowPress %W %x %y + set tk::Priv(selectMode) line + ::tk::spinbox::MouseSelect %W %x 0 +} +bind Spinbox { + set tk::Priv(selectMode) char + %W selection adjust @%x +} +bind Spinbox { + set tk::Priv(selectMode) word + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox { + set tk::Priv(selectMode) line + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox { + set tk::Priv(x) %x + ::tk::spinbox::AutoScan %W +} +bind Spinbox { + tk::CancelRepeat +} +bind Spinbox { + ::tk::spinbox::ButtonUp %W %x %y +} +bind Spinbox { + %W icursor @%x +} + +bind Spinbox <> { + %W invoke buttonup +} +bind Spinbox <> { + %W invoke buttondown +} + +bind Spinbox <> { + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] +} +bind Spinbox <> { + ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] +} +bind Spinbox <> { + ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + ::tk::EntrySeeInsert %W +} +bind Spinbox <> { + ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + ::tk::EntrySeeInsert %W +} +bind Spinbox <> { + ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] +} +bind Spinbox <> { + ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] +} +bind Spinbox <> { + ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] + ::tk::EntrySeeInsert %W +} +bind Spinbox <> { + ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] + ::tk::EntrySeeInsert %W +} +bind Spinbox <> { + ::tk::EntrySetCursor %W 0 +} +bind Spinbox <> { + ::tk::EntryKeySelect %W 0 + ::tk::EntrySeeInsert %W +} +bind Spinbox <> { + ::tk::EntrySetCursor %W end +} +bind Spinbox <> { + ::tk::EntryKeySelect %W end + ::tk::EntrySeeInsert %W +} + +bind Spinbox { + if {[%W selection present]} { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Spinbox { + ::tk::EntryBackspace %W +} + +bind Spinbox { + %W selection from insert +} +bind Spinbox { + %W mark set [tk::TextAnchor %W] insert +} +bind Text { + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert +} +bind Text { + set tk::Priv(selectMode) char + tk::TextKeyExtend %W insert +} +bind Text <> { + %W tag add sel 1.0 end +} +bind Text <> { + %W tag remove sel 1.0 end + # An operation that clears the selection must insert an autoseparator, + # because the selection operation may have moved the insert mark + if {[%W cget -autoseparators]} { + %W edit separator + } +} +bind Text <> { + tk_textCut %W +} +bind Text <> { + tk_textCopy %W +} +bind Text <> { + tk_textPaste %W +} +bind Text <> { + # Make <> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side + if {[%W cget -autoseparators]} { + %W edit separator + } + catch {%W delete sel.first sel.last} + if {[%W cget -autoseparators]} { + %W edit separator + } +} +bind Text <> { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { + tk::TextPasteSelection %W %x %y + } +} +bind Text { + catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} +} +bind Text { + tk::TextInsert %W %A +} + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, if a widget binding for one of these is defined, the +# class binding will also fire and insert the character, +# which is wrong. Ditto for . + +bind Text {# nothing } +bind Text {# nothing} +bind Text {# nothing} +bind Text {# nothing} +bind Text {# nothing} +if {[tk windowingsystem] eq "aqua"} { + bind Text {# nothing} +} + +# Additional emacs-like bindings: + +bind Text { + if {!$tk_strictMotif && [%W compare end != insert+1c]} { + %W delete insert + } +} +bind Text { + if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {[%W compare insert == {insert lineend}]} { + %W delete insert + } else { + %W delete insert {insert lineend} + } + } +} +bind Text { + if {!$tk_strictMotif} { + %W insert insert \n + %W mark set insert insert-1c + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextTranspose %W + } +} + +bind Text <> { + # An Undo operation may remove the separator at the top of the Undo stack. + # Then the item at the top of the stack gets merged with the subsequent changes. + # Place separators before and after Undo to prevent this. + if {[%W cget -autoseparators]} { + %W edit separator + } + catch { %W edit undo } + if {[%W cget -autoseparators]} { + %W edit separator + } +} + +bind Text <> { + catch { %W edit redo } +} + +bind Text { + if {!$tk_strictMotif} { + tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + } +} +bind Text { + if {!$tk_strictMotif && [%W compare end != insert+1c]} { + %W delete insert [tk::TextNextWord %W insert] + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextSetCursor %W [tk::TextNextWord %W insert] + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextSetCursor %W 1.0 + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextSetCursor %W end-1c + } +} +bind Text { + if {!$tk_strictMotif} { + %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + } +} +bind Text { + if {!$tk_strictMotif} { + %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + } +} + +# Macintosh only bindings: + +if {[tk windowingsystem] eq "aqua"} { +bind Text { + tk::TextScrollPages %W 1 +} + +# End of Mac only bindings +} + +# A few additional bindings of my own. + +bind Text { + if {!$tk_strictMotif && [%W compare insert != 1.0]} { + %W delete insert-1c + %W see insert + } +} +bind Text <2> { + if {!$tk_strictMotif} { + tk::TextScanMark %W %x %y + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextScanDrag %W %x %y + } +} +set ::tk::Priv(prevPos) {} + +# The MouseWheel will typically only fire on Windows and MacOS X. +# However, someone could use the "event generate" command to produce one +# on other platforms. We must be careful not to round -ve values of %D +# down to zero. + +if {[tk windowingsystem] eq "aqua"} { + bind Text { + %W yview scroll [expr {-15 * (%D)}] pixels + } + bind Text { + %W yview scroll [expr {-150 * (%D)}] pixels + } + bind Text { + %W xview scroll [expr {-15 * (%D)}] pixels + } + bind Text { + %W xview scroll [expr {-150 * (%D)}] pixels + } +} else { + # We must make sure that positive and negative movements are rounded + # equally to integers, avoiding the problem that + # (int)1/3 = 0, + # but + # (int)-1/3 = -1 + # The following code ensure equal +/- behaviour. + bind Text { + if {%D >= 0} { + %W yview scroll [expr {-%D/3}] pixels + } else { + %W yview scroll [expr {(2-%D)/3}] pixels + } + } + bind Text { + if {%D >= 0} { + %W xview scroll [expr {-%D/3}] pixels + } else { + %W xview scroll [expr {(2-%D)/3}] pixels + } + } +} + +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 Text <4> { + if {!$tk_strictMotif} { + %W yview scroll -50 pixels + } + } + bind Text <5> { + if {!$tk_strictMotif} { + %W yview scroll 50 pixels + } + } + bind Text { + if {!$tk_strictMotif} { + %W xview scroll -50 pixels + } + } + bind Text { + if {!$tk_strictMotif} { + %W xview scroll 50 pixels + } + } +} + +# ::tk::TextClosestGap -- +# Given x and y coordinates, this procedure finds the closest boundary +# between characters to the given coordinates and returns the index +# of the character just after the boundary. +# +# Arguments: +# w - The text window. +# x - X-coordinate within the window. +# y - Y-coordinate within the window. + +proc ::tk::TextClosestGap {w x y} { + set pos [$w index @$x,$y] + set bbox [$w bbox $pos] + if {$bbox eq ""} { + return $pos + } + if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + return $pos + } + $w index "$pos + 1 char" +} + +# ::tk::TextButton1 -- +# This procedure is invoked to handle button-1 presses in text +# widgets. It moves the insertion cursor, sets the selection anchor, +# and claims the input focus. +# +# Arguments: +# w - The text window in which the button was pressed. +# x - The x-coordinate of the button press. +# y - The x-coordinate of the button press. + +proc ::tk::TextButton1 {w x y} { + variable ::tk::Priv + + set Priv(selectMode) char + set Priv(mouseMoved) 0 + set Priv(pressX) $x + set anchorname [tk::TextAnchor $w] + $w mark set insert [TextClosestGap $w $x $y] + $w mark set $anchorname insert + # Set the anchor mark's gravity depending on the click position + # relative to the gap + set bbox [$w bbox [$w index $anchorname]] + if {$x > [lindex $bbox 0]} { + $w mark gravity $anchorname right + } else { + $w mark gravity $anchorname left + } + # Allow focus in any case on Windows, because that will let the + # selection be displayed even for state disabled text widgets. + if {[tk windowingsystem] eq "win32" \ + || [$w cget -state] eq "normal"} { + focus $w + } + if {[$w cget -autoseparators]} { + $w edit separator + } +} + +# ::tk::TextSelectTo -- +# This procedure is invoked to extend the selection, typically when +# dragging it with the mouse. Depending on the selection mode (character, +# word, line) it selects in different-sized units. This procedure +# ignores mouse motions initially until the mouse has moved from +# one character to another or until there have been multiple clicks. +# +# Note that the 'anchor' is implemented programmatically using +# a text widget mark, and uses a name that will be unique for each +# text widget (even when there are multiple peers). Currently the +# anchor is considered private to Tk, hence the name 'tk::anchor$w'. +# +# Arguments: +# w - The text window in which the button was pressed. +# x - Mouse x position. +# y - Mouse y position. + +set ::tk::Priv(textanchoruid) 0 + +proc ::tk::TextAnchor {w} { + variable Priv + if {![info exists Priv(textanchor,$w)]} { + set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)] + } + return $Priv(textanchor,$w) +} + +proc ::tk::TextSelectTo {w x y {extend 0}} { + variable ::tk::Priv + + set anchorname [tk::TextAnchor $w] + set cur [TextClosestGap $w $x $y] + if {[catch {$w index $anchorname}]} { + $w mark set $anchorname $cur + } + set anchor [$w index $anchorname] + if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} { + set Priv(mouseMoved) 1 + } + switch -- $Priv(selectMode) { + char { + if {[$w compare $cur < $anchorname]} { + set first $cur + set last $anchorname + } else { + set first $anchorname + set last $cur + } + } + word { + # Set initial range based only on the anchor (1 char min width) + if {[$w mark gravity $anchorname] eq "right"} { + set first $anchorname + set last "$anchorname + 1c" + } else { + set first "$anchorname - 1c" + set last $anchorname + } + # Extend range (if necessary) based on the current point + if {[$w compare $cur < $first]} { + set first $cur + } elseif {[$w compare $cur > $last]} { + set last $cur + } + + # Now find word boundaries + set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore] + set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter] + } + line { + # Set initial range based only on the anchor + set first "$anchorname linestart" + set last "$anchorname lineend" + + # Extend range (if necessary) based on the current point + if {[$w compare $cur < $first]} { + set first "$cur linestart" + } elseif {[$w compare $cur > $last]} { + set last "$cur lineend" + } + set first [$w index $first] + set last [$w index "$last + 1c"] + } + } + if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} { + $w tag remove sel 0.0 end + $w mark set insert $cur + $w tag add sel $first $last + $w tag remove sel $last end + update idletasks + } +} + +# ::tk::TextKeyExtend -- +# This procedure handles extending the selection from the keyboard, +# where the point to extend to is really the boundary between two +# characters rather than a particular character. +# +# Arguments: +# w - The text window. +# index - The point to which the selection is to be extended. + +proc ::tk::TextKeyExtend {w index} { + + set anchorname [tk::TextAnchor $w] + set cur [$w index $index] + if {[catch {$w index $anchorname}]} { + $w mark set $anchorname $cur + } + set anchor [$w index $anchorname] + if {[$w compare $cur < $anchorname]} { + set first $cur + set last $anchorname + } else { + set first $anchorname + set last $cur + } + $w tag remove sel 0.0 $first + $w tag add sel $first $last + $w tag remove sel $last end +} + +# ::tk::TextPasteSelection -- +# This procedure sets the insertion cursor to the mouse position, +# inserts the selection, and sets the focus to the window. +# +# Arguments: +# w - The text window. +# x, y - Position of the mouse. + +proc ::tk::TextPasteSelection {w x y} { + $w mark set insert [TextClosestGap $w $x $y] + if {![catch {::tk::GetSelection $w PRIMARY} sel]} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w configure -autoseparators 0 + $w edit separator + } + $w insert insert $sel + if {$oldSeparator} { + $w edit separator + $w configure -autoseparators 1 + } + } + if {[$w cget -state] eq "normal"} { + focus $w + } +} + +# ::tk::TextAutoScan -- +# This procedure is invoked when the mouse leaves a text window +# with button 1 down. It scrolls the window up, down, left, or right, +# depending on where the mouse is (this information was saved in +# ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after" +# command so that the window continues to scroll until the mouse +# moves back into the window or the mouse button is released. +# +# Arguments: +# w - The text window. + +proc ::tk::TextAutoScan {w} { + variable ::tk::Priv + if {![winfo exists $w]} { + return + } + if {$Priv(y) >= [winfo height $w]} { + $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels + } elseif {$Priv(y) < 0} { + $w yview scroll [expr {-1 + $Priv(y)}] pixels + } elseif {$Priv(x) >= [winfo width $w]} { + $w xview scroll 2 units + } elseif {$Priv(x) < 0} { + $w xview scroll -2 units + } else { + return + } + TextSelectTo $w $Priv(x) $Priv(y) + set Priv(afterId) [after 50 [list tk::TextAutoScan $w]] +} + +# ::tk::TextSetCursor +# Move the insertion cursor to a given position in a text. Also +# clears the selection, if there is one in the text, and makes sure +# that the insertion cursor is visible. Also, don't let the insertion +# cursor appear on the dummy last line of the text. +# +# Arguments: +# w - The text window. +# pos - The desired new position for the cursor in the window. + +proc ::tk::TextSetCursor {w pos} { + if {[$w compare $pos == end]} { + set pos {end - 1 chars} + } + $w mark set insert $pos + $w tag remove sel 1.0 end + $w see insert + if {[$w cget -autoseparators]} { + $w edit separator + } +} + +# ::tk::TextKeySelect +# This procedure is invoked when stroking out selections using the +# keyboard. It moves the cursor to a new position, then extends +# the selection to that position. +# +# Arguments: +# w - The text window. +# new - A new position for the insertion cursor (the cursor hasn't +# actually been moved to this position yet). + +proc ::tk::TextKeySelect {w new} { + set anchorname [tk::TextAnchor $w] + if {[$w tag nextrange sel 1.0 end] eq ""} { + if {[$w compare $new < insert]} { + $w tag add sel $new insert + } else { + $w tag add sel insert $new + } + $w mark set $anchorname insert + } else { + if {[catch {$w index $anchorname}]} { + $w mark set $anchorname insert + } + if {[$w compare $new < $anchorname]} { + set first $new + set last $anchorname + } else { + set first $anchorname + set last $new + } + $w tag remove sel 1.0 $first + $w tag add sel $first $last + $w tag remove sel $last end + } + $w mark set insert $new + $w see insert + update idletasks +} + +# ::tk::TextResetAnchor -- +# Set the selection anchor to whichever end is farthest from the +# index argument. One special trick: if the selection has two or +# fewer characters, just leave the anchor where it is. In this +# case it doesn't matter which point gets chosen for the anchor, +# and for the things like Shift-Left and Shift-Right this produces +# better behavior when the cursor moves back and forth across the +# anchor. +# +# Arguments: +# w - The text widget. +# index - Position at which mouse button was pressed, which determines +# which end of selection should be used as anchor point. + +proc ::tk::TextResetAnchor {w index} { + if {[$w tag ranges sel] eq ""} { + # Don't move the anchor if there is no selection now; this + # makes the widget behave "correctly" when the user clicks + # once, then shift-clicks somewhere -- ie, the area between + # the two clicks will be selected. [Bug: 5929]. + return + } + set anchorname [tk::TextAnchor $w] + set a [$w index $index] + set b [$w index sel.first] + set c [$w index sel.last] + if {[$w compare $a < $b]} { + $w mark set $anchorname sel.last + return + } + if {[$w compare $a > $c]} { + $w mark set $anchorname sel.first + return + } + scan $a "%d.%d" lineA chA + scan $b "%d.%d" lineB chB + scan $c "%d.%d" lineC chC + if {$lineB < $lineC+2} { + set total [string length [$w get $b $c]] + if {$total <= 2} { + return + } + if {[string length [$w get $b $a]] < ($total/2)} { + $w mark set $anchorname sel.last + } else { + $w mark set $anchorname sel.first + } + return + } + if {($lineA-$lineB) < ($lineC-$lineA)} { + $w mark set $anchorname sel.last + } else { + $w mark set $anchorname sel.first + } +} + +# ::tk::TextCursorInSelection -- +# Check whether the selection exists and contains the insertion cursor. Note +# that it assumes that the selection is contiguous. +# +# Arguments: +# w - The text widget whose selection is to be checked + +proc ::tk::TextCursorInSelection {w} { + expr { + [llength [$w tag ranges sel]] + && [$w compare sel.first <= insert] + && [$w compare sel.last >= insert] + } +} + +# ::tk::TextInsert -- +# Insert a string into a text at the point of the insertion cursor. +# If there is a selection in the text, and it covers the point of the +# insertion cursor, then delete the selection before inserting. +# +# Arguments: +# w - The text window in which to insert the string +# s - The string to insert (usually just a single character) + +proc ::tk::TextInsert {w s} { + if {$s eq "" || [$w cget -state] eq "disabled"} { + return + } + set compound 0 + if {[TextCursorInSelection $w]} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w configure -autoseparators 0 + $w edit separator + set compound 1 + } + $w delete sel.first sel.last + } + $w insert insert $s + $w see insert + if {$compound && $oldSeparator} { + $w edit separator + $w configure -autoseparators 1 + } +} + +# ::tk::TextUpDownLine -- +# Returns the index of the character one display line above or below the +# insertion cursor. There are two tricky things here. First, we want to +# maintain the original x position across repeated operations, even though +# some lines that will get passed through don't have enough characters to +# cover the original column. Second, don't try to scroll past the +# beginning or end of the text. +# +# Arguments: +# w - The text window in which the cursor is to move. +# n - The number of display lines to move: -1 for up one line, +# +1 for down one line. + +proc ::tk::TextUpDownLine {w n} { + variable ::tk::Priv + + set i [$w index insert] + if {$Priv(prevPos) ne $i} { + set Priv(textPosOrig) $i + } + set lines [$w count -displaylines $Priv(textPosOrig) $i] + set new [$w index \ + "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"] + if {[$w compare $new == end] \ + || [$w compare $new == "insert display linestart"]} { + set new $i + } + set Priv(prevPos) $new + return $new +} + +# ::tk::TextPrevPara -- +# Returns the index of the beginning of the paragraph just before a given +# position in the text (the beginning of a paragraph is the first non-blank +# character after a blank line). +# +# Arguments: +# w - The text window in which the cursor is to move. +# pos - Position at which to start search. + +proc ::tk::TextPrevPara {w pos} { + set pos [$w index "$pos linestart"] + while {1} { + if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \ + || $pos eq "1.0"} { + if {[regexp -indices -- {^[ \t]+(.)} \ + [$w get $pos "$pos lineend"] -> index]} { + set pos [$w index "$pos + [lindex $index 0] chars"] + } + if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} { + return $pos + } + } + set pos [$w index "$pos - 1 line"] + } +} + +# ::tk::TextNextPara -- +# Returns the index of the beginning of the paragraph just after a given +# position in the text (the beginning of a paragraph is the first non-blank +# character after a blank line). +# +# Arguments: +# w - The text window in which the cursor is to move. +# start - Position at which to start search. + +proc ::tk::TextNextPara {w start} { + set pos [$w index "$start linestart + 1 line"] + while {[$w get $pos] ne "\n"} { + if {[$w compare $pos == end]} { + return [$w index "end - 1c"] + } + set pos [$w index "$pos + 1 line"] + } + while {[$w get $pos] eq "\n"} { + set pos [$w index "$pos + 1 line"] + if {[$w compare $pos == end]} { + return [$w index "end - 1c"] + } + } + if {[regexp -indices -- {^[ \t]+(.)} \ + [$w get $pos "$pos lineend"] -> index]} { + return [$w index "$pos + [lindex $index 0] chars"] + } + return $pos +} + +# ::tk::TextScrollPages -- +# This is a utility procedure used in bindings for moving up and down +# pages and possibly extending the selection along the way. It scrolls +# the view in the widget by the number of pages, and it returns the +# index of the character that is at the same position in the new view +# as the insertion cursor used to be in the old view. +# +# Arguments: +# w - The text window in which the cursor is to move. +# count - Number of pages forward to scroll; may be negative +# to scroll backwards. + +proc ::tk::TextScrollPages {w count} { + set bbox [$w bbox insert] + $w yview scroll $count pages + if {$bbox eq ""} { + return [$w index @[expr {[winfo height $w]/2}],0] + } + return [$w index @[lindex $bbox 0],[lindex $bbox 1]] +} + +# ::tk::TextTranspose -- +# This procedure implements the "transpose" function for text widgets. +# It tranposes the characters on either side of the insertion cursor, +# unless the cursor is at the end of the line. In this case it +# 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 - Text window in which to transpose. + +proc ::tk::TextTranspose w { + set pos insert + if {[$w compare $pos != "$pos lineend"]} { + set pos [$w index "$pos + 1 char"] + } + set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"] + if {[$w compare "$pos - 1 char" == 1.0]} { + return + } + # ensure this is seen as an atomic op to undo + set autosep [$w cget -autoseparators] + if {$autosep} { + $w configure -autoseparators 0 + $w edit separator + } + $w delete "$pos - 2 char" $pos + $w insert insert $new + $w see insert + if {$autosep} { + $w edit separator + $w configure -autoseparators $autosep + } +} + +# ::tk_textCopy -- +# This procedure copies the selection from a text widget into the +# clipboard. +# +# Arguments: +# w - Name of a text widget. + +proc ::tk_textCopy w { + if {![catch {set data [$w get sel.first sel.last]}]} { + clipboard clear -displayof $w + clipboard append -displayof $w $data + } +} + +# ::tk_textCut -- +# This procedure copies the selection from a text widget into the +# clipboard, then deletes the selection (if it exists in the given +# widget). +# +# Arguments: +# w - Name of a text widget. + +proc ::tk_textCut w { + if {![catch {set data [$w get sel.first sel.last]}]} { + # make <> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side + set oldSeparator [$w cget -autoseparators] + if {([$w cget -state] eq "normal") && $oldSeparator} { + $w edit separator + } + clipboard clear -displayof $w + clipboard append -displayof $w $data + $w delete sel.first sel.last + if {([$w cget -state] eq "normal") && $oldSeparator} { + $w edit separator + } + } +} + +# ::tk_textPaste -- +# This procedure pastes the contents of the clipboard to the insertion +# point in a text widget. +# +# Arguments: +# w - Name of a text widget. + +proc ::tk_textPaste w { + if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w configure -autoseparators 0 + $w edit separator + } + if {[tk windowingsystem] ne "x11"} { + catch { $w delete sel.first sel.last } + } + $w insert insert $sel + if {$oldSeparator} { + $w edit separator + $w configure -autoseparators 1 + } + } +} + +# ::tk::TextNextWord -- +# Returns the index of the next word position after a given position in the +# text. The next word is platform dependent and may be either the next +# end-of-word position or the next start-of-word position after the next +# end-of-word position. +# +# Arguments: +# w - The text window in which the cursor is to move. +# start - Position at which to start search. + +if {[tk windowingsystem] eq "win32"} { + proc ::tk::TextNextWord {w start} { + TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ + tcl_startOfNextWord + } +} else { + proc ::tk::TextNextWord {w start} { + TextNextPos $w $start tcl_endOfWord + } +} + +# ::tk::TextNextPos -- +# Returns the index of the next position after the given starting +# position in the text as computed by a specified function. +# +# Arguments: +# w - The text window in which the cursor is to move. +# start - Position at which to start search. +# op - Function to use to find next position. + +proc ::tk::TextNextPos {w start op} { + set text "" + set cur $start + while {[$w compare $cur < end]} { + set text $text[$w get -displaychars $cur "$cur lineend + 1c"] + set pos [$op $text 0] + if {$pos >= 0} { + return [$w index "$start + $pos display chars"] + } + set cur [$w index "$cur lineend +1c"] + } + return end +} + +# ::tk::TextPrevPos -- +# Returns the index of the previous position before the given starting +# position in the text as computed by a specified function. +# +# Arguments: +# w - The text window in which the cursor is to move. +# start - Position at which to start search. +# op - Function to use to find next position. + +proc ::tk::TextPrevPos {w start op} { + set text "" + set cur $start + while {[$w compare $cur > 0.0]} { + set text [$w get -displaychars "$cur linestart - 1c" $cur]$text + set pos [$op $text end] + if {$pos >= 0} { + return [$w index "$cur linestart - 1c + $pos display chars"] + } + set cur [$w index "$cur linestart - 1c"] + } + return 0.0 +} + +# ::tk::TextScanMark -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanMark {w x y} { + variable ::tk::Priv + $w scan mark $x $y + set Priv(x) $x + set Priv(y) $y + set Priv(mouseMoved) 0 +} + +# ::tk::TextScanDrag -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanDrag {w x y} { + variable ::tk::Priv + # Make sure these exist, as some weird situations can trigger the + # motion binding without the initial press. [Bug #220269] + if {![info exists Priv(x)]} { + set Priv(x) $x + } + if {![info exists Priv(y)]} { + set Priv(y) $y + } + if {($x != $Priv(x)) || ($y != $Priv(y))} { + set Priv(mouseMoved) 1 + } + if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} { + $w scan dragto $x $y + } +} diff --git a/windowsAgent/dist/tk/tk.tcl b/windowsAgent/dist/tk/tk.tcl new file mode 100644 index 0000000..61d1354 --- /dev/null +++ b/windowsAgent/dist/tk/tk.tcl @@ -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 <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> + event $op <> +} + +#---------------------------------------------------------------------- +# 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 <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + # 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 <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + + # Some OS's define a goofy (as in, not ) keysym that is + # returned when the user presses . 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 <> } + # This seems to be correct on *some* HP systems. + catch { event add <> } + + 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 <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + } + "aqua" { + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + + # Official bindings + # See http://support.apple.com/kb/HT1343 + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + event add <> + # Not official, but logical extensions of above. Also derived from + # bindings present in MS Word on OSX. + event add <> + event add <> + event add <> + event add <> + event add <> + } +} + +# ---------------------------------------------------------------------- +# 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 <> +event add <> +bind all <> {tk::TabToWindow [tk_focusNext %W]} +bind all <> {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 <> virtual event to the previous focus window, +# if any, before changing the focus, and a <> 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 <> + } + focus $w + event generate $w <> +} + +# ::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 <> [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 -- +# event handler for standard dialogs. Sends <> +# 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 <> + } +} + +# ::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: diff --git a/windowsAgent/dist/tk/tkfbox.tcl b/windowsAgent/dist/tk/tkfbox.tcl new file mode 100644 index 0000000..f73fdc5 --- /dev/null +++ b/windowsAgent/dist/tk/tkfbox.tcl @@ -0,0 +1,1240 @@ +# tkfbox.tcl -- +# +# Implements the "TK" standard file selection dialog box. This dialog +# box is used on the Unix platforms whenever the tk_strictMotif flag is +# not set. +# +# The "TK" standard file selection dialog box is similar to the file +# selection dialog box on Win95(TM). The user can navigate the +# directories by clicking on the folder icons or by selecting the +# "Directory" option menu. The user can select files by clicking on the +# file icons or by entering a filename in the "Filename:" entry. +# +# Copyright (c) 1994-1998 Sun Microsystems, Inc. +# +# 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 { + namespace import -force ::tk::msgcat::* + variable showHiddenBtn 0 + variable showHiddenVar 1 + + # Create the images if they did not already exist. + if {![info exists ::tk::Priv(updirImage)]} { + set ::tk::Priv(updirImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN + SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE + QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC + JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c + n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs + Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF + uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S + cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq + bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX + BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W + 37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9 + bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E + xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+ + E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx + qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC + Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW + 4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n + 3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG + kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi + w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn + NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV + v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL + mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN + QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF + WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV + h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY + dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC + }] + } + if {![info exists ::tk::Priv(folderImage)]} { + set ::tk::Priv(folderImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA + AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl + Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6 + C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP + qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG + U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7 + 3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl + U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc + K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a + K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n + vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X + fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII= + }] + } + if {![info exists ::tk::Priv(fileImage)]} { + set ::tk::Priv(fileImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva + eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU + OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai + x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3 + A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ + bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/ + KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC + }] + } +} + +# ::tk::dialog::file:: -- +# +# Implements the TK file selection dialog. This dialog is used when the +# tk_strictMotif flag is set to false. This procedure shouldn't be +# called directly. Call tk_getOpenFile or tk_getSaveFile instead. +# +# Arguments: +# type "open" or "save" +# args Options parsed by the procedure. +# + +proc ::tk::dialog::file:: {type args} { + variable ::tk::Priv + variable showHiddenBtn + set dataName __tk_filedialog + upvar ::tk::dialog::file::$dataName data + + Config $dataName $type $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]} { + Create $w TkFDialog + } elseif {[winfo class $w] ne "TkFDialog"} { + destroy $w + Create $w TkFDialog + } 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(typeMenuLab) $w.contents.f2.lab2 + set data(typeMenuBtn) $w.contents.f2.menu + set data(typeMenu) $data(typeMenuBtn).m + set data(okBtn) $w.contents.f2.ok + set data(cancelBtn) $w.contents.f2.cancel + set data(hiddenBtn) $w.contents.f2.hidden + SetSelectMode $w $data(-multiple) + } + if {$showHiddenBtn} { + $data(hiddenBtn) configure -state normal + grid $data(hiddenBtn) + } else { + $data(hiddenBtn) configure -state disabled + grid remove $data(hiddenBtn) + } + + # Make sure subseqent uses of this dialog are independent [Bug 845189] + unset -nocomplain data(extUsed) + + # 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) + } + + # Add traces on the selectPath variable + # + + trace add variable data(selectPath) write \ + [list ::tk::dialog::file::SetPath $w] + $data(dirMenuBtn) configure \ + -textvariable ::tk::dialog::file::${dataName}(selectPath) + + # Cleanup previous menu + # + $data(typeMenu) delete 0 end + $data(typeMenuBtn) configure -state normal -text "" + + # Initialize the file types menu + # + if {[llength $data(-filetypes)]} { + # Default type and name to first entry + set initialtype [lindex $data(-filetypes) 0] + set initialTypeName [lindex $initialtype 0] + if {$data(-typevariable) ne ""} { + upvar #0 $data(-typevariable) typeVariable + if {[info exists typeVariable]} { + set initialTypeName $typeVariable + } + } + foreach type $data(-filetypes) { + set title [lindex $type 0] + set filter [lindex $type 1] + $data(typeMenu) add command -label $title \ + -command [list ::tk::dialog::file::SetFilter $w $type] + # [string first] avoids glob-pattern char issues + if {[string first ${initialTypeName} $title] == 0} { + set initialtype $type + } + } + SetFilter $w $initialtype + $data(typeMenuBtn) configure -state normal + $data(typeMenuLab) configure -state normal + } else { + set data(filter) "*" + $data(typeMenuBtn) configure -state disabled -takefocus 0 + $data(typeMenuLab) configure -state disabled + } + 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(selectFile) + $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) {*}$trace + } + $data(dirMenuBtn) configure -textvariable {} + + return $Priv(selectFilePath) +} + +# ::tk::dialog::file::Config -- +# +# Configures the TK filedialog according to the argument list +# +proc ::tk::dialog::file::Config {dataName type argList} { + upvar ::tk::dialog::file::$dataName data + + set data(type) $type + + # 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) {*}$trace + } + + # 1: the configuration specs + # + set specs { + {-defaultextension "" "" ""} + {-filetypes "" "" ""} + {-initialdir "" "" ""} + {-initialfile "" "" ""} + {-parent "" "" "."} + {-title "" "" ""} + {-typevariable "" "" ""} + } + + # The "-multiple" option is only available for the "open" file dialog. + # + if {$type eq "open"} { + lappend specs {-multiple "" "" "0"} + } + + # The "-confirmoverwrite" option is only for the "save" file dialog. + # + if {$type eq "save"} { + lappend specs {-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"} { + 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 ""} { + # 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] + } + } + set data(selectFile) $data(-initialfile) + + # 5. Parse the -filetypes option + # + set data(origfiletypes) $data(-filetypes) + set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] + + if {![winfo exists $data(-parent)]} { + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" + } + + # Set -multiple to a one or zero value (not other boolean types like + # "yes") so we can use it in tests more easily. + if {$type eq "save"} { + set data(-multiple) 0 + } elseif {$data(-multiple)} { + set data(-multiple) 1 + } else { + set data(-multiple) 0 + } +} + +proc ::tk::dialog::file::Create {w class} { + set dataName [lindex [split $w .] end] + upvar ::tk::dialog::file::$dataName data + variable ::tk::Priv + global tk_library + + toplevel $w -class $class + if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog} + pack [ttk::frame $w.contents] -expand 1 -fill both + #set w $w.contents + + # f1: the frame with the directory option menu + # + set f1 [ttk::frame $w.contents.f1] + bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \ + <> [list focus $f1.menu] + + set data(dirMenuBtn) $f1.menu + if {![info exists data(selectPath)]} { + set data(selectPath) "" + } + set data(dirMenu) $f1.menu.menu + ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \ + -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName] + menu $data(dirMenu) -tearoff 0 + $data(dirMenu) add radiobutton -label "" -variable \ + [format %s(selectPath) ::tk::dialog::file::$dataName] + set data(upBtn) [ttk::button $f1.up] + $data(upBtn) configure -image $Priv(updirImage) + + $f1.menu configure -takefocus 1;# -highlightthickness 2 + + pack $data(upBtn) -side right -padx 4 -fill both + pack $f1.lab -side left -padx 4 -fill both + pack $f1.menu -expand yes -fill both -padx 4 + + # data(icons): the IconList that list the files and directories. + # + if {$class eq "TkFDialog"} { + if { $data(-multiple) } { + set fNameCaption [mc "File &names:"] + } else { + set fNameCaption [mc "File &name:"] + } + set fTypeCaption [mc "Files of &type:"] + set iconListCommand [list ::tk::dialog::file::OkCmd $w] + } else { + set fNameCaption [mc "&Selection:"] + set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w] + } + set data(icons) [::tk::IconList $w.contents.icons \ + -command $iconListCommand -multiple $data(-multiple)] + bind $data(icons) <> \ + [list ::tk::dialog::file::ListBrowse $w] + + # f2: the frame with the OK button, cancel button, "file name" field + # and file types field. + # + set f2 [ttk::frame $w.contents.f2] + bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\ + <> [list focus $f2.ent] + # -pady 0 + set data(ent) [ttk::entry $f2.ent] + + # The font to use for the icons. The default Canvas font on Unix is just + # deviant. + set ::tk::$w.contents.icons(font) [$data(ent) cget -font] + + # Make the file types bits only if this is a File Dialog + if {$class eq "TkFDialog"} { + set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \ + -text $fTypeCaption -anchor e] + # -pady [$f2.lab cget -pady] + set data(typeMenuBtn) [ttk::menubutton $f2.menu \ + -menu $f2.menu.m] + # -indicatoron 1 + set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0] + # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w + bind $data(typeMenuLab) <> [list \ + focus $data(typeMenuBtn)] + } + + # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn is + # true. Create it disabled so the binding doesn't trigger if it isn't + # shown. + if {$class eq "TkFDialog"} { + set text [mc "Show &Hidden Files and Directories"] + } else { + set text [mc "Show &Hidden Directories"] + } + set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \ + -text $text -state disabled \ + -variable ::tk::dialog::file::showHiddenVar \ + -command [list ::tk::dialog::file::UpdateWhenIdle $w]] +# -anchor w -padx 3 + + # the okBtn is created after the typeMenu so that the keyboard traversal + # is in the right order, and add binding so that we find out when the + # dialog is destroyed by the user (added here instead of to the overall + # window so no confusion about how much gets called; exactly + # once will do). [Bug 987169] + + set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \ + -text [mc "&OK"] -default active];# -pady 3] + bind $data(okBtn) [list ::tk::dialog::file::Destroyed $w] + set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \ + -text [mc "&Cancel"] -default normal];# -pady 3] + + # grid the widgets in f2 + # + grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew + grid configure $f2.ent -padx 2 + if {$class eq "TkFDialog"} { + grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \ + -padx 4 -sticky ew + grid configure $data(typeMenuBtn) -padx 0 + grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew + } else { + grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew + } + grid columnconfigure $f2 1 -weight 1 + + # Pack all the frames together. We are done with widget construction. + # + pack $f1 -side top -fill x -pady 4 + pack $f2 -side bottom -pady 4 -fill x + pack $data(icons) -expand yes -fill both -padx 4 -pady 1 + + # Set up the event handlers that are common to Directory and File Dialogs + # + + wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w] + $data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w] + $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w] + bind $w [list $data(cancelBtn) invoke] + bind $w [list tk::AltKeyInDialog $w %A] + + # Set up event handlers specific to File or Directory Dialogs + # + if {$class eq "TkFDialog"} { + bind $data(ent) [list ::tk::dialog::file::ActivateEnt $w] + $data(okBtn) configure -command [list ::tk::dialog::file::OkCmd $w] + bind $w [format { + if {[%s cget -state] eq "normal"} { + focus %s + } + } $data(typeMenuBtn) $data(typeMenuBtn)] + } else { + set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w] + bind $data(ent) $okCmd + $data(okBtn) configure -command $okCmd + bind $w [list focus $data(ent)] + bind $w [list $data(okBtn) invoke] + } + bind $w [list $data(hiddenBtn) invoke] + bind $data(ent) [list ::tk::dialog::file::CompleteEnt $w] + + # Build the focus group for all the entries + # + ::tk::FocusGroup_Create $w + ::tk::FocusGroup_BindIn $w $data(ent) [list \ + ::tk::dialog::file::EntFocusIn $w] + ::tk::FocusGroup_BindOut $w $data(ent) [list \ + ::tk::dialog::file::EntFocusOut $w] +} + +# ::tk::dialog::file::SetSelectMode -- +# +# Set the select mode of the dialog to single select or multi-select. +# +# Arguments: +# w The dialog path. +# multi 1 if the dialog is multi-select; 0 otherwise. +# +# Results: +# None. + +proc ::tk::dialog::file::SetSelectMode {w multi} { + set dataName __tk_filedialog + upvar ::tk::dialog::file::$dataName data + if { $multi } { + set fNameCaption [mc "File &names:"] + } else { + set fNameCaption [mc "File &name:"] + } + set iconListCommand [list ::tk::dialog::file::OkCmd $w] + ::tk::SetAmpText $w.contents.f2.lab $fNameCaption + $data(icons) configure -multiple $multi -command $iconListCommand + return +} + +# ::tk::dialog::file::UpdateWhenIdle -- +# +# Creates an idle event handler which updates the dialog in idle time. +# This is important because loading the directory may take a long time +# and we don't want to load the same directory for multiple times due to +# multiple concurrent events. +# +proc ::tk::dialog::file::UpdateWhenIdle {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[info exists data(updateId)]} { + return + } + set data(updateId) [after idle [list ::tk::dialog::file::Update $w]] +} + +# ::tk::dialog::file::Update -- +# +# Loads the files and directories into the IconList widget. Also sets up +# the directory option menu for quick access to parent directories. +# +proc ::tk::dialog::file::Update {w} { + # This proc may be called within an idle handler. Make sure that the + # window has not been destroyed before this proc is called + if {![winfo exists $w]} { + return + } + set class [winfo class $w] + if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} { + return + } + + set dataName [winfo name $w] + upvar ::tk::dialog::file::$dataName data + variable ::tk::Priv + variable showHiddenVar + global tk_library + unset -nocomplain data(updateId) + + set folder $Priv(folderImage) + set file $Priv(fileImage) + + set appPWD [pwd] + if {[catch { + cd $data(selectPath) + }]} then { + # We cannot change directory to $data(selectPath). $data(selectPath) + # should have been checked before ::tk::dialog::file::Update is + # called, so we normally won't come to here. Anyways, give an error + # and abort action. + tk_messageBox -type ok -parent $w -icon warning -message [mc \ + "Cannot change to the directory \"%1\$s\".\nPermission denied."\ + $data(selectPath)] + cd $appPWD + return + } + + # Turn on the busy cursor. BUG?? We haven't disabled X events, though, + # so the user may still click and cause havoc ... + # + set entCursor [$data(ent) cget -cursor] + set dlgCursor [$w cget -cursor] + $data(ent) configure -cursor watch + $w configure -cursor watch + update idletasks + + $data(icons) deleteall + + set showHidden $showHiddenVar + + # Make the dir list. Note that using an explicit [pwd] (instead of '.') is + # better in some VFS cases. + $data(icons) add $folder [GlobFiltered [pwd] d 1] + + if {$class eq "TkFDialog"} { + # Make the file list if this is a File Dialog, selecting all but + # 'd'irectory type files. + # + $data(icons) add $file [GlobFiltered [pwd] {f b c l p s}] + } + + # Update the Directory: option menu + # + set list "" + set dir "" + foreach subdir [file split $data(selectPath)] { + set dir [file join $dir $subdir] + lappend list $dir + } + + $data(dirMenu) delete 0 end + set var [format %s(selectPath) ::tk::dialog::file::$dataName] + foreach path $list { + $data(dirMenu) add command -label $path -command [list set $var $path] + } + + # Restore the PWD to the application's PWD + # + cd $appPWD + + if {$class eq "TkFDialog"} { + # Restore the Open/Save Button if this is a File Dialog + # + if {$data(type) eq "open"} { + ::tk::SetAmpText $data(okBtn) [mc "&Open"] + } else { + ::tk::SetAmpText $data(okBtn) [mc "&Save"] + } + } + + # turn off the busy cursor. + # + $data(ent) configure -cursor $entCursor + $w configure -cursor $dlgCursor +} + +# ::tk::dialog::file::SetPathSilently -- +# +# Sets data(selectPath) without invoking the trace procedure +# +proc ::tk::dialog::file::SetPathSilently {w path} { + upvar ::tk::dialog::file::[winfo name $w] data + + set cb [list ::tk::dialog::file::SetPath $w] + trace remove variable data(selectPath) write $cb + set data(selectPath) $path + trace add variable data(selectPath) write $cb +} + + +# This proc gets called whenever data(selectPath) is set +# +proc ::tk::dialog::file::SetPath {w name1 name2 op} { + if {[winfo exists $w]} { + upvar ::tk::dialog::file::[winfo name $w] data + UpdateWhenIdle $w + # On directory dialogs, we keep the entry in sync with the currentdir. + if {[winfo class $w] eq "TkChooseDir"} { + $data(ent) delete 0 end + $data(ent) insert end $data(selectPath) + } + } +} + +# This proc gets called whenever data(filter) is set +# +proc ::tk::dialog::file::SetFilter {w type} { + upvar ::tk::dialog::file::[winfo name $w] data + + set data(filterType) $type + set data(filter) [lindex $type 1] + $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1 + + # If we aren't using a default extension, use the one suppled by the + # filter. + if {![info exists data(extUsed)]} { + if {[string length $data(-defaultextension)]} { + set data(extUsed) 1 + } else { + set data(extUsed) 0 + } + } + + if {!$data(extUsed)} { + # Get the first extension in the list that matches {^\*\.\w+$} and + # remove all * from the filter. + set index [lsearch -regexp $data(filter) {^\*\.\w+$}] + if {$index >= 0} { + set data(-defaultextension) \ + [string trimleft [lindex $data(filter) $index] "*"] + } else { + # Couldn't find anything! Reset to a safe default... + set data(-defaultextension) "" + } + } + + $data(icons) see 0 + + UpdateWhenIdle $w +} + +# tk::dialog::file::ResolveFile -- +# +# Interpret the user's text input in a file selection dialog. Performs: +# +# (1) ~ substitution +# (2) resolve all instances of . and .. +# (3) check for non-existent files/directories +# (4) check for chdir permissions +# (5) conversion of environment variable references to their +# contents (once only) +# +# Arguments: +# context: the current directory you are in +# text: the text entered by the user +# defaultext: the default extension to add to files with no extension +# expandEnv: whether to expand environment variables (yes by default) +# +# Return vaue: +# [list $flag $directory $file] +# +# flag = OK : valid input +# = PATTERN : valid directory/pattern +# = PATH : the directory does not exist +# = FILE : the directory exists by the file doesn't exist +# = CHDIR : Cannot change to the directory +# = ERROR : Invalid entry +# +# directory : valid only if flag = OK or PATTERN or FILE +# file : valid only if flag = OK or PATTERN +# +# directory may not be the same as context, because text may contain a +# subdirectory name +# +proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { + set appPWD [pwd] + + set path [JoinFile $context $text] + + # If the file has no extension, append the default. Be careful not to do + # this for directories, otherwise typing a dirname in the box will give + # back "dirname.extension" instead of trying to change dir. + if { + ![file isdirectory $path] && ([file ext $path] eq "") && + ![string match {$*} [file tail $path]] + } then { + set path "$path$defaultext" + } + + if {[catch {file exists $path}]} { + # This "if" block can be safely removed if the following code stop + # generating errors. + # + # file exists ~nonsuchuser + # + return [list ERROR $path ""] + } + + if {[file exists $path]} { + if {[file isdirectory $path]} { + if {[catch {cd $path}]} { + return [list CHDIR $path ""] + } + set directory [pwd] + set file "" + set flag OK + cd $appPWD + } else { + if {[catch {cd [file dirname $path]}]} { + return [list CHDIR [file dirname $path] ""] + } + set directory [pwd] + set file [file tail $path] + set flag OK + cd $appPWD + } + } else { + set dirname [file dirname $path] + if {[file exists $dirname]} { + if {[catch {cd $dirname}]} { + return [list CHDIR $dirname ""] + } + set directory [pwd] + cd $appPWD + set file [file tail $path] + # It's nothing else, so check to see if it is an env-reference + if {$expandEnv && [string match {$*} $file]} { + set var [string range $file 1 end] + if {[info exist ::env($var)]} { + return [ResolveFile $context $::env($var) $defaultext 0] + } + } + if {[regexp {[*?]} $file]} { + set flag PATTERN + } else { + set flag FILE + } + } else { + set directory $dirname + set file [file tail $path] + set flag PATH + # It's nothing else, so check to see if it is an env-reference + if {$expandEnv && [string match {$*} $file]} { + set var [string range $file 1 end] + if {[info exist ::env($var)]} { + return [ResolveFile $context $::env($var) $defaultext 0] + } + } + } + } + + return [list $flag $directory $file] +} + + +# Gets called when the entry box gets keyboard focus. We clear the selection +# from the icon list . This way the user can be certain that the input in the +# entry box is the selection. +# +proc ::tk::dialog::file::EntFocusIn {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[$data(ent) get] ne ""} { + $data(ent) selection range 0 end + $data(ent) icursor end + } else { + $data(ent) selection clear + } + + if {[winfo class $w] eq "TkFDialog"} { + # If this is a File Dialog, make sure the buttons are labeled right. + if {$data(type) eq "open"} { + ::tk::SetAmpText $data(okBtn) [mc "&Open"] + } else { + ::tk::SetAmpText $data(okBtn) [mc "&Save"] + } + } +} + +proc ::tk::dialog::file::EntFocusOut {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + $data(ent) selection clear +} + + +# Gets called when user presses Return in the "File name" entry. +# +proc ::tk::dialog::file::ActivateEnt {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set text [$data(ent) get] + if {$data(-multiple)} { + foreach t $text { + VerifyFileName $w $t + } + } else { + VerifyFileName $w $text + } +} + +# Verification procedure +# +proc ::tk::dialog::file::VerifyFileName {w filename} { + upvar ::tk::dialog::file::[winfo name $w] data + + set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)] + foreach {flag path file} $list { + break + } + + switch -- $flag { + OK { + if {$file eq ""} { + # user has entered an existing (sub)directory + set data(selectPath) $path + $data(ent) delete 0 end + } else { + SetPathSilently $w $path + if {$data(-multiple)} { + lappend data(selectFile) $file + } else { + set data(selectFile) $file + } + Done $w + } + } + PATTERN { + set data(selectPath) $path + set data(filter) $file + } + FILE { + if {$data(type) eq "open"} { + tk_messageBox -icon warning -type ok -parent $w \ + -message [mc "File \"%1\$s\" does not exist." \ + [file join $path $file]] + $data(ent) selection range 0 end + $data(ent) icursor end + } else { + SetPathSilently $w $path + if {$data(-multiple)} { + lappend data(selectFile) $file + } else { + set data(selectFile) $file + } + Done $w + } + } + PATH { + tk_messageBox -icon warning -type ok -parent $w \ + -message [mc "Directory \"%1\$s\" does not exist." $path] + $data(ent) selection range 0 end + $data(ent) icursor end + } + CHDIR { + tk_messageBox -type ok -parent $w -icon warning -message \ + [mc "Cannot change to the directory\ + \"%1\$s\".\nPermission denied." $path] + $data(ent) selection range 0 end + $data(ent) icursor end + } + ERROR { + tk_messageBox -type ok -parent $w -icon warning -message \ + [mc "Invalid file name \"%1\$s\"." $path] + $data(ent) selection range 0 end + $data(ent) icursor end + } + } +} + +# Gets called when user presses the Alt-s or Alt-o keys. +# +proc ::tk::dialog::file::InvokeBtn {w key} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[$data(okBtn) cget -text] eq $key} { + $data(okBtn) invoke + } +} + +# Gets called when user presses the "parent directory" button +# +proc ::tk::dialog::file::UpDirCmd {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {$data(selectPath) ne "/"} { + set data(selectPath) [file dirname $data(selectPath)] + } +} + +# Join a file name to a path name. The "file join" command will break if the +# filename begins with ~ +# +proc ::tk::dialog::file::JoinFile {path file} { + if {[string match {~*} $file] && [file exists $path/$file]} { + return [file join $path ./$file] + } else { + return [file join $path $file] + } +} + +# Gets called when user presses the "OK" button +# +proc ::tk::dialog::file::OkCmd {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set filenames {} + foreach item [$data(icons) selection get] { + lappend filenames [$data(icons) get $item] + } + + if { + ([llength $filenames] && !$data(-multiple)) || + ($data(-multiple) && ([llength $filenames] == 1)) + } then { + set filename [lindex $filenames 0] + set file [JoinFile $data(selectPath) $filename] + if {[file isdirectory $file]} { + ListInvoke $w [list $filename] + return + } + } + + ActivateEnt $w +} + +# Gets called when user presses the "Cancel" button +# +proc ::tk::dialog::file::CancelCmd {w} { + upvar ::tk::dialog::file::[winfo name $w] data + variable ::tk::Priv + + bind $data(okBtn) {} + set Priv(selectFilePath) "" +} + +# Gets called when user destroys the dialog directly [Bug 987169] +# +proc ::tk::dialog::file::Destroyed {w} { + upvar ::tk::dialog::file::[winfo name $w] data + variable ::tk::Priv + + set Priv(selectFilePath) "" +} + +# Gets called when user browses the IconList widget (dragging mouse, arrow +# keys, etc) +# +proc ::tk::dialog::file::ListBrowse {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set text {} + foreach item [$data(icons) selection get] { + lappend text [$data(icons) get $item] + } + if {[llength $text] == 0} { + return + } + if {$data(-multiple)} { + set newtext {} + foreach file $text { + set fullfile [JoinFile $data(selectPath) $file] + if { ![file isdirectory $fullfile] } { + lappend newtext $file + } + } + set text $newtext + set isDir 0 + } else { + set text [lindex $text 0] + set file [JoinFile $data(selectPath) $text] + set isDir [file isdirectory $file] + } + if {!$isDir} { + $data(ent) delete 0 end + $data(ent) insert 0 $text + + if {[winfo class $w] eq "TkFDialog"} { + if {$data(type) eq "open"} { + ::tk::SetAmpText $data(okBtn) [mc "&Open"] + } else { + ::tk::SetAmpText $data(okBtn) [mc "&Save"] + } + } + } elseif {[winfo class $w] eq "TkFDialog"} { + ::tk::SetAmpText $data(okBtn) [mc "&Open"] + } +} + +# Gets called when user invokes the IconList widget (double-click, Return key, +# etc) +# +proc ::tk::dialog::file::ListInvoke {w filenames} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[llength $filenames] == 0} { + return + } + + set file [JoinFile $data(selectPath) [lindex $filenames 0]] + + set class [winfo class $w] + if {$class eq "TkChooseDir" || [file isdirectory $file]} { + set appPWD [pwd] + if {[catch {cd $file}]} { + tk_messageBox -type ok -parent $w -icon warning -message \ + [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file] + } else { + cd $appPWD + set data(selectPath) $file + } + } else { + if {$data(-multiple)} { + set data(selectFile) $filenames + } else { + set data(selectFile) $file + } + Done $w + } +} + +# ::tk::dialog::file::Done -- +# +# Gets called when user has input a valid filename. Pops up a dialog +# box to confirm selection when necessary. Sets the +# tk::Priv(selectFilePath) variable, which will break the "vwait" loop +# in ::tk::dialog::file:: and return the selected filename to the script +# that calls tk_getOpenFile or tk_getSaveFile +# +proc ::tk::dialog::file::Done {w {selectFilePath ""}} { + upvar ::tk::dialog::file::[winfo name $w] data + variable ::tk::Priv + + if {$selectFilePath eq ""} { + if {$data(-multiple)} { + set selectFilePath {} + foreach f $data(selectFile) { + lappend selectFilePath [JoinFile $data(selectPath) $f] + } + } else { + set selectFilePath [JoinFile $data(selectPath) $data(selectFile)] + } + + set Priv(selectFile) $data(selectFile) + set Priv(selectPath) $data(selectPath) + + if {($data(type) eq "save") && $data(-confirmoverwrite) && [file exists $selectFilePath]} { + set reply [tk_messageBox -icon warning -type yesno -parent $w \ + -message [mc "File \"%1\$s\" already exists.\nDo you want\ + to overwrite it?" $selectFilePath]] + if {$reply eq "no"} { + return + } + } + if { + [info exists data(-typevariable)] && $data(-typevariable) ne "" + && [info exists data(-filetypes)] && [llength $data(-filetypes)] + && [info exists data(filterType)] && $data(filterType) ne "" + } then { + upvar #0 $data(-typevariable) typeVariable + set typeVariable [lindex $data(origfiletypes) \ + [lsearch -exact $data(-filetypes) $data(filterType)] 0] + + } + } + bind $data(okBtn) {} + set Priv(selectFilePath) $selectFilePath +} + +# ::tk::dialog::file::GlobFiltered -- +# +# Gets called to do globbing, returning the results and filtering them +# according to the current filter (and removing the entries for '.' and +# '..' which are never shown). Deals with evil cases such as where the +# user is supplying a filter which is an invalid list or where it has an +# unbalanced brace. The resulting list will be dictionary sorted. +# +# Arguments: +# dir Which directory to search +# type List of filetypes to look for ('d' or 'f b c l p s') +# overrideFilter Whether to ignore the filter for this search. +# +# NB: Assumes that the caller has mapped the state variable to 'data'. +# +proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { + variable showHiddenVar + upvar 1 data(filter) filter + + if {$filter eq "*" || $overrideFilter} { + set patterns [list *] + if {$showHiddenVar} { + lappend patterns .* + } + } elseif {[string is list $filter]} { + set patterns $filter + } else { + # Invalid list; assume we can use non-whitespace sequences as words + set patterns [regexp -inline -all {\S+} $filter] + } + + set opts [list -tails -directory $dir -type $type -nocomplain] + + set result {} + catch { + # We have a catch because we might have a really bad pattern (e.g., + # with an unbalanced brace); even [glob -nocomplain] doesn't like it. + # Using a catch ensures that it just means we match nothing instead of + # throwing a nasty error at the user... + foreach f [glob {*}$opts -- {*}$patterns] { + if {$f eq "." || $f eq ".."} { + continue + } + # See ticket [1641721], $f might be a link pointing to a dir + if {$type != "d" && [file isdir [file join $dir $f]]} { + continue + } + lappend result $f + } + } + return [lsort -dictionary -unique $result] +} + +proc ::tk::dialog::file::CompleteEnt {w} { + upvar ::tk::dialog::file::[winfo name $w] data + set f [$data(ent) get] + if {$data(-multiple)} { + if {![string is list $f] || [llength $f] != 1} { + return -code break + } + set f [lindex $f 0] + } + + # Get list of matching filenames and dirnames + set files [if {[winfo class $w] eq "TkFDialog"} { + GlobFiltered $data(selectPath) {f b c l p s} + }] + set dirs2 {} + foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/} + + set targets [concat \ + [lsearch -glob -all -inline $files $f*] \ + [lsearch -glob -all -inline $dirs2 $f*]] + + if {[llength $targets] == 1} { + # We have a winner! + set f [lindex $targets 0] + } elseif {$f in $targets || [llength $targets] == 0} { + if {[string length $f] > 0} { + bell + } + return + } elseif {[llength $targets] > 1} { + # Multiple possibles + if {[string length $f] == 0} { + return + } + set t0 [lindex $targets 0] + for {set len [string length $t0]} {$len>0} {} { + set allmatch 1 + foreach s $targets { + if {![string equal -length $len $s $t0]} { + set allmatch 0 + break + } + } + incr len -1 + if {$allmatch} break + } + set f [string range $t0 0 $len] + } + + if {$data(-multiple)} { + set f [list $f] + } + $data(ent) delete 0 end + $data(ent) insert 0 $f + return -code break +} diff --git a/windowsAgent/dist/tk/ttk/altTheme.tcl b/windowsAgent/dist/tk/ttk/altTheme.tcl new file mode 100644 index 0000000..6fc76f8 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/altTheme.tcl @@ -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 + } +} diff --git a/windowsAgent/dist/tk/ttk/aquaTheme.tcl b/windowsAgent/dist/tk/ttk/aquaTheme.tcl new file mode 100644 index 0000000..d6be5a3 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/aquaTheme.tcl @@ -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) + } +} diff --git a/windowsAgent/dist/tk/ttk/button.tcl b/windowsAgent/dist/tk/ttk/button.tcl new file mode 100644 index 0000000..9f2cec7 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/button.tcl @@ -0,0 +1,83 @@ +# +# Bindings for Buttons, Checkbuttons, and Radiobuttons. +# +# Notes: , 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 event then, which turns off the "active" state) +# +# Normally, and events are +# delivered to the widget which received the initial +# event. However, Tk [grab]s (#1223103) and menu interactions +# (#1222605) can interfere with this. To guard against spurious +# events, the binding only sets +# the pressed state if the button is currently active. +# + +namespace eval ttk::button {} + +bind TButton { %W instate !disabled {%W state active} } +bind TButton { %W state !active } +bind TButton { ttk::button::activate %W } +bind TButton <> { ttk::button::activate %W } + +bind TButton \ + { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } } +bind TButton \ + { %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } } +bind TButton \ + { %W state !pressed } +bind TButton \ + { %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 { ttk::button::RadioTraverse %W -1 } +bind TRadiobutton { ttk::button::RadioTraverse %W +1 } + +# bind TCheckbutton { %W select } +# bind TCheckbutton { %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] +} diff --git a/windowsAgent/dist/tk/ttk/clamTheme.tcl b/windowsAgent/dist/tk/ttk/clamTheme.tcl new file mode 100644 index 0000000..3c6f5c3 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/clamTheme.tcl @@ -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 + } +} diff --git a/windowsAgent/dist/tk/ttk/classicTheme.tcl b/windowsAgent/dist/tk/ttk/classicTheme.tcl new file mode 100644 index 0000000..fefdb99 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/classicTheme.tcl @@ -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)] + } +} diff --git a/windowsAgent/dist/tk/ttk/combobox.tcl b/windowsAgent/dist/tk/ttk/combobox.tcl new file mode 100644 index 0000000..c1b6da6 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/combobox.tcl @@ -0,0 +1,457 @@ +# +# Combobox bindings. +# +# <>: +# +# 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 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 { ttk::combobox::Post %W } +bind TCombobox { ttk::combobox::Unpost %W } + +bind TCombobox { ttk::combobox::Press "" %W %x %y } +bind TCombobox { ttk::combobox::Press "s" %W %x %y } +bind TCombobox { ttk::combobox::Press "2" %W %x %y } +bind TCombobox { ttk::combobox::Press "3" %W %x %y } +bind TCombobox { ttk::combobox::Drag %W %x } +bind TCombobox { ttk::combobox::Motion %W %x %y } + +ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] + +bind TCombobox <> { ttk::combobox::TraverseIn %W } + +### Combobox listbox bindings. +# +bind ComboboxListbox { ttk::combobox::LBSelected %W } +bind ComboboxListbox { ttk::combobox::LBSelected %W } +bind ComboboxListbox { ttk::combobox::LBCancel %W } +bind ComboboxListbox { ttk::combobox::LBTab %W next } +bind ComboboxListbox <> { ttk::combobox::LBTab %W prev } +bind ComboboxListbox { ttk::combobox::LBCleanup %W } +bind ComboboxListbox { ttk::combobox::LBHover %W %x %y } +bind ComboboxListbox { 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 { ttk::combobox::LBCancel %W } + } +} + +### Combobox popdown window bindings. +# +bind ComboboxPopdown { ttk::combobox::MapPopdown %W } +bind ComboboxPopdown { ttk::combobox::UnmapPopdown %W } +bind ComboboxPopdown \ + { 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 <> -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 -- 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 -- binding for ComboboxPopdown +# +proc ttk::combobox::MapPopdown {w} { + [winfo parent $w] state pressed + ttk::globalGrab $w +} + +## UnmapPopdown -- 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 <> +# +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 <> + 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 -- +# 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* diff --git a/windowsAgent/dist/tk/ttk/cursors.tcl b/windowsAgent/dist/tk/ttk/cursors.tcl new file mode 100644 index 0000000..75f7791 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/cursors.tcl @@ -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 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 . [list destroy .] + focus .f +} + +#*EOF* diff --git a/windowsAgent/dist/tk/ttk/defaults.tcl b/windowsAgent/dist/tk/ttk/defaults.tcl new file mode 100644 index 0000000..4c1753d --- /dev/null +++ b/windowsAgent/dist/tk/ttk/defaults.tcl @@ -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)] + } +} diff --git a/windowsAgent/dist/tk/ttk/entry.tcl b/windowsAgent/dist/tk/ttk/entry.tcl new file mode 100644 index 0000000..c123bc9 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/entry.tcl @@ -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: +# +# , , +# , : +# Ttk entry widget doesn't use selection anchor. +# : +# Inserts PRIMARY selection (on non-Windows platforms). +# This is inconsistent with typical platform bindings. +# , : +# These don't do the right thing to start with. +# , , , +# , : +# Judgment call. If happens to be assigned to the Alt key, +# these could conflict with application accelerators. +# (Plus, who has a Meta key these days?) +# : +# Another judgment call. If anyone misses this, let me know +# and I'll put it back. +# + +## Clipboard events: +# +bind TEntry <> { ttk::entry::Cut %W } +bind TEntry <> { ttk::entry::Copy %W } +bind TEntry <> { ttk::entry::Paste %W } +bind TEntry <> { ttk::entry::Clear %W } + +## Button1 bindings: +# Used for selection and navigation. +# +bind TEntry { ttk::entry::Press %W %x } +bind TEntry { ttk::entry::Shift-Press %W %x } +bind TEntry { ttk::entry::Select %W %x word } +bind TEntry { ttk::entry::Select %W %x line } +bind TEntry { ttk::entry::Drag %W %x } + +bind TEntry { ttk::entry::DragOut %W %m } +bind TEntry { ttk::entry::DragIn %W } +bind TEntry { ttk::entry::Release %W } + +bind TEntry <> { + %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } +} + +## Button2 bindings: +# Used for scanning and primary transfer. +# Note: ButtonRelease-2 is mapped to <> in tk.tcl. +# +bind TEntry { ttk::entry::ScanMark %W %x } +bind TEntry { ttk::entry::ScanDrag %W %x } +bind TEntry { ttk::entry::ScanRelease %W %x } +bind TEntry <> { ttk::entry::ScanRelease %W %x } + +## Keyboard navigation bindings: +# +bind TEntry <> { ttk::entry::Move %W prevchar } +bind TEntry <> { ttk::entry::Move %W nextchar } +bind TEntry <> { ttk::entry::Move %W prevword } +bind TEntry <> { ttk::entry::Move %W nextword } +bind TEntry <> { ttk::entry::Move %W home } +bind TEntry <> { ttk::entry::Move %W end } + +bind TEntry <> { ttk::entry::Extend %W prevchar } +bind TEntry <> { ttk::entry::Extend %W nextchar } +bind TEntry <> { ttk::entry::Extend %W prevword } +bind TEntry <> { ttk::entry::Extend %W nextword } +bind TEntry <> { ttk::entry::Extend %W home } +bind TEntry <> { ttk::entry::Extend %W end } + +bind TEntry <> { %W selection range 0 end } +bind TEntry <> { %W selection clear } + +bind TEntry <> { %W selection range 0 end; %W icursor end } + +## Edit bindings: +# +bind TEntry { ttk::entry::Insert %W %A } +bind TEntry { ttk::entry::Delete %W } +bind TEntry { ttk::entry::Backspace %W } + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, the class binding will fire and insert the character. +# Ditto for Escape, Return, and Tab. +# +bind TEntry {# nothing} +bind TEntry {# nothing} +bind TEntry {# nothing} +bind TEntry {# nothing} +bind TEntry {# nothing} +bind TEntry {# nothing} +bind TEntry {# nothing} + +# Argh. Apparently on Windows, the NumLock modifier is interpreted +# as a Command modifier. +if {[tk windowingsystem] eq "aqua"} { + bind TEntry {# nothing} +} +# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] +bind TEntry <> {# nothing} +bind TEntry <> {# nothing} + +## Additional emacs-like bindings: +# +bind TEntry { ttk::entry::Delete %W } +bind TEntry { ttk::entry::Backspace %W } +bind TEntry { %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 } + } +} + +## 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 + } +} + +## binding +# Suspend autoscroll. +# +proc ttk::entry::DragIn {w} { + ttk::CancelRepeat +} + +## 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* diff --git a/windowsAgent/dist/tk/ttk/fonts.tcl b/windowsAgent/dist/tk/ttk/fonts.tcl new file mode 100644 index 0000000..a2781c6 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/fonts.tcl @@ -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* diff --git a/windowsAgent/dist/tk/ttk/menubutton.tcl b/windowsAgent/dist/tk/ttk/menubutton.tcl new file mode 100644 index 0000000..2be064c --- /dev/null +++ b/windowsAgent/dist/tk/ttk/menubutton.tcl @@ -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: 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 event, +# and this might be delivered to the menu. So instead we +# rely on the passive grab that occurs on 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 { %W instate !disabled {%W state active } } +bind TMenubutton { %W state !active } +bind TMenubutton { ttk::menubutton::Popdown %W } +bind TMenubutton <> { ttk::menubutton::Popdown %W } + +if {[tk windowingsystem] eq "x11"} { + bind TMenubutton { ttk::menubutton::Pulldown %W } + bind TMenubutton { ttk::menubutton::TransferGrab %W } + bind TMenubutton { ttk::menubutton::TransferGrab %W } +} else { + bind TMenubutton \ + { %W state pressed ; ttk::menubutton::Popdown %W } + bind TMenubutton \ + { 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* diff --git a/windowsAgent/dist/tk/ttk/notebook.tcl b/windowsAgent/dist/tk/ttk/notebook.tcl new file mode 100644 index 0000000..72b85e6 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/notebook.tcl @@ -0,0 +1,197 @@ +# +# Bindings for TNotebook widget +# + +namespace eval ttk::notebook { + variable TLNotebooks ;# See enableTraversal +} + +bind TNotebook { ttk::notebook::Press %W %x %y } +bind TNotebook { ttk::notebook::CycleTab %W 1; break } +bind TNotebook { ttk::notebook::CycleTab %W -1; break } +bind TNotebook { ttk::notebook::CycleTab %W 1; break } +bind TNotebook { ttk::notebook::CycleTab %W -1; break } +catch { +bind TNotebook { ttk::notebook::CycleTab %W -1; break } +} +bind TNotebook { 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 {+ttk::notebook::TLCycleTab %W 1} + bind $top {+ttk::notebook::TLCycleTab %W -1} + bind $top {+ttk::notebook::TLCycleTab %W 1} + bind $top {+ttk::notebook::TLCycleTab %W -1} + catch { + bind $top {+ttk::notebook::TLCycleTab %W -1} + } + if {[tk windowingsystem] eq "aqua"} { + bind $top \ + +[list ttk::notebook::MnemonicActivation $top %K] + } else { + bind $top \ + +[list ttk::notebook::MnemonicActivation $top %K] + } + bind $top {+ttk::notebook::TLCleanup %W} + } + + lappend TLNotebooks($top) $nb +} + +# TLCleanup -- binding for traversal-enabled toplevels +# +proc ttk::notebook::TLCleanup {w} { + variable TLNotebooks + if {$w eq [winfo toplevel $w]} { + unset -nocomplain -please TLNotebooks($w) + } +} + +# Cleanup -- 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 + } + } +} diff --git a/windowsAgent/dist/tk/ttk/panedwindow.tcl b/windowsAgent/dist/tk/ttk/panedwindow.tcl new file mode 100644 index 0000000..a2e073b --- /dev/null +++ b/windowsAgent/dist/tk/ttk/panedwindow.tcl @@ -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 { ttk::panedwindow::Press %W %x %y } +bind TPanedwindow { ttk::panedwindow::Drag %W %x %y } +bind TPanedwindow { ttk::panedwindow::Release %W %x %y } + +bind TPanedwindow { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow { ttk::panedwindow::ResetCursor %W } +# See <> +bind TPanedwindow <> { 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* diff --git a/windowsAgent/dist/tk/ttk/progress.tcl b/windowsAgent/dist/tk/ttk/progress.tcl new file mode 100644 index 0000000..34dce72 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/progress.tcl @@ -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 +} + + diff --git a/windowsAgent/dist/tk/ttk/scale.tcl b/windowsAgent/dist/tk/ttk/scale.tcl new file mode 100644 index 0000000..62c85bf --- /dev/null +++ b/windowsAgent/dist/tk/ttk/scale.tcl @@ -0,0 +1,94 @@ +# scale.tcl - Copyright (C) 2004 Pat Thoyts +# +# Bindings for the TScale widget + +namespace eval ttk::scale { + variable State + array set State { + dragging 0 + } +} + +bind TScale { ttk::scale::Press %W %x %y } +bind TScale { ttk::scale::Drag %W %x %y } +bind TScale { ttk::scale::Release %W %x %y } + +bind TScale { ttk::scale::Jump %W %x %y } +bind TScale { ttk::scale::Drag %W %x %y } +bind TScale { ttk::scale::Release %W %x %y } + +bind TScale { ttk::scale::Jump %W %x %y } +bind TScale { ttk::scale::Drag %W %x %y } +bind TScale { ttk::scale::Release %W %x %y } + +## Keyboard navigation bindings: +# +bind TScale <> { %W set [%W cget -from] } +bind TScale <> { %W set [%W cget -to] } + +bind TScale <> { ttk::scale::Increment %W -1 } +bind TScale <> { ttk::scale::Increment %W -1 } +bind TScale <> { ttk::scale::Increment %W 1 } +bind TScale <> { ttk::scale::Increment %W 1 } +bind TScale <> { ttk::scale::Increment %W -10 } +bind TScale <> { ttk::scale::Increment %W -10 } +bind TScale <> { ttk::scale::Increment %W 10 } +bind TScale <> { 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}] +} diff --git a/windowsAgent/dist/tk/ttk/scrollbar.tcl b/windowsAgent/dist/tk/ttk/scrollbar.tcl new file mode 100644 index 0000000..4bd5107 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/scrollbar.tcl @@ -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 { ttk::scrollbar::Press %W %x %y } +bind TScrollbar { ttk::scrollbar::Drag %W %x %y } +bind TScrollbar { ttk::scrollbar::Release %W %x %y } + +bind TScrollbar { ttk::scrollbar::Jump %W %x %y } +bind TScrollbar { ttk::scrollbar::Drag %W %x %y } +bind TScrollbar { 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 + } + } +} diff --git a/windowsAgent/dist/tk/ttk/sizegrip.tcl b/windowsAgent/dist/tk/ttk/sizegrip.tcl new file mode 100644 index 0000000..24a67c6 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/sizegrip.tcl @@ -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 { ttk::sizegrip::Press %W %X %Y } +bind TSizegrip { ttk::sizegrip::Drag %W %X %Y } +bind TSizegrip { 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* diff --git a/windowsAgent/dist/tk/ttk/spinbox.tcl b/windowsAgent/dist/tk/ttk/spinbox.tcl new file mode 100644 index 0000000..1aa0ccb --- /dev/null +++ b/windowsAgent/dist/tk/ttk/spinbox.tcl @@ -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 { ttk::spinbox::Motion %W %x %y } +bind TSpinbox { ttk::spinbox::Press %W %x %y } +bind TSpinbox { ttk::spinbox::Release %W } +bind TSpinbox { ttk::spinbox::DoubleClick %W %x %y } +bind TSpinbox {} ;# disable TEntry triple-click + +bind TSpinbox { event generate %W <> } +bind TSpinbox { event generate %W <> } + +bind TSpinbox <> { ttk::spinbox::Spin %W +1 } +bind TSpinbox <> { 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 <> } + *leftarrow - + *downarrow { ttk::Repeatedly event generate $w <> } + *spinbutton { + if {$y * 2 >= [winfo height $w]} { + set event <> + } else { + set event <> + } + 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 <> (-1, up) +# or < (+1, down) events. +# +proc ttk::spinbox::MouseWheel {w dir} { + if {$dir < 0} { + event generate $w <> + } else { + event generate $w <> + } +} + +## 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 <> and <> 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* diff --git a/windowsAgent/dist/tk/ttk/treeview.tcl b/windowsAgent/dist/tk/ttk/treeview.tcl new file mode 100644 index 0000000..1ed87db --- /dev/null +++ b/windowsAgent/dist/tk/ttk/treeview.tcl @@ -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 { ttk::treeview::Motion %W %x %y } +bind Treeview { #nothing } +bind Treeview { ttk::treeview::ActivateHeading {} {}} +bind Treeview { ttk::treeview::Press %W %x %y } +bind Treeview { ttk::treeview::DoubleClick %W %x %y } +bind Treeview { ttk::treeview::Release %W %x %y } +bind Treeview { ttk::treeview::Drag %W %x %y } +bind Treeview { ttk::treeview::Keynav %W up } +bind Treeview { ttk::treeview::Keynav %W down } +bind Treeview { ttk::treeview::Keynav %W right } +bind Treeview { ttk::treeview::Keynav %W left } +bind Treeview { %W yview scroll -1 pages } +bind Treeview { %W yview scroll 1 pages } +bind Treeview { ttk::treeview::ToggleFocus %W } +bind Treeview { ttk::treeview::ToggleFocus %W } + +bind Treeview \ + { ttk::treeview::Select %W %x %y extend } +bind Treeview <> \ + { 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 <> + $w item $item -open true +} + +proc ttk::treeview::CloseItem {w item} { + $w item $item -open false + $w focus $item + event generate $w <> +} + +## 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* diff --git a/windowsAgent/dist/tk/ttk/ttk.tcl b/windowsAgent/dist/tk/ttk/ttk.tcl new file mode 100644 index 0000000..7bae211 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/ttk.tcl @@ -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 <> virtual event to all widgets. +# +proc ::ttk::ThemeChanged {} { + set Q . + while {[llength $Q]} { + set QN [list] + foreach w $Q { + event generate $w <> + 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 <> { tk::TabToWindow [tk_focusNext %W] } +bind TLabel <> { 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* diff --git a/windowsAgent/dist/tk/ttk/utils.tcl b/windowsAgent/dist/tk/ttk/utils.tcl new file mode 100644 index 0000000..7cc1bb7 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/utils.tcl @@ -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 <> + } + focus $w + event generate $w <> +} + +## ttk::clickToFocus $w -- +# Utility routine, used in 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 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 "$callback -1" + bind $bindtag "$callback +1" + } + win32 { + bind $bindtag [append callback { [expr {-(%D/120)}]}] + } + aqua { + bind $bindtag [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 { %W yview scroll -5 units } + bind TtkScrollable { %W yview scroll 5 units } + bind TtkScrollable { %W xview scroll -5 units } + bind TtkScrollable { %W xview scroll 5 units } + } + win32 { + bind TtkScrollable \ + { %W yview scroll [expr {-(%D/120)}] units } + bind TtkScrollable \ + { %W xview scroll [expr {-(%D/120)}] units } + } + aqua { + bind TtkScrollable \ + { %W yview scroll [expr {-(%D)}] units } + bind TtkScrollable \ + { %W xview scroll [expr {-(%D)}] units } + bind TtkScrollable \ + { %W yview scroll [expr {-10*(%D)}] units } + bind TtkScrollable \ + { %W xview scroll [expr {-10*(%D)}] units } + } +} + +#*EOF* diff --git a/windowsAgent/dist/tk/ttk/vistaTheme.tcl b/windowsAgent/dist/tk/ttk/vistaTheme.tcl new file mode 100644 index 0000000..ecb39c9 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/vistaTheme.tcl @@ -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 + } +} diff --git a/windowsAgent/dist/tk/ttk/winTheme.tcl b/windowsAgent/dist/tk/ttk/winTheme.tcl new file mode 100644 index 0000000..a7a2c79 --- /dev/null +++ b/windowsAgent/dist/tk/ttk/winTheme.tcl @@ -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 ; + } +} diff --git a/windowsAgent/dist/tk/ttk/xpTheme.tcl b/windowsAgent/dist/tk/ttk/xpTheme.tcl new file mode 100644 index 0000000..5d8d09b --- /dev/null +++ b/windowsAgent/dist/tk/ttk/xpTheme.tcl @@ -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]; + } +} diff --git a/windowsAgent/dist/tk/unsupported.tcl b/windowsAgent/dist/tk/unsupported.tcl new file mode 100644 index 0000000..b5f404a --- /dev/null +++ b/windowsAgent/dist/tk/unsupported.tcl @@ -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] + } +} diff --git a/windowsAgent/dist/tk/xmfbox.tcl b/windowsAgent/dist/tk/xmfbox.tcl new file mode 100644 index 0000000..14d2be5 --- /dev/null +++ b/windowsAgent/dist/tk/xmfbox.tcl @@ -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] \ + <> [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] \ + <> [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 [list ::tk::AltKeyInDialog $w %A] + + bind $data(fEnt) [list tk::MotifFDialog_ActivateFEnt $w] + bind $data(sEnt) [list tk::MotifFDialog_ActivateSEnt $w] + bind $w [list tk::MotifFDialog_CancelCmd $w] + bind $w.bot {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] \ + <> [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 <> [list tk::MotifFDialog_Browse$cmdPrefix $w] + bind $list \ + [list tk::MotifFDialog_Activate$cmdPrefix $w] + bind $list "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \ + tk::MotifFDialog_Activate$cmdPrefix [list $w]" + + bindtags $list [list Listbox $list [winfo toplevel $list] all] + 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 "" + bind $w [list tk::ListBoxKeyAccel_Unset $w] + bind $w [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 <> + } +} + +proc ::tk::ListBoxKeyAccel_Reset {w} { + variable ::tk::Priv + + unset -nocomplain Priv(lbAccel,$w) +} + +proc ::tk_getFileType {} { + variable ::tk::Priv + + return $Priv(selectFileType) +} +