bunny-lab/Borealis
2
0
Fork 0
Code Issues 10 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Removed the Requirement to Install Python and NodeJS (Now Bundled with Borealis)

Browse Source
This commit is contained in:
Nicole Rappe
2025-04-24 00:42:19 -06:00
parent 785265d3e7
commit 9c68cdea84
7786 changed files with 2386458 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files

272
Dependencies/Python/tcl/tk8.6/bgerror.tcl vendored Normal file
View File

@ -0,0 +1,272 @@
# bgerror.tcl --
#
# Implementation of the bgerror procedure. It posts a dialog box with
# the error message and gives the user a chance to see a more detailed
# stack trace, and possible do something more interesting with that
# trace (like save it to a log). This is adapted from work done by
# Donal K. Fellows.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2007 by ActiveState Software Inc.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
namespace export bgerror
option add *ErrorDialog.function.text [mc "Save To Log"] \
widgetDefault
option add *ErrorDialog.function.command [namespace code SaveToLog]
option add *ErrorDialog*Label.font TkCaptionFont widgetDefault
if {[tk windowingsystem] eq "aqua"} {
option add *ErrorDialog*background systemAlertBackgroundActive \
widgetDefault
option add *ErrorDialog*info.text.background \
systemTextBackgroundColor widgetDefault
option add *ErrorDialog*Button.highlightBackground \
systemAlertBackgroundActive widgetDefault
}
}
proc ::tk::dialog::error::Return {which code} {
variable button
.bgerrorDialog.$which state {active selected focus}
update idletasks
after 100
set button $code
}
proc ::tk::dialog::error::Details {} {
set w .bgerrorDialog
set caption [option get $w.function text {}]
set command [option get $w.function command {}]
if {($caption eq "") || ($command eq "")} {
grid forget $w.function
}
lappend command [$w.top.info.text get 1.0 end-1c]
$w.function configure -text $caption -command $command
grid $w.top.info - -sticky nsew -padx 3m -pady 3m
}
proc ::tk::dialog::error::SaveToLog {text} {
if {$::tcl_platform(platform) eq "windows"} {
set allFiles *.*
} else {
set allFiles *
}
set types [list \
[list [mc "Log Files"] .log] \
[list [mc "Text Files"] .txt] \
[list [mc "All Files"] $allFiles] \
]
set filename [tk_getSaveFile -title [mc "Select Log File"] \
-filetypes $types -defaultextension .log -parent .bgerrorDialog]
if {$filename ne {}} {
set f [open $filename w]
puts -nonewline $f $text
close $f
}
return
}
proc ::tk::dialog::error::Destroy {w} {
if {$w eq ".bgerrorDialog"} {
variable button
set button -1
}
}
proc ::tk::dialog::error::DeleteByProtocol {} {
variable button
set button 1
}
proc ::tk::dialog::error::ReturnInDetails w {
bind $w <Return> {}; # Remove this binding
$w invoke
return -code break
}
# ::tk::dialog::error::bgerror --
#
# This is the default version of bgerror.
# It tries to execute tkerror, if that fails it posts a dialog box
# containing the error message and gives the user a chance to ask
# to see a stack trace.
#
# Arguments:
# err - The error message.
#
proc ::tk::dialog::error::bgerror {err {flag 1}} {
global errorInfo
variable button
set info $errorInfo
set ret [catch {::tkerror $err} msg];
if {$ret != 1} {return -code $ret $msg}
# The application's tkerror either failed or was not found
# so we use the default dialog. But on Aqua we cannot display
# the dialog if the background error occurs in an idle task
# being processed inside of [NSView drawRect]. In that case
# we post the dialog as an after task instead.
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
if $flag {
set errorInfo $info
after 500 [list bgerror "$err" 0]
return
}
}
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 $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 <Button-1> {focus %W}
$W.text configure -state disabled
# 2. Fill the top part with bitmap and message
# Max-width of message is the width of the screen...
set wrapwidth [winfo screenwidth $dlg]
# ...minus the width of the icon, padding and a fudge factor for
# the window manager decorations and aesthetics.
set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}]
ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth
ttk::label $dlg.bitmap -image ::tk::icons::error
grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m
grid configure $dlg.bitmap -sticky ne
grid configure $dlg.msg -sticky nsw -padx {0 3m}
grid rowconfigure $dlg.top 1 -weight 1
grid columnconfigure $dlg.top 1 -weight 1
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach {name caption} $buttons {
ttk::button $dlg.$name -text $caption -default normal \
-command [namespace code [list set button $i]]
grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10
grid columnconfigure $dlg.bot $i -weight 1
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
if {($name eq "ok") || ($name eq "dismiss")} {
grid columnconfigure $dlg.bot $i -minsize 90
}
grid configure $dlg.$name -pady 7
}
incr i
}
# The "OK" button is the default for this dialog.
$dlg.ok configure -default active
bind $dlg <Return> [namespace code {Return ok 0}]
bind $dlg <Escape> [namespace code {Return dismiss 1}]
bind $dlg <Destroy> [namespace code {Destroy %W}]
bind $dlg.function <Return> [namespace code {ReturnInDetails %W}]
$dlg.function configure -command [namespace code Details]
# 6. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $dlg
# 7. Set a grab and claim the focus too.
::tk::SetFocusGrab $dlg $dlg.ok
# 8. Ensure that we are topmost.
raise $dlg
if {[tk windowingsystem] eq "win32"} {
# Place it topmost if we aren't at the top of the stacking
# order to ensure that it's seen
if {[lindex [wm stackorder .] end] ne "$dlg"} {
wm attributes $dlg -topmost 1
}
}
# 9. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait [namespace which -variable button]
set copy $button; # Save a copy...
::tk::RestoreFocusGrab $dlg $dlg.ok destroy
if {$copy == 1} {
return -code break
}
}
namespace eval :: {
# Fool the indexer
proc bgerror err {}
rename bgerror {}
namespace import ::tk::dialog::error::bgerror
}

782
Dependencies/Python/tcl/tk8.6/button.tcl vendored Normal file
View File

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

310
Dependencies/Python/tcl/tk8.6/choosedir.tcl vendored Normal file
View File

@ -0,0 +1,310 @@
# 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]
}
if {[winfo exists $data(dirMenuBtn)]} {
$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
}

694
Dependencies/Python/tcl/tk8.6/clrpick.tcl vendored Normal file
View File

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

322
Dependencies/Python/tcl/tk8.6/comdlg.tcl vendored Normal file
View File

@ -0,0 +1,322 @@
# 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 = a list of flags. Currently supported flags are:
# DONTSETDEFAULTS = skip default values setting
#
# 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
#
if {"DONTSETDEFAULTS" ni $flags} {
foreach cmdsw [array names cmd] {
set data($cmdsw) $def($cmdsw)
}
}
# 3: parse the argument list
#
foreach {cmdsw value} $argList {
if {![info exists cmd($cmdsw)]} {
return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \
"bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
set data($cmdsw) $value
}
# Done!
}
proc tclListValidFlags {v} {
upvar $v cmd
set len [llength [array names cmd]]
set i 1
set separator ""
set errormsg ""
foreach cmdsw [lsort [array names cmd]] {
append errormsg "$separator$cmdsw"
incr i
if {$i == $len} {
set separator ", or "
} else {
set separator ", "
}
}
return $errormsg
}
#----------------------------------------------------------------------
#
# Focus Group
#
# Focus groups are used to handle the user's focusing actions inside a
# toplevel.
#
# One example of using focus groups is: when the user focuses on an
# entry, the text in the entry is highlighted and the cursor is put to
# the end of the text. When the user changes focus to another widget,
# the text in the previously focused entry is validated.
#
#----------------------------------------------------------------------
# ::tk::FocusGroup_Create --
#
# Create a focus group. All the widgets in a focus group must be
# within the same focus toplevel. Each toplevel can have only
# one focus group, which is identified by the name of the
# toplevel widget.
#
proc ::tk::FocusGroup_Create {t} {
variable ::tk::Priv
if {[winfo toplevel $t] ne $t} {
return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \
"$t is not a toplevel window"
}
if {![info exists Priv(fg,$t)]} {
set Priv(fg,$t) 1
set Priv(focus,$t) ""
bind $t <FocusIn> [list tk::FocusGroup_In $t %W %d]
bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d]
bind $t <Destroy> [list tk::FocusGroup_Destroy $t %W]
}
}
# ::tk::FocusGroup_BindIn --
#
# Add a widget into the "FocusIn" list of the focus group. The $cmd will be
# called when the widget is focused on by the user.
#
proc ::tk::FocusGroup_BindIn {t w cmd} {
variable FocusIn
variable ::tk::Priv
if {![info exists Priv(fg,$t)]} {
return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
"focus group \"$t\" doesn't exist"
}
set FocusIn($t,$w) $cmd
}
# ::tk::FocusGroup_BindOut --
#
# Add a widget into the "FocusOut" list of the focus group. The
# $cmd will be called when the widget loses the focus (User
# types Tab or click on another widget).
#
proc ::tk::FocusGroup_BindOut {t w cmd} {
variable FocusOut
variable ::tk::Priv
if {![info exists Priv(fg,$t)]} {
return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
"focus group \"$t\" doesn't exist"
}
set FocusOut($t,$w) $cmd
}
# ::tk::FocusGroup_Destroy --
#
# Cleans up when members of the focus group is deleted, or when the
# toplevel itself gets deleted.
#
proc ::tk::FocusGroup_Destroy {t w} {
variable FocusIn
variable FocusOut
variable ::tk::Priv
if {$t eq $w} {
unset Priv(fg,$t)
unset Priv(focus,$t)
foreach name [array names FocusIn $t,*] {
unset FocusIn($name)
}
foreach name [array names FocusOut $t,*] {
unset FocusOut($name)
}
} else {
if {[info exists Priv(focus,$t)] && ($Priv(focus,$t) eq $w)} {
set Priv(focus,$t) ""
}
unset -nocomplain FocusIn($t,$w) FocusOut($t,$w)
}
}
# ::tk::FocusGroup_In --
#
# Handles the <FocusIn> event. Calls the FocusIn command for the newly
# focused widget in the focus group.
#
proc ::tk::FocusGroup_In {t w detail} {
variable FocusIn
variable ::tk::Priv
if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
# This is caused by mouse moving out&in of the window *or*
# ordinary keypresses some window managers (ie: CDE [Bug: 2960]).
return
}
if {![info exists FocusIn($t,$w)]} {
set FocusIn($t,$w) ""
return
}
if {![info exists Priv(focus,$t)]} {
return
}
if {$Priv(focus,$t) eq $w} {
# This is already in focus
#
return
} else {
set Priv(focus,$t) $w
eval $FocusIn($t,$w)
}
}
# ::tk::FocusGroup_Out --
#
# Handles the <FocusOut> event. Checks if this is really a lose
# focus event, not one generated by the mouse moving out of the
# toplevel window. Calls the FocusOut command for the widget
# who loses its focus.
#
proc ::tk::FocusGroup_Out {t w detail} {
variable FocusOut
variable ::tk::Priv
if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
# This is caused by mouse moving out of the window
return
}
if {![info exists Priv(focus,$t)]} {
return
}
if {![info exists FocusOut($t,$w)]} {
return
} else {
eval $FocusOut($t,$w)
set Priv(focus,$t) ""
}
}
# ::tk::FDGetFileTypes --
#
# Process the string given by the -filetypes option of the file
# dialogs. Similar to the C function TkGetFileFilters() on the Mac
# and Windows platform.
#
proc ::tk::FDGetFileTypes {string} {
foreach t $string {
if {[llength $t] < 2 || [llength $t] > 3} {
return -code error -errorcode {TK VALUE FILE_TYPE} \
"bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
}
lappend fileTypes([lindex $t 0]) {*}[lindex $t 1]
}
set types {}
foreach t $string {
set label [lindex $t 0]
set exts {}
if {[info exists hasDoneType($label)]} {
continue
}
# Validate each macType. This is to agree with the
# behaviour of TkGetFileFilters(). This list may be
# empty.
foreach macType [lindex $t 2] {
if {[string length $macType] != 4} {
return -code error -errorcode {TK VALUE MAC_TYPE} \
"bad Macintosh file type \"$macType\""
}
}
set name "$label \("
set sep ""
set doAppend 1
foreach ext $fileTypes($label) {
if {$ext eq ""} {
continue
}
regsub {^[.]} $ext "*." ext
if {![info exists hasGotExt($label,$ext)]} {
if {$doAppend} {
if {[string length $sep] && [string length $name]>40} {
set doAppend 0
append name $sep...
} else {
append name $sep$ext
}
}
lappend exts $ext
set hasGotExt($label,$ext) 1
}
set sep ","
}
append name "\)"
lappend types [list $name $exts]
set hasDoneType($label) 1
}
return $types
}

1154
Dependencies/Python/tcl/tk8.6/console.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

44
Dependencies/Python/tcl/tk8.6/demos/README vendored Normal file
View File

@ -0,0 +1,44 @@
This directory contains a collection of programs to demonstrate
the features of the Tk toolkit. The programs are all scripts for
"wish", a windowing shell. If wish has been installed on your path
then you can invoke any of the programs in this directory just
by typing its file name to your command shell under Unix. Otherwise
invoke wish with the file as its first argument, e.g., "wish hello".
The rest of this file contains a brief description of each program.
Files with names ending in ".tcl" are procedure packages used by one
or more of the demo programs; they can't be used as programs by
themselves so they aren't described below.
hello - Creates a single button; if you click on it, a message
is typed and the application terminates.
widget - Contains a collection of demonstrations of the widgets
currently available in the Tk library. Most of the .tcl
files are scripts for individual demos available through
the "widget" program.
ixset - A simple Tk-based wrapper for the "xset" program, which
allows you to interactively query and set various X options
such as mouse acceleration and bell volume. Thanks to
Pierre David for contributing this example.
rolodex - A mock-up of a simple rolodex application. It has much of
the user interface for such an application but no back-end
database. This program was written in response to Tom
LaStrange's toolkit benchmark challenge.
tcolor - A color editor. Allows you to edit colors in several
different ways, and will also perform automatic updates
using "send".
rmt - Allows you to "hook-up" remotely to any Tk application
on the display. Select an application with the menu,
then just type commands: they'll go to that application.
timer - Displays a seconds timer with start and stop buttons.
Control-c and control-q cause it to exit.
browse - A simple directory browser. Invoke it with and argument
giving the name of the directory you'd like to browse.
Double-click on files or subdirectories to browse them.
Control-c and control-q cause the program to exit.

160
Dependencies/Python/tcl/tk8.6/demos/anilabel.tcl vendored Normal file
View File

@ -0,0 +1,160 @@
# anilabel.tcl --
#
# This demonstration script creates a toplevel window containing
# several animated label widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .anilabel
catch {destroy $w}
toplevel $w
wm title $w "Animated Label Demonstration"
wm iconname $w "anilabel"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "Four animated labels are displayed below; each of the labels on the left is animated by making the text message inside it appear to scroll, and the label on the right is animated by animating the image that it displays."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Ensure that this this is an array
array set animationCallbacks {}
## This callback is the core of how to do animation in Tcl/Tk; all
## animations work in basically the same way, with a procedure that
## uses the [after] command to reschedule itself at some point in the
## future. Of course, the details of how to update the state will vary
## according to what is being animated.
proc RotateLabelText {w interval} {
global animationCallbacks
# Schedule the calling of this procedure again in the future
set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
# We do marquee-like scrolling text by chopping characters off the
# front of the text and sticking them on the end.
set text [$w cget -text]
set newText [string range $text 1 end][string index $text 0]
$w configure -text $newText
}
## A helper procedure to start the animation happening.
proc animateLabelText {w text interval} {
global animationCallbacks
# Install the text into the widget
$w configure -text $text
# Schedule the start of the animation loop
set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
# Make sure that the animation stops and is cleaned up after itself
# when the animated label is destroyed. Note that at this point we
# cannot manipulate the widget itself, as that has already died.
bind $w <Destroy> {
after cancel $animationCallbacks(%W)
unset animationCallbacks(%W)
}
}
## Next, a similar pair of procedures to animate a GIF loaded into a
## photo image.
proc SelectNextImageFrame {w interval} {
global animationCallbacks
set animationCallbacks($w) \
[after $interval SelectNextImageFrame $w $interval]
set image [$w cget -image]
# The easy way to animate a GIF!
set idx -1
scan [$image cget -format] "GIF -index %d" idx
if {[catch {
# Note that we get an error if the index is out of range
$image configure -format "GIF -index [incr idx]"
}]} then {
$image configure -format "GIF -index 0"
}
}
proc animateLabelImage {w imageData interval} {
global animationCallbacks
# Create a multi-frame GIF from base-64-encoded data
set image [image create photo -format GIF -data $imageData]
# Install the image into the widget
$w configure -image $image
# Schedule the start of the animation loop
set animationCallbacks($w) \
[after $interval SelectNextImageFrame $w $interval]
# Make sure that the animation stops and is cleaned up after itself
# when the animated label is destroyed. Note that at this point we
# cannot manipulate the widget itself, as that has already died.
# Also note that this script is in double-quotes; this is always OK
# because image names are chosen automatically to be simple words.
bind $w <Destroy> "
after cancel \$animationCallbacks(%W)
unset animationCallbacks(%W)
rename $image {}
"
}
# Make some widgets to contain the animations
labelframe $w.left -text "Scrolling Texts"
labelframe $w.right -text "GIF Image"
pack $w.left $w.right -side left -padx 10 -pady 10 -expand yes
# This method of scrolling text looks far better with a fixed-width font
label $w.left.l1 -bd 4 -relief ridge -font fixedFont
label $w.left.l2 -bd 4 -relief groove -font fixedFont
label $w.left.l3 -bd 4 -relief flat -font fixedFont -width 18
pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -padx 10 -pady 10 -anchor w
# Don't need to do very much with this label except turn off the border
label $w.right.l -bd 0
pack $w.right.l -side top -expand yes -padx 10 -pady 10
# This is a base-64-encoded animated GIF file.
set tclPoweredData {
R0lGODlhKgBAAPQAAP//////zP//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM
zMyZmcyZZsxmZsxmAMwzAJnMzJmZzJmZmZlmmZlmZplmM5kzM2aZzGZmzGZm
mWZmZmYzZmYzMzNmzDMzZgAzmSH+IE1hZGUgd2l0aCBHSU1QIGJ5IExARGVt
YWlsbHkuY29tACH5BAVkAAEALAAAAAAqAEAAAAX+YCCOZEkyTKM2jOm66yPP
dF03bx7YcuHIDkGBR7SZeIyhTID4FZ+4Es8nQyCe2EeUNJ0peY2s9mi7PhAM
ngEAMGRbUpvzSxskLh1J+Hkg134OdDIDEB+GHxtYMEQMTjMGEYeGFoomezaC
DZGSHFmLXTQKkh8eNQVpZ2afmDQGHaOYSoEyhhcklzVmMpuHnaZmDqiGJbg0
qFqvh6UNAwB7VA+OwydEjgujkgrPNhbTI8dFvNgEYcHcHx0lB1kX2IYeA2G6
NN0YfkXJ2BsAMuAzHB9cZMk3qoEbRzUACsRCUBK5JxsC3iMiKd8GN088SIyT
0RAFSROyeEg38caDiB/+JEgqxsODrZJ1BkT0oHKSmI0ceQxo94HDpg0qsuDk
UmRAMgu8OgwQ+uIJgUMVeGXA+IQkzEeHGvD8cIGlDXsLiRjQ+EHroQhea7xY
8IQBSgYYDi1IS+OFBCgaDMGVS3fGi5BPJpBaENdQ0EomKGD56IHwO39EXiSC
Ysgxor5+Xfgq0qByYUpiXmwuoredB2aYH4gWWda0B7SeNENpEJHC1ghi+pS4
AJpIAwWvKPBi+8YEht5EriEqpFfMlhEdkBNpx0HUhwypx5T4IB1MBg/Ws2sn
wV3MSQOkzI8fUd48Aw3dOZto71x85hHtHijYv18Gf/3GqCdDCXHNoICBobSo
IqBqJLyCoH8JPrLgdh88CKCFD0CGmAiGYPgffwceZh6FC2ohIIklnkhehTNY
4CIHHGzgwYw01ujBBhvAqKOLLq5AAk9kuSPkkKO40NB+h1gnypJIIvkBf09a
N5QIRz5p5ZJXJpmlIVhOGQA2TmIJZZhKKmmll2BqyWSXWUrZpQtpatlmk1c2
KaWRHeTZEJF8SqLDn/hhsOeQgBbqAh6DGqronxeARUIIACH5BAUeAAAALAUA
LgAFAAUAAAUM4CeKz/OV5YmqaRkCACH5BAUeAAEALAUALgAKAAUAAAUUICCK
z/OdJVCaa7p+7aOWcDvTZwgAIfkEBR4AAQAsCwAuAAkABQAABRPgA4zP95zA
eZqoWqqpyqLkZ38hACH5BAUKAAEALAcALgANAA4AAAU7ICA+jwiUJEqeKau+
r+vGaTmac63v/GP9HM7GQyx+jsgkkoRUHJ3Qx0cK/VQVTKtWwbVKn9suNunc
WkMAIfkEBQoAAAAsBwA3AAcABQAABRGgIHzk842j+Yjlt5KuO8JmCAAh+QQF
CgAAACwLADcABwAFAAAFEeAnfN9TjqP5oOWziq05lmUIACH5BAUKAAAALA8A
NwAHAAUAAAUPoPCJTymS3yiQj4qOcPmEACH5BAUKAAAALBMANwAHAAUAAAUR
oCB+z/MJX2o+I2miKimiawgAIfkEBQoAAAAsFwA3AAcABQAABRGgIHzfY47j
Q4qk+aHl+pZmCAAh+QQFCgAAACwbADcABwAFAAAFEaAgfs/zCV9qPiNJouo7
ll8IACH5BAUKAAAALB8ANwADAAUAAAUIoCB8o0iWZggAOw==
}
# Finally, set up the text scrolling animation
animateLabelText $w.left.l1 "* Slow Animation *" 300
animateLabelText $w.left.l2 "* Fast Animation *" 80
animateLabelText $w.left.l3 "This is a longer scrolling text in a widget that will not show the whole message at once. " 150
animateLabelImage $w.right.l $tclPoweredData 100

104
Dependencies/Python/tcl/tk8.6/demos/aniwave.tcl vendored Normal file
View File

@ -0,0 +1,104 @@
# aniwave.tcl --
#
# This demonstration script illustrates how to adjust canvas item
# coordinates in a way that does something fairly similar to waveform
# display.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .aniwave
catch {destroy $w}
toplevel $w
wm title $w "Animated Wave Demonstration"
wm iconname $w "aniwave"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Create a canvas large enough to hold the wave. In fact, the wave
# sticks off both sides of the canvas to prevent visual glitches.
pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
# Ensure that this this is an array
array set animationCallbacks {}
# Creates a coordinates list of a wave. This code does a very sketchy
# job and relies on Tk's line smoothing to make things look better.
set waveCoords {}
for {set x -10} {$x<=300} {incr x 5} {
lappend waveCoords $x 100
}
lappend waveCoords $x 0 [incr x 5] 200
# Create a smoothed line and arrange for its coordinates to be the
# contents of the variable waveCoords.
$w.c create line $waveCoords -tags wave -width 1 -fill green -smooth 1
proc waveCoordsTracer {w args} {
global waveCoords
# Actual visual update will wait until we have finished
# processing; Tk does that for us automatically.
$w.c coords wave $waveCoords
}
trace add variable waveCoords write [list waveCoordsTracer $w]
# Basic motion handler. Given what direction the wave is travelling
# in, it advances the y coordinates in the coordinate-list one step in
# that direction.
proc basicMotion {} {
global waveCoords direction
set oc $waveCoords
for {set i 1} {$i<[llength $oc]} {incr i 2} {
if {$direction eq "left"} {
lset waveCoords $i [lindex $oc \
[expr {$i+2>[llength $oc] ? 1 : $i+2}]]
} else {
lset waveCoords $i \
[lindex $oc [expr {$i-2<0 ? "end" : $i-2}]]
}
}
}
# Oscillation handler. This detects whether to reverse the direction
# of the wave by checking to see if the peak of the wave has moved off
# the screen (whose size we know already.)
proc reverser {} {
global waveCoords direction
if {[lindex $waveCoords 1] < 10} {
set direction "right"
} elseif {[lindex $waveCoords end] < 10} {
set direction "left"
}
}
# Main animation "loop". This calls the two procedures that handle the
# movement repeatedly by scheduling asynchronous calls back to itself
# using the [after] command. This procedure is the fundamental basis
# for all animated effect handling in Tk.
proc move {} {
basicMotion
reverser
# Theoretically 100 frames-per-second (==10ms between frames)
global animationCallbacks
set animationCallbacks(simpleWave) [after 10 move]
}
# Initialise our remaining animation variables
set direction "left"
set animateAfterCallback {}
# Arrange for the animation loop to stop when the canvas is deleted
bind $w.c <Destroy> {
after cancel $animationCallbacks(simpleWave)
unset animationCallbacks(simpleWave)
}
# Start the animation processing
move

241
Dependencies/Python/tcl/tk8.6/demos/arrow.tcl vendored Normal file
View File

@ -0,0 +1,241 @@
# arrow.tcl --
#
# This demonstration script creates a canvas widget that displays a
# large line with an arrowhead whose shape can be edited interactively.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# arrowSetup --
# This procedure regenerates all the text and graphics in the canvas
# window. It's called when the canvas is initially created, and also
# whenever any of the parameters of the arrow head are changed
# interactively.
#
# Arguments:
# c - Name of the canvas widget.
proc arrowSetup c {
upvar #0 demo_arrowInfo v
# Remember the current box, if there is one.
set tags [$c gettags current]
if {$tags != ""} {
set cur [lindex $tags [lsearch -glob $tags box?]]
} else {
set cur ""
}
# Create the arrow and outline.
$c delete all
eval {$c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \
-width [expr {10*$v(width)}] -arrowshape [list \
[expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \
$v(bigLineStyle)
set xtip [expr {$v(x2)-10*$v(b)}]
set deltaY [expr {10*$v(c)+5*$v(width)}]
$c create line $v(x2) $v(y) $xtip [expr {$v(y)+$deltaY}] \
[expr {$v(x2)-10*$v(a)}] $v(y) $xtip [expr {$v(y)-$deltaY}] \
$v(x2) $v(y) -width 2 -capstyle round -joinstyle round
# Create the boxes for reshaping the line and arrowhead.
eval {$c create rect [expr {$v(x2)-10*$v(a)-5}] [expr {$v(y)-5}] \
[expr {$v(x2)-10*$v(a)+5}] [expr {$v(y)+5}] \
-tags {box1 box}} $v(boxStyle)
eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \
[expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \
-tags {box2 box}} $v(boxStyle)
eval {$c create rect [expr {$v(x1)-5}] [expr {$v(y)-5*$v(width)-5}] \
[expr {$v(x1)+5}] [expr {$v(y)-5*$v(width)+5}] \
-tags {box3 box}} $v(boxStyle)
if {$cur != ""} {
eval $c itemconfigure $cur $v(activeStyle)
}
# Create three arrows in actual size with the same parameters
$c create line [expr {$v(x2)+50}] 0 [expr {$v(x2)+50}] 1000 \
-width 2
set tmp [expr {$v(x2)+100}]
$c create line $tmp [expr {$v(y)-125}] $tmp [expr {$v(y)-75}] \
-width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
$c create line [expr {$tmp-25}] $v(y) [expr {$tmp+25}] $v(y) \
-width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
$c create line [expr {$tmp-25}] [expr {$v(y)+75}] [expr {$tmp+25}] \
[expr {$v(y)+125}] -width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
# Create a bunch of other arrows and text items showing the
# current dimensions.
set tmp [expr {$v(x2)+10}]
$c create line $tmp [expr {$v(y)-5*$v(width)}] \
$tmp [expr {$v(y)-$deltaY}] \
-arrow both -arrowshape $v(smallTips)
$c create text [expr {$v(x2)+15}] [expr {$v(y)-$deltaY+5*$v(c)}] \
-text $v(c) -anchor w
set tmp [expr {$v(x1)-10}]
$c create line $tmp [expr {$v(y)-5*$v(width)}] \
$tmp [expr {$v(y)+5*$v(width)}] \
-arrow both -arrowshape $v(smallTips)
$c create text [expr {$v(x1)-15}] $v(y) -text $v(width) -anchor e
set tmp [expr {$v(y)+5*$v(width)+10*$v(c)+10}]
$c create line [expr {$v(x2)-10*$v(a)}] $tmp $v(x2) $tmp \
-arrow both -arrowshape $v(smallTips)
$c create text [expr {$v(x2)-5*$v(a)}] [expr {$tmp+5}] \
-text $v(a) -anchor n
set tmp [expr {$tmp+25}]
$c create line [expr {$v(x2)-10*$v(b)}] $tmp $v(x2) $tmp \
-arrow both -arrowshape $v(smallTips)
$c create text [expr {$v(x2)-5*$v(b)}] [expr {$tmp+5}] \
-text $v(b) -anchor n
$c create text $v(x1) 310 -text "-width $v(width)" \
-anchor w -font {Helvetica 18}
$c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \
-anchor w -font {Helvetica 18}
incr v(count)
}
set w .arrow
catch {destroy $w}
toplevel $w
wm title $w "Arrowhead Editor Demonstration"
wm iconname $w "arrow"
positionWindow $w
set c $w.c
label $w.msg -font $font -wraplength 5i -justify left -text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a canvas line item."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
canvas $c -width 500 -height 350 -relief sunken -borderwidth 2
pack $c -expand yes -fill both
set demo_arrowInfo(a) 8
set demo_arrowInfo(b) 10
set demo_arrowInfo(c) 3
set demo_arrowInfo(width) 2
set demo_arrowInfo(motionProc) arrowMoveNull
set demo_arrowInfo(x1) 40
set demo_arrowInfo(x2) 350
set demo_arrowInfo(y) 150
set demo_arrowInfo(smallTips) {5 5 2}
set demo_arrowInfo(count) 0
if {[winfo depth $c] > 1} {
if {[tk windowingsystem] eq "aqua"} {
set demo_arrowInfo(bigLineStyle) "-fill systemSelectedTextBackgroundColor"
} else {
set demo_arrowInfo(bigLineStyle) "-fill LightSeaGreen"
}
set demo_arrowInfo(boxStyle) "-fill {} -width 1"
set demo_arrowInfo(activeStyle) "-fill red -width 1"
} else {
# Main widget program sets variable tk_demoDirectory
set demo_arrowInfo(bigLineStyle) "-fill black \
-stipple @[file join $tk_demoDirectory images grey.25]"
set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1"
set demo_arrowInfo(activeStyle) "-fill black -outline black -width 1"
}
arrowSetup $c
$c bind box <Enter> "$c itemconfigure current $demo_arrowInfo(activeStyle)"
$c bind box <Leave> "$c itemconfigure current $demo_arrowInfo(boxStyle)"
$c bind box <B1-Enter> " "
$c bind box <B1-Leave> " "
$c bind box1 <Button-1> {set demo_arrowInfo(motionProc) arrowMove1}
$c bind box2 <Button-1> {set demo_arrowInfo(motionProc) arrowMove2}
$c bind box3 <Button-1> {set demo_arrowInfo(motionProc) arrowMove3}
$c bind box <B1-Motion> "\$demo_arrowInfo(motionProc) $c %x %y"
bind $c <ButtonRelease-1> "arrowSetup $c"
# arrowMove1 --
# This procedure is called for each mouse motion event on box1 (the
# one at the vertex of the arrow). It updates the controlling parameters
# for the line and arrowhead.
#
# Arguments:
# c - The name of the canvas window.
# x, y - The coordinates of the mouse.
proc arrowMove1 {c x y} {
upvar #0 demo_arrowInfo v
set newA [expr {($v(x2)+5-round([$c canvasx $x]))/10}]
if {$newA < 0} {
set newA 0
}
if {$newA > 25} {
set newA 25
}
if {$newA != $v(a)} {
$c move box1 [expr {10*($v(a)-$newA)}] 0
set v(a) $newA
}
}
# arrowMove2 --
# This procedure is called for each mouse motion event on box2 (the
# one at the trailing tip of the arrowhead). It updates the controlling
# parameters for the line and arrowhead.
#
# Arguments:
# c - The name of the canvas window.
# x, y - The coordinates of the mouse.
proc arrowMove2 {c x y} {
upvar #0 demo_arrowInfo v
set newB [expr {($v(x2)+5-round([$c canvasx $x]))/10}]
if {$newB < 0} {
set newB 0
}
if {$newB > 25} {
set newB 25
}
set newC [expr {($v(y)+5-round([$c canvasy $y])-5*$v(width))/10}]
if {$newC < 0} {
set newC 0
}
if {$newC > 20} {
set newC 20
}
if {($newB != $v(b)) || ($newC != $v(c))} {
$c move box2 [expr {10*($v(b)-$newB)}] [expr {10*($v(c)-$newC)}]
set v(b) $newB
set v(c) $newC
}
}
# arrowMove3 --
# This procedure is called for each mouse motion event on box3 (the
# one that controls the thickness of the line). It updates the
# controlling parameters for the line and arrowhead.
#
# Arguments:
# c - The name of the canvas window.
# x, y - The coordinates of the mouse.
proc arrowMove3 {c x y} {
upvar #0 demo_arrowInfo v
set newWidth [expr {($v(y)+2-round([$c canvasy $y]))/5}]
if {$newWidth < 0} {
set newWidth 0
}
if {$newWidth > 20} {
set newWidth 20
}
if {$newWidth != $v(width)} {
$c move box3 0 [expr {5*($v(width)-$newWidth)}]
set v(width) $newWidth
}
}

78
Dependencies/Python/tcl/tk8.6/demos/bind.tcl vendored Normal file
View File

@ -0,0 +1,78 @@
# bind.tcl --
#
# This demonstration script creates a text widget with bindings set
# up for hypertext-like effects.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .bind
catch {destroy $w}
toplevel $w
wm title $w "Text Demonstration - Tag Bindings"
wm iconname $w "bind"
positionWindow $w
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
-width 60 -height 24 -font $font -wrap word
ttk::scrollbar $w.scroll -command "$w.text yview"
pack $w.scroll -side right -fill y
pack $w.text -expand yes -fill both
# Set up display styles.
if {[winfo depth $w] > 1} {
set bold "-background #43ce80 -relief raised -borderwidth 1"
set normal "-background {} -relief flat"
} else {
set bold "-foreground white -background black"
set normal "-foreground {} -background {}"
}
# Add text to widget.
$w.text insert 0.0 {\
The same tag mechanism that controls display styles in text widgets can also be used to associate Tcl commands with regions of text, so that mouse or keyboard actions on the text cause particular Tcl commands to be invoked. For example, in the text below the descriptions of the canvas demonstrations have been tagged. When you move the mouse over a demo description the description lights up, and when you press button 1 over a description then that particular demonstration is invoked.
}
$w.text insert end \
{1. Samples of all the different types of items that can be created in canvas widgets.} d1
$w.text insert end \n\n
$w.text insert end \
{2. A simple two-dimensional plot that allows you to adjust the positions of the data points.} d2
$w.text insert end \n\n
$w.text insert end \
{3. Anchoring and justification modes for text items.} d3
$w.text insert end \n\n
$w.text insert end \
{4. An editor for arrow-head shapes for line items.} d4
$w.text insert end \n\n
$w.text insert end \
{5. A ruler with facilities for editing tab stops.} d5
$w.text insert end \n\n
$w.text insert end \
{6. A grid that demonstrates how canvases can be scrolled.} d6
# Create bindings for tags.
foreach tag {d1 d2 d3 d4 d5 d6} {
$w.text tag bind $tag <Enter> "$w.text tag configure $tag $bold"
$w.text tag bind $tag <Leave> "$w.text tag configure $tag $normal"
}
# Main widget program sets variable tk_demoDirectory
$w.text tag bind d1 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory items.tcl]}
$w.text tag bind d2 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory plot.tcl]}
$w.text tag bind d3 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ctext.tcl]}
$w.text tag bind d4 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory arrow.tcl]}
$w.text tag bind d5 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ruler.tcl]}
$w.text tag bind d6 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory cscroll.tcl]}
$w.text mark set insert 0.0
$w.text configure -state disabled

52
Dependencies/Python/tcl/tk8.6/demos/bitmap.tcl vendored Normal file
View File

@ -0,0 +1,52 @@
# bitmap.tcl --
#
# This demonstration script creates a toplevel window that displays
# all of Tk's built-in bitmaps.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# bitmapRow --
# Create a row of bitmap items in a window.
#
# Arguments:
# w - The window that is to contain the row.
# args - The names of one or more bitmaps, which will be displayed
# in a new row across the bottom of w along with their
# names.
proc bitmapRow {w args} {
frame $w
pack $w -side top -fill both
set i 0
foreach bitmap $args {
frame $w.$i
pack $w.$i -side left -fill both -pady .25c -padx .25c
label $w.$i.bitmap -bitmap $bitmap
label $w.$i.label -text $bitmap -width 9
pack $w.$i.label $w.$i.bitmap -side bottom
incr i
}
}
set w .bitmap
catch {destroy $w}
toplevel $w
wm title $w "Bitmap Demonstration"
wm iconname $w "bitmap"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame
bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75
bitmapRow $w.frame.1 hourglass info question questhead warning
pack $w.frame -side top -expand yes -fill both

66
Dependencies/Python/tcl/tk8.6/demos/browse vendored Normal file
View File

@ -0,0 +1,66 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# browse --
# This script generates a directory browser, which lists the working
# directory and allows you to open files or subdirectories by
# double-clicking.
package require Tk
# Create a scrollbar on the right side of the main window and a listbox
# on the left side.
scrollbar .scroll -command ".list yview"
pack .scroll -side right -fill y
listbox .list -yscroll ".scroll set" -relief sunken -width 20 -height 20 \
-setgrid yes
pack .list -side left -fill both -expand yes
wm minsize . 1 1
# The procedure below is invoked to open a browser on a given file; if the
# file is a directory then another instance of this program is invoked; if
# the file is a regular file then the Mx editor is invoked to display
# the file.
set browseScript [file join [pwd] $argv0]
proc browse {dir file} {
global env browseScript
if {[string compare $dir "."] != 0} {set file $dir/$file}
switch [file type $file] {
directory {
exec [info nameofexecutable] $browseScript $file &
}
file {
if {[info exists env(EDITOR)]} {
eval exec $env(EDITOR) $file &
} else {
exec xedit $file &
}
}
default {
puts stdout "\"$file\" isn't a directory or regular file"
}
}
}
# Fill the listbox with a list of all the files in the directory.
if {$argc>0} {set dir [lindex $argv 0]} else {set dir "."}
foreach i [lsort [glob * .* *.*]] {
if {[file type $i] eq "directory"} {
# Safe to do since it is still a directory.
append i /
}
.list insert end $i
}
# Set up bindings for the browser.
bind all <Control-c> {destroy .}
bind .list <Double-Button-1> {foreach i [selection get] {browse $dir $i}}
# Local Variables:
# mode: tcl
# End:

47
Dependencies/Python/tcl/tk8.6/demos/button.tcl vendored Normal file
View File

@ -0,0 +1,47 @@
# button.tcl --
#
# This demonstration script creates a toplevel window containing
# several button widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .button
catch {destroy $w}
toplevel $w
wm title $w "Button Demonstration"
wm iconname $w "button"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any of the four buttons below, the background of the button area will change to the color indicated in the button. You can press Tab to move among the buttons, then press Space to invoke the current button."
pack $w.msg -side top
## See Code / Dismiss buttons
pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
proc colorrefresh {w col} {
$w configure -bg $col
if {[tk windowingsystem] eq "aqua"} {
# set highlightbackground of all buttons in $w
set l [list $w]
while {[llength $l]} {
set l [concat [lassign $l b] [winfo children $b]]
if {[winfo class $b] eq "Button"} {
$b configure -highlightbackground $col
}
}
}
}
button $w.b1 -text "Peach Puff" -width 10 \
-command [list colorrefresh $w PeachPuff1]
button $w.b2 -text "Light Blue" -width 10 \
-command [list colorrefresh $w LightBlue1]
button $w.b3 -text "Sea Green" -width 10 \
-command [list colorrefresh $w SeaGreen2]
button $w.b4 -text "Yellow" -width 10 \
-command [list colorrefresh $w Yellow1]
pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2

71
Dependencies/Python/tcl/tk8.6/demos/check.tcl vendored Normal file
View File

@ -0,0 +1,71 @@
# check.tcl --
#
# This demonstration script creates a toplevel window containing
# several checkbuttons.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .check
catch {destroy $w}
toplevel $w
wm title $w "Checkbutton Demonstration"
wm iconname $w "check"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "Four checkbuttons are displayed below. If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton. The first button also follows the state of the other three. If only some of the three are checked, the first button will display the tri-state mode. Click the \"See Variables\" button to see the current values of the variables."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w [list safety wipers brakes sober]]
pack $btns -side bottom -fill x
checkbutton $w.b0 -text "Safety Check" -variable safety -relief flat \
-onvalue "all" \
-offvalue "none" \
-tristatevalue "partial"
checkbutton $w.b1 -text "Wipers OK" -variable wipers -relief flat
checkbutton $w.b2 -text "Brakes OK" -variable brakes -relief flat
checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat
pack $w.b0 -side top -pady 2 -anchor w
pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w -padx 15
## This code makes $w.b0 function as a tri-state button; it's not
## needed at all for just straight yes/no buttons.
set in_check 0
proc tristate_check {n1 n2 op} {
global safety wipers brakes sober in_check
if {$in_check} {
return
}
set in_check 1
if {$n1 eq "safety"} {
if {$safety eq "none"} {
set wipers 0
set brakes 0
set sober 0
} elseif {$safety eq "all"} {
set wipers 1
set brakes 1
set sober 1
}
} else {
if {$wipers == 1 && $brakes == 1 && $sober == 1} {
set safety all
} elseif {$wipers == 1 || $brakes == 1 || $sober == 1} {
set safety partial
} else {
set safety none
}
}
set in_check 0
}
trace add variable wipers write tristate_check
trace add variable brakes write tristate_check
trace add variable sober write tristate_check
trace add variable safety write tristate_check

54
Dependencies/Python/tcl/tk8.6/demos/clrpick.tcl vendored Normal file
View File

@ -0,0 +1,54 @@
# clrpick.tcl --
#
# This demonstration script prompts the user to select a color.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .clrpick
catch {destroy $w}
toplevel $w
wm title $w "Color Selection Dialog"
wm iconname $w "colors"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "Press the buttons below to choose the foreground and background colors for the widgets in this window."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
button $w.back -text "Set background color ..." \
-command \
"setColor $w $w.back background {-background -highlightbackground}"
button $w.fore -text "Set foreground color ..." \
-command \
"setColor $w $w.back foreground -foreground"
pack $w.back $w.fore -side top -anchor c -pady 2m
proc setColor {w button name options} {
grab $w
set initialColor [$button cget -$name]
set color [tk_chooseColor -title "Choose a $name color" -parent $w \
-initialcolor $initialColor]
if {[string compare $color ""]} {
setColor_helper $w $options $color
}
grab release $w
}
proc setColor_helper {w options color} {
foreach option $options {
catch {
$w config $option $color
}
}
foreach child [winfo children $w] {
setColor_helper $child $options $color
}
}

99
Dependencies/Python/tcl/tk8.6/demos/colors.tcl vendored Normal file
View File

@ -0,0 +1,99 @@
# colors.tcl --
#
# This demonstration script creates a listbox widget that displays
# many of the colors from the X color database. You can click on
# a color to change the application's palette.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .colors
catch {destroy $w}
toplevel $w
wm title $w "Listbox Demonstration (colors)"
wm iconname $w "Listbox"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing several color names is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. If you double-click button 1 on a color, then the application's color palette will be set to match that color"
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth 10
pack $w.frame -side top -expand yes -fill y
scrollbar $w.frame.scroll -command "$w.frame.list yview"
listbox $w.frame.list -yscroll "$w.frame.scroll set" \
-width 20 -height 16 -setgrid 1
pack $w.frame.list $w.frame.scroll -side left -fill y -expand 1
bind $w.frame.list <Double-Button-1> {
tk_setPalette [selection get]
}
$w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \
snow1 snow2 snow3 snow4 seashell1 seashell2 \
seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \
PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \
NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \
LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \
cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \
honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \
LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \
MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \
SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \
RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \
DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \
SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \
DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \
SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \
LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \
LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \
LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \
LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \
PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \
CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \
turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \
DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \
aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \
PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \
green3 green4 chartreuse1 chartreuse2 chartreuse3 \
chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \
DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \
LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \
LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \
LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \
gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \
DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \
RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \
IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \
sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \
wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \
chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \
firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \
salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \
LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \
DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \
coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \
red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \
PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \
VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \
DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
purple2 purple3 purple4 MediumPurple1 MediumPurple2 \
MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \
thistle4

61
Dependencies/Python/tcl/tk8.6/demos/combo.tcl vendored Normal file
View File

@ -0,0 +1,61 @@
# combo.tcl --
#
# This demonstration script creates several combobox widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .combo
catch {destroy $w}
toplevel $w
wm title $w "Combobox Demonstration"
wm iconname $w "combo"
positionWindow $w
ttk::label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
combo-boxes are displayed below. You can add characters to the first\
one by pointing, clicking and typing, just as with an entry; pressing\
Return will cause the current value to be added to the list that is\
selectable from the drop-down list, and you can choose other values\
by pressing the Down key, using the arrow keys to pick another one,\
and pressing Return again. The second combo-box is fixed to a\
particular value, and cannot be modified at all. The third one only\
allows you to select values from its drop-down list of Australian\
cities."
pack $w.msg -side top -fill x
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w {firstValue secondValue ozCity}]
pack $btns -side bottom -fill x
ttk::frame $w.f
pack $w.f -fill both -expand 1
set w $w.f
set australianCities {
Canberra Sydney Melbourne Perth Adelaide Brisbane
Hobart Darwin "Alice Springs"
}
set secondValue unchangable
set ozCity Sydney
ttk::labelframe $w.c1 -text "Fully Editable"
ttk::combobox $w.c1.c -textvariable firstValue
ttk::labelframe $w.c2 -text Disabled
ttk::combobox $w.c2.c -textvariable secondValue -state disabled
ttk::labelframe $w.c3 -text "Defined List Only"
ttk::combobox $w.c3.c -textvariable ozCity -state readonly \
-values $australianCities
bind $w.c1.c <Return> {
if {[%W get] ni [%W cget -values]} {
%W configure -values [concat [%W cget -values] [list [%W get]]]
}
}
pack $w.c1 $w.c2 $w.c3 -side top -pady 5 -padx 10
pack $w.c1.c -pady 5 -padx 10
pack $w.c2.c -pady 5 -padx 10
pack $w.c3.c -pady 5 -padx 10

171
Dependencies/Python/tcl/tk8.6/demos/cscroll.tcl vendored Normal file
View File

@ -0,0 +1,171 @@
# cscroll.tcl --
#
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .cscroll
catch {destroy $w}
toplevel $w
wm title $w "Scrollable Canvas Demonstration"
wm iconname $w "cscroll"
positionWindow $w
set c $w.c
label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.grid
scrollbar $w.hscroll -orient horizontal -command "$c xview"
scrollbar $w.vscroll -command "$c yview"
canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \
-xscrollcommand "$w.hscroll set" \
-yscrollcommand "$w.vscroll set"
pack $w.grid -expand yes -fill both -padx 1 -pady 1
grid rowconfig $w.grid 0 -weight 1 -minsize 0
grid columnconfig $w.grid 0 -weight 1 -minsize 0
grid $c -padx 1 -in $w.grid -pady 1 \
-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid $w.vscroll -in $w.grid -padx 1 -pady 1 \
-row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid $w.hscroll -in $w.grid -padx 1 -pady 1 \
-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
set bg [lindex [$c config -bg] 4]
for {set i 0} {$i < 20} {incr i} {
set x [expr {-10 + 3*$i}]
for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
$c create rect ${x}c ${y}c [expr {$x+2}]c [expr {$y+2}]c \
-fill $bg -tags rect
$c create text [expr {$x+1}]c [expr {$y+1}]c -text "$i,$j" \
-anchor center -tags text
}
}
$c bind all <Enter> "scrollEnter $c"
$c bind all <Leave> "scrollLeave $c"
$c bind all <Button-1> "scrollButton $c"
if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} {
bind $c <Button-3> "$c scan mark %x %y"
bind $c <B3-Motion> "$c scan dragto %x %y"
bind $c <MouseWheel> {
%W yview scroll [expr {-%D}] units
}
bind $c <Option-MouseWheel> {
%W yview scroll [expr {-10*%D}] units
}
bind $c <Shift-MouseWheel> {
%W xview scroll [expr {-%D}] units
}
bind $c <Shift-Option-MouseWheel> {
%W xview scroll [expr {-10*%D}] units
}
} else {
bind $c <Button-2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y"
# We must make sure that positive and negative movements are rounded
# equally to integers, avoiding the problem that
# (int)1/-30 = -1,
# but
# (int)-1/-30 = 0
# The following code ensures equal +/- behaviour.
bind $c <MouseWheel> {
if {%D >= 0} {
%W yview scroll [expr {%D/-30}] units
} else {
%W yview scroll [expr {(%D-29)/-30}] units
}
}
bind $c <Option-MouseWheel> {
if {%D >= 0} {
%W yview scroll [expr {%D/-12}] units
} else {
%W yview scroll [expr {(%D-11)/-12}] units
}
}
bind $c <Shift-MouseWheel> {
if {%D >= 0} {
%W xview scroll [expr {%D/-30}] units
} else {
%W xview scroll [expr {(%D-29)/-30}] units
}
}
bind $c <Shift-Option-MouseWheel> {
if {%D >= 0} {
%W xview scroll [expr {%D/-12}] units
} else {
%W xview scroll [expr {(%D-11)/-12}] units
}
}
}
if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
# 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:
# https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X
bind $c <Button-4> {
if {!$tk_strictMotif} {
%W yview scroll -5 units
}
}
bind $c <Shift-Button-4> {
if {!$tk_strictMotif} {
%W xview scroll -5 units
}
}
bind $c <Button-5> {
if {!$tk_strictMotif} {
%W yview scroll 5 units
}
}
bind $c <Shift-Button-5> {
if {!$tk_strictMotif} {
%W xview scroll 5 units
}
}
}
proc scrollEnter canvas {
global oldFill
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] >= 0} {
set id [expr {$id-1}]
}
set oldFill [lindex [$canvas itemconfig $id -fill] 4]
if {[winfo depth $canvas] > 1} {
if {[tk windowingsystem] eq "aqua"} {
$canvas itemconfigure $id -fill systemSelectedTextBackgroundColor
} else {
$canvas itemconfigure $id -fill LightSeaGreen
}
}
}
proc scrollLeave canvas {
global oldFill
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] >= 0} {
set id [expr {$id-1}]
}
$canvas itemconfigure $id -fill $oldFill
}
proc scrollButton canvas {
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] < 0} {
set id [expr {$id+1}]
}
puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]"
}

176
Dependencies/Python/tcl/tk8.6/demos/ctext.tcl vendored Normal file
View File

@ -0,0 +1,176 @@
# ctext.tcl --
#
# This demonstration script creates a canvas widget with a text
# item that can be edited and reconfigured in various ways.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ctext
catch {destroy $w}
toplevel $w
wm title $w "Canvas Text Demonstration"
wm iconname $w "Text"
positionWindow $w
set c $w.c
label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification, and on a pie slice to change its angle. The text also supports the following simple bindings for editing:
1. You can point, click, and type.
2. You can also select with button 1.
3. You can copy the selection to the mouse position with button 2.
4. Backspace and Control+h delete the selection if there is one;
otherwise they delete the character just before the insertion cursor.
5. Delete deletes the selection if there is one; otherwise it deletes
the character just after the insertion cursor."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
canvas $c -relief flat -borderwidth 0 -width 500 -height 350
pack $w.c -side top -expand yes -fill both
set textFont {Helvetica 24}
$c create rectangle 245 195 255 205 -outline black -fill red
# First, create the text item and give it bindings so it can be edited.
$c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. Bindings have been defined to support editing (see above)." -width 440 -anchor n -font $textFont -justify left]
$c bind text <Button-1> "textB1Press $c %x %y"
$c bind text <B1-Motion> "textB1Move $c %x %y"
$c bind text <Shift-Button-1> "$c select adjust current @%x,%y"
$c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
$c bind text <Key> "textInsert $c %A"
$c bind text <Return> "textInsert $c \\n"
$c bind text <Control-h> "textBs $c"
$c bind text <BackSpace> "textBs $c"
$c bind text <Delete> "textDel $c"
if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
$c bind text <Button-3> "textPaste $c @%x,%y"
} else {
$c bind text <Button-2> "textPaste $c @%x,%y"
}
# Next, create some items that allow the text's anchor position
# to be edited.
proc mkTextConfigBox {w x y option value color} {
set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \
-outline black -fill $color -width 1]
$w bind $item <Button-1> "$w itemconf text $option $value"
$w addtag config withtag $item
}
proc mkTextConfigPie {w x y a option value color} {
set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \
-start [expr {$a-15}] -extent 30 -outline black -fill $color \
-width 1]
$w bind $item <Button-1> "$w itemconf text $option $value"
$w addtag config withtag $item
}
set x 50
set y 50
set color LightSkyBlue1
mkTextConfigBox $c $x $y -anchor se $color
mkTextConfigBox $c [expr {$x+30}] [expr {$y }] -anchor s $color
mkTextConfigBox $c [expr {$x+60}] [expr {$y }] -anchor sw $color
mkTextConfigBox $c [expr {$x }] [expr {$y+30}] -anchor e $color
mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color
mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w $color
mkTextConfigBox $c [expr {$x }] [expr {$y+60}] -anchor ne $color
mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n $color
mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color
set item [$c create rect \
[expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \
-outline black -fill red]
$c bind $item <Button-1> "$c itemconf text -anchor center"
$c create text [expr {$x+45}] [expr {$y-5}] \
-text {Text Position} -anchor s -font {Times 20} -fill brown
# Now create some items that allow the text's angle to be changed.
set x 205
set y 50
set color Yellow
mkTextConfigPie $c $x $y 0 -angle 90 $color
mkTextConfigPie $c $x $y 30 -angle 120 $color
mkTextConfigPie $c $x $y 60 -angle 150 $color
mkTextConfigPie $c $x $y 90 -angle 180 $color
mkTextConfigPie $c $x $y 120 -angle 210 $color
mkTextConfigPie $c $x $y 150 -angle 240 $color
mkTextConfigPie $c $x $y 180 -angle 270 $color
mkTextConfigPie $c $x $y 210 -angle 300 $color
mkTextConfigPie $c $x $y 240 -angle 330 $color
mkTextConfigPie $c $x $y 270 -angle 0 $color
mkTextConfigPie $c $x $y 300 -angle 30 $color
mkTextConfigPie $c $x $y 330 -angle 60 $color
$c create text [expr {$x+45}] [expr {$y-5}] \
-text {Text Angle} -anchor s -font {Times 20} -fill brown
# Lastly, create some items that allow the text's justification to be
# changed.
set x 350
set y 50
set color SeaGreen2
mkTextConfigBox $c $x $y -justify left $color
mkTextConfigBox $c [expr {$x+30}] $y -justify center $color
mkTextConfigBox $c [expr {$x+60}] $y -justify right $color
$c create text [expr {$x+45}] [expr {$y-5}] \
-text {Justification} -anchor s -font {Times 20} -fill brown
$c bind config <Enter> "textEnter $c"
$c bind config <Leave> "$c itemconf current -fill \$textConfigFill"
set textConfigFill {}
proc textEnter {w} {
global textConfigFill
set textConfigFill [lindex [$w itemconfig current -fill] 4]
$w itemconfig current -fill black
}
proc textInsert {w string} {
if {$string == ""} {
return
}
catch {$w dchars text sel.first sel.last}
$w insert text insert $string
}
proc textPaste {w pos} {
catch {
$w insert text $pos [selection get]
}
}
proc textB1Press {w x y} {
$w icursor current @$x,$y
$w focus current
focus $w
$w select from current @$x,$y
}
proc textB1Move {w x y} {
$w select to current @$x,$y
}
proc textBs {w} {
if {![catch {$w dchars text sel.first sel.last}]} {
return
}
set char [expr {[$w index text insert] - 1}]
if {$char >= 0} {$w dchar text $char}
}
proc textDel {w} {
if {![catch {$w dchars text sel.first sel.last}]} {
return
}
$w dchars text insert
}

25
Dependencies/Python/tcl/tk8.6/demos/dialog1.tcl vendored Normal file
View File

@ -0,0 +1,25 @@
# dialog1.tcl --
#
# This demonstration script creates a dialog box with a local grab.
interp create child
load {} Tk child
child eval {
wm title . child
wm geometry . +700+30
pack [text .t -width 30 -height 10]
}
after idle {.dialog1.msg configure -wraplength 4i}
set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box. It uses Tk's "grab" command to create a "local grab" on the dialog box. The grab prevents any mouse or keyboard events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below. However, you can still interact with other applications. For example, you should be able to edit text in the window named "child" which was created by a child interpreter.} \
info 0 OK Cancel {Show Code}]
switch $i {
0 {puts "You pressed OK"}
1 {puts "You pressed Cancel"}
2 {showCode .dialog1}
}
if {[interp exists child]} {
interp delete child
}

18
Dependencies/Python/tcl/tk8.6/demos/dialog2.tcl vendored Normal file
View File

@ -0,0 +1,18 @@
# dialog2.tcl --
#
# This demonstration script creates a dialog box with a global grab.
after idle {
.dialog2.msg configure -wraplength 4i
}
after 100 {
grab -global .dialog2
}
set i [tk_dialog .dialog2 "Dialog with global grab" {This dialog box uses a global grab. If you are using an X11 window manager you will be prevented from interacting with anything on your display until you invoke one of the buttons below. This is almost always a bad idea; don't use global grabs with X11 unless you're truly desperate. On macOS systems you will not be able to interact with any window belonging to this process, but interaction with other macOS Applications will still be possible.}\
warning 0 OK Cancel {Show Code}]
switch $i {
0 {puts "You pressed OK"}
1 {puts "You pressed Cancel"}
2 {showCode .dialog2}
}

97
Dependencies/Python/tcl/tk8.6/demos/en.msg vendored Normal file
View File

@ -0,0 +1,97 @@
::msgcat::mcset en "Widget Demonstration"
::msgcat::mcset en "tkWidgetDemo"
::msgcat::mcset en "&File"
::msgcat::mcset en "About..."
::msgcat::mcset en "&About..."
::msgcat::mcset en "<F1>"
::msgcat::mcset en "&Quit"
::msgcat::mcset en "Meta+Q" ;# Displayed hotkey
::msgcat::mcset en "Meta-q" ;# Actual binding sequence
::msgcat::mcset en "Ctrl+Q" ;# Displayed hotkey
::msgcat::mcset en "Control-q" ;# Actual binding sequence
::msgcat::mcset en "Variable values"
::msgcat::mcset en "Variable values:"
::msgcat::mcset en "OK"
::msgcat::mcset en "Run the \"%s\" sample program"
::msgcat::mcset en "Dismiss"
::msgcat::mcset en "Rerun Demo"
::msgcat::mcset en "Demo code: %s"
::msgcat::mcset en "About Widget Demo"
::msgcat::mcset en "Tk widget demonstration application"
::msgcat::mcset en "Copyright © %s"
::msgcat::mcset en "
@@title
Tk Widget Demonstrations
@@newline
@@normal
@@newline
This application provides a front end for several short scripts
that demonstrate what you can do with Tk widgets. Each of the
numbered lines below describes a demonstration; you can click on
it to invoke the demonstration. Once the demonstration window
appears, you can click the
@@bold
See Code
@@normal
button to see the Tcl/Tk code that created the demonstration. If
you wish, you can edit the code and click the
@@bold
Rerun Demo
@@normal
button in the code window to reinvoke the demonstration with the
modified code.
@@newline
"
::msgcat::mcset en "Labels, buttons, checkbuttons, and radiobuttons"
::msgcat::mcset en "Labels (text and bitmaps)"
::msgcat::mcset en "Labels and UNICODE text"
::msgcat::mcset en "Buttons"
::msgcat::mcset en "Check-buttons (select any of a group)"
::msgcat::mcset en "Radio-buttons (select one of a group)"
::msgcat::mcset en "A 15-puzzle game made out of buttons"
::msgcat::mcset en "Iconic buttons that use bitmaps"
::msgcat::mcset en "Two labels displaying images"
::msgcat::mcset en "A simple user interface for viewing images"
::msgcat::mcset en "Labelled frames"
::msgcat::mcset en "Listboxes"
::msgcat::mcset en "The 50 states"
::msgcat::mcset en "Colors: change the color scheme for the application"
::msgcat::mcset en "A collection of famous and infamous sayings"
::msgcat::mcset en "Entries and Spin-boxes"
::msgcat::mcset en "Entries without scrollbars"
::msgcat::mcset en "Entries with scrollbars"
::msgcat::mcset en "Validated entries and password fields"
::msgcat::mcset en "Spin-boxes"
::msgcat::mcset en "Simple Rolodex-like form"
::msgcat::mcset en "Text"
::msgcat::mcset en "Basic editable text"
::msgcat::mcset en "Text display styles"
::msgcat::mcset en "Hypertext (tag bindings)"
::msgcat::mcset en "A text widget with embedded windows"
::msgcat::mcset en "A search tool built with a text widget"
::msgcat::mcset en "Canvases"
::msgcat::mcset en "The canvas item types"
::msgcat::mcset en "A simple 2-D plot"
::msgcat::mcset en "Text items in canvases"
::msgcat::mcset en "An editor for arrowheads on canvas lines"
::msgcat::mcset en "A ruler with adjustable tab stops"
::msgcat::mcset en "A building floor plan"
::msgcat::mcset en "A simple scrollable canvas"
::msgcat::mcset en "Scales"
::msgcat::mcset en "Horizontal scale"
::msgcat::mcset en "Vertical scale"
::msgcat::mcset en "Paned Windows"
::msgcat::mcset en "Horizontal paned window"
::msgcat::mcset en "Vertical paned window"
::msgcat::mcset en "Menus"
::msgcat::mcset en "Menus and cascades (sub-menus)"
::msgcat::mcset en "Menu-buttons"
::msgcat::mcset en "Common Dialogs"
::msgcat::mcset en "Message boxes"
::msgcat::mcset en "File selection dialog"
::msgcat::mcset en "Color picker"
::msgcat::mcset en "Miscellaneous"
::msgcat::mcset en "The built-in bitmaps"
::msgcat::mcset en "A dialog box with a local grab"
::msgcat::mcset en "A dialog box with a global grab"

34
Dependencies/Python/tcl/tk8.6/demos/entry1.tcl vendored Normal file
View File

@ -0,0 +1,34 @@
# entry1.tcl --
#
# This demonstration script creates several entry widgets without
# scrollbars.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .entry1
catch {destroy $w}
toplevel $w
wm title $w "Entry Demonstration (no scrollbars)"
wm iconname $w "entry1"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse the middle mouse button pressed."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
entry $w.e1
entry $w.e2
entry $w.e3
pack $w.e1 $w.e2 $w.e3 -side top -pady 5 -padx 10 -fill x
$w.e1 insert 0 "Initial value"
$w.e2 insert end "This entry contains a long value, much too long "
$w.e2 insert end "to fit in the window at one time, so long in fact "
$w.e2 insert end "that you'll have to scan or scroll to see the end."

46
Dependencies/Python/tcl/tk8.6/demos/entry2.tcl vendored Normal file
View File

@ -0,0 +1,46 @@
# entry2.tcl --
#
# This demonstration script is the same as the entry1.tcl script
# except that it creates scrollbars for the entries.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .entry2
catch {destroy $w}
toplevel $w
wm title $w "Entry Demonstration (with scrollbars)"
wm iconname $w "entry2"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries with the scrollbars, or by dragging with the middle mouse button pressed."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth 10
pack $w.frame -side top -fill x -expand 1
entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set"
ttk::scrollbar $w.frame.s1 -orient horizontal -command \
"$w.frame.e1 xview"
frame $w.frame.spacer1 -width 20 -height 10
entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set"
ttk::scrollbar $w.frame.s2 -orient horizontal -command \
"$w.frame.e2 xview"
frame $w.frame.spacer2 -width 20 -height 10
entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set"
ttk::scrollbar $w.frame.s3 -orient horizontal -command \
"$w.frame.e3 xview"
pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \
$w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x
$w.frame.e1 insert 0 "Initial value"
$w.frame.e2 insert end "This entry contains a long value, much too long "
$w.frame.e2 insert end "to fit in the window at one time, so long in fact "
$w.frame.e2 insert end "that you'll have to scan or scroll to see the end."

185
Dependencies/Python/tcl/tk8.6/demos/entry3.tcl vendored Normal file
View File

@ -0,0 +1,185 @@
# entry3.tcl --
#
# This demonstration script creates several entry widgets whose
# permitted input is constrained in some way. It also shows off a
# password entry.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .entry3
catch {destroy $w}
toplevel $w
wm title $w "Constrained Entry Demonstration"
wm iconname $w "entry3"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Four different\
entries are displayed below. You can add characters by pointing,\
clicking and typing, though each is constrained in what it will\
accept. The first only accepts 32-bit integers or the empty string\
(checking when focus leaves it) and will flash to indicate any\
problem. The second only accepts strings with fewer than ten\
characters and sounds the bell when an attempt to go over the limit\
is made. The third accepts US phone numbers, mapping letters to\
their digit equivalent and sounding the bell on encountering an\
illegal character or if trying to type over a character that is not\
a digit. The fourth is a password field that accepts up to eight\
characters (silently ignoring further ones), and displaying them as\
asterisk characters."
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# focusAndFlash --
# Error handler for entry widgets that forces the focus onto the
# widget and makes the widget flash by exchanging the foreground and
# background colours at intervals of 200ms (i.e. at approximately
# 2.5Hz).
#
# Arguments:
# W - Name of entry widget to flash
# fg - Initial foreground colour
# bg - Initial background colour
# count - Counter to control the number of times flashed
proc focusAndFlash {W fg bg {count 9}} {
focus -force $W
if {$count<1} {
$W configure -foreground $fg -background $bg
} else {
if {$count%2} {
$W configure -foreground $bg -background $fg
} else {
$W configure -foreground $fg -background $bg
}
after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]]
}
}
labelframe $w.l1 -text "Integer Entry"
# Alternatively try using {string is digit} for arbitrary length numbers,
# and not just 32-bit ones.
entry $w.l1.e -validate focus -vcmd {string is integer %P}
$w.l1.e configure -invalidcommand \
"focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]"
pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m
labelframe $w.l2 -text "Length-Constrained Entry"
entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}}
pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m
### PHONE NUMBER ENTRY ###
# Note that the source to this is quite a bit longer as the behaviour
# demonstrated is a lot more ambitious than with the others.
# Initial content for the third entry widget
set entry3content "1-(000)-000-0000"
# Mapping from alphabetic characters to numbers. This is probably
# wrong, but it is the only mapping I have; the UK doesn't really go
# for associating letters with digits for some reason.
set phoneNumberMap {}
foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} {
foreach char [split $chars ""] {
lappend phoneNumberMap $char $digit [string toupper $char] $digit
}
}
# validatePhoneChange --
# Checks that the replacement (mapped to a digit) of the given
# character in an entry widget at the given position will leave a
# valid phone number in the widget.
#
# W - The entry widget to validate
# vmode - The widget's validation mode
# idx - The index where replacement is to occur
# char - The character (or string, though that will always be
# refused) to be overwritten at that point.
proc validatePhoneChange {W vmode idx char} {
global phoneNumberMap entry3content
if {$idx < 0} {return 1}
after idle [list $W configure -validate $vmode -invcmd bell]
if {
!($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) &&
[string match {[0-9A-Za-z]} $char]
} then {
$W delete $idx
$W insert $idx [string map $phoneNumberMap $char]
after idle [list phoneSkipRight $W -1]
return 1
}
return 0
}
# phoneSkipLeft --
# Skip over fixed characters in a phone-number string when moving left.
#
# Arguments:
# W - The entry widget containing the phone-number.
proc phoneSkipLeft {W} {
set idx [$W index insert]
if {$idx == 8} {
# Skip back two extra characters
$W icursor [incr idx -2]
} elseif {$idx == 7 || $idx == 12} {
# Skip back one extra character
$W icursor [incr idx -1]
} elseif {$idx <= 3} {
# Can't move any further
bell
return -code break
}
}
# phoneSkipRight --
# Skip over fixed characters in a phone-number string when moving right.
#
# Arguments:
# W - The entry widget containing the phone-number.
# add - Offset to add to index before calculation (used by validation.)
proc phoneSkipRight {W {add 0}} {
set idx [$W index insert]
if {$idx+$add == 5} {
# Skip forward two extra characters
$W icursor [incr idx 2]
} elseif {$idx+$add == 6 || $idx+$add == 10} {
# Skip forward one extra character
$W icursor [incr idx]
} elseif {$idx+$add == 15 && !$add} {
# Can't move any further
bell
return -code break
}
}
labelframe $w.l3 -text "US Phone-Number Entry"
entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \
-vcmd {validatePhoneChange %W %v %i %S}
# Click to focus goes to the first editable character...
bind $w.l3.e <FocusIn> {
if {"%d" ne "NotifyAncestor"} {
%W icursor 3
after idle {%W selection clear}
}
}
bind $w.l3.e <<PrevChar>> {phoneSkipLeft %W}
bind $w.l3.e <<NextChar>> {phoneSkipRight %W}
pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m
labelframe $w.l4 -text "Password Entry"
entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}}
pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m
lower [frame $w.mid]
grid $w.l1 $w.l2 -in $w.mid -padx 3m -pady 1m -sticky ew
grid $w.l3 $w.l4 -in $w.mid -padx 3m -pady 1m -sticky ew
grid columnconfigure $w.mid {0 1} -uniform 1
pack $w.msg -side top
pack $w.mid -fill both -expand 1

81
Dependencies/Python/tcl/tk8.6/demos/filebox.tcl vendored Normal file
View File

@ -0,0 +1,81 @@
# filebox.tcl --
#
# This demonstration script prompts the user to select a file.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .filebox
catch {destroy $w}
toplevel $w
wm title $w "File Selection Dialogs"
wm iconname $w "filebox"
positionWindow $w
ttk::frame $w._bg
place $w._bg -x 0 -y 0 -relwidth 1 -relheight 1
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
foreach i {open save} {
set f [ttk::frame $w.$i]
ttk::label $f.lab -text "Select a file to $i: " -anchor e
ttk::entry $f.ent -width 20
ttk::button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i"
pack $f.lab -side left
pack $f.ent -side left -expand yes -fill x
pack $f.but -side left
pack $f -fill x -padx 1c -pady 3
}
if {[tk windowingsystem] eq "x11"} {
ttk::checkbutton $w.strict -text "Use Motif Style Dialog" \
-variable tk_strictMotif -onvalue 1 -offvalue 0
pack $w.strict -anchor c
# This binding ensures that we don't run the rest of the demos
# with motif style interactions
bind $w.strict <Destroy> {set tk_strictMotif 0}
}
proc fileDialog {w ent operation} {
# Type names Extension(s) Mac File Type(s)
#
#---------------------------------------------------------
set types {
{"Text files" {.txt .doc} }
{"Text files" {} TEXT}
{"Tcl Scripts" {.tcl} TEXT}
{"C Source Files" {.c .h} }
{"All Source Files" {.tcl .c .h} }
{"Image Files" {.gif} }
{"Image Files" {.jpeg .jpg} }
{"Image Files" "" {GIFF JPEG}}
{"All files" *}
}
if {$operation == "open"} {
global selected_type
if {![info exists selected_type]} {
set selected_type "Tcl Scripts"
}
set file [tk_getOpenFile -filetypes $types -parent $w \
-typevariable selected_type]
puts "You selected filetype \"$selected_type\""
} else {
set file [tk_getSaveFile -filetypes $types -parent $w \
-initialfile Untitled -defaultextension .txt]
}
if {[string compare $file ""]} {
$ent delete 0 end
$ent insert 0 $file
$ent xview end
}
}

1372
Dependencies/Python/tcl/tk8.6/demos/floor.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

67
Dependencies/Python/tcl/tk8.6/demos/fontchoose.tcl vendored Normal file
View File

@ -0,0 +1,67 @@
# fontchoose.tcl --
#
# Show off the stock font selector dialog
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .fontchoose
catch {destroy $w}
toplevel $w
wm title $w "Font Selection Dialog"
wm iconname $w "fontchooser"
positionWindow $w
catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]}
# The font chooser needs to be configured and then shown.
proc SelectFont {parent} {
tk fontchooser configure -font FontchooseDemoFont \
-command ApplyFont -parent $parent
tk fontchooser show
}
proc ApplyFont {font} {
font configure FontchooseDemoFont {*}[font actual $font]
}
# When the visibility of the fontchooser changes, the following event is fired
# to the parent widget.
#
bind $w <<TkFontchooserVisibility>> {
if {[tk fontchooser configure -visible]} {
%W.f.font state disabled
} else {
%W.f.font state !disabled
}
}
set f [ttk::frame $w.f -relief sunken -padding 2]
text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \
-yscrollcommand [list $f.vs set]
ttk::scrollbar $f.vs -command [list $f.msg yview]
$f.msg insert end "Press the buttons below to choose a new font for the\
text shown in this window.\n" {}
ttk::button $f.font -text "Set font ..." -command [list SelectFont $w]
grid $f.msg $f.vs -sticky news
grid $f.font - -sticky e
grid columnconfigure $f 0 -weight 1
grid rowconfigure $f 0 -weight 1
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
grid $f -sticky news
grid $btns -sticky ew
grid columnconfigure $w 0 -weight 1
grid rowconfigure $w 0 -weight 1
update idletasks
grid propagate $f 0

38
Dependencies/Python/tcl/tk8.6/demos/form.tcl vendored Normal file
View File

@ -0,0 +1,38 @@
# form.tcl --
#
# This demonstration script creates a simple form with a bunch
# of entry widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .form
catch {destroy $w}
toplevel $w
wm title $w "Form Demonstration"
wm iconname $w "form"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
foreach i {f1 f2 f3 f4 f5} {
frame $w.$i -bd 2
entry $w.$i.entry -relief sunken -width 40
label $w.$i.label
pack $w.$i.entry -side right
pack $w.$i.label -side left
}
$w.f1.label config -text Name:
$w.f2.label config -text Address:
$w.f5.label config -text Phone:
pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
bind $w <Return> "destroy $w"
focus $w.f1.entry

1834
Dependencies/Python/tcl/tk8.6/demos/goldberg.tcl vendored Normal file
View File

File diff suppressed because it is too large Load Diff

22
Dependencies/Python/tcl/tk8.6/demos/hello vendored Normal file
View File

@ -0,0 +1,22 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# hello --
# Simple Tk script to create a button that prints "Hello, world".
# Click on the button to terminate the program.
package require Tk
# The first line below creates the button, and the second line
# asks the packer to shrink-wrap the application's main window
# around the button.
button .hello -text "Hello, world" -command {
puts stdout "Hello, world"; destroy .
}
pack .hello
# Local Variables:
# mode: tcl
# End:

45
Dependencies/Python/tcl/tk8.6/demos/hscale.tcl vendored Normal file
View File

@ -0,0 +1,45 @@
# hscale.tcl --
#
# This demonstration script shows an example with a horizontal scale.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .hscale
catch {destroy $w}
toplevel $w
wm title $w "Horizontal Scale Demonstration"
wm iconname $w "hscale"
positionWindow $w
label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a horizontal scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the length of the arrow."
pack $w.msg -side top -padx .5c
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth 10
pack $w.frame -side top -fill x
canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
$w.frame.canvas create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly
$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
scale $w.frame.scale -orient horizontal -length 284 -from 0 -to 250 \
-command "setWidth $w.frame.canvas" -tickinterval 50
pack $w.frame.canvas -side top -expand yes -anchor s -fill x -padx 15
pack $w.frame.scale -side bottom -expand yes -anchor n
$w.frame.scale set 75
proc setWidth {w width} {
incr width 21
set x2 [expr {$width - 30}]
if {$x2 < 21} {
set x2 21
}
$w coords poly 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
$w coords line 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
}

51
Dependencies/Python/tcl/tk8.6/demos/icon.tcl vendored Normal file
View File

@ -0,0 +1,51 @@
# icon.tcl --
#
# This demonstration script creates a toplevel window containing
# buttons that display bitmaps instead of text.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .icon
catch {destroy $w}
toplevel $w
wm title $w "Iconic Button Demonstration"
wm iconname $w "icon"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons. On the left are two radiobuttons, each of which displays a bitmap and an indicator. In the middle is a checkbutton that displays a different image depending on whether it is selected or not. On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Main widget program sets variable tk_demoDirectory
image create bitmap flagup \
-file [file join $tk_demoDirectory images flagup.xbm] \
-maskfile [file join $tk_demoDirectory images flagup.xbm]
image create bitmap flagdown \
-file [file join $tk_demoDirectory images flagdown.xbm] \
-maskfile [file join $tk_demoDirectory images flagdown.xbm]
frame $w.frame -borderwidth 10
pack $w.frame -side top
checkbutton $w.frame.b1 -image flagdown -selectimage flagup \
-indicatoron 0
$w.frame.b1 configure -selectcolor [$w.frame.b1 cget -background]
checkbutton $w.frame.b2 \
-bitmap @[file join $tk_demoDirectory images letters.xbm] \
-indicatoron 0 -selectcolor SeaGreen1
frame $w.frame.left
pack $w.frame.left $w.frame.b1 $w.frame.b2 -side left -expand yes -padx 5m
radiobutton $w.frame.left.b3 \
-bitmap @[file join $tk_demoDirectory images letters.xbm] \
-variable letters -value full
radiobutton $w.frame.left.b4 \
-bitmap @[file join $tk_demoDirectory images noletter.xbm] \
-variable letters -value empty
pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes

35
Dependencies/Python/tcl/tk8.6/demos/image1.tcl vendored Normal file
View File

@ -0,0 +1,35 @@
# image1.tcl --
#
# This demonstration script displays two image widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .image1
catch {destroy $w}
toplevel $w
wm title $w "Image Demonstration #1"
wm iconname $w "Image1"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration displays two images, each in a separate label widget."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Main widget program sets variable tk_demoDirectory
catch {image delete image1a}
image create photo image1a -file [file join $tk_demoDirectory images earth.gif]
label $w.l1 -image image1a -bd 1 -relief sunken
catch {image delete image1b}
image create photo image1b \
-file [file join $tk_demoDirectory images earthris.gif]
label $w.l2 -image image1b -bd 1 -relief sunken
pack $w.l1 $w.l2 -side top -padx .5m -pady .5m

108
Dependencies/Python/tcl/tk8.6/demos/image2.tcl vendored Normal file
View File

@ -0,0 +1,108 @@
# image2.tcl --
#
# This demonstration script creates a simple collection of widgets
# that allow you to select and view images in a Tk label.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# loadDir --
# This procedure reloads the directory listbox from the directory
# named in the demo's entry.
#
# Arguments:
# w - Name of the toplevel window of the demo.
proc loadDir w {
global dirName
$w.f.list delete 0 end
foreach i [lsort [glob -type f -directory $dirName *]] {
$w.f.list insert end [file tail $i]
}
}
# selectAndLoadDir --
# This procedure pops up a dialog to ask for a directory to load into
# the listobx and (if the user presses OK) reloads the directory
# listbox from the directory named in the demo's entry.
#
# Arguments:
# w - Name of the toplevel window of the demo.
proc selectAndLoadDir w {
global dirName
set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1]
if {$dir ne ""} {
set dirName $dir
loadDir $w
}
}
# loadImage --
# Given the name of the toplevel window of the demo and the mouse
# position, extracts the directory entry under the mouse and loads
# that file into a photo image for display.
#
# Arguments:
# w - Name of the toplevel window of the demo.
# x, y- Mouse position within the listbox.
proc loadImage {w x y} {
global dirName
set file [file join $dirName [$w.f.list get @$x,$y]]
if {[catch {
image2a configure -file $file
}]} then {
# Mark the file as not loadable
$w.f.list itemconfigure @$x,$y -bg \#c00000 -selectbackground \#ff0000
}
}
set w .image2
catch {destroy $w}
toplevel $w
wm title $w "Image Demonstration #2"
wm iconname $w "Image2"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image. First type a directory name in the listbox, then type Return to load the directory into the listbox. Then double-click on a file name in the listbox to see that image."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.mid
pack $w.mid -fill both -expand 1
labelframe $w.dir -text "Directory:"
# Main widget program sets variable tk_demoDirectory
set dirName [file join $tk_demoDirectory images]
entry $w.dir.e -width 30 -textvariable dirName
button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \
-command "selectAndLoadDir $w"
bind $w.dir.e <Return> "loadDir $w"
pack $w.dir.e -side left -fill both -padx 2m -pady 2m -expand true
pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m
labelframe $w.f -text "File:" -padx 2m -pady 2m
listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
ttk::scrollbar $w.f.scroll -command "$w.f.list yview"
pack $w.f.list $w.f.scroll -side left -fill y -expand 1
$w.f.list insert 0 earth.gif earthris.gif teapot.ppm
bind $w.f.list <Double-Button-1> "loadImage $w %x %y"
catch {image delete image2a}
image create photo image2a
labelframe $w.image -text "Image:"
label $w.image.image -image image2a
pack $w.image.image -padx 2m -pady 2m
grid $w.dir - -sticky ew -padx 1m -pady 1m -in $w.mid
grid $w.f $w.image -sticky nw -padx 1m -pady 1m -in $w.mid
grid columnconfigure $w.mid 1 -weight 1

BIN
Dependencies/Python/tcl/tk8.6/demos/images/earth.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 50 KiB

BIN
Dependencies/Python/tcl/tk8.6/demos/images/earthmenu.png vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.0 KiB

BIN
Dependencies/Python/tcl/tk8.6/demos/images/earthris.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.2 KiB

27
Dependencies/Python/tcl/tk8.6/demos/images/flagdown.xbm vendored Normal file
View File

@ -0,0 +1,27 @@
#define flagdown_width 48
#define flagdown_height 48
static char flagdown_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00,
0x00, 0x00, 0x80, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xe1, 0x00, 0x00,
0x00, 0x00, 0x70, 0x80, 0x01, 0x00, 0x00, 0x00, 0x18, 0x00, 0x03, 0x00,
0x00, 0x00, 0x0c, 0x00, 0x03, 0x00, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04,
0x00, 0x00, 0x03, 0x00, 0x06, 0x06, 0x00, 0x80, 0x01, 0x00, 0x06, 0x07,
0x00, 0xc0, 0x1f, 0x00, 0x87, 0x07, 0x00, 0xe0, 0x7f, 0x80, 0xc7, 0x07,
0x00, 0x70, 0xe0, 0xc0, 0xe5, 0x07, 0x00, 0x38, 0x80, 0xe1, 0x74, 0x07,
0x00, 0x18, 0x80, 0x71, 0x3c, 0x07, 0x00, 0x0c, 0x00, 0x3b, 0x1e, 0x03,
0x00, 0x0c, 0x00, 0x1f, 0x0f, 0x00, 0x00, 0x86, 0x1f, 0x8e, 0x07, 0x00,
0x00, 0x06, 0x06, 0xc6, 0x05, 0x00, 0x00, 0x06, 0x00, 0xc6, 0x05, 0x00,
0x00, 0x06, 0x00, 0xc6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
0x7f, 0x06, 0x00, 0x06, 0xe4, 0xff, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
0x00, 0x06, 0x00, 0x06, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x06, 0x00,
0x00, 0x06, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
0x00, 0x06, 0x00, 0xc6, 0x00, 0x00, 0x00, 0x06, 0x00, 0x66, 0x00, 0x00,
0x00, 0x06, 0x00, 0x36, 0x00, 0x00, 0x00, 0x06, 0x00, 0x3e, 0x00, 0x00,
0x00, 0xfe, 0xff, 0x2f, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x27, 0x00, 0x00,
0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
0xf7, 0xbf, 0x8e, 0xfc, 0xdf, 0xf8, 0x9d, 0xeb, 0x9b, 0x76, 0xd2, 0x7a,
0x46, 0x30, 0xe2, 0x0f, 0xe1, 0x47, 0x55, 0x84, 0x48, 0x11, 0x84, 0x19};

27
Dependencies/Python/tcl/tk8.6/demos/images/flagup.xbm vendored Normal file
View File

@ -0,0 +1,27 @@
#define flagup_width 48
#define flagup_height 48
static char flagup_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00,
0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xef, 0x6a, 0x00,
0x00, 0x00, 0xc0, 0x7b, 0x75, 0x00, 0x00, 0x00, 0xe0, 0xe0, 0x6a, 0x00,
0x00, 0x00, 0x30, 0x60, 0x75, 0x00, 0x00, 0x00, 0x18, 0xe0, 0x7f, 0x00,
0x00, 0x00, 0x0c, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x06, 0xe0, 0x04, 0x00,
0x00, 0x00, 0x03, 0xe0, 0x04, 0x00, 0x00, 0x80, 0x01, 0xe0, 0x06, 0x00,
0x00, 0xc0, 0x1f, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x7f, 0xe0, 0x07, 0x00,
0x00, 0x70, 0xe0, 0xe0, 0x05, 0x00, 0x00, 0x38, 0x80, 0xe1, 0x04, 0x00,
0x00, 0x18, 0x80, 0xf1, 0x04, 0x00, 0x00, 0x0c, 0x00, 0xfb, 0x04, 0x00,
0x00, 0x0c, 0x00, 0xff, 0x04, 0x00, 0x00, 0x86, 0x1f, 0xee, 0x04, 0x00,
0x00, 0x06, 0x06, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00,
0x00, 0x06, 0x00, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x66, 0x04, 0x00,
0x7f, 0x56, 0x52, 0x06, 0xe4, 0xff, 0x00, 0x76, 0x55, 0x06, 0x04, 0x00,
0x00, 0x56, 0x57, 0x06, 0x04, 0x00, 0x00, 0x56, 0x55, 0x06, 0x06, 0x00,
0x00, 0x56, 0xd5, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
0x54, 0x06, 0x00, 0xc6, 0x54, 0x55, 0xaa, 0x06, 0x00, 0x66, 0xaa, 0x2a,
0x54, 0x06, 0x00, 0x36, 0x55, 0x55, 0xaa, 0x06, 0x00, 0xbe, 0xaa, 0x2a,
0x54, 0xfe, 0xff, 0x6f, 0x55, 0x55, 0xaa, 0xfc, 0xff, 0xa7, 0xaa, 0x2a,
0x54, 0x01, 0x88, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
0x54, 0x55, 0x8d, 0x50, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa8, 0xaa, 0x2a,
0x54, 0x55, 0x95, 0x54, 0x55, 0x55, 0xaa, 0xaa, 0xaa, 0xaa, 0xaa, 0x2a,
0x54, 0x55, 0x55, 0x55, 0x55, 0x15, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

6
Dependencies/Python/tcl/tk8.6/demos/images/gray25.xbm vendored Normal file
View File

@ -0,0 +1,6 @@
#define grey_width 16
#define grey_height 16
static char grey_bits[] = {
0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44};

27
Dependencies/Python/tcl/tk8.6/demos/images/letters.xbm vendored Normal file
View File

@ -0,0 +1,27 @@
#define letters_width 48
#define letters_height 48
static char letters_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, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xfe, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x02, 0x00, 0x00, 0x00, 0x20,
0x00, 0xfa, 0x00, 0x00, 0x00, 0x2e, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2a,
0x00, 0x3a, 0x00, 0x00, 0x00, 0x2a, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2e,
0xe0, 0xff, 0xff, 0xff, 0xff, 0x21, 0x20, 0x00, 0x00, 0x00, 0x00, 0x21,
0xa0, 0x03, 0x00, 0x00, 0x70, 0x21, 0x20, 0x00, 0x00, 0x00, 0x50, 0x21,
0xa0, 0x1f, 0x00, 0x00, 0x50, 0x21, 0x20, 0x00, 0x00, 0x00, 0x70, 0x21,
0xfe, 0xff, 0xff, 0xff, 0x0f, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
0xfa, 0x01, 0x00, 0x80, 0x0b, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0a, 0x21,
0xba, 0x01, 0x00, 0x80, 0x0a, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0b, 0x21,
0x3a, 0x00, 0x00, 0x00, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
0x02, 0xc0, 0xfb, 0x03, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x3f,
0x02, 0xc0, 0xbd, 0x0f, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
0x02, 0xc0, 0x7f, 0x7b, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
0x02, 0x00, 0x00, 0x00, 0xf8, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
0xfe, 0xff, 0xff, 0xff, 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};

27
Dependencies/Python/tcl/tk8.6/demos/images/noletter.xbm vendored Normal file
View File

@ -0,0 +1,27 @@
#define noletters_width 48
#define noletters_height 48
static char noletters_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00,
0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07,
0xe0, 0x01, 0x00, 0x00, 0xf0, 0x0f, 0xe0, 0x00, 0x00, 0x00, 0x78, 0x0e,
0xf0, 0x00, 0x00, 0x00, 0x3c, 0x1e, 0x70, 0x00, 0x00, 0x00, 0x1e, 0x1c,
0x38, 0x00, 0x00, 0x00, 0x0f, 0x38, 0x38, 0x00, 0x00, 0x80, 0x07, 0x38,
0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x1c, 0x04, 0x00, 0xe0, 0x41, 0x70,
0x1c, 0x04, 0x00, 0xf0, 0x40, 0x70, 0x1c, 0x74, 0x00, 0x78, 0x4e, 0x70,
0x0e, 0x04, 0x00, 0x3c, 0x4a, 0xe0, 0x0e, 0x74, 0x03, 0x1e, 0x4a, 0xe0,
0x0e, 0x04, 0x00, 0x0f, 0x4e, 0xe0, 0x0e, 0x04, 0x80, 0x07, 0x40, 0xe0,
0x0e, 0x04, 0xf8, 0x0f, 0x40, 0xe0, 0x0e, 0x04, 0xe0, 0x01, 0x40, 0xe0,
0x0e, 0x04, 0xf8, 0x00, 0x40, 0xe0, 0x0e, 0x04, 0x78, 0x00, 0x40, 0xe0,
0x0e, 0x04, 0xfc, 0xf3, 0x40, 0xe0, 0x1c, 0x04, 0x1e, 0x00, 0x40, 0x70,
0x1c, 0x04, 0x0f, 0x00, 0x40, 0x70, 0x1c, 0x84, 0x07, 0x00, 0x40, 0x70,
0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x38, 0xe0, 0x01, 0x00, 0x00, 0x38,
0x38, 0xf0, 0x00, 0x00, 0x00, 0x38, 0x70, 0x78, 0x00, 0x00, 0x00, 0x1c,
0xf0, 0x3c, 0x00, 0x00, 0x00, 0x1e, 0xe0, 0x1e, 0x00, 0x00, 0x00, 0x0e,
0xe0, 0x0f, 0x00, 0x00, 0x00, 0x0f, 0xc0, 0x07, 0x00, 0x00, 0x80, 0x07,
0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00};

BIN
Dependencies/Python/tcl/tk8.6/demos/images/ouster.png vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 53 KiB

6
Dependencies/Python/tcl/tk8.6/demos/images/pattern.xbm vendored Normal file
View File

@ -0,0 +1,6 @@
#define foo_width 16
#define foo_height 16
static char foo_bits[] = {
0x60, 0x06, 0x90, 0x09, 0x90, 0x09, 0xb0, 0x0d, 0x4e, 0x72, 0x49, 0x92,
0x71, 0x8e, 0x8e, 0x71, 0x8e, 0x71, 0x71, 0x8e, 0x49, 0x92, 0x4e, 0x72,
0xb0, 0x0d, 0x90, 0x09, 0x90, 0x09, 0x60, 0x06};

BIN
Dependencies/Python/tcl/tk8.6/demos/images/tcllogo.gif vendored Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.3 KiB

31
Dependencies/Python/tcl/tk8.6/demos/images/teapot.ppm vendored Normal file
View File

File diff suppressed because one or more lines are too long

302
Dependencies/Python/tcl/tk8.6/demos/items.tcl vendored Normal file
View File

@ -0,0 +1,302 @@
# items.tcl --
#
# This demonstration script creates a canvas that displays the
# canvas item types.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .items
catch {destroy $w}
toplevel $w
wm title $w "Canvas Item Demonstration"
wm iconname $w "Items"
positionWindow $w
set c $w.frame.c
label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Left-Button drag:\tmoves item under pointer.\n Middle-Button drag:\trepositions view.\n Right-Button drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame
pack $w.frame -side top -fill both -expand yes
canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
-relief sunken -borderwidth 2 \
-xscrollcommand "$w.frame.hscroll set" \
-yscrollcommand "$w.frame.vscroll set"
ttk::scrollbar $w.frame.vscroll -command "$c yview"
ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview"
grid $c -in $w.frame \
-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid $w.frame.vscroll \
-row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid $w.frame.hscroll \
-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid rowconfig $w.frame 0 -weight 1 -minsize 0
grid columnconfig $w.frame 0 -weight 1 -minsize 0
# Display a 3x3 rectangular grid.
$c create rect 0c 0c 30c 24c -width 2
$c create line 0c 8c 30c 8c -width 2
$c create line 0c 16c 30c 16c -width 2
$c create line 10c 0c 10c 24c -width 2
$c create line 20c 0c 20c 24c -width 2
set font1 {Helvetica 12}
set font2 {Helvetica 24 bold}
if {[winfo depth $c] > 1} {
set blue DeepSkyBlue3
set red red
set bisque bisque3
set green SeaGreen3
} else {
set blue black
set red black
set bisque black
set green black
}
# Set up demos within each of the areas of the grid.
$c create text 5c .2c -text Lines -anchor n
$c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \
-cap butt -join miter -tags item
$c create line 4.67c 1c 4.67c 4c -arrow last -tags item
$c create line 6.33c 1c 6.33c 4c -arrow both -tags item
$c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \
8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \
-width 3 -fill $red -tags item
# Main widget program sets variable tk_demoDirectory
$c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
-arrow both -arrowshape {15 15 7} -tags item
$c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \
-cap round -join round -tags item
$c create text 15c .2c -text "Curves (smoothed lines)" -anchor n
$c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \
-fill $blue -tags item
$c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \
-arrow both -width 3 -tags item
$c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \
16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
-fill $red -tags item
$c create text 25c .2c -text Polygons -anchor n
$c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \
24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \
-outline {} -width 4 -tags item
$c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \
29c 1c 29c 4c 29c 4c -fill $red -outline {} -smooth on -tags item
$c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \
28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
-fill $blue -outline {} -tags item
$c create text 5c 8.2c -text Rectangles -anchor n
$c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item
$c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item
$c create rectangle 6c 10c 9c 15c -outline {} \
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
-fill $blue -tags item
$c create text 15c 8.2c -text Ovals -anchor n
$c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item
$c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item
$c create oval 16c 10c 19c 15c -outline {} \
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
-fill $blue -tags item
$c create text 25c 8.2c -text Text -anchor n
$c create rectangle 22.4c 8.9c 22.6c 9.1c
$c create text 22.5c 9c -anchor n -font $font1 -width 4c \
-text "A short string of text, word-wrapped, justified left, and anchored north (at the top). The rectangles show the anchor points for each piece of text." -tags item
$c create rectangle 25.4c 10.9c 25.6c 11.1c
$c create text 25.5c 11c -anchor w -font $font1 -fill $blue \
-text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \
-justify center -tags item
$c create rectangle 24.9c 13.9c 25.1c 14.1c
catch {
$c create text 25c 14c -font $font2 -anchor c -fill $red -angle 15 \
-text "Angled characters" -tags item
}
$c create text 5c 16.2c -text Arcs -anchor n
$c create arc 0.5c 17c 7c 20c -fill $green -outline black \
-start 45 -extent 270 -style pieslice -tags item
$c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \
-outline $blue -start -135 -extent 270 -tags item \
-outlinestipple @[file join $tk_demoDirectory images gray25.xbm]
$c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \
-fill {} -outline $red -start 225 -extent -90 -tags item
$c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \
-fill $blue -outline {} -start 45 -extent 270 -tags item
$c create text 15c 16.2c -text "Bitmaps and Images" -anchor n
catch {
image create photo items.ousterhout \
-file [file join $tk_demoDirectory images ouster.png]
image create photo items.ousterhout.active -format "png -alpha 0.5" \
-file [file join $tk_demoDirectory images ouster.png]
$c create image 13c 20c -tags item -image items.ousterhout \
-activeimage items.ousterhout.active
}
$c create bitmap 17c 18.5c -tags item \
-bitmap @[file join $tk_demoDirectory images noletter.xbm]
$c create bitmap 17c 21.5c -tags item \
-bitmap @[file join $tk_demoDirectory images letters.xbm]
$c create text 25c 16.2c -text Windows -anchor n
button $c.button -text "Press Me" -command "butPress $c $red"
$c create window 21c 18c -window $c.button -anchor nw -tags item
entry $c.entry -width 20 -relief sunken
$c.entry insert end "Edit this text"
$c create window 21c 21c -window $c.entry -anchor nw -tags item
scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \
-width .5c -tickinterval 0
$c create window 28.5c 17.5c -window $c.scale -anchor n -tags item
$c create text 21c 17.9c -text Button: -anchor sw
$c create text 21c 20.9c -text Entry: -anchor sw
$c create text 28.5c 17.4c -text Scale: -anchor s
# Set up event bindings for canvas:
$c bind item <Enter> "itemEnter $c"
$c bind item <Leave> "itemLeave $c"
if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
bind $c <Button-2> "itemMark $c %x %y"
bind $c <B2-Motion> "itemStroke $c %x %y"
bind $c <Button-3> "$c scan mark %x %y"
bind $c <B3-Motion> "$c scan dragto %x %y"
} else {
bind $c <Button-2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y"
bind $c <Button-3> "itemMark $c %x %y"
bind $c <B3-Motion> "itemStroke $c %x %y"
}
bind $c <<NextChar>> "itemsUnderArea $c"
bind $c <Button-1> "itemStartDrag $c %x %y"
bind $c <B1-Motion> "itemDrag $c %x %y"
# Utility procedures for highlighting the item under the pointer:
proc itemEnter {c} {
global restoreCmd
if {[winfo depth $c] == 1} {
set restoreCmd {}
return
}
set type [$c type current]
if {$type == "window" || $type == "image"} {
set restoreCmd {}
return
} elseif {$type == "bitmap"} {
set bg [lindex [$c itemconf current -background] 4]
set restoreCmd [list $c itemconfig current -background $bg]
$c itemconfig current -background SteelBlue2
return
} elseif {$type == "image"} {
set restoreCmd [list $c itemconfig current -state normal]
$c itemconfig current -state active
return
}
set fill [lindex [$c itemconfig current -fill] 4]
if {(($type == "rectangle") || ($type == "oval") || ($type == "arc"))
&& ($fill == "")} {
set outline [lindex [$c itemconfig current -outline] 4]
set restoreCmd "$c itemconfig current -outline $outline"
$c itemconfig current -outline SteelBlue2
} else {
set restoreCmd "$c itemconfig current -fill $fill"
$c itemconfig current -fill SteelBlue2
}
}
proc itemLeave {c} {
global restoreCmd
eval $restoreCmd
}
# Utility procedures for stroking out a rectangle and printing what's
# underneath the rectangle's area.
proc itemMark {c x y} {
global areaX1 areaY1
set areaX1 [$c canvasx $x]
set areaY1 [$c canvasy $y]
$c delete area
}
proc itemStroke {c x y} {
global areaX1 areaY1 areaX2 areaY2
set x [$c canvasx $x]
set y [$c canvasy $y]
if {($areaX1 != $x) && ($areaY1 != $y)} {
$c delete area
$c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \
-outline black]
set areaX2 $x
set areaY2 $y
}
}
proc itemsUnderArea {c} {
global areaX1 areaY1 areaX2 areaY2
set area [$c find withtag area]
set items ""
foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
if {[lsearch [$c gettags $i] item] >= 0} {
lappend items $i
}
}
puts stdout "Items enclosed by area: $items"
set items ""
foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
if {[lsearch [$c gettags $i] item] >= 0} {
lappend items $i
}
}
puts stdout "Items overlapping area: $items"
}
set areaX1 0
set areaY1 0
set areaX2 0
set areaY2 0
# Utility procedures to support dragging of items.
proc itemStartDrag {c x y} {
global lastX lastY
set lastX [$c canvasx $x]
set lastY [$c canvasy $y]
}
proc itemDrag {c x y} {
global lastX lastY
set x [$c canvasx $x]
set y [$c canvasy $y]
$c move current [expr {$x-$lastX}] [expr {$y-$lastY}]
set lastX $x
set lastY $y
}
# Procedure that's invoked when the button embedded in the canvas
# is invoked.
proc butPress {w color} {
set i [$w create text 25c 18.1c -text "Oooohhh!!" -fill $color -anchor n]
after 500 "$w delete $i"
}

328
Dependencies/Python/tcl/tk8.6/demos/ixset vendored Normal file
View File

@ -0,0 +1,328 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# ixset --
# A nice interface to "xset" to change X server settings
#
# History :
# 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design
# 92/08/01 : pda@masi.ibp.fr : cleaning
package require Tk
#
# Button actions
#
proc quit {} {
destroy .
}
proc ok {} {
writesettings
quit
}
proc cancel {} {
readsettings
dispsettings
.buttons.apply configure -state disabled
.buttons.cancel configure -state disabled
}
proc apply {} {
writesettings
.buttons.apply configure -state disabled
.buttons.cancel configure -state disabled
}
#
# Read current settings
#
proc readsettings {} {
global kbdrep ; set kbdrep "on"
global kbdcli ; set kbdcli 0
global bellvol ; set bellvol 100
global bellpit ; set bellpit 440
global belldur ; set belldur 100
global mouseacc ; set mouseacc "3/1"
global mousethr ; set mousethr 4
global screenbla ; set screenbla "blank"
global screentim ; set screentim 600
global screencyc ; set screencyc 600
set xfd [open "|xset q" r]
while {[gets $xfd line] >= 0} {
switch -- [lindex $line 0] {
auto {
set rpt [lindex $line 1]
if {$rpt eq "repeat:"} {
set kbdrep [lindex $line 2]
set kbdcli [lindex $line 6]
}
}
bell {
set bellvol [lindex $line 2]
set bellpit [lindex $line 5]
set belldur [lindex $line 8]
}
acceleration: {
set mouseacc [lindex $line 1]
set mousethr [lindex $line 3]
}
prefer {
set bla [lindex $line 2]
set screenbla [expr {$bla eq "yes" ? "blank" : "noblank"}]
}
timeout: {
set screentim [lindex $line 1]
set screencyc [lindex $line 3]
}
}
}
close $xfd
# puts stdout [format "Key REPEAT = %s\n" $kbdrep]
# puts stdout [format "Key CLICK = %s\n" $kbdcli]
# puts stdout [format "Bell VOLUME = %s\n" $bellvol]
# puts stdout [format "Bell PITCH = %s\n" $bellpit]
# puts stdout [format "Bell DURATION = %s\n" $belldur]
# puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc]
# puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr]
# puts stdout [format "Screen BLANCK = %s\n" $screenbla]
# puts stdout [format "Screen TIMEOUT = %s\n" $screentim]
# puts stdout [format "Screen CYCLE = %s\n" $screencyc]
}
#
# Write settings into the X server
#
proc writesettings {} {
global kbdrep kbdcli bellvol bellpit belldur
global mouseacc mousethr screenbla screentim screencyc
set bellvol [.bell.vol get]
set bellpit [.bell.val.pit.entry get]
set belldur [.bell.val.dur.entry get]
if {$kbdrep eq "on"} {
set kbdcli [.kbd.val.cli get]
} else {
set kbdcli "off"
}
set mouseacc [.mouse.hor.acc.entry get]
set mousethr [.mouse.hor.thr.entry get]
set screentim [.screen.tim.entry get]
set screencyc [.screen.cyc.entry get]
exec xset \
b $bellvol $bellpit $belldur \
c $kbdcli \
r $kbdrep \
m $mouseacc $mousethr \
s $screentim $screencyc \
s $screenbla
}
#
# Sends all settings to the window
#
proc dispsettings {} {
global kbdrep kbdcli bellvol bellpit belldur
global mouseacc mousethr screenbla screentim screencyc
.bell.vol set $bellvol
.bell.val.pit.entry delete 0 end
.bell.val.pit.entry insert 0 $bellpit
.bell.val.dur.entry delete 0 end
.bell.val.dur.entry insert 0 $belldur
.kbd.val.onoff [expr {$kbdrep eq "on" ? "select" : "deselect"}]
.kbd.val.cli set $kbdcli
.mouse.hor.acc.entry delete 0 end
.mouse.hor.acc.entry insert 0 $mouseacc
.mouse.hor.thr.entry delete 0 end
.mouse.hor.thr.entry insert 0 $mousethr
.screen.blank [expr {$screenbla eq "blank" ? "select" : "deselect"}]
.screen.pat [expr {$screenbla ne "blank" ? "select" : "deselect"}]
.screen.tim.entry delete 0 end
.screen.tim.entry insert 0 $screentim
.screen.cyc.entry delete 0 end
.screen.cyc.entry insert 0 $screencyc
}
#
# Create all windows, and pack them
#
proc labelentry {path text length {range {}}} {
frame $path
label $path.label -text $text
if {[llength $range]} {
spinbox $path.entry -width $length -relief sunken \
-from [lindex $range 0] -to [lindex $range 1]
} else {
entry $path.entry -width $length -relief sunken
}
pack $path.label -side left
pack $path.entry -side right -expand y -fill x
}
proc createwindows {} {
#
# Buttons
#
frame .buttons
button .buttons.ok -default active -command ok -text "Ok"
button .buttons.apply -default normal -command apply -text "Apply" \
-state disabled
button .buttons.cancel -default normal -command cancel -text "Cancel" \
-state disabled
button .buttons.quit -default normal -command quit -text "Quit"
pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
-side left -expand yes -pady 5
bind . <Return> {.buttons.ok flash; .buttons.ok invoke}
bind . <Escape> {.buttons.quit flash; .buttons.quit invoke}
bind . <Button-1> {
if {![string match .buttons* %W]} {
.buttons.apply configure -state normal
.buttons.cancel configure -state normal
}
}
bind . <Key> {
if {![string match .buttons* %W]} {
switch -glob %K {
Return - Escape - Tab - *Shift* {}
default {
.buttons.apply configure -state normal
.buttons.cancel configure -state normal
}
}
}
}
#
# Bell settings
#
labelframe .bell -text "Bell Settings" -padx 1.5m -pady 1.5m
scale .bell.vol \
-from 0 -to 100 -length 200 -tickinterval 20 \
-label "Volume (%)" -orient horizontal
frame .bell.val
labelentry .bell.val.pit "Pitch (Hz)" 6 {25 20000}
labelentry .bell.val.dur "Duration (ms)" 6 {1 10000}
pack .bell.val.pit -side left -padx 5
pack .bell.val.dur -side right -padx 5
pack .bell.vol .bell.val -side top -expand yes
#
# Keyboard settings
#
labelframe .kbd -text "Keyboard Repeat Settings" -padx 1.5m -pady 1.5m
frame .kbd.val
checkbutton .kbd.val.onoff \
-text "On" \
-onvalue "on" -offvalue "off" -variable kbdrep \
-relief flat
scale .kbd.val.cli \
-from 0 -to 100 -length 200 -tickinterval 20 \
-label "Click Volume (%)" -orient horizontal
pack .kbd.val.onoff -side left -fill x -expand yes -padx {0 1m}
pack .kbd.val.cli -side left -expand yes -fill x -padx {1m 0}
pack .kbd.val -side top -expand yes -pady 2 -fill x
#
# Mouse settings
#
labelframe .mouse -text "Mouse Settings" -padx 1.5m -pady 1.5m
frame .mouse.hor
labelentry .mouse.hor.acc "Acceleration" 5
labelentry .mouse.hor.thr "Threshold (pixels)" 3 {1 2000}
pack .mouse.hor.acc -side left -padx {0 1m}
pack .mouse.hor.thr -side right -padx {1m 0}
pack .mouse.hor -side top -expand yes
#
# Screen Saver settings
#
labelframe .screen -text "Screen-saver Settings" -padx 1.5m -pady 1.5m
radiobutton .screen.blank \
-variable screenblank -text "Blank" -relief flat \
-value "blank" -variable screenbla -anchor w
radiobutton .screen.pat \
-variable screenblank -text "Pattern" -relief flat \
-value "noblank" -variable screenbla -anchor w
labelentry .screen.tim "Timeout (s)" 5 {1 100000}
labelentry .screen.cyc "Cycle (s)" 5 {1 100000}
grid .screen.blank .screen.tim -sticky e
grid .screen.pat .screen.cyc -sticky e
grid configure .screen.blank .screen.pat -sticky ew
#
# Main window
#
pack .buttons -side top -fill both
pack .bell .kbd .mouse .screen -side top -fill both -expand yes \
-padx 1m -pady 1m
#
# Let the user resize our window
#
wm minsize . 10 10
}
##############################################################################
# Main program
#
# Listen what "xset" tells us...
#
readsettings
#
# Create all windows
#
createwindows
#
# Write xset parameters
#
dispsettings
#
# Now, wait for user actions...
#
# Local Variables:
# mode: tcl
# End:

268
Dependencies/Python/tcl/tk8.6/demos/knightstour.tcl vendored Normal file
View File

@ -0,0 +1,268 @@
# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Calculate a Knight's tour of a chessboard.
#
# This uses Warnsdorff's rule to calculate the next square each
# time. This specifies that the next square should be the one that
# has the least number of available moves.
#
# Using this rule it is possible to get to a position where
# there are no squares available to move into. In this implementation
# this occurs when the starting square is d6.
#
# To solve this fault an enhancement to the rule is that if we
# have a choice of squares with an equal score, we should choose
# the one nearest the edge of the board.
#
# If the call to the Edgemost function is commented out you can see
# this occur.
#
# You can drag the knight to a specific square to start if you wish.
# If you let it repeat then it will choose random start positions
# for each new tour.
package require Tk
# Return a list of accessible squares from a given square
proc ValidMoves {square} {
set moves {}
foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} {
set col [expr {($square % 8) + [lindex $pair 0]}]
set row [expr {($square / 8) + [lindex $pair 1]}]
if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} {
lappend moves [expr {$row * 8 + $col}]
}
}
return $moves
}
# Return the number of available moves for this square
proc CheckSquare {square} {
variable visited
set moves 0
foreach test [ValidMoves $square] {
if {[lsearch -exact -integer $visited $test] < 0} {
incr moves
}
}
return $moves
}
# Select the next square to move to. Returns -1 if there are no available
# squares remaining that we can move to.
proc Next {square} {
variable visited
set minimum 9
set nextSquare -1
foreach testSquare [ValidMoves $square] {
if {[lsearch -exact -integer $visited $testSquare] < 0} {
set count [CheckSquare $testSquare]
if {$count < $minimum} {
set minimum $count
set nextSquare $testSquare
} elseif {$count == $minimum} {
# to remove the enhancement to Warnsdorff's rule
# remove the next line:
set nextSquare [Edgemost $nextSquare $testSquare]
}
}
}
return $nextSquare
}
# Select the square nearest the edge of the board
proc Edgemost {a b} {
set colA [expr {3-int(abs(3.5-($a%8)))}]
set colB [expr {3-int(abs(3.5-($b%8)))}]
set rowA [expr {3-int(abs(3.5-($a/8)))}]
set rowB [expr {3-int(abs(3.5-($b/8)))}]
return [expr {($colA * $rowA) < ($colB * $rowB) ? $a : $b}]
}
# Display a square number as a standard chess square notation.
proc N {square} {
return [format %c%d [expr {97 + $square % 8}] \
[expr {$square / 8 + 1}]]
}
# Perform a Knight's move and schedule the next move.
proc MovePiece {dlg last square} {
variable visited
variable delay
variable continuous
$dlg.f.txt insert end "[llength $visited]. [N $last] .. [N $square]\n" {}
$dlg.f.txt see end
$dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black
$dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red
$dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1+$square}]] 0 1]
lappend visited $square
set next [Next $square]
if {$next ne -1} {
variable aid [after $delay [list MovePiece $dlg $square $next]]
} else {
$dlg.tf.b1 configure -state normal
if {[llength $visited] == 64} {
variable initial
if {$initial == $square} {
$dlg.f.txt insert end "Closed tour!"
} else {
$dlg.f.txt insert end "Success\n" {}
if {$continuous} {
after [expr {$delay * 2}] [namespace code \
[list Tour $dlg [expr {int(rand() * 64)}]]]
}
}
} else {
$dlg.f.txt insert end "FAILED!\n" {}
}
}
}
# Begin a new tour of the board given a random start position
proc Tour {dlg {square {}}} {
variable visited {}
$dlg.f.txt delete 1.0 end
$dlg.tf.b1 configure -state disabled
for {set n 0} {$n < 64} {incr n} {
$dlg.f.c itemconfigure $n -state disabled -outline black
}
if {$square eq {}} {
set coords [lrange [$dlg.f.c coords knight] 0 1]
set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}]
}
variable initial $square
after idle [list MovePiece $dlg $initial $initial]
}
proc Stop {} {
variable aid
catch {after cancel $aid}
}
proc Exit {dlg} {
Stop
destroy $dlg
}
proc SetDelay {new} {
variable delay [expr {int($new)}]
}
proc DragStart {w x y} {
$w dtag selected
$w addtag selected withtag current
variable dragging [list $x $y]
}
proc DragMotion {w x y} {
variable dragging
if {[info exists dragging]} {
$w move selected [expr {$x - [lindex $dragging 0]}] \
[expr {$y - [lindex $dragging 1]}]
variable dragging [list $x $y]
}
}
proc DragEnd {w x y} {
set square [$w find closest $x $y 0 65]
$w moveto selected {*}[lrange [$w coords $square] 0 1]
$w dtag selected
variable dragging ; unset dragging
}
proc CreateGUI {} {
catch {destroy .knightstour}
set dlg [toplevel .knightstour]
wm title $dlg "Knights tour"
wm withdraw $dlg
set f [ttk::frame $dlg.f]
set c [canvas $f.c -width 240 -height 240]
text $f.txt -width 10 -height 1 \
-yscrollcommand [list $f.vs set] -font {Arial 8}
ttk::scrollbar $f.vs -command [list $f.txt yview]
variable delay 600
variable continuous 0
ttk::frame $dlg.tf
ttk::label $dlg.tf.ls -text Speed
ttk::scale $dlg.tf.sc -from 8 -to 2000 -command [list SetDelay] \
-variable [namespace which -variable delay]
ttk::checkbutton $dlg.tf.cc -text Repeat \
-variable [namespace which -variable continuous]
ttk::button $dlg.tf.b1 -text Start -command [list Tour $dlg]
ttk::button $dlg.tf.b2 -text Exit -command [list Exit $dlg]
set square 0
for {set row 7} {$row >= 0} {incr row -1} {
for {set col 0} {$col < 8} {incr col} {
if {(($col & 1) ^ ($row & 1))} {
set fill tan3 ; set dfill tan4
} else {
set fill bisque ; set dfill bisque3
}
set coords [list [expr {$col * 30 + 4}] [expr {$row * 30 + 4}] \
[expr {$col * 30 + 30}] [expr {$row * 30 + 30}]]
$c create rectangle $coords -fill $fill -disabledfill $dfill \
-width 2 -state disabled -outline black
}
}
if {[tk windowingsystem] ne "x11"} {
catch {eval font create KnightFont -size -24}
$c create text 0 0 -font KnightFont -text "\u265e" \
-anchor nw -tags knight -fill black -activefill "#600000"
} else {
# On X11 we cannot reliably tell if the \u265e glyph is available
# so just use a polygon
set pts {
2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16
2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21
}
$c create polygon $pts -tag knight -offset 8 \
-fill black -activefill "#600000"
}
$c moveto knight {*}[lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1]
$c bind knight <Button-1> [namespace code [list DragStart %W %x %y]]
$c bind knight <Motion> [namespace code [list DragMotion %W %x %y]]
$c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]]
grid $c $f.txt $f.vs -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 1 -weight 1
grid $f - - - - - -sticky news
set things [list $dlg.tf.ls $dlg.tf.sc $dlg.tf.cc $dlg.tf.b1]
if {![info exists ::widgetDemo]} {
lappend things $dlg.tf.b2
if {[tk windowingsystem] ne "aqua"} {
set things [linsert $things 0 [ttk::sizegrip $dlg.tf.sg]]
}
}
pack {*}$things -side right
if {[tk windowingsystem] eq "aqua"} {
pack configure {*}$things -padx {4 4} -pady {12 12}
pack configure [lindex $things 0] -padx {4 24}
pack configure [lindex $things end] -padx {16 4}
}
grid $dlg.tf - - - - - -sticky ew
if {[info exists ::widgetDemo]} {
grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew
}
grid rowconfigure $dlg 0 -weight 1
grid columnconfigure $dlg 0 -weight 1
bind $dlg <Control-F2> {console show}
bind $dlg <Return> [list $dlg.tf.b1 invoke]
bind $dlg <Escape> [list $dlg.tf.b2 invoke]
bind $dlg <Destroy> [namespace code [list Stop]]
wm protocol $dlg WM_DELETE_WINDOW [namespace code [list Exit $dlg]]
wm deiconify $dlg
tkwait window $dlg
}
if {![winfo exists .knightstour]} {
if {![info exists widgetDemo]} { wm withdraw . }
set r [catch [linsert $argv 0 CreateGUI] err]
if {$r} {
tk_messageBox -icon error -title "Error" -message $err
}
if {![info exists widgetDemo]} { exit $r }
}

40
Dependencies/Python/tcl/tk8.6/demos/label.tcl vendored Normal file
View File

@ -0,0 +1,40 @@
# label.tcl --
#
# This demonstration script creates a toplevel window containing
# several label widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .label
catch {destroy $w}
toplevel $w
wm title $w "Label Demonstration"
wm iconname $w "label"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and an image label and a text label on the right. Labels are pretty boring because you can't do anything with them."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.left
frame $w.right
pack $w.left $w.right -side left -expand yes -padx 10 -pady 10 -fill both
label $w.left.l1 -text "First label"
label $w.left.l2 -text "Second label, raised" -relief raised
label $w.left.l3 -text "Third label, sunken" -relief sunken
pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w
# Main widget program sets variable tk_demoDirectory
image create photo label.ousterhout \
-file [file join $tk_demoDirectory images ouster.png]
label $w.right.picture -borderwidth 2 -relief sunken -image label.ousterhout
label $w.right.caption -text "Tcl/Tk Creator"
pack $w.right.picture $w.right.caption -side top

76
Dependencies/Python/tcl/tk8.6/demos/labelframe.tcl vendored Normal file
View File

@ -0,0 +1,76 @@
# labelframe.tcl --
#
# This demonstration script creates a toplevel window containing
# several labelframe widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .labelframe
catch {destroy $w}
toplevel $w
wm title $w "Labelframe Demonstration"
wm iconname $w "labelframe"
positionWindow $w
# Some information
label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\
used to group related widgets together. The label may be either \
plain text or another widget."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Demo area
frame $w.f
pack $w.f -side bottom -fill both -expand 1
set w $w.f
# A group of radiobuttons in a labelframe
labelframe $w.f -text "Value" -padx 2 -pady 2
grid $w.f -row 0 -column 0 -pady 2m -padx 2m
foreach value {1 2 3 4} {
radiobutton $w.f.b$value -text "This is value $value" \
-variable lfdummy -value $value
pack $w.f.b$value -side top -fill x -pady 2
}
# Using a label window to control a group of options.
proc lfEnableButtons {w} {
foreach child [winfo children $w] {
if {$child == "$w.cb"} continue
if {$::lfdummy2} {
$child configure -state normal
} else {
$child configure -state disabled
}
}
}
labelframe $w.f2 -pady 2 -padx 2
checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \
-command "lfEnableButtons $w.f2" -padx 0
$w.f2 configure -labelwidget $w.f2.cb
grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m
set t 0
foreach str {Option1 Option2 Option3} {
checkbutton $w.f2.b$t -text $str
pack $w.f2.b$t -side top -fill x -pady 2
incr t
}
lfEnableButtons $w.f2
grid columnconfigure $w {0 1} -weight 1

40
Dependencies/Python/tcl/tk8.6/demos/license.terms vendored Normal file
View File

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

119
Dependencies/Python/tcl/tk8.6/demos/mclist.tcl vendored Normal file
View File

@ -0,0 +1,119 @@
# mclist.tcl --
#
# This demonstration script creates a toplevel window containing a Ttk
# tree widget configured as a multi-column listbox.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .mclist
catch {destroy $w}
toplevel $w
wm title $w "Multi-Column List"
wm iconname $w "mclist"
positionWindow $w
## Explanatory text
ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listbox that has multiple columns. Clicking on the heading for a column will sort the data by that column. You can also change the width of the columns by dragging the boundary between them."
pack $w.msg -fill x
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
ttk::frame $w.container
ttk::treeview $w.tree -columns {country capital currency} -show headings \
-yscroll "$w.vsb set" -xscroll "$w.hsb set"
ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
pack $w.container -fill both -expand 1
grid $w.tree $w.vsb -in $w.container -sticky nsew
grid $w.hsb -in $w.container -sticky nsew
grid column $w.container 0 -weight 1
grid row $w.container 0 -weight 1
image create photo upArrow -data {
R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAImhI+
py+1LIsJHiBAh+BgmiEAJQITgW6DgUQIAECH4JN8IPqYuNxUAOw==}
image create photo downArrow -data {
R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAInhI+
py+1I4ocQ/IgDEYIPgYJICUCE4F+YIBolEoKPEJKZmVJK6ZACADs=}
image create photo noArrow -height 14 -width 14
## The data we're going to insert
set data {
Argentina {Buenos Aires} ARS
Australia Canberra AUD
Brazil Brazilia BRL
Canada Ottawa CAD
China Beijing CNY
France Paris EUR
Germany Berlin EUR
India {New Delhi} INR
Italy Rome EUR
Japan Tokyo JPY
Mexico {Mexico City} MXN
Russia Moscow RUB
{South Africa} Pretoria ZAR
{United Kingdom} London GBP
{United States} {Washington, D.C.} USD
}
## Code to insert the data nicely
set font [ttk::style lookup Heading -font]
foreach col {country capital currency} name {Country Capital Currency} {
$w.tree heading $col -text $name -image noArrow -anchor w \
-command [list SortBy $w.tree $col 0]
$w.tree column $col -width [expr {
[font measure $font $name] + [image width noArrow] + 5
}]
}
set font [ttk::style lookup Treeview -font]
foreach {country capital currency} $data {
$w.tree insert {} end -values [list $country $capital $currency]
foreach col {country capital currency} {
set len [font measure $font "[set $col] "]
if {[$w.tree column $col -width] < $len} {
$w.tree column $col -width $len
}
}
}
## Code to do the sorting of the tree contents when clicked on
proc SortBy {tree col direction} {
# Determine currently sorted column and its sort direction
foreach c {country capital currency} {
set s [$tree heading $c state]
if {("selected" in $s || "alternate" in $s) && $col ne $c} {
# Sorted column has changed
$tree heading $c -image noArrow state {!selected !alternate !user1}
set direction [expr {"alternate" in $s}]
}
}
# Build something we can sort
set data {}
foreach row [$tree children {}] {
lappend data [list [$tree set $row $col] $row]
}
set dir [expr {$direction ? "-decreasing" : "-increasing"}]
set r -1
# Now reshuffle the rows into the sorted order
foreach info [lsort -dictionary -index 0 $dir $data] {
$tree move [lindex $info 1] {} [incr r]
}
# Switch the heading so that it will sort in the opposite direction
$tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \
state [expr {$direction?"!selected alternate":"selected !alternate"}]
if {[ttk::style theme use] eq "aqua"} {
# Aqua theme displays native sort arrows when user1 state is set
$tree heading $col state "user1"
} else {
$tree heading $col -image [expr {$direction?"upArrow":"downArrow"}]
}
}

177
Dependencies/Python/tcl/tk8.6/demos/menu.tcl vendored Normal file
View File

@ -0,0 +1,177 @@
# menu.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .menu
catch {destroy $w}
toplevel $w
wm title $w "Menu Demonstration"
wm iconname $w "menu"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left
if {[tk windowingsystem] eq "aqua"} {
$w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
} else {
$w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
}
pack $w.msg -side top
set menustatus " "
frame $w.statusBar
label $w.statusBar.label -textvariable menustatus -relief sunken -bd 1 -font "Helvetica 10" -anchor w
pack $w.statusBar.label -side left -padx 2 -expand yes -fill both
pack $w.statusBar -side bottom -fill x -pady 2
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
menu $w.menu -tearoff 0
set m $w.menu.file
menu $m -tearoff 0
$w.menu add cascade -label "File" -menu $m -underline 0
$m add command -label "Open..." -command {error "this is just a demo: no action has been defined for the \"Open...\" entry"}
$m add command -label "New" -command {error "this is just a demo: no action has been defined for the \"New\" entry"}
$m add command -label "Save" -command {error "this is just a demo: no action has been defined for the \"Save\" entry"}
$m add command -label "Save As..." -command {error "this is just a demo: no action has been defined for the \"Save As...\" entry"}
$m add separator
$m add command -label "Print Setup..." -command {error "this is just a demo: no action has been defined for the \"Print Setup...\" entry"}
$m add command -label "Print..." -command {error "this is just a demo: no action has been defined for the \"Print...\" entry"}
$m add separator
$m add command -label "Dismiss Menus Demo" -command "destroy $w"
set m $w.menu.basic
$w.menu add cascade -label "Basic" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Long entry that does nothing"
if {[tk windowingsystem] eq "aqua"} {
set modifier Command
} elseif {[tk windowingsystem] eq "win32"} {
set modifier Control
} else {
set modifier Meta
}
foreach i {A B C D E F} {
$m add command -label "Print letter \"$i\"" -underline 14 \
-accelerator $modifier+$i -command "puts $i"
bind $w <$modifier-[string tolower $i]> "puts $i"
}
set m $w.menu.cascade
$w.menu add cascade -label "Cascades" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Print hello" \
-command {puts stdout "Hello"} -accelerator $modifier+H -underline 6
bind $w <$modifier-h> {puts stdout "Hello"}
$m add command -label "Print goodbye" -command {\
puts stdout "Goodbye"} -accelerator $modifier+G -underline 6
bind $w <$modifier-g> {puts stdout "Goodbye"}
$m add cascade -label "Check buttons" \
-menu $w.menu.cascade.check -underline 0
$m add cascade -label "Radio buttons" \
-menu $w.menu.cascade.radio -underline 0
set m $w.menu.cascade.check
menu $m -tearoff 0
$m add check -label "Oil checked" -variable oil
$m add check -label "Transmission checked" -variable trans
$m add check -label "Brakes checked" -variable brakes
$m add check -label "Lights checked" -variable lights
$m add separator
$m add command -label "Show current values" \
-command "showVars $w.menu.cascade.dialog oil trans brakes lights"
$m invoke 1
$m invoke 3
set m $w.menu.cascade.radio
menu $m -tearoff 0
$m add radio -label "10 point" -variable pointSize -value 10
$m add radio -label "14 point" -variable pointSize -value 14
$m add radio -label "18 point" -variable pointSize -value 18
$m add radio -label "24 point" -variable pointSize -value 24
$m add radio -label "32 point" -variable pointSize -value 32
$m add sep
$m add radio -label "Roman" -variable style -value roman
$m add radio -label "Bold" -variable style -value bold
$m add radio -label "Italic" -variable style -value italic
$m add sep
$m add command -label "Show current values" \
-command "showVars $w.menu.cascade.dialog pointSize style"
$m invoke 1
$m invoke 7
set m $w.menu.icon
$w.menu add cascade -label "Icons" -menu $m -underline 0
menu $m -tearoff 0
# Main widget program sets variable tk_demoDirectory
image create photo lilearth -file [file join $tk_demoDirectory \
images earthmenu.png]
$m add command -image lilearth \
-hidemargin 1 -command [list \
tk_dialog $w.pattern {Bitmap Menu Entry} \
"The menu entry you invoked displays a photoimage rather than\
a text string. Other than this, it is just like any other\
menu entry." {} 0 OK ]
foreach i {info questhead error} {
$m add command -bitmap $i -hidemargin 1 -command [list \
puts "You invoked the $i bitmap" ]
}
$m entryconfigure 2 -columnbreak 1
set m $w.menu.more
$w.menu add cascade -label "More" -menu $m -underline 0
menu $m -tearoff 0
foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} {
$m add command -label $i -command [list puts "You invoked \"$i\""]
}
set emojiLabel [encoding convertfrom utf-8 "\xF0\x9F\x98\x8D Make friends"]
$m add command -label $emojiLabel -command [list puts "Menu labels can include non-BMP characters."]
$m entryconfigure "Does almost nothing" -bitmap questhead -compound left \
-command [list \
tk_dialog $w.compound {Compound Menu Entry} \
"The menu entry you invoked displays both a bitmap and a\
text string. Other than this, it is just like any other\
menu entry." {} 0 OK ]
set m $w.menu.colors
$w.menu add cascade -label "Colors" -menu $m -underline 1
menu $m -tearoff 1
if {[tk windowingsystem] eq "aqua"} {
# Aqua ignores the -background and -foreground options, but a compound
# button can be used for selecting colors.
foreach i {red orange yellow green blue} {
image create photo image_$i -height 16 -width 16
image_$i put black -to 0 0 16 1
image_$i put black -to 0 1 1 16
image_$i put black -to 0 15 16 16
image_$i put black -to 15 1 16 16
image_$i put $i -to 1 1 15 15
$m add command -label $i -image image_$i -compound left -command [list \
puts "You invoked \"$i\"" ]
}
} else {
foreach i {red orange yellow green blue} {
$m add command -label $i -background $i -command [list \
puts "You invoked \"$i\"" ]
}
}
$w configure -menu $w.menu
bind Menu <<MenuSelect>> {
global $menustatus
if {[catch {%W entrycget active -label} label]} {
set label " "
}
set menustatus $label
update idletasks
}

87
Dependencies/Python/tcl/tk8.6/demos/menubu.tcl vendored Normal file
View File

@ -0,0 +1,87 @@
# menubu.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubuttons.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .menubu
catch {destroy $w}
toplevel $w
wm title $w "Menu Button Demonstration"
wm iconname $w "menubutton"
positionWindow $w
frame $w.body
pack $w.body -expand 1 -fill both
menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised
menu $w.body.below.m -tearoff 0
$w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\""
$w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\""
grid $w.body.below -row 0 -column 1 -sticky n
menubutton $w.body.right -text "Right" -underline 0 -direction right -menu $w.body.right.m -relief raised
menu $w.body.right.m -tearoff 0
$w.body.right.m add command -label "Right menu: first item" -command "puts \"You have selected the first item from the Right menu.\""
$w.body.right.m add command -label "Right menu: second item" -command "puts \"You have selected the second item from the Right menu.\""
frame $w.body.center
menubutton $w.body.left -text "Left" -underline 0 -direction left -menu $w.body.left.m -relief raised
menu $w.body.left.m -tearoff 0
$w.body.left.m add command -label "Left menu: first item" -command "puts \"You have selected the first item from the Left menu.\""
$w.body.left.m add command -label "Left menu: second item" -command "puts \"You have selected the second item from the Left menu.\""
grid $w.body.right -row 1 -column 0 -sticky w
grid $w.body.center -row 1 -column 1 -sticky news
grid $w.body.left -row 1 -column 2 -sticky e
menubutton $w.body.above -text "Above" -underline 0 -direction above -menu $w.body.above.m -relief raised
menu $w.body.above.m -tearoff 0
$w.body.above.m add command -label "Above menu: first item" -command "puts \"You have selected the first item from the Above menu.\""
$w.body.above.m add command -label "Above menu: second item" -command "puts \"You have selected the second item from the Above menu.\""
grid $w.body.above -row 2 -column 1 -sticky s
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
set body $w.body.center
label $body.label -wraplength 300 -font "Helvetica 14" -justify left -text "This is a demonstration of menubuttons. The \"Below\" menubutton pops its menu below the button; the \"Right\" button pops to the right, etc. There are two option menus directly below this text; one is just a standard menu and the other is a 16-color palette."
pack $body.label -side top -padx 25 -pady 25
frame $body.buttons
pack $body.buttons -padx 25 -pady 25
tk_optionMenu $body.buttons.options menubuttonoptions one two three
pack $body.buttons.options -side left -padx 25 -pady 25
set m [tk_optionMenu $body.buttons.colors paletteColor Black red4 DarkGreen NavyBlue gray75 Red Green Blue gray50 Yellow Cyan Magenta White Brown DarkSeaGreen DarkViolet]
if {[tk windowingsystem] eq "aqua"} {
set topBorderColor Black
set bottomBorderColor Black
} else {
set topBorderColor gray50
set bottomBorderColor gray75
}
for {set i 0} {$i <= [$m index last]} {incr i} {
set name [$m entrycget $i -label]
image create photo image_$name -height 16 -width 16
image_$name put $topBorderColor -to 0 0 16 1
image_$name put $topBorderColor -to 0 1 1 16
image_$name put $bottomBorderColor -to 0 15 16 16
image_$name put $bottomBorderColor -to 15 1 16 16
image_$name put $name -to 1 1 15 15
image create photo image_${name}_s -height 16 -width 16
image_${name}_s put Black -to 0 0 16 2
image_${name}_s put Black -to 0 2 2 16
image_${name}_s put Black -to 2 14 16 16
image_${name}_s put Black -to 14 2 16 14
image_${name}_s put $name -to 2 2 14 14
$m entryconfigure $i -image image_$name -selectimage image_${name}_s -hidemargin 1
}
$m configure -tearoff 1
foreach i {Black gray75 gray50 White} {
$m entryconfigure $i -columnbreak 1
}
pack $body.buttons.colors -side left -padx 25 -pady 25

62
Dependencies/Python/tcl/tk8.6/demos/msgbox.tcl vendored Normal file
View File

@ -0,0 +1,62 @@
# msgbox.tcl --
#
# This demonstration script creates message boxes of various type
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .msgbox
catch {destroy $w}
toplevel $w
wm title $w "Message Box Demonstration"
wm iconname $w "messagebox"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "Choose the icon and type option of the message box. Then press the \"Message Box\" button to see the message box."
pack $w.msg -side top
pack [addSeeDismiss $w.buttons $w {} {
ttk::button $w.buttons.vars -text "Message Box" -command "showMessageBox $w"
}] -side bottom -fill x
#pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
frame $w.left
frame $w.right
pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c
label $w.left.label -text "Icon"
frame $w.left.sep -relief ridge -bd 1 -height 2
pack $w.left.label -side top
pack $w.left.sep -side top -fill x -expand no
set msgboxIcon info
foreach i {error info question warning} {
radiobutton $w.left.b$i -text $i -variable msgboxIcon \
-relief flat -value $i -width 16 -anchor w
pack $w.left.b$i -side top -pady 2 -anchor w -fill x
}
label $w.right.label -text "Type"
frame $w.right.sep -relief ridge -bd 1 -height 2
pack $w.right.label -side top
pack $w.right.sep -side top -fill x -expand no
set msgboxType ok
foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} {
radiobutton $w.right.$t -text $t -variable msgboxType \
-relief flat -value $t -width 16 -anchor w
pack $w.right.$t -side top -pady 2 -anchor w -fill x
}
proc showMessageBox {w} {
global msgboxIcon msgboxType
set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
-title Message -parent $w\
-message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
-parent $w
}

125
Dependencies/Python/tcl/tk8.6/demos/nl.msg vendored Normal file
View File

@ -0,0 +1,125 @@
::msgcat::mcset nl "Widget Demonstration" "Demonstratie van widgets"
::msgcat::mcset nl "tkWidgetDemo" "tkWidgetDemo"
::msgcat::mcset nl "&File" "&Bestand"
::msgcat::mcset nl "About..." "Info..."
::msgcat::mcset nl "&About..." "&Info..."
::msgcat::mcset nl "<F1>" "<F1>"
::msgcat::mcset nl "&Quit" "&Einde"
::msgcat::mcset nl "Meta+Q" "Meta+E" ;# Displayed hotkey
::msgcat::mcset nl "Meta-q" "Meta-e" ;# Actual binding sequence
::msgcat::mcset nl "Ctrl+Q" "Ctrl+E" ;# Displayed hotkey
::msgcat::mcset nl "Control-q" "Control-e" ;# Actual binding sequence
::msgcat::mcset nl "Dismiss" "Sluiten"
::msgcat::mcset nl "See Variables" "Bekijk Variabelen"
::msgcat::mcset nl "Variable Values" "Waarden Variabelen"
::msgcat::mcset nl "OK" "OK"
::msgcat::mcset nl "Run the \"%s\" sample program" "Start voorbeeld \"%s\""
::msgcat::mcset nl "Print Code" "Code Afdrukken"
::msgcat::mcset nl "Demo code: %s" "Code van Demo %s"
::msgcat::mcset nl "About Widget Demo" "Over deze demonstratie"
::msgcat::mcset nl "Tk widget demonstration" "Demonstratie van Tk widgets"
::msgcat::mcset nl "Copyright © %s"
::msgcat::mcset nl "Tk Widget Demonstrations" "Demonstratie van Tk widgets"
::msgcat::mcset nl "This application provides a front end for several short scripts" \
"Dit programma is een schil rond enkele korte scripts waarmee"
::msgcat::mcset nl "that demonstrate what you can do with Tk widgets. Each of the" \
"gedemonstreerd wordt wat je kunt doen met Tk widgets. Elk van de"
::msgcat::mcset nl "numbered lines below describes a demonstration; you can click on" \
"genummerde regels hieronder omschrijft een demonstratie; je kunt de"
::msgcat::mcset nl "it to invoke the demonstration. Once the demonstration window" \
"demonstratie starten door op de regel te klikken."
::msgcat::mcset nl "appears, you can click the" \
"Zodra het nieuwe venster verschijnt, kun je op de knop"
::msgcat::mcset nl "See Code" "Bekijk Code" ;# This is also button text!
::msgcat::mcset nl "button to see the Tcl/Tk code that created the demonstration. If" \
"drukken om de achterliggende Tcl/Tk code te zien. Als je dat wilt,"
::msgcat::mcset nl "you wish, you can edit the code and click the" \
"kun je de code wijzigen en op de knop"
::msgcat::mcset nl "Rerun Demo" "Herstart Demo" ;# This is also button text!
::msgcat::mcset nl "button in the code window to reinvoke the demonstration with the" \
"drukken in het codevenster om de demonstratie uit te voeren met de"
::msgcat::mcset nl "modified code." \
"nieuwe code."
::msgcat::mcset nl "Labels, buttons, checkbuttons, and radiobuttons" \
"Labels, knoppen, vinkjes/aankruishokjes en radioknoppen"
::msgcat::mcset nl "Labels (text and bitmaps)" "Labels (tekst en plaatjes)"
::msgcat::mcset nl "Labels and UNICODE text" "Labels en tekst in UNICODE"
::msgcat::mcset nl "Buttons" "Buttons (drukknoppen)"
::msgcat::mcset nl "Check-buttons (select any of a group)" \
"Check-buttons (een of meer uit een groep)"
::msgcat::mcset nl "Radio-buttons (select one of a group)" \
"Radio-buttons (een van een groep)"
::msgcat::mcset nl "A 15-puzzle game made out of buttons" \
"Een schuifpuzzel van buttons"
::msgcat::mcset nl "Iconic buttons that use bitmaps" \
"Buttons met pictogrammen"
::msgcat::mcset nl "Two labels displaying images" \
"Twee labels met plaatjes in plaats van tekst"
::msgcat::mcset nl "A simple user interface for viewing images" \
"Een eenvoudige user-interface voor het bekijken van plaatjes"
::msgcat::mcset nl "Labelled frames" \
"Kaders met bijschrift"
::msgcat::mcset nl "Listboxes" "Keuzelijsten"
::msgcat::mcset nl "The 50 states" "De 50 staten van de VS"
::msgcat::mcset nl "Colors: change the color scheme for the application" \
"Kleuren: verander het kleurenschema voor het programma"
::msgcat::mcset nl "A collection of famous and infamous sayings" \
"Beroemde en beruchte citaten en gezegden"
::msgcat::mcset nl "Entries and Spin-boxes" "Invulvelden en Spinboxen"
::msgcat::mcset nl "Entries without scrollbars" "Invulvelden zonder schuifbalk"
::msgcat::mcset nl "Entries with scrollbars" "Invulvelden met schuifbalk"
::msgcat::mcset nl "Validated entries and password fields" \
"Invulvelden met controle of wachtwoorden"
::msgcat::mcset nl "Spin-boxes" "Spinboxen"
::msgcat::mcset nl "Simple Rolodex-like form" "Simpel kaartsysteem"
::msgcat::mcset nl "Text" "Tekst"
::msgcat::mcset nl "Basic editable text" "Voorbeeld met te wijzigen tekst"
::msgcat::mcset nl "Text display styles" "Tekst met verschillende stijlen"
::msgcat::mcset nl "Hypertext (tag bindings)" \
"Hypertext (verwijzingen via \"tags\")"
::msgcat::mcset nl "A text widget with embedded windows" \
"Tekstwidget met windows erin"
::msgcat::mcset nl "A search tool built with a text widget" \
"Zoeken in tekst met behulp van een tekstwidget"
::msgcat::mcset nl "Canvases" "Canvaswidgets"
::msgcat::mcset nl "The canvas item types" "Objecten in een canvas"
::msgcat::mcset nl "A simple 2-D plot" "Eenvoudige 2D-grafiek"
::msgcat::mcset nl "Text items in canvases" "Tekstobjecten in een canvas"
::msgcat::mcset nl "An editor for arrowheads on canvas lines" \
"Editor voor de vorm van de pijl (begin/eind van een lijn)"
::msgcat::mcset nl "A ruler with adjustable tab stops" \
"Een meetlat met aanpasbare ruiters"
::msgcat::mcset nl "A building floor plan" "Plattegrond van een gebouw"
::msgcat::mcset nl "A simple scrollable canvas" "Een schuifbaar canvas"
::msgcat::mcset nl "Scales" "Schaalverdelingen"
::msgcat::mcset nl "Horizontal scale" "Horizontale schaal"
::msgcat::mcset nl "Vertical scale" "Verticale schaal"
::msgcat::mcset nl "Paned Windows" "Vensters opgedeeld in stukken"
::msgcat::mcset nl "Horizontal paned window" "Horizontaal gedeeld venster"
::msgcat::mcset nl "Vertical paned window" "Verticaal gedeeld venster"
::msgcat::mcset nl "Menus" "Menu's"
::msgcat::mcset nl "Menus and cascades (sub-menus)" \
"Menu's en cascades (submenu's)"
::msgcat::mcset nl "Menu-buttons" "Menu-buttons"
::msgcat::mcset nl "Common Dialogs" "Veel voorkomende dialoogvensters"
::msgcat::mcset nl "Message boxes" "Mededeling (message box)"
::msgcat::mcset nl "File selection dialog" "Selectie van bestanden"
::msgcat::mcset nl "Color picker" "Kleurenpalet"
::msgcat::mcset nl "Miscellaneous" "Diversen"
::msgcat::mcset nl "The built-in bitmaps" "Ingebouwde plaatjes"
::msgcat::mcset nl "A dialog box with a local grab" \
"Een dialoogvenster met een locale \"grab\""
::msgcat::mcset nl "A dialog box with a global grab" \
"Een dialoogvenster met een globale \"grab\""

32
Dependencies/Python/tcl/tk8.6/demos/paned1.tcl vendored Normal file
View File

@ -0,0 +1,32 @@
# paned1.tcl --
#
# This demonstration script creates a toplevel window containing
# a paned window that separates two windows horizontally.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .paned1
catch {destroy $w}
toplevel $w
wm title $w "Horizontal Paned Window Demonstration"
wm iconname $w "paned1"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
panedwindow $w.pane
pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
label $w.pane.left -text "This is the\nleft side" -fg black -bg yellow
label $w.pane.right -text "This is the\nright side" -fg black -bg cyan
$w.pane add $w.pane.left $w.pane.right

74
Dependencies/Python/tcl/tk8.6/demos/paned2.tcl vendored Normal file
View File

@ -0,0 +1,74 @@
# paned2.tcl --
#
# This demonstration script creates a toplevel window containing
# a paned window that separates two windows vertically.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .paned2
catch {destroy $w}
toplevel $w
wm title $w "Vertical Paned Window Demonstration"
wm iconname $w "paned2"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Create the pane itself
panedwindow $w.pane -orient vertical
pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
# The top window is a listbox with scrollbar
set paneList {
{List of Tk Widgets}
button
canvas
checkbutton
entry
frame
label
labelframe
listbox
menu
menubutton
message
panedwindow
radiobutton
scale
scrollbar
spinbox
text
toplevel
}
set f [frame $w.pane.top]
listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set"
# Invert the first item to highlight it
$f.list itemconfigure 0 \
-background [$f.list cget -fg] -foreground [$f.list cget -bg]
ttk::scrollbar $f.scr -orient vertical -command "$f.list yview"
pack $f.scr -side right -fill y
pack $f.list -fill both -expand 1
# The bottom window is a text widget with scrollbar
set f [frame $w.pane.bottom]
text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \
-width 30 -height 8 -wrap none
ttk::scrollbar $f.xscr -orient horizontal -command "$f.text xview"
ttk::scrollbar $f.yscr -orient vertical -command "$f.text yview"
grid $f.text $f.yscr -sticky nsew
grid $f.xscr -sticky nsew
grid columnconfigure $f 0 -weight 1
grid rowconfigure $f 0 -weight 1
$f.text insert 1.0 "This is just a normal text widget"
# Now add our contents to the paned window
$w.pane add $w.pane.top $w.pane.bottom

197
Dependencies/Python/tcl/tk8.6/demos/pendulum.tcl vendored Normal file
View File

@ -0,0 +1,197 @@
# pendulum.tcl --
#
# This demonstration illustrates how Tcl/Tk can be used to construct
# simulations of physical systems.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .pendulum
catch {destroy $w}
toplevel $w
wm title $w "Pendulum Animation Demonstration"
wm iconname $w "pendulum"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows how Tcl/Tk can be used to carry out animations that are linked to simulations of physical systems. In the left canvas is a graphical representation of the physical system itself, a simple pendulum, and in the right canvas is a graph of the phase space of the system, which is a plot of the angle (relative to the vertical) against the angular velocity. The pendulum bob may be repositioned by clicking and dragging anywhere on the left canvas."
pack $w.msg
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Create some structural widgets
pack [panedwindow $w.p] -fill both -expand 1
$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"]
$w.p add [labelframe $w.p.l2 -text "Phase Space"]
# Create the canvas containing the graphical representation of the
# simulated system.
canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken
$w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position"
# Coordinates of these items don't matter; they will be set properly below
$w.c create line 0 25 320 25 -tags plate -fill grey50 -width 2
$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline {}
$w.c create line 1 1 1 1 -tags rod -fill black -width 3
$w.c create oval 1 1 2 2 -tags bob -fill yellow -outline black
pack $w.c -in $w.p.l1 -fill both -expand true
# Create the canvas containing the phase space graph; this consists of
# a line that gets gradually paler as it ages, which is an extremely
# effective visual trick.
canvas $w.k -width 320 -height 200 -background white -bd 2 -relief sunken
$w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis
$w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis
for {set i 90} {$i>=0} {incr i -10} {
# Coordinates of these items don't matter; they will be set properly below
$w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
}
$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta
$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta
pack $w.k -in $w.p.l2 -fill both -expand true
# Initialize some variables
set points {}
set Theta 45.0
set dTheta 0.0
set pi 3.1415926535897933
set length 150
set home 160
# This procedure makes the pendulum appear at the correct place on the
# canvas. If the additional arguments "at $x $y" are passed (the 'at'
# is really just syntactic sugar) instead of computing the position of
# the pendulum from the length of the pendulum rod and its angle, the
# length and angle are computed in reverse from the given location
# (which is taken to be the centre of the pendulum bob.)
proc showPendulum {canvas {at {}} {x {}} {y {}}} {
global Theta dTheta pi length home
if {$at eq "at" && ($x!=$home || $y!=25)} {
set dTheta 0.0
set x2 [expr {$x - $home}]
set y2 [expr {$y - 25}]
set length [expr {hypot($x2, $y2)}]
set Theta [expr {atan2($x2, $y2) * 180/$pi}]
} else {
set angle [expr {$Theta * $pi/180}]
set x [expr {$home + $length*sin($angle)}]
set y [expr {25 + $length*cos($angle)}]
}
$canvas coords rod $home 25 $x $y
$canvas coords bob [expr {$x - 15}] [expr {$y - 15}] \
[expr {$x + 15}] [expr {$y + 15}]
}
showPendulum $w.c
# Update the phase-space graph according to the current angle and the
# rate at which the angle is changing (the first derivative with
# respect to time.)
proc showPhase {canvas} {
global Theta dTheta points psw psh
lappend points [expr {$Theta + $psw}] [expr {-20*$dTheta + $psh}]
if {[llength $points] > 100} {
set points [lrange $points end-99 end]
}
for {set i 0} {$i<100} {incr i 10} {
set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]]
if {[llength $list] >= 4} {
$canvas coords graph$i $list
}
}
}
# Set up some bindings on the canvases. Note that when the user
# clicks we stop the animation until they release the mouse
# button. Also note that both canvases are sensitive to <Configure>
# events, which allows them to find out when they have been resized by
# the user.
bind $w.c <Destroy> {
after cancel $animationCallbacks(pendulum)
unset animationCallbacks(pendulum)
}
bind $w.c <Button-1> {
after cancel $animationCallbacks(pendulum)
showPendulum %W at %x %y
}
bind $w.c <B1-Motion> {
showPendulum %W at %x %y
}
bind $w.c <ButtonRelease-1> {
showPendulum %W at %x %y
set animationCallbacks(pendulum) [after 15 repeat [winfo toplevel %W]]
}
bind $w.c <Configure> {
%W coords plate 0 25 %w 25
set home [expr {%w/2}]
%W coords pivot [expr {$home - 5}] 20 [expr {$home + 5}] 30
}
bind $w.k <Configure> {
set psh [expr {%h/2}]
set psw [expr {%w/2}]
%W coords x_axis 2 $psh [expr {%w - 2}] $psh
%W coords y_axis $psw [expr {%h - 2}] $psw 2
%W coords label_dtheta [expr {$psw - 4}] 6
%W coords label_theta [expr {%w - 6}] [expr {$psh + 4}]
}
# This procedure is the "business" part of the simulation that does
# simple numerical integration of the formula for a simple rotational
# pendulum.
proc recomputeAngle {} {
global Theta dTheta pi length
set scaling [expr {3000.0/$length/$length}]
# To estimate the integration accurately, we really need to
# compute the end-point of our time-step. But to do *that*, we
# need to estimate the integration accurately! So we try this
# technique, which is inaccurate, but better than doing it in a
# single step. What we really want is bound up in the
# differential equation:
# .. - sin theta
# theta + theta = -----------
# length
# But my math skills are not good enough to solve this!
# first estimate
set firstDDTheta [expr {-sin($Theta * $pi/180)*$scaling}]
set midDTheta [expr {$dTheta + $firstDDTheta}]
set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
# second estimate
set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
set midDTheta [expr {$dTheta + ($firstDDTheta + $midDDTheta)/2}]
set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
# Now we do a double-estimate approach for getting the final value
# first estimate
set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
set lastDTheta [expr {$midDTheta + $midDDTheta}]
set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
# second estimate
set lastDDTheta [expr {-sin($lastTheta * $pi/180)*$scaling}]
set lastDTheta [expr {$midDTheta + ($midDDTheta + $lastDDTheta)/2}]
set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
# Now put the values back in our globals
set dTheta $lastDTheta
set Theta $lastTheta
}
# This method ties together the simulation engine and the graphical
# display code that visualizes it.
proc repeat w {
global animationCallbacks
# Simulate
recomputeAngle
# Update the display
showPendulum $w.c
showPhase $w.k
# Reschedule ourselves
set animationCallbacks(pendulum) [after 15 [list repeat $w]]
}
# Start the simulation after a short pause
set animationCallbacks(pendulum) [after 500 [list repeat $w]]

97
Dependencies/Python/tcl/tk8.6/demos/plot.tcl vendored Normal file
View File

@ -0,0 +1,97 @@
# plot.tcl --
#
# This demonstration script creates a canvas widget showing a 2-D
# plot with data points that can be dragged with the mouse.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .plot
catch {destroy $w}
toplevel $w
wm title $w "Plot Demonstration"
wm iconname $w "Plot"
positionWindow $w
set c $w.c
label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
canvas $c -relief raised -width 450 -height 300
pack $w.c -side top -fill x
set plotFont {Helvetica 18}
$c create line 100 250 400 250 -width 2
$c create line 100 250 100 50 -width 2
$c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown
for {set i 0} {$i <= 10} {incr i} {
set x [expr {100 + ($i*30)}]
$c create line $x 250 $x 245 -width 2
$c create text $x 254 -text [expr {10*$i}] -anchor n -font $plotFont
}
for {set i 0} {$i <= 5} {incr i} {
set y [expr {250 - ($i*40)}]
$c create line 100 $y 105 $y -width 2
$c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $plotFont
}
foreach point {
{12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
} {
set x [expr {100 + (3*[lindex $point 0])}]
set y [expr {250 - (4*[lindex $point 1])/5}]
set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
[expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
-fill SkyBlue2]
$c addtag point withtag $item
}
$c bind point <Enter> "$c itemconfig current -fill red"
$c bind point <Leave> "$c itemconfig current -fill SkyBlue2"
$c bind point <Button-1> "plotDown $c %x %y"
$c bind point <ButtonRelease-1> "$c dtag selected"
bind $c <B1-Motion> "plotMove $c %x %y"
set plot(lastX) 0
set plot(lastY) 0
# plotDown --
# This procedure is invoked when the mouse is pressed over one of the
# data points. It sets up state to allow the point to be dragged.
#
# Arguments:
# w - The canvas window.
# x, y - The coordinates of the mouse press.
proc plotDown {w x y} {
global plot
$w dtag selected
$w addtag selected withtag current
$w raise current
set plot(lastX) $x
set plot(lastY) $y
}
# plotMove --
# This procedure is invoked during mouse motion events. It drags the
# current item.
#
# Arguments:
# w - The canvas window.
# x, y - The coordinates of the mouse.
proc plotMove {w x y} {
global plot
$w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}]
set plot(lastX) $x
set plot(lastY) $y
}

82
Dependencies/Python/tcl/tk8.6/demos/puzzle.tcl vendored Normal file
View File

@ -0,0 +1,82 @@
# puzzle.tcl --
#
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# puzzleSwitch --
# This procedure is invoked when the user clicks on a particular button;
# if the button is next to the empty space, it moves the button into the
# empty space.
proc puzzleSwitch {w num} {
global xpos ypos
if {(($ypos($num) >= ($ypos(space) - .01))
&& ($ypos($num) <= ($ypos(space) + .01))
&& ($xpos($num) >= ($xpos(space) - .26))
&& ($xpos($num) <= ($xpos(space) + .26)))
|| (($xpos($num) >= ($xpos(space) - .01))
&& ($xpos($num) <= ($xpos(space) + .01))
&& ($ypos($num) >= ($ypos(space) - .26))
&& ($ypos($num) <= ($ypos(space) + .26)))} {
set tmp $xpos(space)
set xpos(space) $xpos($num)
set xpos($num) $tmp
set tmp $ypos(space)
set ypos(space) $ypos($num)
set ypos($num) $tmp
place $w.frame.$num -relx $xpos($num) -rely $ypos($num)
}
}
set w .puzzle
catch {destroy $w}
toplevel $w
wm title $w "15-Puzzle Demonstration"
wm iconname $w "15-Puzzle"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to the space, and that piece will slide over the space. Continue this until the pieces are arranged in numerical order from upper-left to lower-right."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Special trick: select a darker color for the space by creating a
# scrollbar widget and using its trough color.
scrollbar $w.s
# The button metrics are a bit bigger in Aqua, and since we are
# using place which doesn't autosize, then we need to have a
# slightly larger frame here...
if {[tk windowingsystem] eq "aqua"} {
set frameSize 168
} else {
set frameSize 120
}
frame $w.frame -width $frameSize -height $frameSize -borderwidth 2\
-relief sunken -bg [$w.s cget -troughcolor]
pack $w.frame -side top -pady 1c -padx 1c
destroy $w.s
set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
for {set i 0} {$i < 15} {set i [expr {$i+1}]} {
set num [lindex $order $i]
set xpos($num) [expr {($i%4)*.25}]
set ypos($num) [expr {($i/4)*.25}]
button $w.frame.$num -relief raised -text $num -bd 0 -highlightthickness 0 \
-command "puzzleSwitch $w $num"
place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
-relwidth .25 -relheight .25
}
set xpos(space) .75
set ypos(space) .75

66
Dependencies/Python/tcl/tk8.6/demos/radio.tcl vendored Normal file
View File

@ -0,0 +1,66 @@
# radio.tcl --
#
# This demonstration script creates a toplevel window containing
# several radiobutton widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .radio
catch {destroy $w}
toplevel $w
wm title $w "Radiobutton Demonstration"
wm iconname $w "radio"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Three groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. When the 'Tristate' button is pressed, the radio buttons will display the tri-state mode. Selecting any radio button will return the buttons to their respective on/off state. Click the \"See Variables\" button to see the current values of the variables."
grid $w.msg -row 0 -column 0 -columnspan 3 -sticky nsew
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w [list size color align]]
grid $btns -row 3 -column 0 -columnspan 3 -sticky ew
labelframe $w.left -pady 2 -text "Point Size" -padx 2
labelframe $w.mid -pady 2 -text "Color" -padx 2
labelframe $w.right -pady 2 -text "Alignment" -padx 2
button $w.tristate -text Tristate -command "set size multi; set color multi" \
-pady 2 -padx 2
if {[tk windowingsystem] eq "aqua"} {
$w.tristate configure -padx 10
}
grid $w.left -column 0 -row 1 -pady .5c -padx .5c -rowspan 2
grid $w.mid -column 1 -row 1 -pady .5c -padx .5c -rowspan 2
grid $w.right -column 2 -row 1 -pady .5c -padx .5c
grid $w.tristate -column 2 -row 2 -pady .5c -padx .5c
foreach i {10 12 14 18 24} {
radiobutton $w.left.b$i -text "Point Size $i" -variable size \
-relief flat -value $i -tristatevalue "multi"
pack $w.left.b$i -side top -pady 2 -anchor w -fill x
}
foreach c {Red Green Blue Yellow Orange Purple} {
set lower [string tolower $c]
radiobutton $w.mid.$lower -text $c -variable color \
-relief flat -value $lower -anchor w \
-command "$w.mid configure -fg \$color" \
-tristatevalue "multi"
pack $w.mid.$lower -side top -pady 2 -fill x
}
label $w.right.l -text "Label" -bitmap questhead -compound left
$w.right.l configure -width [winfo reqwidth $w.right.l] -compound top
$w.right.l configure -height [winfo reqheight $w.right.l]
foreach a {Top Left Right Bottom} {
set lower [string tolower $a]
radiobutton $w.right.$lower -text $a -variable align \
-relief flat -value $lower -indicatoron 0 -width 7 \
-command "$w.right.l configure -compound \$align"
}
grid x $w.right.top
grid $w.right.left $w.right.l $w.right.right
grid x $w.right.bottom

210
Dependencies/Python/tcl/tk8.6/demos/rmt vendored Normal file
View File

@ -0,0 +1,210 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# rmt --
# This script implements a simple remote-control mechanism for
# Tk applications. It allows you to select an application and
# then type commands to that application.
package require Tk
wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
wm minsize . 1 1
# The global variable below keeps track of the remote application
# that we're sending to. If it's an empty string then we execute
# the commands locally.
set app "local"
# The global variable below keeps track of whether we're in the
# middle of executing a command entered via the text.
set executing 0
# The global variable below keeps track of the last command executed,
# so it can be re-executed in response to !! commands.
set lastCommand ""
# Create menu bar. Arrange to recreate all the information in the
# applications sub-menu whenever it is cascaded to.
. configure -menu [menu .menu]
menu .menu.file
menu .menu.file.apps -postcommand fillAppsMenu
.menu add cascade -label "File" -underline 0 -menu .menu.file
.menu.file add cascade -label "Select Application" -underline 0 \
-menu .menu.file.apps
.menu.file add command -label "Quit" -command "destroy ." -underline 0
# Create text window and scrollbar.
text .t -yscrollcommand ".s set" -setgrid true
scrollbar .s -command ".t yview"
grid .t .s -sticky nsew
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
# Create a binding to forward commands to the target application,
# plus modify many of the built-in bindings so that only information
# in the current command can be deleted (can still set the cursor
# earlier in the text and select and insert; just can't delete).
bindtags .t {.t Text . all}
bind .t <Return> {
.t mark set insert {end - 1c}
.t insert insert \n
invoke
break
}
bind .t <Delete> {
catch {.t tag remove sel sel.first promptEnd}
if {[.t tag nextrange sel 1.0 end] eq ""} {
if {[.t compare insert < promptEnd]} {
break
}
}
}
bind .t <BackSpace> {
catch {.t tag remove sel sel.first promptEnd}
if {[.t tag nextrange sel 1.0 end] eq ""} {
if {[.t compare insert <= promptEnd]} {
break
}
}
}
bind .t <Control-d> {
if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Control-k> {
if {[.t compare insert < promptEnd]} {
.t mark set insert promptEnd
}
}
bind .t <Control-t> {
if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Meta-d> {
if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Meta-BackSpace> {
if {[.t compare insert <= promptEnd]} {
break
}
}
bind .t <Control-h> {
if {[.t compare insert <= promptEnd]} {
break
}
}
### This next bit *isn't* nice - DKF ###
auto_load tk::TextInsert
proc tk::TextInsert {w s} {
if {$s eq ""} {
return
}
catch {
if {
[$w compare sel.first <= insert] && [$w compare sel.last >= insert]
} then {
$w tag remove sel sel.first promptEnd
$w delete sel.first sel.last
}
}
$w insert insert $s
$w see insert
}
.t configure -font {Courier 12}
.t tag configure bold -font {Courier 12 bold}
# The procedure below is used to print out a prompt at the
# insertion point (which should be at the beginning of a line
# right now).
proc prompt {} {
global app
.t insert insert "$app: "
.t mark set promptEnd {insert}
.t mark gravity promptEnd left
.t tag add bold {promptEnd linestart} promptEnd
}
# The procedure below executes a command (it takes everything on the
# current line after the prompt and either sends it to the remote
# application or executes it locally, depending on "app".
proc invoke {} {
global app executing lastCommand
set cmd [.t get promptEnd insert]
incr executing 1
if {[info complete $cmd]} {
if {$cmd eq "!!\n"} {
set cmd $lastCommand
} else {
set lastCommand $cmd
}
if {$app eq "local"} {
set result [catch [list uplevel #0 $cmd] msg]
} else {
set result [catch [list send $app $cmd] msg]
}
if {$result != 0} {
.t insert insert "Error: $msg\n"
} elseif {$msg ne ""} {
.t insert insert $msg\n
}
prompt
.t mark set promptEnd insert
}
incr executing -1
.t yview -pickplace insert
}
# The following procedure is invoked to change the application that
# we're talking to. It also updates the prompt for the current
# command, unless we're in the middle of executing a command from
# the text item (in which case a new prompt is about to be output
# so there's no need to change the old one).
proc newApp appName {
global app executing
set app $appName
if {!$executing} {
.t mark gravity promptEnd right
.t delete "promptEnd linestart" promptEnd
.t insert promptEnd "$appName: "
.t tag add bold "promptEnd linestart" promptEnd
.t mark gravity promptEnd left
}
return
}
# The procedure below will fill in the applications sub-menu with a list
# of all the applications that currently exist.
proc fillAppsMenu {} {
set m .menu.file.apps
catch {$m delete 0 last}
foreach i [lsort [winfo interps]] {
$m add command -label $i -command [list newApp $i]
}
$m add command -label local -command {newApp local}
}
set app [winfo name .]
prompt
focus .t
# Local Variables:
# mode: tcl
# End:

204
Dependencies/Python/tcl/tk8.6/demos/rolodex vendored Normal file
View File

@ -0,0 +1,204 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# rolodex --
# This script was written as an entry in Tom LaStrange's rolodex
# benchmark. It creates something that has some of the look and
# feel of a rolodex program, although it's lifeless and doesn't
# actually do the rolodex application.
package require Tk
foreach i [winfo children .] {
catch {destroy $i}
}
set version 1.2
#------------------------------------------
# Phase 0: create the front end.
#------------------------------------------
frame .frame -relief flat
pack .frame -side top -fill y -anchor center
set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
foreach i {1 2 3 4 5 6 7} {
label .frame.label$i -text [lindex $names $i] -anchor e
entry .frame.entry$i -width 35
grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1
}
frame .buttons
pack .buttons -side bottom -pady 2 -anchor center
button .buttons.clear -text Clear
button .buttons.add -text Add
button .buttons.search -text Search
button .buttons.delete -text "Delete ..."
pack .buttons.clear .buttons.add .buttons.search .buttons.delete \
-side left -padx 2
#------------------------------------------
# Phase 1: Add menus, dialog boxes
#------------------------------------------
# DKF - note that this is an old-style menu bar; I just have not yet
# got around to converting the context help code to work with the new
# menu system and its <<MenuSelect>> virtual event.
frame .menu -relief raised -borderwidth 1
pack .menu -before .frame -side top -fill x
menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add command -label "Load ..." -command fileAction -underline 0
.menu.file.m add command -label "Exit" -command {destroy .} -underline 0
pack .menu.file -side left
menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
menu .menu.help.m
pack .menu.help -side right
proc deleteAction {} {
if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0 Cancel]
== 0} {
clearAction
}
}
.buttons.delete config -command deleteAction
proc fileAction {} {
tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK
puts stderr {dummy file name}
}
#------------------------------------------
# Phase 3: Print contents of card
#------------------------------------------
proc addAction {} {
global names
foreach i {1 2 3 4 5 6 7} {
puts stderr [format "%-12s %s" [lindex $names $i] [.frame.entry$i get]]
}
}
.buttons.add config -command addAction
#------------------------------------------
# Phase 4: Miscellaneous other actions
#------------------------------------------
proc clearAction {} {
foreach i {1 2 3 4 5 6 7} {
.frame.entry$i delete 0 end
}
}
.buttons.clear config -command clearAction
proc fillCard {} {
clearAction
.frame.entry1 insert 0 "John Ousterhout"
.frame.entry2 insert 0 "CS Division, Department of EECS"
.frame.entry3 insert 0 "University of California"
.frame.entry4 insert 0 "Berkeley, CA 94720"
.frame.entry5 insert 0 "private"
.frame.entry6 insert 0 "510-642-0865"
.frame.entry7 insert 0 "510-642-5775"
}
.buttons.search config -command "addAction; fillCard"
#----------------------------------------------------
# Phase 5: Accelerators, mnemonics, command-line info
#----------------------------------------------------
.buttons.clear config -text "Clear Ctrl+C"
bind . <Control-c> clearAction
.buttons.add config -text "Add Ctrl+A"
bind . <Control-a> addAction
.buttons.search config -text "Search Ctrl+S"
bind . <Control-s> "addAction; fillCard"
.buttons.delete config -text "Delete... Ctrl+D"
bind . <Control-d> deleteAction
.menu.file.m entryconfig 1 -accel Ctrl+F
bind . <Control-f> fileAction
.menu.file.m entryconfig 2 -accel Ctrl+Q
bind . <Control-q> {destroy .}
focus .frame.entry1
#----------------------------------------------------
# Phase 6: help
#----------------------------------------------------
proc Help {topic {x 0} {y 0}} {
global helpTopics helpCmds
if {$topic == ""} return
while {[info exists helpCmds($topic)]} {
set topic [eval $helpCmds($topic)]
}
if [info exists helpTopics($topic)] {
set msg $helpTopics($topic)
} else {
set msg "Sorry, but no help is available for this topic"
}
tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
{} 0 OK
}
proc getMenuTopic {w x y} {
return $w.[$w index @[expr {$y-[winfo rooty $w]}]]
}
event add <<Help>> <F1> <Help>
bind . <<Help>> {Help [winfo containing %X %Y] %X %Y}
bind Menu <<Help>> {Help [winfo containing %X %Y] %X %Y}
# Help text and commands follow:
set helpTopics(.menu.file) {This is the "file" menu. It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.}
set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
set helpTopics(.menu.file.m.1) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
set helpTopics(.menu.file.m.2) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
set helpTopics(.frame.entry1) {In this field of the rolodex entry you should type the person's name}
set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address}
set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address}
set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address}
set helpTopics(.frame.entry5) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized}
set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number}
set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
set helpCmds(.frame.label1) {set topic .frame.entry1}
set helpCmds(.frame.label2) {set topic .frame.entry2}
set helpCmds(.frame.label3) {set topic .frame.entry3}
set helpCmds(.frame.label4) {set topic .frame.entry4}
set helpCmds(.frame.label5) {set topic .frame.entry5}
set helpCmds(.frame.label6) {set topic .frame.entry6}
set helpCmds(.frame.label7) {set topic .frame.entry7}
set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.}
set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.}
set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark. It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.}
set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)"
set helpTopics(version) "This is version $version."
# Entries in "Help" menu
.menu.help.m add command -label "On Context..." -command {Help context} \
-underline 3
.menu.help.m add command -label "On Help..." -command {Help help} \
-underline 3
.menu.help.m add command -label "On Window..." -command {Help window} \
-underline 3
.menu.help.m add command -label "On Keys..." -command {Help keys} \
-underline 3
.menu.help.m add command -label "On Version..." -command {Help version} \
-underline 3
# Local Variables:
# mode: tcl
# End:

175
Dependencies/Python/tcl/tk8.6/demos/ruler.tcl vendored Normal file
View File

@ -0,0 +1,175 @@
# ruler.tcl --
#
# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# rulerMkTab --
# This procedure creates a new triangular polygon in a canvas to
# represent a tab stop.
#
# Arguments:
# c - The canvas window.
# x, y - Coordinates at which to create the tab stop.
proc rulerMkTab {c x y} {
upvar #0 demo_rulerInfo v
set newTab [$c create polygon $x $y \
[expr {$x+$v(size)}] [expr {$y+$v(size)}] \
[expr {$x-$v(size)}] [expr {$y+$v(size)}]]
set fill [$c itemcget $newTab -outline]
$c itemconfigure $newTab -fill $fill -outline {}
set v(normalStyle) "-fill $fill"
return $newTab
}
set w .ruler
catch {destroy $w}
toplevel $w
wm title $w "Ruler Demonstration"
wm iconname $w "ruler"
positionWindow $w
set c $w.c
label $w.msg -font $font -wraplength 5i -justify left -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
canvas $c -width 14.8c -height 2.5c
pack $w.c -side top -fill x
set demo_rulerInfo(grid) .25c
set demo_rulerInfo(left) [winfo fpixels $c 1c]
set demo_rulerInfo(right) [winfo fpixels $c 13c]
set demo_rulerInfo(top) [winfo fpixels $c 1c]
set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c]
set demo_rulerInfo(size) [winfo fpixels $c .2c]
# Main widget program sets variable tk_demoDirectory
if {[winfo depth $c] > 1} {
set demo_rulerInfo(activeStyle) "-fill red -stipple {}"
set demo_rulerInfo(deleteStyle) [list -fill red \
-stipple @[file join $tk_demoDirectory images gray25.xbm]]
} else {
set demo_rulerInfo(activeStyle) "-fill black -stipple {}"
set demo_rulerInfo(deleteStyle) [list -fill black \
-stipple @[file join $tk_demoDirectory images gray25.xbm]]
}
$c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
for {set i 0} {$i < 12} {incr i} {
set x [expr {$i+1}]
$c create line ${x}c 1c ${x}c 0.6c -width 1
$c create line $x.25c 1c $x.25c 0.8c -width 1
$c create line $x.5c 1c $x.5c 0.7c -width 1
$c create line $x.75c 1c $x.75c 0.8c -width 1
$c create text $x.15c .75c -text $i -anchor sw
}
$c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \
-fill [lindex [$c config -bg] 4]]
$c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
[winfo pixels $c .65c]]
$c bind well <Button-1> "rulerNewTab $c %x %y"
$c bind tab <Button-1> "rulerSelectTab $c %x %y"
bind $c <B1-Motion> "rulerMoveTab $c %x %y"
bind $c <ButtonRelease-1> "rulerReleaseTab $c"
# rulerNewTab --
# Does all the work of creating a tab stop, including creating the
# triangle object and adding tags to it to give it tab behavior.
#
# Arguments:
# c - The canvas window.
# x, y - The coordinates of the tab stop.
proc rulerNewTab {c x y} {
upvar #0 demo_rulerInfo v
$c addtag active withtag [rulerMkTab $c $x $y]
$c addtag tab withtag active
set v(x) $x
set v(y) $y
rulerMoveTab $c $x $y
}
# rulerSelectTab --
# This procedure is invoked when mouse button 1 is pressed over
# a tab. It remembers information about the tab so that it can
# be dragged interactively.
#
# Arguments:
# c - The canvas widget.
# x, y - The coordinates of the mouse (identifies the point by
# which the tab was picked up for dragging).
proc rulerSelectTab {c x y} {
upvar #0 demo_rulerInfo v
set v(x) [$c canvasx $x $v(grid)]
set v(y) [expr {$v(top)+2}]
$c addtag active withtag current
eval "$c itemconf active $v(activeStyle)"
$c raise active
}
# rulerMoveTab --
# This procedure is invoked during mouse motion events to drag a tab.
# It adjusts the position of the tab, and changes its appearance if
# it is about to be dragged out of the ruler.
#
# Arguments:
# c - The canvas widget.
# x, y - The coordinates of the mouse.
proc rulerMoveTab {c x y} {
upvar #0 demo_rulerInfo v
if {[$c find withtag active] == ""} {
return
}
set cx [$c canvasx $x $v(grid)]
set cy [$c canvasy $y]
if {$cx < $v(left)} {
set cx $v(left)
}
if {$cx > $v(right)} {
set cx $v(right)
}
if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
set cy [expr {$v(top)+2}]
eval "$c itemconf active $v(activeStyle)"
} else {
set cy [expr {$cy-$v(size)-2}]
eval "$c itemconf active $v(deleteStyle)"
}
$c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}]
set v(x) $cx
set v(y) $cy
}
# rulerReleaseTab --
# This procedure is invoked during button release events that end
# a tab drag operation. It deselects the tab and deletes the tab if
# it was dragged out of the ruler.
#
# Arguments:
# c - The canvas widget.
# x, y - The coordinates of the mouse.
proc rulerReleaseTab c {
upvar #0 demo_rulerInfo v
if {[$c find withtag active] == {}} {
return
}
if {$v(y) != $v(top)+2} {
$c delete active
} else {
eval "$c itemconf active $v(normalStyle)"
$c dtag active
}
}

44
Dependencies/Python/tcl/tk8.6/demos/sayings.tcl vendored Normal file
View File

@ -0,0 +1,44 @@
# sayings.tcl --
#
# This demonstration script creates a listbox that can be scrolled
# both horizontally and vertically. It displays a collection of
# well-known sayings.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .sayings
catch {destroy $w}
toplevel $w
wm title $w "Listbox Demonstration (well-known sayings)"
wm iconname $w "sayings"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "The listbox below contains a collection of well-known sayings. You can scan the list using either of the scrollbars or by dragging in the listbox window with button 2 pressed."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth 10
pack $w.frame -side top -expand yes -fill both -padx 1c
ttk::scrollbar $w.frame.yscroll -command "$w.frame.list yview"
ttk::scrollbar $w.frame.xscroll -orient horizontal \
-command "$w.frame.list xview"
listbox $w.frame.list -width 20 -height 10 -setgrid 1 \
-yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set"
grid $w.frame.list -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid $w.frame.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid rowconfig $w.frame 0 -weight 1 -minsize 0
grid columnconfig $w.frame 0 -weight 1 -minsize 0
$w.frame.list insert 0 "Don't speculate, measure" "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" "Measure twice, cut once"

139
Dependencies/Python/tcl/tk8.6/demos/search.tcl vendored Normal file
View File

@ -0,0 +1,139 @@
# search.tcl --
#
# This demonstration script creates a collection of widgets that
# allow you to load a file into a text widget, then perform searches
# on that file.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# textLoadFile --
# This procedure below loads a file into a text widget, discarding
# the previous contents of the widget. Tags for the old widget are
# not affected, however.
#
# Arguments:
# w - The window into which to load the file. Must be a
# text widget.
# file - The name of the file to load. Must be readable.
proc textLoadFile {w file} {
set f [open $file]
$w delete 1.0 end
while {![eof $f]} {
$w insert end [read $f 10000]
}
close $f
}
# textSearch --
# Search for all instances of a given string in a text widget and
# apply a given tag to each instance found.
#
# Arguments:
# w - The window in which to search. Must be a text widget.
# string - The string to search for. The search is done using
# exact matching only; no special characters.
# tag - Tag to apply to each instance of a matching string.
proc textSearch {w string tag} {
$w tag remove search 0.0 end
if {$string == ""} {
return
}
set cur 1.0
while 1 {
set cur [$w search -count length $string $cur end]
if {$cur == ""} {
break
}
$w tag add $tag $cur "$cur + $length char"
set cur [$w index "$cur + $length char"]
}
}
# textToggle --
# This procedure is invoked repeatedly to invoke two commands at
# periodic intervals. It normally reschedules itself after each
# execution but if an error occurs (e.g. because the window was
# deleted) then it doesn't reschedule itself.
#
# Arguments:
# cmd1 - Command to execute when procedure is called.
# sleep1 - Ms to sleep after executing cmd1 before executing cmd2.
# cmd2 - Command to execute in the *next* invocation of this
# procedure.
# sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again.
proc textToggle {cmd1 sleep1 cmd2 sleep2} {
catch {
eval $cmd1
after $sleep1 [list textToggle $cmd2 $sleep2 $cmd1 $sleep1]
}
}
set w .search
catch {destroy $w}
toplevel $w
wm title $w "Text Demonstration - Search and Highlight"
wm iconname $w "search"
positionWindow $w
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.file
label $w.file.label -text "File name:" -width 13 -anchor w
entry $w.file.entry -width 40 -textvariable fileName
button $w.file.button -text "Load File" \
-command "textLoadFile $w.text \$fileName"
pack $w.file.label $w.file.entry -side left
pack $w.file.button -side left -pady 5 -padx 10
bind $w.file.entry <Return> "
textLoadFile $w.text \$fileName
focus $w.string.entry
"
focus $w.file.entry
frame $w.string
label $w.string.label -text "Search string:" -width 13 -anchor w
entry $w.string.entry -width 40 -textvariable searchString
button $w.string.button -text "Highlight" \
-command "textSearch $w.text \$searchString search"
pack $w.string.label $w.string.entry -side left
pack $w.string.button -side left -pady 5 -padx 10
bind $w.string.entry <Return> "textSearch $w.text \$searchString search"
text $w.text -yscrollcommand "$w.scroll set" -setgrid true
ttk::scrollbar $w.scroll -command "$w.text yview"
pack $w.file $w.string -side top -fill x
pack $w.scroll -side right -fill y
pack $w.text -expand yes -fill both
# Set up display styles for text highlighting.
if {[winfo depth $w] > 1} {
textToggle "$w.text tag configure search -background \
#ce5555 -foreground white" 800 "$w.text tag configure \
search -background {} -foreground {}" 200
} else {
textToggle "$w.text tag configure search -background \
black -foreground white" 800 "$w.text tag configure \
search -background {} -foreground {}" 200
}
$w.text insert 1.0 \
{This window demonstrates how to use the tagging facilities in text
widgets to implement a searching mechanism. First, type a file name
in the top entry, then type <Return> or click on "Load File". Then
type a string in the lower entry and type <Return> or click on
"Load File". This will cause all of the instances of the string to
be tagged with the tag "search", and it will arrange for the tag's
display attributes to change to make all of the strings blink.}
$w.text mark set insert 0.0
set fileName ""
set searchString ""

45
Dependencies/Python/tcl/tk8.6/demos/spin.tcl vendored Normal file
View File

@ -0,0 +1,45 @@
# spin.tcl --
#
# This demonstration script creates several spinbox widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .spin
catch {destroy $w}
toplevel $w
wm title $w "Spinbox Demonstration"
wm iconname $w "spin"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
spin-boxes are displayed below. You can add characters by pointing,\
clicking and typing. The normal Motif editing characters are\
supported, along with many Emacs bindings. For example, Backspace\
and Control-h delete the character to the left of the insertion\
cursor and Delete and Control-d delete the chararacter to the right\
of the insertion cursor. For values that are too large to fit in the\
window all at once, you can scan through the value by dragging with\
mouse button2 pressed. Note that the first spin-box will only permit\
you to type in integers, and the third selects from a list of\
Australian cities."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
set australianCities {
Canberra Sydney Melbourne Perth Adelaide Brisbane
Hobart Darwin "Alice Springs"
}
spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \
-validatecommand {string is integer %P}
spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10
spinbox $w.s3 -values $australianCities -width 10
pack $w.s1 $w.s2 $w.s3 -side top -pady 5 -padx 10

60
Dependencies/Python/tcl/tk8.6/demos/square vendored Normal file
View File

@ -0,0 +1,60 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# square --
# This script generates a demo application containing only a "square"
# widget. It's only usable in the "tktest" application or if Tk has
# been compiled with tkSquare.c. This demo arranges the following
# bindings for the widget:
#
# Button-1 press/drag: moves square to mouse
# "a": toggle size animation on/off
package require Tk ;# We use Tk generally, and...
package require Tktest ;# ... we use the square widget too.
square .s
pack .s -expand yes -fill both
wm minsize . 1 1
bind .s <Button-1> {center %x %y}
bind .s <B1-Motion> {center %x %y}
bind .s a animate
focus .s
# The procedure below centers the square on a given position.
proc center {x y} {
set a [.s size]
.s position [expr {$x-($a/2)}] [expr {$y-($a/2)}]
}
# The procedures below provide a simple form of animation where
# the box changes size in a pulsing pattern: larger, smaller, larger,
# and so on.
set inc 0
proc animate {} {
global inc
if {$inc == 0} {
set inc 3
timer
} else {
set inc 0
}
}
proc timer {} {
global inc
set s [.s size]
if {$inc == 0} return
if {$s >= 40} {set inc -3}
if {$s <= 10} {set inc 3}
.s size [expr {$s+$inc}]
after 30 timer
}
# Local Variables:
# mode: tcl
# End:

54
Dependencies/Python/tcl/tk8.6/demos/states.tcl vendored Normal file
View File

@ -0,0 +1,54 @@
# states.tcl --
#
# This demonstration script creates a listbox widget that displays
# the names of the 50 states in the United States of America.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .states
catch {destroy $w}
toplevel $w
wm title $w "Listbox Demonstration (50 states)"
wm iconname $w "states"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by scanning. To scan, press button 2 in the widget and drag up or down."
pack $w.msg -side top
labelframe $w.justif -text Justification
foreach c {Left Center Right} {
set lower [string tolower $c]
radiobutton $w.justif.$lower -text $c -variable just \
-relief flat -value $lower -anchor w \
-command "$w.frame.list configure -justify \$just" \
-tristatevalue "multi"
pack $w.justif.$lower -side left -pady 2 -fill x
}
pack $w.justif
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth .5c
pack $w.frame -side top -expand yes -fill y
ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview"
listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12
pack $w.frame.scroll -side right -fill y
pack $w.frame.list -side left -expand 1 -fill both
$w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \
Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \
Massachusetts Michigan Minnesota Mississippi Missouri \
Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \
"New York" "North Carolina" "North Dakota" \
Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \
"South Carolina" "South Dakota" \
Tennessee Texas Utah Vermont Virginia Washington \
"West Virginia" Wisconsin Wyoming

155
Dependencies/Python/tcl/tk8.6/demos/style.tcl vendored Normal file
View File

@ -0,0 +1,155 @@
# style.tcl --
#
# This demonstration script creates a text widget that illustrates the
# various display styles that may be set for tags.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .style
catch {destroy $w}
toplevel $w
wm title $w "Text Demonstration - Display Styles"
wm iconname $w "style"
positionWindow $w
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
# Only set the font family in one place for simplicity and consistency
set family Courier
text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
-width 70 -height 32 -wrap word -font "$family 12"
ttk::scrollbar $w.scroll -command "$w.text yview"
pack $w.scroll -side right -fill y
pack $w.text -expand yes -fill both
# Set up display styles
$w.text tag configure bold -font "$family 12 bold italic"
$w.text tag configure big -font "$family 14 bold"
$w.text tag configure verybig -font "Helvetica 24 bold"
$w.text tag configure tiny -font "Times 8 bold"
if {[winfo depth $w] > 1} {
$w.text tag configure color1 -background #a0b7ce
$w.text tag configure color2 -foreground red
$w.text tag configure raised -relief raised -borderwidth 1
$w.text tag configure sunken -relief sunken -borderwidth 1
} else {
$w.text tag configure color1 -background black -foreground white
$w.text tag configure color2 -background black -foreground white
$w.text tag configure raised -background white -relief raised \
-borderwidth 1
$w.text tag configure sunken -background white -relief sunken \
-borderwidth 1
}
$w.text tag configure bgstipple -background black -borderwidth 0 \
-bgstipple gray12
$w.text tag configure fgstipple -fgstipple gray50
$w.text tag configure underline -underline on
$w.text tag configure overstrike -overstrike on
$w.text tag configure right -justify right
$w.text tag configure center -justify center
$w.text tag configure super -offset 4p -font "$family 10"
$w.text tag configure sub -offset -2p -font "$family 10"
$w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m
$w.text tag configure spacing -spacing1 10p -spacing2 2p \
-lmargin1 12m -lmargin2 6m -rmargin 10m
$w.text insert end {Text widgets like this one allow you to display information in a
variety of styles. Display styles are controlled using a mechanism
called }
$w.text insert end tags bold
$w.text insert end {. Tags are just textual names that you can apply to one
or more ranges of characters within a text widget. You can configure
tags with various display styles. If you do this, then the tagged
characters will be displayed with the styles you chose. The
available display styles are:
}
$w.text insert end "\n1. Font." big
$w.text insert end " You can choose any system font, "
$w.text insert end large verybig
$w.text insert end " or "
$w.text insert end "small" tiny ".\n"
$w.text insert end "\n2. Color." big
$w.text insert end " You can change either the "
$w.text insert end background color1
$w.text insert end " or "
$w.text insert end foreground color2
$w.text insert end "\ncolor, or "
$w.text insert end both {color1 color2}
$w.text insert end ".\n"
$w.text insert end "\n3. Stippling." big
$w.text insert end " You can cause either the "
$w.text insert end background bgstipple
$w.text insert end " or "
$w.text insert end foreground fgstipple
$w.text insert end {
information to be drawn with a stipple fill instead of a solid fill.
}
$w.text insert end "\n4. Underlining." big
$w.text insert end " You can "
$w.text insert end underline underline
$w.text insert end " ranges of text.\n"
$w.text insert end "\n5. Overstrikes." big
$w.text insert end " You can "
$w.text insert end "draw lines through" overstrike
$w.text insert end " ranges of text.\n"
$w.text insert end "\n6. 3-D effects." big
$w.text insert end { You can arrange for the background to be drawn
with a border that makes characters appear either }
$w.text insert end raised raised
$w.text insert end " or "
$w.text insert end sunken sunken
$w.text insert end ".\n"
$w.text insert end "\n7. Justification." big
$w.text insert end " You can arrange for lines to be displayed\n"
$w.text insert end "left-justified,\n"
$w.text insert end "right-justified, or\n" right
$w.text insert end "centered.\n" center
$w.text insert end "\n8. Superscripts and subscripts." big
$w.text insert end " You can control the vertical\n"
$w.text insert end "position of text to generate superscript effects like 10"
$w.text insert end "n" super
$w.text insert end " or\nsubscript effects like X"
$w.text insert end "i" sub
$w.text insert end ".\n"
$w.text insert end "\n9. Margins." big
$w.text insert end " You can control the amount of extra space left"
$w.text insert end " on\neach side of the text:\n"
$w.text insert end "This paragraph is an example of the use of " margins
$w.text insert end "margins. It consists of a single line of text " margins
$w.text insert end "that wraps around on the screen. There are two " margins
$w.text insert end "separate left margin values, one for the first " margins
$w.text insert end "display line associated with the text line, " margins
$w.text insert end "and one for the subsequent display lines, which " margins
$w.text insert end "occur because of wrapping. There is also a " margins
$w.text insert end "separate specification for the right margin, " margins
$w.text insert end "which is used to choose wrap points for lines.\n" margins
$w.text insert end "\n10. Spacing." big
$w.text insert end " You can control the spacing of lines with three\n"
$w.text insert end "separate parameters. \"Spacing1\" tells how much "
$w.text insert end "extra space to leave\nabove a line, \"spacing3\" "
$w.text insert end "tells how much space to leave below a line,\nand "
$w.text insert end "if a text line wraps, \"spacing2\" tells how much "
$w.text insert end "space to leave\nbetween the display lines that "
$w.text insert end "make up the text line.\n"
$w.text insert end "These indented paragraphs illustrate how spacing " spacing
$w.text insert end "can be used. Each paragraph is actually a " spacing
$w.text insert end "single line in the text widget, which is " spacing
$w.text insert end "word-wrapped by the widget.\n" spacing
$w.text insert end "Spacing1 is set to 10 points for this text, " spacing
$w.text insert end "which results in relatively large gaps between " spacing
$w.text insert end "the paragraphs. Spacing2 is set to 2 points, " spacing
$w.text insert end "which results in just a bit of extra space " spacing
$w.text insert end "within a pararaph. Spacing3 isn't used " spacing
$w.text insert end "in this example.\n" spacing
$w.text insert end "To see where the space is, select ranges of " spacing
$w.text insert end "text within these paragraphs. The selection " spacing
$w.text insert end "highlight will cover the extra space." spacing

67
Dependencies/Python/tcl/tk8.6/demos/tclIndex vendored Normal file
View File

@ -0,0 +1,67 @@
# Tcl autoload index file, version 2.0
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands. Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.
set auto_index(arrowSetup) [list source -encoding utf-8 [file join $dir arrow.tcl]]
set auto_index(arrowMove1) [list source -encoding utf-8 [file join $dir arrow.tcl]]
set auto_index(arrowMove2) [list source -encoding utf-8 [file join $dir arrow.tcl]]
set auto_index(arrowMove3) [list source -encoding utf-8 [file join $dir arrow.tcl]]
set auto_index(textLoadFile) [list source -encoding utf-8 [file join $dir search.tcl]]
set auto_index(textSearch) [list source -encoding utf-8 [file join $dir search.tcl]]
set auto_index(textToggle) [list source -encoding utf-8 [file join $dir search.tcl]]
set auto_index(itemEnter) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemLeave) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemMark) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemStroke) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemsUnderArea) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemStartDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(itemDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(butPress) [list source -encoding utf-8 [file join $dir items.tcl]]
set auto_index(loadDir) [list source -encoding utf-8 [file join $dir image2.tcl]]
set auto_index(loadImage) [list source -encoding utf-8 [file join $dir image2.tcl]]
set auto_index(rulerMkTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
set auto_index(rulerNewTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
set auto_index(rulerSelectTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
set auto_index(rulerMoveTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
set auto_index(rulerReleaseTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
set auto_index(mkTextConfig) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textEnter) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textInsert) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textPaste) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textB1Press) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textB1Move) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textBs) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(textDel) [list source -encoding utf-8 [file join $dir ctext.tcl]]
set auto_index(bitmapRow) [list source -encoding utf-8 [file join $dir bitmap.tcl]]
set auto_index(scrollEnter) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
set auto_index(scrollLeave) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
set auto_index(scrollButton) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
set auto_index(textWindOn) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(textWindOff) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(textWindPlot) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(embPlotDown) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(embPlotMove) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(textWindDel) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(embDefBg) [list source -encoding utf-8 [file join $dir twind.tcl]]
set auto_index(floorDisplay) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(newRoom) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(roomChanged) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(bg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(bg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(bg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(fg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(fg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(fg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
set auto_index(setWidth) [list source -encoding utf-8 [file join $dir hscale.tcl]]
set auto_index(plotDown) [list source -encoding utf-8 [file join $dir plot.tcl]]
set auto_index(plotMove) [list source -encoding utf-8 [file join $dir plot.tcl]]
set auto_index(puzzleSwitch) [list source -encoding utf-8 [file join $dir puzzle.tcl]]
set auto_index(setHeight) [list source -encoding utf-8 [file join $dir vscale.tcl]]
set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgbox.tcl]]
set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]]

358
Dependencies/Python/tcl/tk8.6/demos/tcolor vendored Normal file
View File

@ -0,0 +1,358 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# tcolor --
# This script implements a simple color editor, where you can
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
package require Tk
wm title . "Color Editor"
# Global variables that control the program:
#
# colorSpace - Color space currently being used for
# editing. Must be "rgb", "cmy", or "hsb".
# label1, label2, label3 - Labels for the scales.
# red, green, blue - Current color intensities in decimal
# on a scale of 0-65535.
# color - A string giving the current color value
# in the proper form for x:
# #RRRRGGGGBBBB
# updating - Non-zero means that we're in the middle of
# updating the scales to load a new color,so
# information shouldn't be propagating back
# from the scales to other elements of the
# program: this would make an infinite loop.
# command - Holds the command that has been typed
# into the "Command" entry.
# autoUpdate - 1 means execute the update command
# automatically whenever the color changes.
# name - Name for new color, typed into entry.
set colorSpace hsb
set red 65535
set green 0
set blue 0
set color #ffff00000000
set updating 0
set autoUpdate 1
set name ""
# Create the menu bar at the top of the window.
. configure -menu [menu .menu]
menu .menu.file
.menu add cascade -menu .menu.file -label File -underline 0
.menu.file add radio -label "RGB color space" -variable colorSpace \
-value rgb -underline 0 -command {changeColorSpace rgb}
.menu.file add radio -label "CMY color space" -variable colorSpace \
-value cmy -underline 0 -command {changeColorSpace cmy}
.menu.file add radio -label "HSB color space" -variable colorSpace \
-value hsb -underline 0 -command {changeColorSpace hsb}
.menu.file add separator
.menu.file add radio -label "Automatic updates" -variable autoUpdate \
-value 1 -underline 0
.menu.file add radio -label "Manual updates" -variable autoUpdate \
-value 0 -underline 0
.menu.file add separator
.menu.file add command -label "Exit program" -underline 0 -command {exit}
# Create the command entry window at the bottom of the window, along
# with the update button.
labelframe .command -text "Command:" -padx {1m 0}
entry .command.e -textvariable command
button .command.update -text Update -command doUpdate
pack .command.update -side right -pady .1c -padx {.25c 0}
pack .command.e -expand yes -fill x -ipadx 0.25c
# Create the listbox that holds all of the color names in rgb.txt,
# if an rgb.txt file can be found.
grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}
grid columnconfigure . {1 2} -weight 1
grid rowconfigure . 0 -weight 1
foreach i {
/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
/X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
/usr/openwin/lib/X11/rgb.txt
} {
if {![file readable $i]} {
continue;
}
set f [open $i]
labelframe .names -text "Select:" -padx .1c -pady .1c
grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
grid columnconfigure . 0 -weight 1
listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
-exportselection false
bind .names.lb <Double-Button-1> {
tc_loadNamedColor [.names.lb get [.names.lb curselection]]
}
scrollbar .names.s -orient vertical -command ".names.lb yview"
pack .names.lb .names.s -side left -fill y -expand 1
while {[gets $f line] >= 0} {
if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
.names.lb insert end $col
}
}
close $f
break
}
# Create the three scales for editing the color, and the entry for
# typing in a color value.
frame .adjust
foreach i {1 2 3} {
label .adjust.l$i -textvariable label$i -pady 0
labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
-command tc_scaleChanged
pack .scale$i -in .adjust.$i
pack .adjust.$i
}
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c
labelframe .name -text "Name:" -padx 1m -pady 1m
entry .name.e -textvariable name -width 10
pack .name.e -side right -expand 1 -fill x
bind .name.e <Return> {tc_loadNamedColor $name}
grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
# Create the color display swatch on the right side of the window.
labelframe .sample -text "Color:" -padx 1m -pady 1m
frame .sample.swatch -width 2c -height 5c -background $color
label .sample.value -textvariable color -width 13 -font {Courier 12}
pack .sample.swatch -side top -expand yes -fill both
pack .sample.value -side bottom -pady .25c
grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2
# The procedure below is invoked when one of the scales is adjusted.
# It propagates color information from the current scale readings
# to everywhere else that it is used.
proc tc_scaleChanged args {
global red green blue colorSpace color updating autoUpdate
if {$updating} {
return
}
switch $colorSpace {
rgb {
set red [format %.0f [expr {[.scale1 get]*65.535}]]
set green [format %.0f [expr {[.scale2 get]*65.535}]]
set blue [format %.0f [expr {[.scale3 get]*65.535}]]
}
cmy {
set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
}
hsb {
set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
[expr {[.scale2 get]/1000.0}] \
[expr {[.scale3 get]/1000.0}]]
set red [lindex $list 0]
set green [lindex $list 1]
set blue [lindex $list 2]
}
}
set color [format "#%04x%04x%04x" $red $green $blue]
.sample.swatch config -bg $color
if {$autoUpdate} doUpdate
update idletasks
}
# The procedure below is invoked to update the scales from the
# current red, green, and blue intensities. It's invoked after
# a change in the color space and after a named color value has
# been loaded.
proc tc_setScales {} {
global red green blue colorSpace updating
set updating 1
switch $colorSpace {
rgb {
.scale1 set [format %.0f [expr {$red/65.535}]]
.scale2 set [format %.0f [expr {$green/65.535}]]
.scale3 set [format %.0f [expr {$blue/65.535}]]
}
cmy {
.scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
.scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
.scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
}
hsb {
set list [rgbToHsv $red $green $blue]
.scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
.scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
.scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
}
}
set updating 0
}
# The procedure below is invoked when a named color has been
# selected from the listbox or typed into the entry. It loads
# the color into the editor.
proc tc_loadNamedColor name {
global red green blue color autoUpdate
if {[string index $name 0] != "#"} {
set list [winfo rgb .sample.swatch $name]
set red [lindex $list 0]
set green [lindex $list 1]
set blue [lindex $list 2]
} else {
switch [string length $name] {
4 {set format "#%1x%1x%1x"; set shift 12}
7 {set format "#%2x%2x%2x"; set shift 8}
10 {set format "#%3x%3x%3x"; set shift 4}
13 {set format "#%4x%4x%4x"; set shift 0}
default {error "syntax error in color name \"$name\""}
}
if {[scan $name $format red green blue] != 3} {
error "syntax error in color name \"$name\""
}
set red [expr {$red<<$shift}]
set green [expr {$green<<$shift}]
set blue [expr {$blue<<$shift}]
}
tc_setScales
set color [format "#%04x%04x%04x" $red $green $blue]
.sample.swatch config -bg $color
if {$autoUpdate} doUpdate
}
# The procedure below is invoked when a new color space is selected.
# It changes the labels on the scales and re-loads the scales with
# the appropriate values for the current color in the new color space
proc changeColorSpace space {
global label1 label2 label3
switch $space {
rgb {
set label1 "Adjust Red:"
set label2 "Adjust Green:"
set label3 "Adjust Blue:"
tc_setScales
return
}
cmy {
set label1 "Adjust Cyan:"
set label2 "Adjust Magenta:"
set label3 "Adjust Yellow:"
tc_setScales
return
}
hsb {
set label1 "Adjust Hue:"
set label2 "Adjust Saturation:"
set label3 "Adjust Brightness:"
tc_setScales
return
}
}
}
# The procedure below converts an RGB value to HSB. It takes red, green,
# and blue components (0-65535) as arguments, and returns a list containing
# HSB components (floating-point, 0-1) as result. The code here is a copy
# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
# by Foley and Van Dam.
proc rgbToHsv {red green blue} {
if {$red > $green} {
set max [expr {double($red)}]
set min [expr {double($green)}]
} else {
set max [expr {double($green)}]
set min [expr {double($red)}]
}
if {$blue > $max} {
set max [expr {double($blue)}]
} elseif {$blue < $min} {
set min [expr {double($blue)}]
}
set range [expr {$max-$min}]
if {$max == 0} {
set sat 0
} else {
set sat [expr {($max-$min)/$max}]
}
if {$sat == 0} {
set hue 0
} else {
set rc [expr {($max - $red)/$range}]
set gc [expr {($max - $green)/$range}]
set bc [expr {($max - $blue)/$range}]
if {$red == $max} {
set hue [expr {($bc - $gc)/6.0}]
} elseif {$green == $max} {
set hue [expr {(2 + $rc - $bc)/6.0}]
} else {
set hue [expr {(4 + $gc - $rc)/6.0}]
}
if {$hue < 0.0} {
set hue [expr {$hue + 1.0}]
}
}
return [list $hue $sat [expr {$max/65535}]]
}
# The procedure below converts an HSB value to RGB. It takes hue, saturation,
# and value components (floating-point, 0-1.0) as arguments, and returns a
# list containing RGB components (integers, 0-65535) as result. The code
# here is a copy of the code on page 616 of "Fundamentals of Interactive
# Computer Graphics" by Foley and Van Dam.
proc hsbToRgb {hue sat value} {
set v [format %.0f [expr {65535.0*$value}]]
if {$sat == 0} {
return "$v $v $v"
} else {
set hue [expr {$hue*6.0}]
if {$hue >= 6.0} {
set hue 0.0
}
scan $hue. %d i
set f [expr {$hue-$i}]
set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
switch $i {
0 {return "$v $t $p"}
1 {return "$q $v $p"}
2 {return "$p $v $t"}
3 {return "$p $q $v"}
4 {return "$t $p $v"}
5 {return "$v $p $q"}
default {error "i value $i is out of range"}
}
}
}
# The procedure below is invoked when the "Update" button is pressed,
# and whenever the color changes if update mode is enabled. It
# propagates color information as determined by the command in the
# Command entry.
proc doUpdate {} {
global color command
set newCmd $command
regsub -all %% $command $color newCmd
eval $newCmd
}
changeColorSpace hsb
# Local Variables:
# mode: tcl
# End:

113
Dependencies/Python/tcl/tk8.6/demos/text.tcl vendored Normal file
View File

@ -0,0 +1,113 @@
# text.tcl --
#
# This demonstration script creates a text widget that describes
# the basic editing functions.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .text
catch {destroy $w}
toplevel $w
wm title $w "Text Demonstration - Basic Facilities"
wm iconname $w "text"
positionWindow $w
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w {} \
{ttk::button $w.buttons.fontchooser -command fontchooserToggle}]
pack $btns -side bottom -fill x
text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \
-height 30 -undo 1 -autosep 1
ttk::scrollbar $w.scroll -command [list $w.text yview]
pack $w.scroll -side right -fill y
pack $w.text -expand yes -fill both
# TIP 324 Demo: [tk fontchooser]
proc fontchooserToggle {} {
tk fontchooser [expr {[tk fontchooser configure -visible] ?
"hide" : "show"}]
}
proc fontchooserVisibility {w} {
$w configure -text [expr {[tk fontchooser configure -visible] ?
"Hide Font Dialog" : "Show Font Dialog"}]
}
proc fontchooserFocus {w} {
tk fontchooser configure -font [$w cget -font] \
-command [list fontchooserFontSel $w]
}
proc fontchooserFontSel {w font args} {
$w configure -font [font actual $font]
}
tk fontchooser configure -parent $w
bind $w.text <FocusIn> [list fontchooserFocus $w.text]
fontchooserVisibility $w.buttons.fontchooser
bind $w <<TkFontchooserVisibility>> [list \
fontchooserVisibility $w.buttons.fontchooser]
focus $w.text
$w.text insert 0.0 \
{This window is a text widget. It displays one or more lines of text
and allows you to edit the text. Here is a summary of the things you
can do to a text widget:
1. Scrolling. Use the scrollbar to adjust the view in the text window.
2. Scanning. Press the middle mouse button in the text window and drag up
or down. This will drag the text at high speed to allow you to scan its
contents.
3. Insert text. Press mouse button 1 to set the insertion cursor, then
type text. What you type will be added to the widget.
4. Select. Press mouse button 1 and drag to select a range of characters.
Once you've released the button, you can adjust the selection by pressing
button 1 with the shift key down. This will reset the end of the
selection nearest the mouse cursor and you can drag that end of the
selection by dragging the mouse before releasing the mouse button.
You can double-click to select whole words or triple-click to select
whole lines.
5. Delete and replace. To delete text, select the characters you'd like
to delete and type Backspace or Delete. Alternatively, you can type new
text, in which case it will replace the selected text.
6. Copy the selection. To copy the selection into this window, select
what you want to copy (either here or in another application), then
click the middle mouse button to copy the selection to the point of the
mouse cursor.
7. Edit. Text widgets support the standard Motif editing characters
plus many Emacs editing characters. Backspace and Control-h erase the
character to the left of the insertion cursor. Delete and Control-d
erase the character to the right of the insertion cursor. Meta-backspace
deletes the word to the left of the insertion cursor, and Meta-d deletes
the word to the right of the insertion cursor. Control-k deletes from
the insertion cursor to the end of the line, or it deletes the newline
character if that is the only thing left on the line. Control-o opens
a new line by inserting a newline character to the right of the insertion
cursor. Control-t transposes the two characters on either side of the
insertion cursor. Control-z undoes the last editing action performed,
and }
switch [tk windowingsystem] {
"aqua" - "x11" {
$w.text insert end "Control-Shift-z"
}
"win32" {
$w.text insert end "Control-y"
}
}
$w.text insert end { redoes undone edits.
7. Resize the window. This widget has been configured with the "setGrid"
option on, so that if you resize the window it will always resize to an
even number of characters high and wide. Also, if you make the window
narrow you can see that long lines automatically wrap around onto
additional lines so that all the information is always visible.}
$w.text mark set insert 0.0

62
Dependencies/Python/tcl/tk8.6/demos/textpeer.tcl vendored Normal file
View File

@ -0,0 +1,62 @@
# textpeer.tcl --
#
# This demonstration script creates a pair of text widgets that can edit a
# single logical buffer. This is particularly useful when editing related text
# in two (or more) parts of the same file.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .textpeer
catch {destroy $w}
toplevel $w
wm title $w "Text Widget Peering Demonstration"
wm iconname $w "textpeer"
positionWindow $w
set count 0
## Define a widget that we peer from; it won't ever actually be shown though
set first [text $w.text[incr count]]
$first insert end "This is a coupled pair of text widgets; they are peers to "
$first insert end "each other. They have the same underlying data model, but "
$first insert end "can show different locations, have different current edit "
$first insert end "locations, and have different selections. You can also "
$first insert end "create additional peers of any of these text widgets using "
$first insert end "the Make Peer button beside the text widget to clone, and "
$first insert end "delete a particular peer widget using the Delete Peer "
$first insert end "button."
## Procedures to make and kill clones; most of this is just so that the demo
## looks nice...
proc makeClone {w parent} {
global count
set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\
-height 10 -wrap word]
set sb [ttk::scrollbar $w.sb$count -command "$t yview" -orient vertical]
set b1 [button $w.clone$count -command "makeClone $w $t" \
-text "Make Peer"]
set b2 [button $w.kill$count -command "killClone $w $count" \
-text "Delete Peer"]
set row [expr {$count * 2}]
grid $t $sb $b1 -sticky nsew -row $row
grid ^ ^ $b2 -row [incr row]
grid configure $b1 $b2 -sticky new
grid rowconfigure $w $b2 -weight 1
}
proc killClone {w count} {
destroy $w.text$count $w.sb$count
destroy $w.clone$count $w.kill$count
}
## Now set up the GUI
makeClone $w $first
makeClone $w $first
destroy $first
## See Code / Dismiss buttons
grid [addSeeDismiss $w.buttons $w] - - -sticky ew -row 5000
grid columnconfigure $w 0 -weight 1

47
Dependencies/Python/tcl/tk8.6/demos/timer vendored Normal file
View File

@ -0,0 +1,47 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# timer --
# This script generates a counter with start and stop buttons.
package require Tk
label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m
button .start -text Start -command {
if {$stopped} {
set stopped 0
set startMoment [clock clicks -milliseconds]
tick
.stop configure -state normal
.start configure -state disabled
}
}
button .stop -text Stop -state disabled -command {
set stopped 1
.stop configure -state disabled
.start configure -state normal
}
pack .counter -side bottom -fill both
pack .start -side left -fill both -expand yes
pack .stop -side right -fill both -expand yes
set startMoment {}
set stopped 1
proc tick {} {
global startMoment stopped
if {$stopped} {return}
after 50 tick
set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}]
.counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]]
}
bind . <Control-c> {destroy .}
bind . <Control-q> {destroy .}
focus .
# Local Variables:
# mode: tcl
# End:

92
Dependencies/Python/tcl/tk8.6/demos/toolbar.tcl vendored Normal file
View File

@ -0,0 +1,92 @@
# toolbar.tcl --
#
# This demonstration script creates a toolbar that can be torn off.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .toolbar
destroy $w
toplevel $w
wm title $w "Toolbar Demonstration"
wm iconname $w "toolbar"
positionWindow $w
ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
a toolbar that is styled correctly and which can be torn off. The\
buttons are configured to be \u201Ctoolbar style\u201D buttons by\
telling them that they are to use the Toolbutton style. At the left\
end of the toolbar is a simple marker that the cursor changes to a\
movement icon over; drag that away from the toolbar to tear off the\
whole toolbar into a separate toplevel widget. When the dragged-off\
toolbar is no longer needed, just close it like any normal toplevel\
and it will reattach to the window it was torn off from."
## Set up the toolbar hull
set t [frame $w.toolbar] ;# Must be a frame!
ttk::separator $w.sep
ttk::frame $t.tearoff -cursor fleur
ttk::separator $t.tearoff.to -orient vertical
ttk::separator $t.tearoff.to2 -orient vertical
pack $t.tearoff.to -fill y -expand 1 -padx 4 -side left
pack $t.tearoff.to2 -fill y -expand 1 -side left
ttk::frame $t.contents
grid $t.tearoff $t.contents -sticky nsew
grid columnconfigure $t $t.contents -weight 1
grid columnconfigure $t.contents 1000 -weight 1
## Bindings so that the toolbar can be torn off and reattached
bind $t.tearoff <B1-Motion> [list tearoff $t %X %Y]
bind $t.tearoff.to <B1-Motion> [list tearoff $t %X %Y]
bind $t.tearoff.to2 <B1-Motion> [list tearoff $t %X %Y]
proc tearoff {w x y} {
if {[string match $w* [winfo containing $x $y]]} {
return
}
grid remove $w
grid remove $w.tearoff
wm manage $w
wm protocol $w WM_DELETE_WINDOW [list untearoff $w]
}
proc untearoff {w} {
wm forget $w
grid $w.tearoff
grid $w
}
## Toolbar contents
ttk::button $t.button -text "Button" -style Toolbutton -command [list \
$w.txt insert end "Button Pressed\n"]
ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
-command [concat [list $w.txt insert end] {"check is $check\n"}]
ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m
ttk::combobox $t.combo -value [lsort [font families]] -state readonly
menu $t.menu.m
$t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n]
$t.menu.m add command -label "An" -command [list $w.txt insert end An\n]
$t.menu.m add command -label "Example" \
-command [list $w.txt insert end Example\n]
bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo]
proc changeFont {txt combo} {
$txt configure -font [list [$combo get] 10]
}
## Some content for the rest of the toplevel
text $w.txt -width 40 -height 10
interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write
## Arrange contents
grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -pady 4 -sticky ns
grid $t -sticky ew
grid $w.sep -sticky ew
grid $w.msg -sticky ew
grid $w.txt -sticky nsew
grid rowconfigure $w $w.txt -weight 1
grid columnconfigure $w $w.txt -weight 1
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
grid $btns -sticky ew

89
Dependencies/Python/tcl/tk8.6/demos/tree.tcl vendored Normal file
View File

@ -0,0 +1,89 @@
# tree.tcl --
#
# This demonstration script creates a toplevel window containing a Ttk
# tree widget.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .tree
catch {destroy $w}
toplevel $w
wm title $w "Directory Browser"
wm iconname $w "tree"
positionWindow $w
## Explanatory text
ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them."
pack $w.msg -fill x
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
## Code to populate the roots of the tree (can be more than one on Windows)
proc populateRoots {tree} {
foreach dir [lsort -dictionary [file volumes]] {
populateTree $tree [$tree insert {} end -text $dir \
-values [list $dir directory]]
}
}
## Code to populate a node of the tree
proc populateTree {tree node} {
if {[$tree set $node type] ne "directory"} {
return
}
set path [$tree set $node fullpath]
$tree delete [$tree children $node]
foreach f [lsort -dictionary [glob -nocomplain -dir $path *]] {
set f [file normalize $f]
set type [file type $f]
set id [$tree insert $node end -text [file tail $f] \
-values [list $f $type]]
if {$type eq "directory"} {
## Make it so that this node is openable
$tree insert $id 0 -text dummy ;# a dummy
$tree item $id -text [file tail $f]/
} elseif {$type eq "file"} {
set size [file size $f]
## Format the file size nicely
if {$size >= 1024*1024*1024} {
set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]]
} elseif {$size >= 1024*1024} {
set size [format %.1f\ MB [expr {$size/1024/1024.}]]
} elseif {$size >= 1024} {
set size [format %.1f\ kB [expr {$size/1024.}]]
} else {
append size " bytes"
}
$tree set $id size $size
}
}
# Stop this code from rerunning on the current node
$tree set $node type processedDirectory
}
## Create the tree and set it up
ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \
-yscroll "$w.vsb set" -xscroll "$w.hsb set"
ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
$w.tree heading \#0 -text "Directory Structure"
$w.tree heading size -text "File Size"
$w.tree column size -width 70
populateRoots $w.tree
bind $w.tree <<TreeviewOpen>> {populateTree %W [%W focus]}
## Arrange the tree and its scrollbars in the toplevel
lower [ttk::frame $w.dummy]
pack $w.dummy -fill both -expand 1
grid $w.tree $w.vsb -sticky nsew -in $w.dummy
grid $w.hsb -sticky nsew -in $w.dummy
grid columnconfigure $w.dummy 0 -weight 1
grid rowconfigure $w.dummy 0 -weight 1

84
Dependencies/Python/tcl/tk8.6/demos/ttkbut.tcl vendored Normal file
View File

@ -0,0 +1,84 @@
# ttkbut.tcl --
#
# This demonstration script creates a toplevel window containing several
# simple Ttk widgets, such as labels, labelframes, buttons, checkbuttons and
# radiobuttons.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkbut
catch {destroy $w}
toplevel $w
wm title $w "Simple Ttk Widgets"
wm iconname $w "ttkbut"
positionWindow $w
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
pack $w.msg -side top -fill x
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w {enabled cheese tomato basil oregano happiness}]\
-side bottom -fill x
## Add buttons for setting the theme
ttk::labelframe $w.buttons -text "Buttons"
foreach theme [ttk::themes] {
ttk::button $w.buttons.$theme -text $theme \
-command [list ttk::setTheme $theme]
pack $w.buttons.$theme -pady 2
}
## Helper procedure for the top checkbutton
proc setState {rootWidget exceptThese value} {
if {$rootWidget in $exceptThese} {
return
}
## Non-Ttk widgets (e.g. the toplevel) will fail, so make it silent
catch {
$rootWidget state $value
}
## Recursively invoke on all children of this root that are in the same
## toplevel widget
foreach w [winfo children $rootWidget] {
if {[winfo toplevel $w] eq [winfo toplevel $rootWidget]} {
setState $w $exceptThese $value
}
}
}
## Set up the checkbutton group
ttk::labelframe $w.checks -text "Checkbuttons"
ttk::checkbutton $w.checks.e -text Enabled -variable enabled -command {
setState .ttkbut .ttkbut.checks.e \
[expr {$enabled ? "!disabled" : "disabled"}]
}
set enabled 1
## See ttk_widget(n) for other possible state flags
ttk::separator $w.checks.sep1
ttk::checkbutton $w.checks.c1 -text Cheese -variable cheese
ttk::checkbutton $w.checks.c2 -text Tomato -variable tomato
ttk::separator $w.checks.sep2
ttk::checkbutton $w.checks.c3 -text Basil -variable basil
ttk::checkbutton $w.checks.c4 -text Oregano -variable oregano
pack $w.checks.e $w.checks.sep1 $w.checks.c1 $w.checks.c2 $w.checks.sep2 \
$w.checks.c3 $w.checks.c4 -fill x -pady 2
## Set up the radiobutton group
ttk::labelframe $w.radios -text "Radiobuttons"
ttk::radiobutton $w.radios.r1 -text "Great" -variable happiness -value great
ttk::radiobutton $w.radios.r2 -text "Good" -variable happiness -value good
ttk::radiobutton $w.radios.r3 -text "OK" -variable happiness -value ok
ttk::radiobutton $w.radios.r4 -text "Poor" -variable happiness -value poor
ttk::radiobutton $w.radios.r5 -text "Awful" -variable happiness -value awful
pack $w.radios.r1 $w.radios.r2 $w.radios.r3 $w.radios.r4 $w.radios.r5 \
-fill x -padx 3 -pady 2
## Arrange things neatly
pack [ttk::frame $w.f] -fill both -expand 1
lower $w.f
grid $w.buttons $w.checks $w.radios -in $w.f -sticky nwe -pady 2 -padx 3
grid columnconfigure $w.f {0 1 2} -weight 1 -uniform yes

53
Dependencies/Python/tcl/tk8.6/demos/ttkmenu.tcl vendored Normal file
View File

@ -0,0 +1,53 @@
# ttkmenu.tcl --
#
# This demonstration script creates a toplevel window containing several Ttk
# menubutton widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkmenu
catch {destroy $w}
toplevel $w
wm title $w "Ttk Menu Buttons"
wm iconname $w "ttkmenu"
positionWindow $w
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set, and one widget that is available in themed form is the menubutton. Below are some themed menu buttons that allow you to pick the current theme in use. Notice how picking a theme changes the way that the menu buttons themselves look, and that the central menu button is styled differently (in a way that is normally suitable for toolbars). However, there are no themed menus; the standard Tk menus were judged to have a sufficiently good look-and-feel on all platforms, especially as they are implemented as native controls in many places."
pack $w.msg [ttk::separator $w.msgSep] -side top -fill x
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
ttk::menubutton $w.m1 -menu $w.m1.menu -text "Select a theme" -direction above
ttk::menubutton $w.m2 -menu $w.m1.menu -text "Select a theme" -direction left
ttk::menubutton $w.m3 -menu $w.m1.menu -text "Select a theme" -direction right
ttk::menubutton $w.m4 -menu $w.m1.menu -text "Select a theme" \
-direction flush -style TMenubutton.Toolbutton
ttk::menubutton $w.m5 -menu $w.m1.menu -text "Select a theme" -direction below
menu $w.m1.menu -tearoff 0
menu $w.m2.menu -tearoff 0
menu $w.m3.menu -tearoff 0
menu $w.m4.menu -tearoff 0
menu $w.m5.menu -tearoff 0
foreach theme [ttk::themes] {
$w.m1.menu add command -label $theme -command [list ttk::setTheme $theme]
$w.m2.menu add command -label $theme -command [list ttk::setTheme $theme]
$w.m3.menu add command -label $theme -command [list ttk::setTheme $theme]
$w.m4.menu add command -label $theme -command [list ttk::setTheme $theme]
$w.m5.menu add command -label $theme -command [list ttk::setTheme $theme]
}
pack [ttk::frame $w.f] -fill x
pack [ttk::frame $w.f1] -fill both -expand yes
lower $w.f
grid anchor $w.f center
grid x $w.m1 x -in $w.f -padx 3 -pady 2
grid $w.m2 $w.m4 $w.m3 -in $w.f -padx 3 -pady 2
grid x $w.m5 x -in $w.f -padx 3 -pady 2

57
Dependencies/Python/tcl/tk8.6/demos/ttknote.tcl vendored Normal file
View File

@ -0,0 +1,57 @@
# ttknote.tcl --
#
# This demonstration script creates a toplevel window containing a Ttk
# notebook widget.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttknote
catch {destroy $w}
toplevel $w
wm title $w "Ttk Notebook Widget"
wm iconname $w "ttknote"
positionWindow $w
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
ttk::frame $w.f
pack $w.f -fill both -expand 1
set w $w.f
## Make the notebook and set up Ctrl+Tab traversal
ttk::notebook $w.note
pack $w.note -fill both -expand 1 -padx 2 -pady 3
ttk::notebook::enableTraversal $w.note
## Popuplate the first pane
ttk::frame $w.note.msg
ttk::label $w.note.msg.m -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is the notebook widget, which provides a set of tabs that allow the selection of a group of panels, each with distinct content. They are a feature of many modern user interfaces. Not only can the tabs be selected with the mouse, but they can also be switched between using Ctrl+Tab when the notebook page heading itself is selected. Note that the second tab is disabled, and cannot be selected."
ttk::button $w.note.msg.b -text "Neat!" -underline 0 -command {
set neat "Yeah, I know..."
after 500 {set neat {}}
}
bind $w <Alt-n> "focus $w.note.msg.b; $w.note.msg.b invoke"
ttk::label $w.note.msg.l -textvariable neat
$w.note add $w.note.msg -text "Description" -underline 0 -padding 2
grid $w.note.msg.m - -sticky new -pady 2
grid $w.note.msg.b $w.note.msg.l -pady {2 4}
grid rowconfigure $w.note.msg 1 -weight 1
grid columnconfigure $w.note.msg {0 1} -weight 1 -uniform 1
## Populate the second pane. Note that the content doesn't really matter
ttk::frame $w.note.disabled
$w.note add $w.note.disabled -text "Disabled" -state disabled
## Popuplate the third pane
ttk::frame $w.note.editor
$w.note add $w.note.editor -text "Text Editor" -underline 0
text $w.note.editor.t -width 40 -height 10 -wrap char \
-yscroll "$w.note.editor.s set"
ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview"
pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2
pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0}

112
Dependencies/Python/tcl/tk8.6/demos/ttkpane.tcl vendored Normal file
View File

@ -0,0 +1,112 @@
# ttkpane.tcl --
#
# This demonstration script creates a Ttk pane with some content.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkpane
catch {destroy $w}
toplevel $w
wm title $w "Themed Nested Panes"
wm iconname $w "ttkpane"
positionWindow $w
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows off a nested set of themed paned windows. Their sizes can be changed by grabbing the area between each contained pane and dragging the divider."
pack $w.msg [ttk::separator $w.msgSep] -side top -fill x
## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
ttk::frame $w.f
pack $w.f -fill both -expand 1
set w $w.f
ttk::panedwindow $w.outer -orient horizontal
$w.outer add [ttk::panedwindow $w.outer.inLeft -orient vertical]
$w.outer add [ttk::panedwindow $w.outer.inRight -orient vertical]
$w.outer.inLeft add [ttk::labelframe $w.outer.inLeft.top -text Button]
$w.outer.inLeft add [ttk::labelframe $w.outer.inLeft.bot -text Clocks]
$w.outer.inRight add [ttk::labelframe $w.outer.inRight.top -text Progress]
$w.outer.inRight add [ttk::labelframe $w.outer.inRight.bot -text Text]
if {[tk windowingsystem] eq "aqua"} {
foreach i [list inLeft.top inLeft.bot inRight.top inRight.bot] {
$w.outer.$i configure -padding 3
}
}
# Fill the button pane
ttk::button $w.outer.inLeft.top.b -text "Press Me" -command {
tk_messageBox -type ok -icon info -message "Ouch!" -detail "That hurt..." \
-parent .ttkpane -title "Button Pressed"
}
pack $w.outer.inLeft.top.b -padx 2 -pady 5
# Fill the clocks pane
set i 0
proc every {delay script} {
uplevel #0 $script
after $delay [list every $delay $script]
}
set testzones {
:Europe/Berlin
:America/Argentina/Buenos_Aires
:Africa/Johannesburg
:Europe/London
:America/Los_Angeles
:Europe/Moscow
:America/New_York
:Asia/Singapore
:Australia/Sydney
:Asia/Tokyo
}
# Force a pre-load of all the timezones needed; otherwise can end up
# poor-looking synch problems!
set zones {}
foreach zone $testzones {
if {![catch {clock format 0 -timezone $zone}]} {
lappend zones $zone
}
}
if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 }
foreach zone $zones {
set city [string map {_ " "} [regexp -inline {[^/]+$} $zone]]
if {$i} {
pack [ttk::separator $w.outer.inLeft.bot.s$i] -fill x
}
ttk::label $w.outer.inLeft.bot.l$i -text $city -anchor w
ttk::label $w.outer.inLeft.bot.t$i -textvariable time($zone) -anchor w
pack $w.outer.inLeft.bot.l$i $w.outer.inLeft.bot.t$i -fill x
every 1000 "set time($zone) \[clock format \[clock seconds\] -timezone $zone -format %T\]"
incr i
}
# Fill the progress pane
ttk::progressbar $w.outer.inRight.top.progress -mode indeterminate
pack $w.outer.inRight.top.progress -fill both -expand 1
$w.outer.inRight.top.progress start
# Fill the text pane
if {[tk windowingsystem] ne "aqua"} {
# The trick with the ttk::frame makes the text widget look like it fits with
# the current Ttk theme despite not being a themed widget itself. It is done
# by styling the frame like an entry, turning off the border in the text
# widget, and putting the text widget in the frame with enough space to allow
# the surrounding border to show through (2 pixels seems to be enough).
ttk::frame $w.outer.inRight.bot.f -style TEntry
text $w.txt -wrap word -yscroll "$w.sb set" -width 30 -borderwidth 0
pack $w.txt -fill both -expand 1 -in $w.outer.inRight.bot.f -pady 2 -padx 2
ttk::scrollbar $w.sb -orient vertical -command "$w.txt yview"
pack $w.sb -side right -fill y -in $w.outer.inRight.bot
pack $w.outer.inRight.bot.f -fill both -expand 1
pack $w.outer -fill both -expand 1
} else {
text $w.txt -wrap word -yscroll "$w.sb set" -width 30 -borderwidth 0
ttk::scrollbar $w.sb -orient vertical -command "$w.txt yview"
pack $w.sb -side right -fill y -in $w.outer.inRight.bot
pack $w.txt -fill both -expand 1 -in $w.outer.inRight.bot
pack $w.outer -fill both -expand 1 -padx 10 -pady {6 10}
}

46
Dependencies/Python/tcl/tk8.6/demos/ttkprogress.tcl vendored Normal file
View File

@ -0,0 +1,46 @@
# ttkprogress.tcl --
#
# This demonstration script creates several progress bar widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkprogress
catch {destroy $w}
toplevel $w
wm title $w "Progress Bar Demonstration"
wm iconname $w "ttkprogress"
positionWindow $w
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
pack $w.msg -side top -fill x
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
ttk::frame $w.f
pack $w.f -fill both -expand 1
set w $w.f
proc doBars {op args} {
foreach w $args {
$w $op
}
}
ttk::progressbar $w.p1 -mode determinate
ttk::progressbar $w.p2 -mode indeterminate
ttk::button $w.start -text "Start Progress" -command [list \
doBars start $w.p1 $w.p2]
ttk::button $w.stop -text "Stop Progress" -command [list \
doBars stop $w.p1 $w.p2]
grid $w.p1 - -pady 5 -padx 10
grid $w.p2 - -pady 5 -padx 10
grid $w.start $w.stop -padx 10 -pady 5
grid configure $w.start -sticky e
grid configure $w.stop -sticky w
grid columnconfigure $w all -weight 1

39
Dependencies/Python/tcl/tk8.6/demos/ttkscale.tcl vendored Normal file
View File

@ -0,0 +1,39 @@
# ttkscale.tcl --
#
# This demonstration script shows an example with a horizontal scale.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkscale
catch {destroy $w}
toplevel $w -bg [ttk::style lookup TLabel -background]
wm title $w "Themed Scale Demonstration"
wm iconname $w "ttkscale"
positionWindow $w
pack [ttk::frame [set w $w.contents]] -fill both -expand 1
ttk::label $w.msg -font $font -wraplength 3.5i -justify left -text "A label tied to a horizontal scale is displayed below. If you click or drag mouse button 1 in the scale, you can change the contents of the label; a callback command is used to couple the slider to both the text and the coloring of the label."
pack $w.msg -side top -padx .5c
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons [winfo toplevel $w]]
pack $btns -side bottom -fill x
ttk::frame $w.frame -borderwidth 10
pack $w.frame -side top -fill x
# List of colors from rainbox; "Indigo" is not a standard color
set colorList {Red Orange Yellow Green Blue Violet}
ttk::label $w.frame.label
ttk::scale $w.frame.scale -from 0 -to 5 -command [list apply {{w idx} {
set c [lindex $::colorList [tcl::mathfunc::int $idx]]
$w.frame.label configure -foreground $c -text "Color: $c"
}} $w]
# Trigger the setting of the label's text
$w.frame.scale set 0
pack $w.frame.label $w.frame.scale

49
Dependencies/Python/tcl/tk8.6/demos/ttkspin.tcl vendored Normal file
View File

@ -0,0 +1,49 @@
# ttkspin.tcl --
#
# This demonstration script creates several Ttk spinbox widgets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .ttkspin
catch {destroy $w}
toplevel $w
wm title $w "Themed Spinbox Demonstration"
wm iconname $w "ttkspin"
positionWindow $w
label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
themed spin-boxes are displayed below. You can add characters by\
pointing, clicking and typing. The normal Motif editing characters\
are supported, along with many Emacs bindings. For example, Backspace\
and Control-h delete the character to the left of the insertion\
cursor and Delete and Control-d delete the chararacter to the right\
of the insertion cursor. For values that are too large to fit in the\
window all at once, you can scan through the value by dragging with\
mouse button2 pressed. Note that the first spin-box will only permit\
you to type in integers, and the third selects from a list of\
Australian cities."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
set australianCities {
Canberra Sydney Melbourne Perth Adelaide Brisbane
Hobart Darwin "Alice Springs"
}
ttk::spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \
-validatecommand {string is integer %P}
ttk::spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10
ttk::spinbox $w.s3 -values $australianCities -width 10
$w.s1 set 1
$w.s2 set 00.00
$w.s3 set Canberra
pack $w.s1 $w.s2 $w.s3 -side top -pady 5 -padx 10

351
Dependencies/Python/tcl/tk8.6/demos/twind.tcl vendored Normal file
View File

@ -0,0 +1,351 @@
# twind.tcl --
#
# This demonstration script creates a text widget with a bunch of
# embedded windows.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
# Make an Aqua button's fill color match its parent's background
proc blend {bt} {
if {[tk windowingsystem] eq "aqua"} {
$bt configure -highlightbackground [[winfo parent $bt] cget -background]
}
return $bt
}
set w .twind
catch {destroy $w}
toplevel $w
wm title $w "Text Demonstration - Embedded Windows and Other Features"
wm iconname $w "Embedded Windows"
positionWindow $w
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken
set t $w.f.text
text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
-height 35 -wrap word -highlightthickness 0 -borderwidth 0
pack $t -expand yes -fill both
ttk::scrollbar $w.scroll -command "$t yview"
pack $w.scroll -side right -fill y
panedwindow $w.pane
pack $w.pane -expand yes -fill both
$w.pane add $w.f
# Import to raise given creation order above
raise $w.f
$t tag configure center -justify center -spacing1 5m -spacing3 5m
$t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
-spacing1 3m -spacing2 0 -spacing3 0
button $t.on -text "Turn On" -command "textWindOn $w" \
-cursor top_left_arrow
button $t.off -text "Turn Off" -command "textWindOff $w" \
-cursor top_left_arrow
$t insert end "A text widget can contain many different kinds of items, "
$t insert end "both active and passive. It can lay these out in various "
$t insert end "ways, with wrapping, tabs, centering, etc. In addition, "
$t insert end "when the contents are too big for the window, smooth "
$t insert end "scrolling in all directions is provided.\n\n"
$t insert end "A text widget can contain other widgets embedded "
$t insert end "it. These are called \"embedded windows\", "
$t insert end "and they can consist of arbitrary widgets. "
$t insert end "For example, here are two embedded button "
$t insert end "widgets. You can click on the first button to "
$t window create end -window [blend $t.on]
$t insert end " horizontal scrolling, which also turns off "
$t insert end "word wrapping. Or, you can click on the second "
$t insert end "button to\n"
$t window create end -window [blend $t.off]
$t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
$t insert end "Or, here is another example. If you "
$t window create end -create {
button %W.click -text "Click Here" -command "textWindPlot %W" \
-cursor top_left_arrow
blend %W.click
}
$t insert end " a canvas displaying an x-y plot will appear right here."
$t mark set plot insert
$t mark gravity plot left
$t insert end " You can drag the data points around with the mouse, "
$t insert end "or you can click here to "
$t window create end -create {
button %W.delete -text "Delete" -command "textWindDel %W" \
-cursor top_left_arrow
blend %W.delete
}
$t insert end " the plot again.\n\n"
$t insert end "You can also create multiple text widgets each of which "
$t insert end "display the same underlying text. Click this button to "
$t window create end \
-create {button %W.peer -text "Make A Peer" -command "textMakePeer %W" \
-cursor top_left_arrow
blend %W.peer} -padx 3
$t insert end " widget. Notice how peer widgets can have different "
$t insert end "font settings, and by default contain all the images "
$t insert end "of the 'parent', but that the embedded windows, "
$t insert end "such as buttons may not appear in the peer. To ensure "
$t insert end "that embedded windows appear in all peers you can set the "
$t insert end "'-create' option to a script or a string containing %W. "
$t insert end "(The plot above and the 'Make A Peer' button are "
$t insert end "designed to show up in all peers.) A good use of "
$t insert end "peers is for "
$t window create end \
-create {button %W.split -text "Split Windows" -command "textSplitWindow %W" \
-cursor top_left_arrow
blend %W.split} -padx 3
$t insert end " \n\n"
$t insert end "Users of previous versions of Tk will also be interested "
$t insert end "to note that now cursor movement is now by visual line by "
$t insert end "default, and that all scrolling of this widget is by pixel.\n\n"
$t insert end "You may also find it useful to put embedded windows in "
$t insert end "a text without any actual text. In this case the "
$t insert end "text widget acts like a geometry manager. For "
$t insert end "example, here is a collection of buttons laid out "
$t insert end "neatly into rows by the text widget. These buttons "
$t insert end "can be used to change the background color of the "
$t insert end "text widget (\"Default\" restores the color to "
$t insert end "its default). If you click on the button labeled "
$t insert end "\"Short\", it changes to a longer string so that "
$t insert end "you can see how the text widget automatically "
$t insert end "changes the layout. Click on the button again "
$t insert end "to restore the short string.\n"
$t insert end "\nNOTE: these buttons will not appear in peers!\n" "peer_warning"
button $t.default -text Default -command "embDefBg $t" \
-cursor top_left_arrow
$t window create end -window $t.default -padx 3
global embToggle
set embToggle Short
checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
-variable embToggle -onvalue "A much longer string" \
-offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
$t window create end -window $t.toggle -padx 3 -pady 2
set i 1
foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
button $t.color$i -text $color -cursor top_left_arrow -command \
"changeBg $t $color"
$t window create end -window [blend $t.color$i] -padx 3 -pady 2
incr i
}
$t tag add buttons [blend $t.default] end
button $t.bigB -text "Big borders" -command "textWindBigB $t" \
-cursor top_left_arrow
button $t.smallB -text "Small borders" -command "textWindSmallB $t" \
-cursor top_left_arrow
button $t.bigH -text "Big highlight" -command "textWindBigH $t" \
-cursor top_left_arrow
button $t.smallH -text "Small highlight" -command "textWindSmallH $t" \
-cursor top_left_arrow
button $t.bigP -text "Big pad" -command "textWindBigP $t" \
-cursor top_left_arrow
button $t.smallP -text "Small pad" -command "textWindSmallP $t" \
-cursor top_left_arrow
set text_normal(border) [$t cget -borderwidth]
set text_normal(highlight) [$t cget -highlightthickness]
set text_normal(pad) [$t cget -padx]
$t insert end "\nYou can also change the usual border width and "
$t insert end "highlightthickness and padding.\n"
$t window create end -window [blend $t.bigB]
$t window create end -window [blend $t.smallB]
$t window create end -window [blend $t.bigH]
$t window create end -window [blend $t.smallH]
$t window create end -window [blend $t.bigP]
$t window create end -window [blend $t.smallP]
$t insert end "\n\nFinally, images fit comfortably in text widgets too:"
$t image create end -image \
[image create photo -file [file join $tk_demoDirectory images ouster.png]]
proc textWindBigB w {
$w configure -borderwidth 15
}
proc textWindBigH w {
$w configure -highlightthickness 15
}
proc textWindBigP w {
$w configure -padx 15 -pady 15
}
proc textWindSmallB w {
$w configure -borderwidth $::text_normal(border)
}
proc textWindSmallH w {
$w configure -highlightthickness $::text_normal(highlight)
}
proc textWindSmallP w {
$w configure -padx $::text_normal(pad) -pady $::text_normal(pad)
}
proc textWindOn w {
catch {destroy $w.scroll2}
set t $w.f.text
ttk::scrollbar $w.scroll2 -orient horizontal -command "$t xview"
pack $w.scroll2 -after $w.buttons -side bottom -fill x
$t configure -xscrollcommand "$w.scroll2 set" -wrap none
}
proc textWindOff w {
catch {destroy $w.scroll2}
set t $w.f.text
$t configure -xscrollcommand {} -wrap word
}
proc textWindPlot t {
set c $t.c
if {[winfo exists $c]} {
return
}
while {[string first [$t get plot] " \t\n"] >= 0} {
$t delete plot
}
$t insert plot "\n"
$t window create plot -create {createPlot %W}
$t tag add center plot
$t insert plot "\n"
}
proc createPlot {t} {
set c $t.c
canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
set font {Helvetica 18}
$c create line 100 250 400 250 -width 2
$c create line 100 250 100 50 -width 2
$c create text 225 20 -text "A Simple Plot" -font $font -fill brown
for {set i 0} {$i <= 10} {incr i} {
set x [expr {100 + ($i*30)}]
$c create line $x 250 $x 245 -width 2
$c create text $x 254 -text [expr {10*$i}] -anchor n -font $font
}
for {set i 0} {$i <= 5} {incr i} {
set y [expr {250 - ($i*40)}]
$c create line 100 $y 105 $y -width 2
$c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font
}
foreach point {
{12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
} {
set x [expr {100 + (3*[lindex $point 0])}]
set y [expr {250 - (4*[lindex $point 1])/5}]
set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
[expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
-fill SkyBlue2]
$c addtag point withtag $item
}
$c bind point <Enter> "$c itemconfig current -fill red"
$c bind point <Leave> "$c itemconfig current -fill SkyBlue2"
$c bind point <Button-1> "embPlotDown $c %x %y"
$c bind point <ButtonRelease-1> "$c dtag selected"
bind $c <B1-Motion> "embPlotMove $c %x %y"
return $c
}
set embPlot(lastX) 0
set embPlot(lastY) 0
proc embPlotDown {w x y} {
global embPlot
$w dtag selected
$w addtag selected withtag current
$w raise current
set embPlot(lastX) $x
set embPlot(lastY) $y
}
proc embPlotMove {w x y} {
global embPlot
$w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}]
set embPlot(lastX) $x
set embPlot(lastY) $y
}
proc textWindDel t {
if {[winfo exists $t.c]} {
$t delete $t.c
while {[string first [$t get plot] " \t\n"] >= 0} {
$t delete plot
}
$t insert plot " "
}
}
proc changeBg {t c} {
$t configure -background $c
if {[tk windowingsystem] eq "aqua"} {
foreach b [$t window names] {
if {[winfo class $b] eq "Button"} {
$b configure -highlightbackground $c
}
}
}
}
proc embDefBg t {
set bg [lindex [$t configure -background] 3]
changeBg $t $bg
}
proc textMakePeer {parent} {
set n 1
while {[winfo exists .peer$n]} { incr n }
set w [toplevel .peer$n]
wm title $w "Text Peer #$n"
frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken
set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \
-borderwidth 0 -highlightthickness 0]
$t tag configure peer_warning -font boldFont
pack $t -expand yes -fill both
ttk::scrollbar $w.scroll -command "$t yview"
pack $w.scroll -side right -fill y
pack $w.f -expand yes -fill both
}
proc textSplitWindow {textW} {
if {$textW eq ".twind.f.text"} {
if {[winfo exists .twind.peer]} {
destroy .twind.peer
} else {
set parent [winfo parent $textW]
set w [winfo parent $parent]
set t [$textW peer create $w.peer \
-yscrollcommand "$w.scroll set"]
$t tag configure peer_warning -font boldFont
$w.pane add $t
}
} else {
return
}
}

145
Dependencies/Python/tcl/tk8.6/demos/unicodeout.tcl vendored Normal file
View File

@ -0,0 +1,145 @@
# unicodeout.tcl --
#
# This demonstration script shows how you can produce output (in label
# widgets) using many different alphabets.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .unicodeout
catch {destroy $w}
toplevel $w
wm title $w "Unicode Label Demonstration"
wm iconname $w "unicodeout"
positionWindow $w
label $w.msg -font $font -wraplength 4i -anchor w -justify left \
-text "This is a sample of Tk's support for languages that use\
non-Western character sets. However, what you will actually see\
below depends largely on what character sets you have installed,\
and what you see for characters that are not present varies greatly\
between platforms as well. The strings are written in Tcl using\
UNICODE characters using the \\uXXXX escape so as to do so in a\
portable fashion."
pack $w.msg -side top
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
## The frame that will contain the sample texts.
pack [frame $w.f] -side bottom -expand 1 -fill both -padx 2m -pady 1m
grid columnconfigure $w.f 1 -weight 1
set i 0
proc addSample {w language args} {
global font i
set sample [join $args ""]
set j [incr i]
label $w.f.l$j -font $font -text "${language}:" -anchor nw -pady 0
label $w.f.s$j -font $font -text $sample -anchor nw -width 30 -pady 0
grid $w.f.l$j $w.f.s$j -sticky ew -pady 0
grid configure $w.f.l$j -padx 1m
}
## A helper procedure that determines what form to use to express languages
## that have complex rendering rules...
proc usePresentationFormsFor {language} {
switch [tk windowingsystem] {
aqua {
# OSX wants natural character order; the renderer knows how to
# compose things for display for all languages.
return false
}
x11 {
# The X11 font renderers that Tk supports all know nothing about
# composing characters, so we need to use presentation forms.
return true
}
win32 {
# On Windows, we need to determine whether the font system will
# render right-to-left text. This varies by language!
try {
package require registry
set rkey [join {
HKEY_LOCAL_MACHINE
SOFTWARE
Microsoft
{Windows NT}
CurrentVersion
LanguagePack
} \\]
return [expr {
[string toupper $language] ni [registry values $rkey]
}]
} trap error {} {
# Cannot work it out, so use presentation forms.
return true
}
}
default {
# Default to using presentation forms.
return true
}
}
}
## Processing when some characters are not currently cached by the display
## engine might take a while, so make sure we're displaying something in the
## meantime...
pack [label $w.wait -text "Please wait while loading fonts..." \
-font {Helvetica 12 italic}]
set oldCursor [$w cget -cursor]
$w conf -cursor watch
update
## Add the samples...
if {[usePresentationFormsFor Arabic]} {
# Using presentation forms (pre-layouted)
addSample $w Arabic \
"\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
"\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
} else {
# Using standard text characters
addSample $w Arabic \
"\u0627\u0644\u0643\u0644\u0645\u0629 " \
"\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
}
addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57"
addSample $w "Simpl. Chinese" "\u6C49\u8BED"
addSample $w French "Langue fran\xE7aise"
addSample $w Greek \
"\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
"\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
if {[usePresentationFormsFor Hebrew]} {
# Visual order (pre-layouted)
addSample $w Hebrew \
"\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
} else {
# Standard logical order
addSample $w Hebrew \
"\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
}
addSample $w Hindi \
"\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E"
addSample $w Icelandic "\xCDslenska"
addSample $w Japanese \
"\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
"\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
addSample $w Russian \
"\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
if {[package vsatisfies [package provide Tcl] 8.7-]} {
addSample $w Emoji "😀💩👍🇳🇱"
} else {
addSample $w Emoji \
"\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
}
}
## We're done processing, so change things back to normal running...
destroy $w.wait
$w conf -cursor $oldCursor

46
Dependencies/Python/tcl/tk8.6/demos/vscale.tcl vendored Normal file
View File

@ -0,0 +1,46 @@
# vscale.tcl --
#
# This demonstration script shows an example with a vertical scale.
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
}
package require Tk
set w .vscale
catch {destroy $w}
toplevel $w
wm title $w "Vertical Scale Demonstration"
wm iconname $w "vscale"
positionWindow $w
label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the size of the arrow."
pack $w.msg -side top -padx .5c
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x
frame $w.frame -borderwidth 10
pack $w.frame
scale $w.frame.scale -orient vertical -length 284 -from 0 -to 250 \
-command "setHeight $w.frame.canvas" -tickinterval 50
canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
$w.frame.canvas create polygon 0 0 1 1 2 2 -fill SeaGreen3 -tags poly
$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
frame $w.frame.right -borderwidth 15
pack $w.frame.scale -side left -anchor ne
pack $w.frame.canvas -side left -anchor nw -fill y
$w.frame.scale set 75
proc setHeight {w height} {
incr height 21
set y2 [expr {$height - 30}]
if {$y2 < 21} {
set y2 21
}
$w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
$w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
}

735
Dependencies/Python/tcl/tk8.6/demos/widget vendored Normal file
View File

@ -0,0 +1,735 @@
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}
# widget --
# This script demonstrates the various widgets provided by Tk, along with many
# of the features of the Tk toolkit. This file only contains code to generate
# the main window for the application, which invokes individual
# demonstrations. The code for the actual demonstrations is contained in
# separate ".tcl" files is this directory, which are sourced by this script as
# needed.
package require Tk 8.5-
package require msgcat
destroy {*}[winfo children .]
set tk_demoDirectory [file join [pwd] [file dirname [info script]]]
::msgcat::mcload $tk_demoDirectory
namespace import ::msgcat::mc
wm title . [mc "Widget Demonstration"]
if {[tk windowingsystem] eq "x11"} {
# This won't work everywhere, but there's no other way in core Tk at the
# moment to display a coloured icon.
image create photo TclPowered \
-file [file join $tk_library images logo64.gif]
wm iconwindow . [toplevel ._iconWindow]
pack [label ._iconWindow.i -image TclPowered]
wm iconname . [mc "tkWidgetDemo"]
}
if {"defaultFont" ni [font names]} {
# TIP #145 defines some standard named fonts
if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} {
# FIX ME: the following technique of cloning the font to copy it works
# fine but means that if the system font is changed by Tk
# cannot update the copied font. font alias might be useful
# here -- or fix the app to use TkDefaultFont etc.
font create mainFont {*}[font configure TkDefaultFont]
font create fixedFont {*}[font configure TkFixedFont]
font create boldFont {*}[font configure TkDefaultFont] -weight bold
font create titleFont {*}[font configure TkDefaultFont] -weight bold
font create statusFont {*}[font configure TkDefaultFont]
font create varsFont {*}[font configure TkDefaultFont]
if {[tk windowingsystem] eq "aqua"} {
font configure titleFont -size 17
}
} else {
font create mainFont -family Helvetica -size 12
font create fixedFont -family Courier -size 10
font create boldFont -family Helvetica -size 12 -weight bold
font create titleFont -family Helvetica -size 18 -weight bold
font create statusFont -family Helvetica -size 10
font create varsFont -family Helvetica -size 14
}
}
set widgetDemo 1
set font mainFont
image create photo ::img::refresh -format GIF -data {
R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp
xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR
2tICU0gXBQA7
}
image create photo ::img::view -format GIF -data {
R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA
AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27
yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7
}
image create photo ::img::delete -format GIF -data {
R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy
PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw==
}
image create photo ::img::print -format GIF -data {
R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA
AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ
fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g
ryhH5pgnEQA7
}
# Note that this is run through the message catalog! This is because this is
# actually an image of a word.
image create photo ::img::new -format PNG -data [mc {
iVBORw0KGgoAAAANSUhEUgAAAB4AAAAOCAYAAAA45qw5AAACMElEQVR4AeVTAwxd
QRCc2tZHGtQ2w9q2bdsOa9u2bUW1bdt2Z372JZe6DapJLqtb3h7+T8yKi5j4CsYD
EUQXxETclT7kWOlH2VV+tFkdQHPSwksSISF+BauCqL0qgOcMWgGfgEkaMsHxqUBk
3plE/sOnh/qDPAPJH/CKFBivGHWzFwBRnHhlqbu1Mh6CoFNnC/JshQ9p4YC2lrKt
DCAV+THiVejyhMjAbrNSrroiEfKR9g7ZfCgOog8QfnUQV62wAk68ndQ9ZbyoWO1H
Y6eDY1LCQL6a9ApOp9Hi1T0+gQq2JKMlky/oTKQliKWxEZvyG575kpW4pl1aZnQK
CLOVt45Lkp8uXp2SL8KO6uitNTZLdpK6s+I/eZbhpmsmWeOGOVQNKYLITzpKPAO3
tY7LSNZ7ccSLxX9y3uuOxRkg3dKESMoCHvL+GRVCutXsB3guLgDCeXOv4iWWkvwG
BaS+PmlpK6SI9ApI2oC2UtrwZQEkhkH+NtolVlQXJl1I+QltuU3XEc721bIRFpa8
IA5iqTo6vNNWmkNBLQbPeXwF2g17Q94nTQAfY3YzeY+WSu8MDzQ2kpELUhSGJUHE
0zeR3rY1L+Xl5G/re+jbiK6KhThwwInsts1fbMUUcpZszKeVtggZEiGdZDe5AtHh
7vL4CGiRvvKPS8FAvq9Nr4ZkFadR2y6kggu1z4vlyIbBp6BugQ8JLEg4bTkD9eMZ
QZ8hpJ3VvTtuvbWrY/ElvP/9R+Aj3603+iE3fkEAAAAASUVORK5CYII=
}]
#----------------------------------------------------------------
# The code below creates the main window, consisting of a menu bar and a text
# widget that explains how to use the program, plus lists all of the demos as
# hypertext items.
#----------------------------------------------------------------
menu .menuBar -tearoff 0
# On Aqua, just use the default menu.
if {[tk windowingsystem] ne "aqua"} {
# This is a tk-internal procedure to make i18n easier
::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \
-menu .menuBar.file
menu .menuBar.file -tearoff 0
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
-command {tkAboutDialog} -accelerator [mc "<F1>"]
bind . <F1> {tkAboutDialog}
.menuBar.file add sep
if {[string match win* [tk windowingsystem]]} {
# Windows doesn't usually have a Meta key
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
-command {exit} -accelerator [mc "Ctrl+Q"]
bind . <[mc "Control-q"]> {exit}
} else {
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
-command {exit} -accelerator [mc "Meta-Q"]
bind . <[mc "Meta-q"]> {exit}
}
. configure -menu .menuBar
}
ttk::frame .statusBar
ttk::label .statusBar.lab -text " " -anchor w
if {[tk windowingsystem] eq "aqua"} {
ttk::separator .statusBar.sep
pack .statusBar.sep -side top -expand yes -fill x -pady 0
}
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
if {[tk windowingsystem] ne "aqua"} {
ttk::sizegrip .statusBar.foo
pack .statusBar.foo -side left -padx 2
}
pack .statusBar -side bottom -fill x -pady 2
set textheight 30
catch {
set textheight [expr {
([winfo screenheight .] * 0.7) /
[font metrics mainFont -displayof . -linespace]
}]
}
ttk::frame .textFrame
ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1
pack .s -in .textFrame -side right -fill y
text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \
-font mainFont -setgrid 1 -highlightthickness 0 \
-padx 4 -pady 2 -takefocus 0
pack .t -in .textFrame -expand y -fill both -padx 1
pack .textFrame -expand yes -fill both
if {[tk windowingsystem] eq "aqua"} {
pack configure .statusBar.lab -padx {10 18} -pady {4 6}
pack configure .statusBar -pady 0
.t configure -padx 10 -pady 0
}
# Create a bunch of tags to use in the text widget, such as those for section
# titles and demo descriptions. Also define the bindings for tags.
.t tag configure title -font titleFont
.t tag configure subtitle -font titleFont
.t tag configure bold -font boldFont
if {[tk windowingsystem] eq "aqua"} {
.t tag configure title -spacing1 8
.t tag configure subtitle -spacing3 3
}
# We put some "space" characters to the left and right of each demo
# description so that the descriptions are highlighted only when the mouse
# cursor is right over them (but not when the cursor is to their left or
# right).
#
.t tag configure demospace -lmargin1 1c -lmargin2 1c
if {[winfo depth .] == 1} {
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-underline 1
.t tag configure visited -lmargin1 1c -lmargin2 1c \
-underline 1
.t tag configure hot -background black -foreground white
} else {
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-foreground blue -underline 1
.t tag configure visited -lmargin1 1c -lmargin2 1c \
-foreground #303080 -underline 1
if {[tk windowingsystem] eq "aqua"} {
.t tag configure demo -foreground systemLinkColor
.t tag configure visited -foreground purple
}
.t tag configure hot -foreground red -underline 1
}
.t tag bind demo <ButtonRelease-1> {
invoke [.t index {@%x,%y}]
}
set lastLine ""
.t tag bind demo <Enter> {
set lastLine [.t index {@%x,%y linestart}]
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
.t config -cursor [::ttk::cursor link]
showStatus [.t index {@%x,%y}]
}
.t tag bind demo <Leave> {
.t tag remove hot 1.0 end
.t config -cursor [::ttk::cursor text]
.statusBar.lab config -text ""
}
.t tag bind demo <Motion> {
set newLine [.t index {@%x,%y linestart}]
if {$newLine ne $lastLine} {
.t tag remove hot 1.0 end
set lastLine $newLine
set tags [.t tag names {@%x,%y}]
set i [lsearch -glob $tags demo-*]
if {$i >= 0} {
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
}
}
showStatus [.t index {@%x,%y}]
}
##############################################################################
# Create the text for the text widget.
# addFormattedText --
#
# Add formatted text (but not hypertext) to the text widget after first
# passing it through the message catalog to allow for localization.
# Lines starting with @@ are formatting directives (insert title, insert
# demo hyperlink, begin newline, or change style) and all other lines
# are literal strings to be inserted. Substitutions are performed,
# allowing processing pieces through the message catalog. Blank lines
# are ignored.
#
proc addFormattedText {formattedText} {
set style normal
set isNL 1
set demoCount 0
set new 0
foreach line [split $formattedText \n] {
set line [string trim $line]
if {$line eq ""} {
continue
}
if {[string match @@* $line]} {
set data [string range $line 2 end]
set key [lindex $data 0]
set values [lrange $data 1 end]
switch -exact -- $key {
title {
.t insert end [mc $values]\n title \n normal
}
newline {
.t insert end \n $style
set isNL 1
}
subtitle {
.t insert end "\n" {} [mc $values] subtitle \
" \n " demospace
set demoCount 0
}
demo {
set description [lassign $values name]
.t insert end "[incr demoCount]. [mc $description]" \
[list demo demo-$name]
if {$new} {
.t image create end -image ::img::new -padx 5
set new 0
}
.t insert end " \n " demospace
}
new {
set new 1
}
default {
set style $key
}
}
continue
}
if {!$isNL} {
.t insert end " " $style
}
set isNL 0
.t insert end [mc $line] $style
}
}
addFormattedText {
@@title Tk Widget Demonstrations
This application provides a front end for several short scripts
that demonstrate what you can do with Tk widgets. Each of the
numbered lines below describes a demonstration; you can click on
it to invoke the demonstration. Once the demonstration window
appears, you can click the
@@bold
See Code
@@normal
button to see the Tcl/Tk code that created the demonstration. If
you wish, you can edit the code and click the
@@bold
Rerun Demo
@@normal
button in the code window to reinvoke the demonstration with the
modified code.
@@newline
@@subtitle Labels, buttons, checkbuttons, and radiobuttons
@@demo label Labels (text and bitmaps)
@@demo unicodeout Labels and UNICODE text
@@demo button Buttons
@@demo check Check-buttons (select any of a group)
@@demo radio Radio-buttons (select one of a group)
@@demo puzzle A 15-puzzle game made out of buttons
@@demo icon Iconic buttons that use bitmaps
@@demo image1 Two labels displaying images
@@demo image2 A simple user interface for viewing images
@@demo labelframe Labelled frames
@@demo ttkbut The simple Themed Tk widgets
@@subtitle Listboxes and Trees
@@demo states The 50 states
@@demo colors Colors: change the color scheme for the application
@@demo sayings A collection of famous and infamous sayings
@@demo mclist A multi-column list of countries
@@demo tree A directory browser tree
@@subtitle Entries, Spin-boxes and Combo-boxes
@@demo entry1 Entries without scrollbars
@@demo entry2 Entries with scrollbars
@@demo entry3 Validated entries and password fields
@@demo spin Spin-boxes
@@demo ttkspin Themed spin-boxes
@@demo combo Combo-boxes
@@demo form Simple Rolodex-like form
@@subtitle Text
@@demo text Basic editable text
@@demo style Text display styles
@@demo bind Hypertext (tag bindings)
@@demo twind A text widget with embedded windows and other features
@@demo search A search tool built with a text widget
@@demo textpeer Peering text widgets
@@subtitle Canvases
@@demo items The canvas item types
@@demo plot A simple 2-D plot
@@demo ctext Text items in canvases
@@demo arrow An editor for arrowheads on canvas lines
@@demo ruler A ruler with adjustable tab stops
@@demo floor A building floor plan
@@demo cscroll A simple scrollable canvas
@@demo knightstour A Knight's tour of the chess board
@@subtitle Scales and Progress Bars
@@demo hscale Horizontal scale
@@demo vscale Vertical scale
@@new
@@demo ttkscale Themed scale linked to a label with traces
@@demo ttkprogress Progress bar
@@subtitle Paned Windows and Notebooks
@@demo paned1 Horizontal paned window
@@demo paned2 Vertical paned window
@@demo ttkpane Themed nested panes
@@demo ttknote Notebook widget
@@subtitle Menus and Toolbars
@@demo menu Menus and cascades (sub-menus)
@@demo menubu Menu-buttons
@@demo ttkmenu Themed menu buttons
@@demo toolbar Themed toolbar
@@subtitle Common Dialogs
@@demo msgbox Message boxes
@@demo filebox File selection dialog
@@demo clrpick Color picker
@@demo fontchoose Font selection dialog
@@subtitle Animation
@@demo anilabel Animated labels
@@demo aniwave Animated wave
@@demo pendulum Pendulum simulation
@@demo goldberg A celebration of Rube Goldberg
@@subtitle Miscellaneous
@@demo bitmap The built-in bitmaps
@@demo dialog1 A dialog box with a local grab
@@demo dialog2 A dialog box with a global grab
}
##############################################################################
.t configure -state disabled
focus .s
# addSeeDismiss --
# Add "See Code" and "Dismiss" button frame, with optional "See Vars"
#
# Arguments:
# w - The name of the frame to use.
proc addSeeDismiss {w show {vars {}} {extra {}}} {
## See Code / Dismiss buttons
ttk::frame $w
ttk::separator $w.sep
#ttk::frame $w.sep -height 2 -relief sunken
grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2
ttk::button $w.dismiss -text [mc "Dismiss"] \
-image ::img::delete -compound left \
-command [list destroy [winfo toplevel $w]]
ttk::button $w.code -text [mc "See Code"] \
-image ::img::view -compound left \
-command [list showCode $show]
set buttons [list x $w.code $w.dismiss]
if {[llength $vars]} {
ttk::button $w.vars -text [mc "See Variables"] \
-image ::img::view -compound left \
-command [concat [list showVars $w.dialog] $vars]
set buttons [linsert $buttons 1 $w.vars]
}
if {$extra ne ""} {
set buttons [linsert $buttons 1 [uplevel 1 $extra]]
}
grid {*}$buttons -padx 4 -pady 4
grid columnconfigure $w 0 -weight 1
if {[tk windowingsystem] eq "aqua"} {
foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
grid configure $w.sep -pady 0
grid configure {*}$buttons -pady {10 12}
grid configure [lindex $buttons 1] -padx {16 4}
grid configure [lindex $buttons end] -padx {4 18}
}
return $w
}
# positionWindow --
# This procedure is invoked by most of the demos to position a new demo
# window.
#
# Arguments:
# w - The name of the window to position.
proc positionWindow w {
wm geometry $w +300+300
}
# showVars --
# Displays the values of one or more variables in a window, and updates the
# display whenever any of the variables changes.
#
# Arguments:
# w - Name of new window to create for display.
# args - Any number of names of variables.
proc showVars {w args} {
catch {destroy $w}
toplevel $w
if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
wm title $w [mc "Variable values"]
set b [ttk::frame $w.frame]
grid $b -sticky news
set f [ttk::labelframe $b.title -text [mc "Variable values:"]]
foreach var $args {
ttk::label $f.n$var -text "$var:" -anchor w
ttk::label $f.v$var -textvariable $var -anchor w
grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w
}
ttk::button $b.ok -text [mc "OK"] \
-command [list destroy $w] -default active
bind $w <Return> [list $b.ok invoke]
bind $w <Escape> [list $b.ok invoke]
grid $f -sticky news -padx 4
grid $b.ok -sticky e -padx 4 -pady {6 4}
if {[tk windowingsystem] eq "aqua"} {
$b.ok configure -takefocus 0
grid configure $b.ok -pady {10 12} -padx {16 18}
grid configure $f -padx 10 -pady {10 0}
}
grid columnconfig $f 1 -weight 1
grid rowconfigure $f 100 -weight 1
grid columnconfig $b 0 -weight 1
grid rowconfigure $b 0 -weight 1
grid columnconfig $w 0 -weight 1
grid rowconfigure $w 0 -weight 1
}
# invoke --
# This procedure is called when the user clicks on a demo description. It is
# responsible for invoking the demonstration.
#
# Arguments:
# index - The index of the character that the user clicked on.
proc invoke index {
global tk_demoDirectory
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
if {$i < 0} {
return
}
set cursor [.t cget -cursor]
.t configure -cursor [::ttk::cursor busy]
update
set demo [string range [lindex $tags $i] 5 end]
uplevel 1 [list source -encoding utf-8 [file join $tk_demoDirectory $demo.tcl]]
update
.t configure -cursor $cursor
.t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
}
# showStatus --
#
# Show the name of the demo program in the status bar. This procedure is
# called when the user moves the cursor over a demo description.
#
proc showStatus index {
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
set cursor [.t cget -cursor]
if {$i < 0} {
.statusBar.lab config -text " "
set newcursor [::ttk::cursor text]
} else {
set demo [string range [lindex $tags $i] 5 end]
.statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
set newcursor [::ttk::cursor link]
}
if {$cursor ne $newcursor} {
.t config -cursor $newcursor
}
}
# evalShowCode --
#
# Arguments:
# w - Name of text widget containing code to eval
proc evalShowCode {w} {
set code [$w get 1.0 end-1c]
uplevel #0 $code
}
# showCode --
# This procedure creates a toplevel window that displays the code for a
# demonstration and allows it to be edited and reinvoked.
#
# Arguments:
# w - The name of the demonstration's window, which can be used to
# derive the name of the file containing its code.
proc showCode w {
global tk_demoDirectory
set file [string range $w 1 end].tcl
set top .code
if {![winfo exists $top]} {
toplevel $top
if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog}
set t [frame $top.f]
set text [text $t.text -font fixedFont -height 24 -wrap word \
-xscrollcommand [list $t.xscroll set] \
-yscrollcommand [list $t.yscroll set] \
-setgrid 1 -highlightthickness 0 -pady 2 -padx 3]
ttk::scrollbar $t.xscroll -command [list $t.text xview] \
-orient horizontal
ttk::scrollbar $t.yscroll -command [list $t.text yview] \
-orient vertical
grid $t.text $t.yscroll -sticky news
#grid $t.xscroll
grid rowconfigure $t 0 -weight 1
grid columnconfig $t 0 -weight 1
set btns [ttk::frame $top.btns]
ttk::separator $btns.sep
grid $btns.sep -columnspan 4 -row 0 -sticky ew -pady 2
ttk::button $btns.dismiss -text [mc "Dismiss"] \
-default active -command [list destroy $top] \
-image ::img::delete -compound left
ttk::button $btns.print -text [mc "Print Code"] \
-command [list printCode $text $file] \
-image ::img::print -compound left
ttk::button $btns.rerun -text [mc "Rerun Demo"] \
-command [list evalShowCode $text] \
-image ::img::refresh -compound left
set buttons [list x $btns.rerun $btns.print $btns.dismiss]
grid {*}$buttons -padx 4 -pady 4
grid columnconfigure $btns 0 -weight 1
if {[tk windowingsystem] eq "aqua"} {
foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
grid configure $btns.sep -pady 0
grid configure {*}$buttons -pady {10 12}
grid configure [lindex $buttons 1] -padx {16 4}
grid configure [lindex $buttons end] -padx {4 18}
}
grid $t -sticky news
grid $btns -sticky ew
grid rowconfigure $top 0 -weight 1
grid columnconfig $top 0 -weight 1
bind $top <Return> {
if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke }
}
bind $top <Escape> [bind $top <Return>]
} else {
wm deiconify $top
raise $top
}
wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]]
wm iconname $top $file
set id [open [file join $tk_demoDirectory $file]]
fconfigure $id -encoding utf-8 -eofchar "\032 {}"
$top.f.text delete 1.0 end
$top.f.text insert 1.0 [read $id]
$top.f.text mark set insert 1.0
close $id
}
# printCode --
# Prints the source code currently displayed in the See Code dialog. Much
# thanks to Arjen Markus for this.
#
# Arguments:
# w - Name of text widget containing code to print
# file - Name of the original file (implicitly for title)
proc printCode {w file} {
set code [$w get 1.0 end-1c]
set dir "."
if {[info exists ::env(HOME)]} {
set dir "$::env(HOME)"
}
if {[info exists ::env(TMP)]} {
set dir $::env(TMP)
}
if {[info exists ::env(TEMP)]} {
set dir $::env(TEMP)
}
set filename [file join $dir "tkdemo-$file"]
set outfile [open $filename "w"]
puts $outfile $code
close $outfile
switch -- $::tcl_platform(platform) {
unix {
if {[catch {exec lp -c $filename} msg]} {
tk_messageBox -title "Print spooling failure" \
-message "Print spooling probably failed: $msg"
}
}
windows {
if {[catch {PrintTextWin32 $filename} msg]} {
tk_messageBox -title "Print spooling failure" \
-message "Print spooling probably failed: $msg"
}
}
default {
tk_messageBox -title "Operation not Implemented" \
-message "Wow! Unknown platform: $::tcl_platform(platform)"
}
}
#
# Be careful to throw away the temporary file in a gentle manner ...
#
if {[file exists $filename]} {
catch {file delete $filename}
}
}
# PrintTextWin32 --
# Print a file under Windows using all the "intelligence" necessary
#
# Arguments:
# filename - Name of the file
#
# Note:
# Taken from the Wiki page by Keith Vetter, "Printing text files under
# Windows".
# Note:
# Do not execute the command in the background: that way we can dispose of the
# file smoothly.
#
proc PrintTextWin32 {filename} {
package require registry
set app [auto_execok notepad.exe]
set pcmd "$app /p %1"
catch {
set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
set pcmd [registry get \
{HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
}
regsub -all {%1} $pcmd $filename pcmd
puts $pcmd
regsub -all {\\} $pcmd {\\\\} pcmd
set command "[auto_execok start] /min $pcmd"
eval exec $command
}
# tkAboutDialog --
#
# Pops up a message box with an "about" message
#
proc tkAboutDialog {} {
tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
-message [mc "Tk widget demonstration application"] -detail \
"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}]
[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}]
[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}]
[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]"
}
# Local Variables:
# mode: tcl
# End:

175
Dependencies/Python/tcl/tk8.6/dialog.tcl vendored Normal file
View File

@ -0,0 +1,175 @@
# 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]
# 1. Create the top-level window and divide it into top
# and bottom parts.
destroy $w
toplevel $w -class Dialog
wm title $w $title
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW { }
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
#
if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
wm transient $w [winfo toplevel [winfo parent $w]]
}
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
} elseif {$windowingsystem eq "x11"} {
wm attributes $w -type dialog
}
frame $w.bot
frame $w.top
if {$windowingsystem eq "x11"} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
pack $w.bot -side bottom -fill both
pack $w.top -side top -fill both -expand 1
grid anchor $w.bot center
# 2. Fill the top part with bitmap and message (use the option
# database for -wraplength and -font so that they can be
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
option add *Dialog.msg.font TkCaptionFont widgetDefault
label $w.msg -justify left -text $text
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
if {$bitmap ne ""} {
if {$windowingsystem eq "aqua" && $bitmap eq "error"} {
set bitmap "stop"
}
label $w.bitmap -bitmap $bitmap
pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
}
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach but $args {
button $w.button$i -text $but -command [list set ::tk::Priv(button) $i]
if {$i == $default} {
$w.button$i configure -default active
} else {
$w.button$i configure -default normal
}
grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \
-padx 10 -pady 4
grid columnconfigure $w.bot $i
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
set tmp [string tolower $but]
if {$tmp eq "ok" || $tmp eq "cancel"} {
grid columnconfigure $w.bot $i -minsize 90
}
grid configure $w.button$i -pady 7
}
incr i
}
# 4. Create a binding for <Return> on the dialog if there is a
# default button.
# Convention also dictates that if the keyboard focus moves among the
# the buttons that the <Return> binding affects the button with the focus.
if {$default >= 0} {
bind $w <Return> [list $w.button$default invoke]
}
bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}]
bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}]
# 5. Create a <Destroy> binding for the window that sets the
# button variable to -1; this is needed in case something happens
# that destroys the window, such as its parent window being destroyed.
bind $w <Destroy> {set ::tk::Priv(button) -1}
# 6. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display (Motif style) and de-iconify it.
::tk::PlaceWindow $w
tkwait visibility $w
# 7. Set a grab and claim the focus too.
if {$default >= 0} {
set focus $w.button$default
} else {
set focus $w
}
tk::SetFocusGrab $w $focus
# 8. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(button)
catch {
# It's possible that the window has already been destroyed,
# hence this "catch". Delete the Destroy handler so that
# Priv(button) doesn't get reset by it.
bind $w <Destroy> {}
}
tk::RestoreFocusGrab $w $focus
return $Priv(button)
}

699
Dependencies/Python/tcl/tk8.6/entry.tcl vendored Normal file
View File

@ -0,0 +1,699 @@
# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# Elements of tk::Priv that are used in this file:
#
# afterId - If non-null, it means that auto-scanning is underway
# and it gives the "after" id for the next auto-scan
# command to be executed.
# mouseMoved - Non-zero means the mouse has moved a significant
# amount since the button went down (so, for example,
# start dragging out a selection).
# pressX - X-coordinate at which the mouse button was pressed.
# selectMode - The style of selection currently underway:
# char, word, or line.
# x, y - Last known mouse coordinates for scanning
# and auto-scanning.
# data - Used for Cut and Copy
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
bind Entry <<Cut>> {
if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
%W delete sel.first sel.last
unset tk::Priv(data)
}
}
bind Entry <<Copy>> {
if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tk::Priv(data)
unset tk::Priv(data)
}
}
bind Entry <<Paste>> {
catch {
if {[tk windowingsystem] ne "x11"} {
catch {
%W delete sel.first sel.last
}
}
%W insert insert [::tk::GetSelection %W CLIPBOARD]
tk::EntrySeeInsert %W
}
}
bind Entry <<Clear>> {
# ignore if there is no selection
catch {%W delete sel.first sel.last}
}
bind Entry <<PasteSelection>> {
if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
|| !$tk::Priv(mouseMoved)} {
tk::EntryPaste %W %x
}
}
bind Entry <<TraverseIn>> {
%W selection range 0 end
%W icursor end
}
# Standard Motif bindings:
bind Entry <Button-1> {
tk::EntryButton1 %W %x
%W selection clear
}
bind Entry <B1-Motion> {
set tk::Priv(x) %x
tk::EntryMouseSelect %W %x
}
bind Entry <Double-Button-1> {
set tk::Priv(selectMode) word
tk::EntryMouseSelect %W %x
catch {%W icursor sel.last}
}
bind Entry <Triple-Button-1> {
set tk::Priv(selectMode) line
tk::EntryMouseSelect %W %x
catch {%W icursor sel.last}
}
bind Entry <Shift-Button-1> {
set tk::Priv(selectMode) char
%W selection adjust @%x
}
bind Entry <Double-Shift-Button-1> {
set tk::Priv(selectMode) word
tk::EntryMouseSelect %W %x
}
bind Entry <Triple-Shift-Button-1> {
set tk::Priv(selectMode) line
tk::EntryMouseSelect %W %x
}
bind Entry <B1-Leave> {
set tk::Priv(x) %x
tk::EntryAutoScan %W
}
bind Entry <B1-Enter> {
tk::CancelRepeat
}
bind Entry <ButtonRelease-1> {
tk::CancelRepeat
}
bind Entry <Control-Button-1> {
%W icursor @%x
}
bind Entry <<PrevChar>> {
tk::EntrySetCursor %W [expr {[%W index insert]-1}]
}
bind Entry <<NextChar>> {
tk::EntrySetCursor %W [expr {[%W index insert]+1}]
}
bind Entry <<SelectPrevChar>> {
tk::EntryKeySelect %W [expr {[%W index insert]-1}]
tk::EntrySeeInsert %W
}
bind Entry <<SelectNextChar>> {
tk::EntryKeySelect %W [expr {[%W index insert]+1}]
tk::EntrySeeInsert %W
}
bind Entry <<PrevWord>> {
tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
}
bind Entry <<NextWord>> {
tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
}
bind Entry <<SelectPrevWord>> {
tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
tk::EntrySeeInsert %W
}
bind Entry <<SelectNextWord>> {
tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
tk::EntrySeeInsert %W
}
bind Entry <<LineStart>> {
tk::EntrySetCursor %W 0
}
bind Entry <<SelectLineStart>> {
tk::EntryKeySelect %W 0
tk::EntrySeeInsert %W
}
bind Entry <<LineEnd>> {
tk::EntrySetCursor %W end
}
bind Entry <<SelectLineEnd>> {
tk::EntryKeySelect %W end
tk::EntrySeeInsert %W
}
bind Entry <Delete> {
if {[%W selection present]} {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind Entry <BackSpace> {
tk::EntryBackspace %W
}
bind Entry <Control-space> {
%W selection from insert
}
bind Entry <Select> {
%W selection from insert
}
bind Entry <Control-Shift-space> {
%W selection adjust insert
}
bind Entry <Shift-Select> {
%W selection adjust insert
}
bind Entry <<SelectAll>> {
%W selection range 0 end
}
bind Entry <<SelectNone>> {
%W selection clear
}
bind Entry <Key> {
tk::CancelRepeat
tk::EntryInsert %W %A
}
# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, if a widget binding for one of these is defined, the
# <Key> class binding will also fire and insert the character,
# which is wrong. Ditto for Escape, Return, and Tab.
bind Entry <Alt-Key> {# nothing}
bind Entry <Meta-Key> {# nothing}
bind Entry <Control-Key> {# nothing}
bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
bind Entry <Prior> {# nothing}
bind Entry <Next> {# nothing}
if {[tk windowingsystem] eq "aqua"} {
bind Entry <Command-Key> {# nothing}
bind Entry <Mod4-Key> {# nothing}
}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind Entry <<NextLine>> {# nothing}
bind Entry <<PrevLine>> {# nothing}
# On Windows, paste is done using Shift-Insert. Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[tk windowingsystem] ne "win32"} {
bind Entry <Insert> {
catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
}
}
# Additional emacs-like bindings:
bind Entry <Control-d> {
if {!$tk_strictMotif} {
%W delete insert
}
}
bind Entry <Control-h> {
if {!$tk_strictMotif} {
tk::EntryBackspace %W
}
}
bind Entry <Control-k> {
if {!$tk_strictMotif} {
%W delete insert end
}
}
bind Entry <Control-t> {
if {!$tk_strictMotif} {
tk::EntryTranspose %W
}
}
bind Entry <Meta-b> {
if {!$tk_strictMotif} {
tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
}
}
bind Entry <Meta-d> {
if {!$tk_strictMotif} {
%W delete insert [tk::EntryNextWord %W insert]
}
}
bind Entry <Meta-f> {
if {!$tk_strictMotif} {
tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
}
}
bind Entry <Meta-BackSpace> {
if {!$tk_strictMotif} {
%W delete [tk::EntryPreviousWord %W insert] insert
}
}
bind Entry <Meta-Delete> {
if {!$tk_strictMotif} {
%W delete [tk::EntryPreviousWord %W insert] insert
}
}
# Bindings for IME text input and accents.
bind Entry <<TkStartIMEMarkedText>> {
dict set ::tk::Priv(IMETextMark) "%W" [%W index insert]
}
bind Entry <<TkEndIMEMarkedText>> {
if {[catch {dict get $::tk::Priv(IMETextMark) "%W"} mark]} {
bell
} else {
%W selection range $mark insert
}
}
bind Entry <<TkClearIMEMarkedText>> {
%W delete [dict get $::tk::Priv(IMETextMark) "%W"] [%W index insert]
}
bind Entry <<TkAccentBackspace>> {
tk::EntryBackspace %W
}
# A few additional bindings of my own.
if {[tk windowingsystem] ne "aqua"} {
bind Entry <Button-2> {
if {!$tk_strictMotif} {
::tk::EntryScanMark %W %x
}
}
bind Entry <B2-Motion> {
if {!$tk_strictMotif} {
::tk::EntryScanDrag %W %x
}
}
} else {
bind Entry <Button-3> {
if {!$tk_strictMotif} {
::tk::EntryScanMark %W %x
}
}
bind Entry <B3-Motion> {
if {!$tk_strictMotif} {
::tk::EntryScanDrag %W %x
}
}
}
# ::tk::EntryClosestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
# of the character just after the boundary.
#
# Arguments:
# w - The entry window.
# x - X-coordinate within the window.
proc ::tk::EntryClosestGap {w x} {
set pos [$w index @$x]
set bbox [$w bbox $pos]
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
return $pos
}
incr pos
}
# ::tk::EntryButton1 --
# This procedure is invoked to handle button-1 presses in entry
# widgets. It moves the insertion cursor, sets the selection anchor,
# and claims the input focus.
#
# Arguments:
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the button press.
proc ::tk::EntryButton1 {w x} {
variable ::tk::Priv
set Priv(selectMode) char
set Priv(mouseMoved) 0
set Priv(pressX) $x
$w icursor [EntryClosestGap $w $x]
$w selection from insert
if {"disabled" ne [$w cget -state]} {
focus $w
}
}
# ::tk::EntryMouseSelect --
# This procedure is invoked when dragging out a selection with
# the mouse. Depending on the selection mode (character, word,
# line) it selects in different-sized units. This procedure
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the mouse.
proc ::tk::EntryMouseSelect {w x} {
variable ::tk::Priv
set cur [EntryClosestGap $w $x]
set anchor [$w index anchor]
if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
set Priv(mouseMoved) 1
}
switch $Priv(selectMode) {
char {
if {$Priv(mouseMoved)} {
if {$cur < $anchor} {
$w selection range $cur $anchor
} elseif {$cur > $anchor} {
$w selection range $anchor $cur
} else {
$w selection clear
}
}
}
word {
if {$cur < $anchor} {
set before [tcl_wordBreakBefore [$w get] $cur]
set after [tcl_wordBreakAfter [$w get] $anchor-1]
} elseif {$cur > $anchor} {
set before [tcl_wordBreakBefore [$w get] $anchor]
set after [tcl_wordBreakAfter [$w get] $cur-1]
} else {
if {[$w index @$Priv(pressX)] < $anchor} {
incr anchor -1
}
set before [tcl_wordBreakBefore [$w get] $anchor]
set after [tcl_wordBreakAfter [$w get] $anchor]
}
if {$before < 0} {
set before 0
}
if {$after < 0} {
set after end
}
$w selection range $before $after
}
line {
$w selection range 0 end
}
}
if {$Priv(mouseMoved)} {
$w icursor $cur
}
update idletasks
}
# ::tk::EntryPaste --
# This procedure sets the insertion cursor to the current mouse position,
# pastes the selection there, and sets the focus to the window.
#
# Arguments:
# w - The entry window.
# x - X position of the mouse.
proc ::tk::EntryPaste {w x} {
$w icursor [EntryClosestGap $w $x]
catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
if {"disabled" ne [$w cget -state]} {
focus $w
}
}
# ::tk::EntryAutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down. It scrolls the window left or right,
# depending on where the mouse is, and reschedules itself as an
# "after" command so that the window continues to scroll until the
# mouse moves back into the window or the mouse button is released.
#
# Arguments:
# w - The entry window.
proc ::tk::EntryAutoScan {w} {
variable ::tk::Priv
set x $Priv(x)
if {![winfo exists $w]} {
return
}
if {$x >= [winfo width $w]} {
$w xview scroll 2 units
EntryMouseSelect $w $x
} elseif {$x < 0} {
$w xview scroll -2 units
EntryMouseSelect $w $x
}
set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
}
# ::tk::EntryKeySelect --
# This procedure is invoked when stroking out selections using the
# keyboard. It moves the cursor to a new position, then extends
# the selection to that position.
#
# Arguments:
# w - The entry window.
# new - A new position for the insertion cursor (the cursor hasn't
# actually been moved to this position yet).
proc ::tk::EntryKeySelect {w new} {
if {![$w selection present]} {
$w selection from insert
$w selection to $new
} else {
$w selection adjust $new
}
$w icursor $new
}
# ::tk::EntryInsert --
# Insert a string into an entry at the point of the insertion cursor.
# If there is a selection in the entry, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w - The entry window in which to insert the string
# s - The string to insert (usually just a single character)
proc ::tk::EntryInsert {w s} {
if {$s eq ""} {
return
}
catch {
set insert [$w index insert]
if {([$w index sel.first] <= $insert)
&& ([$w index sel.last] >= $insert)} {
$w delete sel.first sel.last
}
}
$w insert insert $s
EntrySeeInsert $w
}
# ::tk::EntryBackspace --
# Backspace over the character just before the insertion cursor.
# If backspacing would move the cursor off the left edge of the
# window, reposition the cursor at about the middle of the window.
#
# Arguments:
# w - The entry window in which to backspace.
proc ::tk::EntryBackspace w {
if {[$w selection present]} {
$w delete sel.first sel.last
} else {
set x [$w index insert]
if {$x > 0} {
$w delete [expr {$x-1}]
}
if {[$w index @0] >= [$w index insert]} {
set range [$w xview]
set left [lindex $range 0]
set right [lindex $range 1]
$w xview moveto [expr {$left - ($right - $left)/2.0}]
}
}
}
# ::tk::EntrySeeInsert --
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.
#
# Arguments:
# w - The entry window.
proc ::tk::EntrySeeInsert w {
set c [$w index insert]
if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
$w xview $c
}
}
# ::tk::EntrySetCursor -
# Move the insertion cursor to a given position in an entry. Also
# clears the selection, if there is one in the entry, and makes sure
# that the insertion cursor is visible.
#
# Arguments:
# w - The entry window.
# pos - The desired new position for the cursor in the window.
proc ::tk::EntrySetCursor {w pos} {
$w icursor $pos
$w selection clear
EntrySeeInsert $w
}
# ::tk::EntryTranspose -
# This procedure implements the "transpose" function for entry widgets.
# It tranposes the characters on either side of the insertion cursor,
# unless the cursor is at the end of the line. In this case it
# transposes the two characters to the left of the cursor. In either
# case, the cursor ends up to the right of the transposed characters.
#
# Arguments:
# w - The entry window.
proc ::tk::EntryTranspose w {
set i [$w index insert]
if {$i < [$w index end]} {
incr i
}
if {$i < 2} {
return
}
set first [expr {$i-2}]
set data [$w get]
set new [string index $data $i-1][string index $data $first]
$w delete $first $i
$w insert insert $new
EntrySeeInsert $w
}
# ::tk::EntryNextWord --
# Returns the index of the next word position after a given position in the
# entry. The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
if {[tk windowingsystem] eq "win32"} {
proc ::tk::EntryNextWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return end
}
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0} {
set pos [tcl_startOfNextWord [$w get] $pos]
}
if {$pos < 0} {
return end
}
return $pos
}
} else {
proc ::tk::EntryNextWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return end
}
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos < 0} {
return end
}
return $pos
}
}
# ::tk::EntryPreviousWord --
#
# Returns the index of the previous word position before a given
# position in the entry.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
proc ::tk::EntryPreviousWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return 0
}
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0
}
return $pos
}
# ::tk::EntryScanMark --
#
# Marks the start of a possible scan drag operation
#
# Arguments:
# w - The entry window from which the text to get
# x - x location on screen
proc ::tk::EntryScanMark {w x} {
$w scan mark $x
set ::tk::Priv(x) $x
set ::tk::Priv(y) 0 ; # not used
set ::tk::Priv(mouseMoved) 0
}
# ::tk::EntryScanDrag --
#
# Marks the start of a possible scan drag operation
#
# Arguments:
# w - The entry window from which the text to get
# x - x location on screen
proc ::tk::EntryScanDrag {w x} {
# Make sure these exist, as some weird situations can trigger the
# motion binding without the initial press. [Bug #220269]
if {![info exists ::tk::Priv(x)]} {set ::tk::Priv(x) $x}
# allow for a delta
if {abs($x-$::tk::Priv(x)) > 2} {
set ::tk::Priv(mouseMoved) 1
}
$w scan dragto $x
}
# ::tk::EntryGetSelection --
#
# Returns the selected text of the entry with respect to the -show option.
#
# Arguments:
# w - The entry window from which the text to get
proc ::tk::EntryGetSelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
[$w index sel.last]-1]
if {[$w cget -show] ne ""} {
return [string repeat [string index [$w cget -show] 0] \
[string length $entryString]]
}
return $entryString
}

178
Dependencies/Python/tcl/tk8.6/focus.tcl vendored Normal file
View File

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

515
Dependencies/Python/tcl/tk8.6/fontchooser.tcl vendored Normal file
View File

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

715
Dependencies/Python/tcl/tk8.6/iconlist.tcl vendored Normal file
View File

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

153
Dependencies/Python/tcl/tk8.6/icons.tcl vendored Normal file
View File

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

7
Dependencies/Python/tcl/tk8.6/images/README vendored Normal file
View File

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

2091
Dependencies/Python/tcl/tk8.6/images/logo.eps vendored Normal file
View File

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More