When I try to execute any simple TCL script these lines always appear on the terminal screen
tclParseConfigSpec $w $specs "" $args
if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
if {[string equal $tcl_platform(platform) "macintosh"]} {
switch -- $data(-icon) {
"error" {set data(-icon) "stop"}
"warning" {set data(-icon) "caution"}
"info" {set data(-icon) "note"}
}
}
if {![winfo exists $data(-parent)]} {
error "bad window path name \"$data(-parent)\""
}
switch -- $data(-type) {
abortretryignore {
set buttons {
{abort -width 6 -text Abort -under 0}
{retry -width 6 -text Retry -under 0}
{ignore -width 6 -text Ignore -under 0}
}
}
ok {
set buttons {
{ok -width 6 -text OK -under 0}
}
if {[string equal $data(-default) ""]} {
set data(-default) "ok"
}
}
okcancel {
set buttons {
{ok -width 6 -text OK -under 0}
{cancel -width 6 -text Cancel -under 0}
}
}
retrycancel {
set buttons {
{retry -width 6 -text Retry -under 0}
{cancel -width 6 -text Cancel -under 0}
}
}
yesno {
set buttons {
{yes -width 6 -text Yes -under 0}
{no -width 6 -text No -under 0}
}
}
yesnocancel {
set buttons {
{yes -width 6 -text Yes -under 0}
{no -width 6 -text No -under 0}
{cancel -width 6 -text Cancel -under 0}
}
}
default {
error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
}
}
if {[string compare $data(-default) ""]} {
set valid 0
foreach btn $buttons {
if {[string equal [lindex $btn 0] $data(-default)]} {
set valid 1
break
}
}
if {!$valid} {
error "invalid default button \"$data(-default)\""
}
}
if {[string compare $data(-parent) .]} {
set w $data(-parent).__tk__messagebox
} else {
set w .__tk__messagebox
}
catch {destroy $w}
toplevel $w -class Dialog
wm title $w $data(-title)
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW { }
if { [winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
}
if {[string equal $tcl_platform(platform) "macintosh"]} {
unsupported1 style $w dBoxProc
}
frame $w.bot
pack $w.bot -side bottom -fill both
frame $w.top
pack $w.top -side top -fill both -expand 1
if {[string compare $tcl_platform(platform) "macintosh"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
option add *Dialog.msg.wrapLength 3i widgetDefault
if {[string equal $tcl_platform(platform) "macintosh"]} {
option add *Dialog.msg.font system widgetDefault
} else {
option add *Dialog.msg.font {Times 18} widgetDefault
}
label $w.msg -anchor nw -justify left -text $data(-message)
if {[string compare $data(-icon) ""]} {
if {[string equal $tcl_platform(platform) "macintosh"] || ([winfo depth $w] < 4) || $tk_strictMotif} {
label $w.bitmap -bitmap $data(-icon)
} else {
canvas $w.bitmap -width 32 -height 32 -highlightthickness 0
switch $data(-icon) {
error {
$w.bitmap create oval 0 0 31 31 -fill red -outline black
$w.bitmap create line 9 9 23 23 -fill white -width 4
$w.bitmap create line 9 23 23 9 -fill white -width 4
}
info {
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::b1
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::b2
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::i
}
question {
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::b1
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::b2
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::q
}
default {
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::w1
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::w2
$w.bitmap create image 0 0 -anchor nw -image ::tk::dialog::w3
}
}
}
}
grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
grid columnconfigure $w.top 1 -weight 1
grid rowconfigure $w.top 0 -weight 1
set i 0
foreach but $buttons {
set name [lindex $but 0]
set opts [lrange $but 1 end]
if {![llength $opts]} {
set capName [string toupper $name 0]
set opts[list -text $capName]
}
eval button[list $w.$name] $opts[list -command[list set tkPriv(button) $name]]
if {[string equal $name $data(-default)]} {
$w.$name configure -default active
}
pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
set underIdx [$w.$name cget -under]
if {$underIdx >= 0} {
set key [string index [$w.$name cget -text] $underIdx]
bind $w <Alt-[string tolower $key]>[list $w.$name invoke]
bind $w <Alt-[string toupper $key]>[list $w.$name invoke]
}
incr i
}
if {[string compare {} $data(-default)]} {
bind $w <FocusIn> {
if {[string equal Button [winfo class %W]]} {
%W configure -default active
}
}
bind $w <FocusOut> {
if {[string equal Button [winfo class %W]]} {
%W configure -default normal
}
}
}
bind $w <Return> {
if {[string equal Button [winfo class %W]]} {
tkButtonInvoke %W
}
}
::tk::PlaceWindow $w widget $data(-parent)
if {[string compare $data(-default) ""]} {
set focus $w.$data(-default)
} else {
set focus $w
}
::tk::SetFocusGrab $w $focus
tkwait variable tkPriv(button)
::tk::RestoreFocusGrab $w $focus
return $tkPriv(button)
}
proc tk_optionMenu {w varName firstValue args} {
upvar #0 $varName var
if {![info exists var]} {
set var $firstValue
}
menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu -relief raised -bd 2 -highlightthickness 2 -anchor c -direction flush
menu $w.menu -tearoff 0
$w.menu add radiobutton -label $firstValue -variable $varName
foreach i $args {
$w.menu add radiobutton -label $i -variable $varName
}
return $w.menu
}
if {[string compare $tcl_platform(platform) "windows"] && [string compare $tcl_platform(platform) "macintosh"]} {
bind Scrollbar <Enter> {
if {$tk_strictMotif} {
set tkPriv(activeBg) [%W cget -activebackground]
%W config -activebackground [%W cget -background]
}
%W activate [%W identify %x %y]
}
bind Scrollbar <Motion> {
%W activate [%W identify %x %y]
}
bind Scrollbar <Leave> {
if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {
%W config -activebackground $tkPriv(activeBg)
}
%W activate {}
}
bind Scrollbar <1> {
tkScrollButtonDown %W %x %y
}
bind Scrollbar <B1-Motion> {
tkScrollDrag %W %x %y
}
bind Scrollbar <B1-B2-Motion> {
tkScrollDrag %W %x %y
}
bind Scrollbar <ButtonRelease-1> {
tkScrollButtonUp %W %x %y
}
bind Scrollbar <B1-Leave> {
}
bind Scrollbar <B1-Enter> {
}
bind Scrollbar <2> {
tkScrollButton2Down %W %x %y
}
bind Scrollbar <B1-2> {
}
bind Scrollbar <B2-1> {
}
bind Scrollbar <B2-Motion> {
tkScrollDrag %W %x %y
}
bind Scrollbar <ButtonRelease-2> {
tkScrollButtonUp %W %x %y
}
bind Scrollbar <B1-ButtonRelease-2> {
}
bind Scrollbar <B2-ButtonRelease-1> {
}
bind Scrollbar <B2-Leave> {
}
bind Scrollbar <B2-Enter> {
}
bind Scrollbar <Control-1> {
tkScrollTopBottom %W %x %y
}
bind Scrollbar <Control-2> {
tkScrollTopBottom %W %x %y
}
bind Scrollbar <Up> {
tkScrollByUnits %W v -1
}
bind Scrollbar <Down> {
tkScrollByUnits %W v 1
}
bind Scrollbar <Control-Up> {
tkScrollByPages %W v -1
}
bind Scrollbar <Control-Down> {
tkScrollByPages %W v 1
}
bind Scrollbar <Left> {
tkScrollByUnits %W h -1
}
bind Scrollbar <Right> {
tkScrollByUnits %W h 1
}
bind Scrollbar <Control-Left> {
tkScrollByPages %W h -1
}
bind Scrollbar <Control-Right> {
tkScrollByPages %W h 1
}
bind Scrollbar <Prior> {
tkScrollByPages %W hv -1
}
bind Scrollbar <Next> {
tkScrollByPages %W hv 1
}
bind Scrollbar <Home> {
tkScrollToPos %W 0
}
bind Scrollbar <End> {
tkScrollToPos %W 1
}
}
proc tkScrollButtonDown {w x y} {
global tkPriv
set tkPriv(relief) [$w cget -activerelief]
$w configure -activerelief sunken
set element [$w identify $x $y]
if {[string equal $element "slider"]} {
tkScrollStartDrag $w $x $y
} else {
tkScrollSelect $w $element initial
}
}
proc tkScrollButtonUp {w x y} {
global tkPriv
tkCancelRepeat
if {[info exists tkPriv(relief)]} {
$w configure -activerelief $tkPriv(relief)
tkScrollEndDrag $w $x $y
$w activate [$w identify $x $y]
}
}
proc tkScrollSelect {w element repeat} {
global tkPriv
if {![winfo exists $w]} return
switch -- $element {
"arrow1" {tkScrollByUnits $w hv -1}
"trough1" {tkScrollByPages $w hv -1}
"trough2" {tkScrollByPages $w hv 1}
"arrow2" {tkScrollByUnits $w hv 1}
default {return}
}
if {[string equal $repeat "again"]} {
set tkPriv(afterId) [after [$w cget -repeatinterval][list tkScrollSelect $w $element again]]
} elseif {[string equal $repeat "initial"]} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set tkPriv(afterId) [after $delay[list tkScrollSelect $w $element again]]
}
}
}
proc tkScrollStartDrag {w x y} {
global tkPriv
if {[string equal [$w cget -command] ""]} {
return
}
set tkPriv(pressX) $x
set tkPriv(pressY) $y
set tkPriv(initValues) [$w get]
set iv0 [lindex $tkPriv(initValues) 0]
if {[llength $tkPriv(initValues)] == 2} {
set tkPriv(initPos) $iv0
} elseif {$iv0 == 0} {
set tkPriv(initPos) 0.0
} else {
set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) / [lindex $tkPriv(initValues) 0]}]
}
}
proc tkScrollDrag {w x y} {
global tkPriv
if {[string equal $tkPriv(initPos) ""]} {
return
}
set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
if {[$w cget -jump]} {
if {[llength $tkPriv(initValues)] == 2} {
$w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] [expr {[lindex $tkPriv(initValues) 1] + $delta}]
} else {
set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]
eval[list $w] set [lreplace $tkPriv(initValues) 2 3 [expr {[lindex $tkPriv(initValues) 2] + $delta}] [expr {[lindex $tkPriv(initValues) 3] + $delta}]]
}
} else {
tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
}
}
proc tkScrollEndDrag {w x y} {
global tkPriv
if {[string equal $tkPriv(initPos) ""]} {
return
}
if {[$w cget -jump]} {
set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
}
set tkPriv(initPos) ""
}
proc tkScrollByUnits {w orient amount} {
set cmd [$w cget -command]
if {[string equal $cmd ""] || ([string first [string index [$w cget -orient] 0] $orient] < 0)} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount units
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
}
}
proc tkScrollByPages {w orient amount} {
set cmd [$w cget -command]
if {[string equal $cmd ""] || ([string first [string index [$w cget -orient] 0] $orient] < 0)} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount pages
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
}
}
proc tkScrollToPos {w pos} {
set cmd [$w cget -command]
if {[string equal $cmd ""]} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd moveto $pos
} else {
uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]
}
}
proc tkScrollTopBottom {w x y} {
global tkPriv
set element [$w identify $x $y]
if {[string match *1 $element]} {
tkScrollToPos $w 0
} elseif {[string match *2 $element]} {
tkScrollToPos $w 1
}
set tkPriv(relief) [$w cget -activerelief]
}
proc tkScrollButton2Down {w x y} {
global tkPriv
set element [$w identify $x $y]
if {[string match {arrow[12]} $element]} {
tkScrollButtonDown $w $x $y
return
}
tkScrollToPos $w [$w fraction $x $y]
set tkPriv(relief) [$w cget -activerelief]
update idletasks
$w configure -activerelief sunken
$w activate slider
tkScrollStartDrag $w $x $y
}
: no event type or button # or keysym
while executing
"bind Listbox <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 4}] units
}"
..
