This file contains the code for most of the examples in the
book "Tcl and the Tk Toolkit".  It follows the order of the book,
chapter by chapter.

Chapter 1:
----------

set a 44

set a 44 55

Chapter 2:
----------

expr 2 + 2

expr 3 << 2

expr 14.1*6

expr (3 > 4) || (6 <= 7)

button .b -text "Hello, world!" -command exit
pack .b

#!/usr/local/bin/wish -f
button .b -text "Hello, world!" -command exit
pack .b

source hello

#!/usr/local/bin/wish -f
button .b -text "Hello, world!" -command "puts Good-bye!; exit"
pack .b

destroy .b
source hello

set a 44

expr $a*4

set a 44
set b [expr $a*4]

set x \$a
set newline \n

proc power {base p} {
	set result 1
	while {$p>0} {
		set result [expr $result*$base]
		set p [expr $p-1]
	}
	return $result
}

power 2 6

power 1.15 5

while (p>0) {
	result *= base;
	p -= 1;
}

while {$p>0} {
	set result [expr $result*$base]
	set p [expr $p-1]
}

set {$p>0} {
	set result [expr $result*$base]
	set p [expr $p-1]
}

#!/usr/local/bin/wish -f
proc power {base p} {
	set result 1
	while {$p>0} {
		set result [expr $result*$base]
		set p [expr $p-1]
	}
	return $result
}
entry .base -width 6 -relief sunken -textvariable base
label .label1 -text "to the power"
entry .power -width 6 -relief sunken -textvariable power
label .label2 -text "is"
label .result -textvariable result
pack .base .label1 .power .label2 .result -side left \
		-padx 1m -pady 2m
bind .base <Return> {set result [power $base $power]}
bind .power <Return> {set result [power $base $power]}

bind . <Any-Motion> {puts "pointer at %x,%y"}

exec grep #include tk.h

#!/usr/local/bin/wish -f
set id 0
entry .entry -width 30 -relief sunken -textvariable cmd
pack .entry -padx 1m -pady 1m
bind .entry <Return> {
	set id [expr $id + 1]
	if {$id > 5} {
		destroy .b[expr $id - 5]
	}
	button .b$id -command "exec <@stdin >@stdout $cmd" \
			-text $cmd
	pack .b$id -fill x
	.b$id invoke
	.entry delete 0 end
}

.entry configure -background yellow

.b1 configure -foreground brown
.b1 flash

Chapter 3:
----------

set a 24
set b 15

set a 24; set b 15

set a 122

expr 24/3.2

eval {set a 122}

lindex {red green blue purple} 2

string length abracadabra

button .b -text Hello -fg red

x = 4;
y = x+10;

set x 4
set y x+10

set x 4
set y [expr $x+10]

set kgrams 20
expr $kgrams*2.2046

expr $result*$base

foreach num {1 2 3 4 5} {
	button .b$num
}

set kgrams 20
set lbs [expr $kgrams*2.2046]

set msg Eggs:\ \$2.18/dozen\nGasoline:\ \$1.49/gallon

pack .base .label1 .power .label2 .result \
		-side left -padx 1m -pady 2m

set msg "Eggs: \$2.18/dozen\nGasoline: \$1.49/gallon"

set msg "Eggs: \$2.18/dozen
Gasoline: \$1.49/gallon"

set a 2.1
set msg "a is $a; the square of a is [expr $a*$a]"

set name a.out
set msg "Couldn`t open file \"$name\""

set msg {Eggs: $2.18/dozen
Gasoline: $1.49/gallon}

set msg {Eggs: $2.18/dozen\nGasoline: $1.49/gallon}

proc occur {value list} {
	set count 0
	foreach el $list {
		if $el==$value {
			incr count
		}
	}
	return $count
}

occur 18 {1 34 18 16 18 72 1994 -3}

# This is a comment
set a 100	# Not a comment

set b 101	;# This is a comment

set state West Virginia

expr 3 * (20+4

set x [format {Earnings for July: $%.2f} $earnings]

set city "Los Angeles"
set bigCity $city

exec rm [glob *.o]

eval exec rm [glob *.o]

Chapter 4:
----------

set a {Four score and seven years ago}

set a

set a 12.6

set earnings(January) 87966

set earnings(February) 95400

set earnings(January)

expr $a+2

set yearTotal 0
foreach month {Jan Feb Mar Apr May Jun Jul Aug Sep \
		Oct Nov Dec} {
	set yearTotal [expr $yearTotal+$earnings($month)]
}

.canvas configure -width ${size}m

unset a earnings(January) b

set matrix(1,1) 140
set matrix(1,2) 218
set matrix(1,3) 84
set i 1
set j 2
set cell $matrix($i,$j)

set matrix(1, 1) 140

set x 43
incr x 12

set x 43
incr x

set msg ""
foreach i {1 2 3 4 5} {
	append msg "$i squared is [expr $i*$i]\n"
}
set msg

append x $piece

set x "$x$piece"

#!/usr/local/bin/tclsh
puts "The command name is \"$argv0\""
puts "There were $argc arguments: $argv"

Chapter 5:
----------

expr (8+4) * 6.2

if $x<2 {set x 2}

expr 8&&2

expr 8&2

expr {($a < $b) ? $a : $b}

expr 2*sin($x)
expr hypot($x, $y) + $z

expr 2*sin($x)

expr {2*sin($x)}

set pow 1
while {$pow < $num} {
	set pow [expr $pow*2]
}

set x 0
set y 00
if {$x == $y} {
	...
}

expr 1.11111111 + 1.11111111

set tcl_precision 12
expr 1.11111111 + 1.11111111

Chapter 6:
----------

lindex {John Anne Mary Jim} 1

set x {John Anne Mary Jim}

lindex {a b {c d e} f} 2

concat {a b c} {d e} f {g h i}

set x {a b c}
set y {d e}
set z [concat $x $y]

set z "$x $y"

llength {{a b c} {d e} f {g h i}}

llength a

llength {}

set x {a b {c d} e}

linsert $x 2 X Y Z

linsert $x 0 {X Y} Z

lreplace {a b {c d} e} 3 3

lreplace {a b {c d} e} 1 2 {W X} Y Z

set x {a b {c d} e}

lrange $x 1 3

lrange $x 0 1

set x {a b {c d} e}

lappend x XX {YY ZZ}

set x

lappend x $a $b $c

set x "$x [list $a $b $c]"

set x {John Anne Mary Jim}
lsearch $x Mary

lsearch $x Phil

lsearch -glob $x A*

lsort {John Anne Mary Jim}

lsort -decreasing {John Anne Mary Jim}

lsort {10 1 2}

lsort -integer {10 1 2}

set x a/b/c
set y /usr/include/sys/types.h
split $x /

split $y /

split xbaybz ab

split {a b c} {}

join {{} usr include sys types.h} /

set x {24 112 5}
expr [join $x +]

button .b -text "Reset" -command {set x 0}

button .b -text "Reset" -command {set x $initValue}

button .b -text "Reset" -command "set x $initValue"

button .b -text "Reset" -command [list set x $initValue]

set x {New York}

set initValue {Earnings: $1410.13}
list set x $initValue

set initValue "{ \\"
list set x $initValue

Chapter 7:
----------

if {$x < 0} {
	set x 0
}

if {$x < 0} {
	...
} elseif {$x == 0} {
	...
} elseif {$x == 1} {
	...
} else {
	...
}

if {$x < 0}
{
	set x 0
}

set b ""
set i [expr [llength $a]-1]
while {$i >= 0} {
	lappend b [lindex $a $i]
	incr i -1
}

set b ""
for {set i [expr [llength $a]-1]} {$i >= 0} {incr i -1} {
	lappend b [lindex $a $i]
}

set b ""
foreach i $a {
	set b [linsert $b 0 $i]
}

set b ""
foreach i $a {
	if {$i == "ZZZ"} break
	set b [linsert $b 0 $i]
}

set b ""
foreach i $a {
	if {$i == "ZZZ"} continue
	set b [linsert $b 0 $i]
}

switch $x {a {incr t1} b {incr t2} c {incr t3}}

switch $x a {incr t1} b {incr t2} c {incr t3}

switch $x {
	a {incr t1}
	b {incr t2}
	c {incr t3}
}

switch $x \
	a {incr t1} \
	b {incr t2} \
	c {incr t3}

set t1 0
set t2 0
set t3 0
foreach i $x {
	switch -regexp $i {
		a			{incr t1}
		^[0-9]*$		{incr t2}
		default			{incr t3}
	}
}

switch $x {
	a -
	b -
	c {incr t1}
	d {incr t2}
}

set cmd "set a 0"
...
eval $cmd

set vars {a b c d}
foreach i $vars {
	unset $i
}

set vars {a b c d}
unset $vars

set vars {a b c d}
eval unset $vars

eval unset $vars

eval [concat unset $vars]

source init.tcl

Chapter 8:
----------

proc plus {a b} {expr $a+$b}

plus 3 4

plus 3 -1

plus 1

proc fac x {
	if {$x <= 1} {
		return 1
	}
	expr $x * [fac [expr $x-1]]
}

fac 4

fac 0

global x y

proc printVars {} {
	global a b
	puts "a is $a, b is $b"
}

proc inc {value {increment 1}} {
	expr $value+$increment
}

inc 42 3

inc 42

proc sum args {
	set s 0
	foreach i $args {
		incr s $i
	}
	return $s
}
sum 1 2 3 4 5

sum

proc parray name {
	upvar $name a
	foreach el [lsort [array names a]] {
		puts "$el = $a($el)"
	}
}
set info(age) 37
set info(position) "Vice President"
parray info

upvar #0 other x

upvar -2 other x

proc do {varName first last body} {
	upvar $varName v
	for {set v $first} {$v <= $last} {incr v} {
		uplevel $body
	}
}

set v {}
do i 1 5 {
	lappend v [expr $i*$i]
}
set v

Chapter 9:
----------

set list {44 16 123 98 57}
set sum 0
foreach el $list {
	set sum [expr $sum+$element]
}

if {($x < 0) || ($x > 100)} {
	error "x is out of range ($x)"
}

unset x

catch {unset x}

catch {unset x} msg

set msg

catch {return "all done"} string
set string

return -code return 42

proc do {varName first last body} {
	global errorInfo errorCode
	upvar $varName v
	for {set v $first} {$v <= $last} {incr v} {
		set code [catch {uplevel $body} string]
		if {$code == 1} {
			return -code error -errorinfo $errorInfo \
					-errorcode $errorCode $string
		} elseif {$code == 2} {
			return -code return $string
		} else if {$code == 3} {
			return
		} else if {$code > 4} {
			return -code $code $string
		}
	}
}

Chapter 10:
-----------

set new {}
foreach el $list {
	if [string match Tcl* $el] {
		lappend new $el
	}
}

^((0x)?[0-9a-fA-F]+|[0-9]+)$

regexp {^[0-9]+$} 510

regexp {^[0-9]+$} -510

regexp {([0-9]+) *([a-z]+)} "Walk 10 km" a b c

regexp {[a-z]} A

regexp -nocase {[a-z]} A

regexp -indices {([0-9]+) *([a-z]+)} "Walk 10 km" \
	a b c

regsub there "They live there lives" their x

regsub -all a ababa zz x

regsub -all a|b axaab && x

regsub -all (a+)(ba*) aabaabxab {z\2} x

format "The square root of 10 is %.3f" [expr sqrt(10)]

set msg [format "%s is %d years old" $name $age]

set msg "$name is $age years old"

puts "Number  Exponential"
for {set i 1} {$i <= 10} {incr i} {
	puts [format "%4d %12.3f" $i [expr exp($i)]]
}

puts "Integer  ASCII"
for {set i 95} {$i <= 101} {incr i} {
	puts [format "%4d       %c" $i $i]
}

scan "16 units, 24.2% margin" "%d units, %f" a b

proc next c {
	scan $c %c i
	format %c [expr $i+1]
}
next a

next 9

string index "Sample string" 3

string range "Sample string" 3 7

string range "Sample string" 3 end

string first th "There is the tub where I bathed today"

string last th "There is the tub where I bathed today"

string compare Michigan Minnesota

string compare Michigan Michigan

string length "sample string"

string toupper "Watch out!"

string tolower "15 Charing Cross Road"

string trim aaxxxbab abc

Chapter 11:
-----------

#!/usr/local/bin/tclsh
if {$argc != 2} {
	error "Usage: tgrep pattern fileName"
}
set f [open [lindex $argv 1] r]
set pat [lindex $argv 0]
while {[gets $f line] >= 0} {
	if [regexp $pat $line] {
		puts $line
	}
}
close $f

flush $f

seek $f 2000

seek $f -100 end

tell $f

eof $f

glob *.c *.h

glob {{src,backup}/*.[ch]}

glob {src/*.[ch]} {backup/*.[ch]}

glob */

file dirname /a/b/c

file dirname main.c

file extension src/main.c

file rootname src/main.c

file rootname foo

file tail /a/b/c

file tail foo

file stat main.c info

open bogus

set errorCode

Chapter 12:
-----------

exec rm main.o

exec wc /usr/include/stdio.h

exec cat << "test data" > foo

exec grep #include tclInt.h | wc

exec rm *.o

exec rm [glob *.o]

eval exec rm [glob *.o]

exec rm a.o b.o

exec sh -c rm *.o

set f1 [open {|tbl | ditroff -ms} w]
set f2 [open |prog r+]

set f [open {| tbl | ditroff -ms} w]
pid $f

Chapter 13:
-----------

set currency(France) franc
set "currency(Great Britain)" pound
set currency(Germany) mark
array size currency

array names currency

foreach i [array names a] {
	if {($a($i) == "") || ($a($i) == 0)} {
		unset a($i)
	}
}

set x 24
info exists x

unset x
info exists x

proc test {arg1 arg2} {
	global global1
	set local1 1
	set local2 2
	puts "info vars is \"[info vars]\""
	puts "info globals is \"[info globals]\""
	puts "info locals is \"[info locals]\""
	puts "info vars *al* is \"[info vars *al*]\""
}

proc maybePrint {a b {c 24}} {
	if {$a < $b} {
		puts stdout "c is $c"
	}
}
info body maybePrint

info args maybePrint

info default maybePrint a x

info default maybePrint c x

set x

proc printProcs file {
	set f [open $file w]
	foreach proc [info procs] {
		set argList {}
		foreach arg [info args $proc] {
			if [info default $proc $arg default] {
				lappend argList [list $arg $default]
			} else {
				lappend argList $arg
			}
		}
		puts $f [list proc $proc $argList \
				[info body $proc]]
	}
	close $f
}

proc printStack {} {
	set level [info level]
	for {set i 1} {$i < $level} {incr i} {
		puts "Level $i: [info level $i]"
	}
}

time {set a xyz} 10000

trace variable color w pvar
trace variable a(length) w pvar
proc pvar {name element op} {
	if {$element != ""} {
		set name ${name}($element)
	}
	upvar $name x
	puts "Variable $name set to $x"
}

Variable color set to purple
Variable a(length) set to 108

trace variable a w pvar

trace variable size w forceInt
proc forceInt {name element op} {
	upvar $name x ${name}_old x_old
	if ![regexp {^[0-9]*$} $x] {
		set x $x_old
		error "value must be a postive integer"
	}
	set x_old $x
}

set size 47

set size red

set size

trace vdelete color w pvar

trace vinfo color

foreach cmd {open close read gets puts} {
	rename $cmd {}
}

rename exit exit.old
proc exit status {
	application-specific cleanup
	...
	exit.old $status
}

set x 24
createDatabase library $x

unknown createDatabase library 24

proc unknown {name args} {
	set cmds [info commands $name*]
	if {[llength $cmds] != 1} {
		error "unknown command \"$name\""
	}
	uplevel $cmds $args
}

auto_mkindex . *.tcl

set auto_path \
		[linsert $auto_path 0 /usr/local/lib/shapes]

Chapter 14:
-----------

set x 24
set y [expr $x*2.6]
incr x

history

history keep 100

history redo

history redo 1

set x "200 illimeters"

history substitute ill mill -1

history nextid

Chapter 15:
-----------

button .b -text "Press me" -foreground red

.b configure -foreground blue
.b flash
.b invoke

Chapter 16:
-----------

foreach relief {raised sunken flat groove ridge} {
	frame .$relief -width 15m -height 10m -relief $relief \
			-borderwidth 4
	pack .$relief -side left -padx 2m -pady 2m
}
.flat configure -background black

label .bitmap -bitmap @$tk_library/demos/bitmaps/flagdown
label .label -text "No new mail"
pack .bitmap .label

proc watch name {
	toplevel .watch
	label .watch.label -text "Value of \"$name\": "
	label .watch.value -textvariable $name
	pack .watch.label .watch.value -side left
}

set country Japan
watch country

set country "Great Britain"

button .ok -text OK -command ok
button .apply -text Apply -command apply
button .cancel -text Cancel -command cancel
button .help -text Help -command help
pack .ok .apply .cancel .help -side left

checkbutton .bold -text Bold -variable bold -anchor w
checkbutton .italic -text Italic -variable italic -anchor w
checkbutton .underline -text Underline -variable underline \
		-anchor w
pack .bold .italic .underline -side top -fill x

radiobutton .times -text Times -variable font \
		-value times -anchor w
radiobutton .helvetica -text Helvetica -variable font \
		-value helvetica -anchor w
radiobutton .courier -text Courier -variable font \
		-value courier -anchor w
radiobutton .symbol -text Symbol -variable font \
		-value symbol -anchor w
pack .times .helvetica .courier .symbol -side top -fill x

message .msg -width 8c -justify left -relief raised -bd 2 \
		-font -Adobe-Helvetica-Medium-R-Normal--*-180-* \
		-text "You have made changes to this document\
		since the last time it was saved. Is it OK to\
		discard the changes?"
pack .msg

listbox .colors
pack .colors
set f [open /usr/lib/X11/rgb.txt]
while {[gets $f line] >= 0} {
	.colors insert end [lrange $line 3 end]
}
close $f
bind .colors <Double-Button-1> {
	.colors configure -background [selection get]
}

listbox .files -relief raised -borderwidth 2 \
		-yscrollcommand ".scroll set"
pack .files -side left
scrollbar .scroll -command ".files yview"
pack .scroll -side right -fill y
foreach i [lsort [glob *]] {
	.files insert end $i
}

scale .red -label Red -from 0 -to 255 -length 10c \
		-orient horizontal -command newColor
scale .green -label Green -from 0 -to 255 -length 10c \
		-orient horizontal -command newColor
scale .blue -label Blue -from 0 -to 255 -length 10c \
		-orient horizontal -command newColor
frame .sample -height 1.5c -width 6c
pack .red .green .blue -side top
pack .sample -side bottom -pady 2m
proc newColor value {
	set color [format #%02x%02x%02x [.red get] [.green get] \
			[.blue get]]
	.sample config -background $color
}

label .label -text "File name:"
entry .entry -width 20 -relief sunken -bd 2 -textvariable name
pack .label .entry -side left -padx 1m -pady 2m

menu .m
.m add checkbutton -label Bold -variable bold
.m add checkbutton -label Italic -variable italic
.m add checkbutton -label Underline -variable underline
.m add separator
.m add radiobutton -label Times -variable font -value times
.m add radiobutton -label Helvetica -variable font \
		-value helvetica
.m add radiobutton -label Courier -variable font \
		-value courier
.m add separator
.m add command -label "Insert Bullet" -command "insertBullet"
.m add command -label "Margins and Tabs..." \
		-command "mkMarginPanel"

frame .mbar -relief raised -bd 2
frame .dummy -width 10c -height 5c
pack .mbar .dummy -side top -fill x
menubutton .mbar.file -text File -underline 0 \
		-menu .mbar.file.menu
menubutton .mbar.edit -text Edit -underline 0 \
		-menu .mbar.edit.menu
menubutton .mbar.graphics -text Graphics -underline 0 \
		-menu .mbar.graphics.menu
menubutton .mbar.text -text Text -underline 0 \
		-menu .mbar.text.menu
menubutton .mbar.view -text View -underline 0 \
		-menu .mbar.view.menu
menubutton .mbar.help -text Help -underline 0 \
		-menu .mbar.help.menu
pack .mbar.file .mbar.edit .mbar.graphics .mbar.text \
		.mbar.view -side left
pack .mbar.help -side right
menu .mbar.text.menu
.mbar.text.menu add checkbutton -label Bold -variable bold
.mbar.text.menu add checkbutton -label Italic -variable italic
tk_menuBar .mbar .mbar.file .mbar.edit .mbar.graphics \
		.mbar.text .mbar.view .mbar.help
focus .mbar

frame .mbar -relief raised -bd 2
frame .dummy -width 10c -height 5c
pack .mbar .dummy -side top -fill x
menubutton .mbar.file -text File -underline 0 \
		-menu .mbar.file.menu
menubutton .mbar.edit -text Edit -underline 0 \
		-menu .mbar.edit.menu
menubutton .mbar.graphics -text Graphics -underline 0 \
		-menu .mbar.graphics.menu
menu .mbar.graphics.menu
.mbar.graphics.menu add cascade -label "Line Color" \
		-menu .mbar.graphics.menu.color
.mbar.graphics.menu add cascade -label "Line Width" \
		-menu .mbar.graphics.menu.width
menu .mbar.graphics.menu.width
.mbar.graphics.menu.width add radiobutton -label "0.25 point" \
		-variable lineWidth -value 0.25
menubutton .mbar.text -text Text -underline 0 \
		-menu .mbar.text.menu
menubutton .mbar.view -text View -underline 0 \
		-menu .mbar.view.menu
menubutton .mbar.help -text Help -underline 0 \
		-menu .mbar.help.menu
pack .mbar.file .mbar.edit .mbar.graphics .mbar.text \
		.mbar.view -side left
pack .mbar.help -side right
menu .mbar.text.menu
.mbar.text.menu add checkbutton -label Bold -variable bold
.mbar.text.menu add checkbutton -label Italic -variable italic
tk_menuBar .mbar .mbar.file .mbar.edit .mbar.graphics \
		.mbar.text .mbar.view .mbar.help
focus .mbar

frame .mbar -relief raised -bd 2
frame .dummy -width 10c -height 5c
pack .mbar .dummy -side top -fill x
menubutton .mbar.file -text File -underline 0 \
		-menu .mbar.file.menu
menubutton .mbar.edit -text Edit -underline 0 \
		-menu .mbar.edit.menu
menu .mbar.edit.menu
.mbar.edit.menu add command -label "Undo" -underline 0 \
		-accelerator "Ctrl+z" -command undo
.mbar.edit.menu add command -label "Redo" -underline 0 \
		-accelerator "Ctrl+r" -command redo
.mbar.edit.menu add command -label "Select All" -underline 7 \
		-command allSelect
menubutton .mbar.graphics -text Graphics -underline 0 \
		-menu .mbar.graphics.menu
menubutton .mbar.text -text Text -underline 0 \
		-menu .mbar.text.menu
menubutton .mbar.view -text View -underline 0 \
		-menu .mbar.view.menu
menubutton .mbar.help -text Help -underline 0 \
		-menu .mbar.help.menu
pack .mbar.file .mbar.edit .mbar.graphics .mbar.text \
		.mbar.view -side left
pack .mbar.help -side right
menu .mbar.text.menu
.mbar.text.menu add checkbutton -label Bold -variable bold
.mbar.text.menu add checkbutton -label Italic -variable italic
tk_menuBar .mbar .mbar.file .mbar.edit .mbar.graphics \
		.mbar.text .mbar.view .mbar.help
focus .mbar


.f config -cursor {arrow red white}

.f config -cursor {@cursors/bits cursors/mask red white}

Chapter 17:
-----------

button .ok -text OK
button .cancel -text Cancel
button .help -text Help
pack .ok .cancel .help -side left

.cancel configure -text "Cancel Command"

pack .ok .cancel .help -side top

pack .ok .cancel .help -side left -padx 2m -pady 1m

pack .ok .cancel .help -side left -ipadx 2m -ipady 1m

pack .ok .cancel .help -side left -padx 2m -pady 2m \
	-ipadx 2m -ipady 2m

pack .ok .cancel .help -side top -fill x

pack .label side top -fill x
pack .scrollbar -side right -fill y
pack .listbox

pack .ok .cancel .help -side left

pack .ok .cancel -side left
pack .help -side left -expand 1 \
	-fill x

pack .ok .cancel -side left
pack .help -side left -expand 1

pack .ok .cancel .help \
	-side left -expand 1

pack .ok .cancel .help -side left \
	-expand 1 -fill both

pack .ok .cancel .help -side top -anchor w

pack .ok .cancel .help -side top -anchor w -padx 2m -pady 1m

pack .left -side left -padx 3m -pady 3m
pack .right -side right -padx 3m -pady 3m
pack .pts8 .pts10 .pts12 .pts18 .pts24 \
    -in .left -side top -anchor w
pack .bold .italic .underline \
    -in .right -side top -anchor w

Chapter 18:
-----------

bind .entry <Control-d> {.entry delete insert}

bind .entry <Control-d> {}

bind .entry <Control-d>

bind .entry

bind Button

bind .b <Enter> {.b config -state active}
bind .b <Leave> {.b config -state normal}

bind .entry a {.entry insert insert a}

bind .entry <KeyPress-a> {.entry insert insert a}

bind . <Any-KeyPress> {puts "The keysym is %K"}
focus .

bind .exit <Enter> {.status config -text "Exit application"}

bind Button <Any-Enter> {tk_butEnter %W}

bind .exit <Enter> {
	tk_butEnter %W
	.status config -text "Exit application"
}

Chapter 19:
-----------

canvas .c
pack .c
.c create rectangle 1c 2c 4c 4c -width 2m \
		-outline blue -fill yellow

# ruler: draw a ruler on a canvas
canvas .c -width 12c -height 1.5c
pack .c
.c create line 1c 0.5c 1c 1c 11c 1c 11c 0.5c
for {set i 0} {$i < 10} {incr i} {
	set x [expr $i+1]
	.c create line ${x}c 1c ${x}c 0.6c
	.c create line $x.25c 1c $x.25c 0.8c
	.c create line $x.5c 1c $x.5c 0.7c
	.c create line $x.75c 1c $x.75c 0.8c
	.c create text $x.15c .75c -text $i -anchor sw
}

set circle [.c create oval 1c 1c 2c 2c -fill black \
		-outline {}]

.c delete $circle

.c create oval 1c 1c 2c 2c -fill black -outline {} \
		-tags circle

.c delete circle

.c itemconfigure circle -fill red
.c move circle 0 1c

.c bind itemOrTag sequence script

# graph: simple interactive graph editor

canvas .c
pack .c

proc mkNode {x y} {			;# Create new node at (x,y)
	global nodeX nodeY edgeFirst edgeSecond
	set new [.c create oval [expr $x-10] [expr $y-10] \
			[expr $x+10] [expr $y+10] -outline black \
			-fill white -tags node]
	set nodeX($new) $x
	set nodeY($new) $y
	set edgeFirst($new) {}
	set edgeSecond($new) {}
}

proc mkEdge {first second} {		;# Create edge between nodes
	global nodeX nodeY edgeFirst edgeSecond
	set edge [.c create line $nodeX($first) $nodeY($first) \
			$nodeX($second) $nodeY($second)]
	.c lower $edge
	lappend edgeFirst($first) $edge
	lappend edgeSecond($second) $edge
}

bind .c <Button-1> {mkNode %x %y}
.c bind node <Any-Enter> {
	.c itemconfigure current -fill black
}
.c bind node <Any-Leave> {
	.c itemconfigure current -fill white
}
bind .c 1 {set firstNode [.c find withtag current]}
bind .c 2 {
	set curNode [.c find withtag current]
	if {($firstNode != "") && ($curNode != "")} {
		mkEdge $firstNode $curNode
	}
}
focus .c

proc moveNode {node xDist yDist} {
	global nodeX nodeY edgeFirst edgeSecond
	.c move $node $xDist $yDist
	incr nodeX($node) $xDist
	incr nodeY($node) $yDist
	foreach edge $edgeFirst($node) {
		.c coords $edge $nodeX($node) $nodeY($node) \
				[lindex [.c coords $edge] 2] \
				[lindex [.c coords $edge] 3]
	}
	foreach edge $edgeSecond($node) {
		.c coords $edge [lindex [.c coords $edge] 0] \
				[lindex [.c coords $edge] 1] \
				$nodeX($node) $nodeY($node)
	}
}

.c bind node <Button-2> {
	set curX %x
	set curY %y
}
.c bind node <B2-Motion> {
	moveNode [.c find withtag current] [expr %x-$curX] \
			[expr %y-$curY]
	set curX %x
	set curY %y
}

# text: read a file into a text widget

text .text -relief raised -bd 2 \
		-yscrollcommand ".scroll set"
scrollbar .scroll -command ".text yview"
pack .scroll -side right -fill y
pack .text -side left

proc loadFile file {
	.text delete 1.0 end
	set f [open $file]
	while {![eof $f]} {
		.text insert end [read $f 1000]
	}
	close $f
}
loadFile README

.text mark set first 2.3

.text delete insert "insert + 2 chars"

proc forAllMatches {w pattern script} {
	scan [$w index end] %d numLines
	for {set i 1} {$i < $numLines} {incr i} {
		$w mark set last $i.0
		while {[regexp -indices $pattern \
				[$w get last "last lineend"] indices]} {
			$w mark set first \
					"last + [lindex $indices 0] chars"
			$w mark set last "last + 1 chars \
					+ [lindex $indices 1] chars"
			uplevel $script
		}
	}
}

forAllMatches .text Tcl {
	puts "[.text index first] --> [.text index last]"
}

forAllMatches .text "the the" {
	.text delete first "first + 4 chars"
}

.text tag add x 1.0 1.end

.text tag remove x "insert wordstart" "insert wordend"

.text tag ranges x

forAllMatches .text Tcl {
	.text tag add big first last
}
.text tag configure big -background Bisque3 -borderwidth 2 \
		-font -Adobe-Helvetica-Medium-R-Normal--*-240-* \
		-relief raised

.text tag bind big <Enter> {
	.text tag configure big -background SeaGreen2
}
.text tag bind big <Leave> {
	.text tag configure big -background Bisque3
}

.text tag bind big <Button-3> {
	.text delete 1.0 end
	loadFile /usr/local/src/tcl/tcl7.0/README
}

Chapter 20:
-----------

selection get

selection get FILE_NAME

selection get LINE

proc getSelection {} {
	set targets [selection get TARGETS]
	if {[lsearch -exact $targets POSTSCRIPT] >= 0} {
		return [selection get POSTSCRIPT]
	} else {
		return [selection get STRING]
	}
}

selection get APPLICATION

selection get WINDOW_NAME

selection clear .

if {[selection own] != ""} {
	selection clear [selection own]
}

selection handle .t getFile FILE_NAME
proc getFile {offset maxBytes} {
	global fileName
	set last [expr $offset+$maxBytes-1]
	string range $fileName $offset $last
}

getFile 0 4000

selection handle .a getValue STRING
proc getValue {offset maxBytes} {
	global state
	set last [expr $offset+$maxBytes-1]
	string range $state $offset $last
}
foreach w {.a .b .c} {
	$w config -command {selection own .a selGone}
}
proc selGone {} {
	global state
	set state {}
}

Chapter 21:
-----------

toplevel .form
foreach e {1 2 3 4} {
    entry .form.e$e
    .form.e$e insert 0 "Entry $e"
}
pack .form.e1 .form.e2 .form.e3 .form.e4
set tabList {.form.e1 .form.e2 .form.e3 .form.e4}
foreach w $tabList {
	bind $w <Tab> {tab $tabList}
}
proc tab list {
	set i [lsearch -exact $list [focus]]
	incr i
	if {$i >= [llength $list]} {
		set i 0
	}
	focus [lindex $list $i]
}

focus default

focus default .entry
focus default

Chapter 22:
-----------

wm minsize .w 100 50
wm maxsize .w 400 150

wm minsize .w 1 1

wm minsize .w {} {}
wm maxsize .w {} {}

wm aspect .w 1 3 4 1

wm geometry .w 300x200

wm geometry .w {}

.t configure -setgrid 1

wm geometry . 50x30

wm geometry .w +100+200

wm geometry .w -0-0

wm iconify .w

wm iconify .w
wm state .w

wm title . "Berkeley Introduction"

wm protocol . WM_DELETE_WINDOW {
	puts stdout "I don`t wish to die"
}

wm transient .w .

foreach i {.top2 .top3 .top4} {
	wm group $i .top1
}

wm overrideredirect .popup 1

wm client . sprite.berkeley.edu
wm command . {browse /usr/local/bin}

Chapter 23:
----------

send tgdb {break tkButton.c 200}

winfo name .

winfo interps

selection get APPLICATION

Chapter 24:
-----------

grab set .dlg
grab release .dlg

grab set -global .dlg

tkwait window .dlg

toplevel .panel
button .panel.ok -text OK -command {
	set label OK
	destroy .panel
}
button .panel.cancel -text Cancel -command {
	set label Cancel
	destroy .panel
}
pack .panel.ok -side left
pack .panel.cancel -side right
grab set .panel
tkwait window .panel

tkwait visibility .intro

tkwait variable x

proc waitWindows args {
	global dead
	foreach w $args {
		bind $w <Destroy> "set dead $w"
	}
	tkwait variable dead
	return $dead
}

Chapter 25:
-----------

option add *Button.background Bisque1

option readfile newOptions

option get .a.b background Background

.button configure -text Quit

.button configure -text

lindex [.button configure -text] 4

.button configure -bg

.button configure

Chapter 26:
-----------

destroy .dlg1 .dlg2

after 500

after 5000 {puts "Time's up!"}

proc blink {w option value1 value2 interval} {
	$w config $option $value1
	after $interval [list blink $w $option \
			$value2 $value1 $interval]
}
blink .b -bg red black 500

update idletasks

proc flash {w option value1 value2 interval count} {
	for {set i 0} {$i < $count} {incr i} {
		$w config $option $value1
		update idletasks
		after $interval
		$w config $option $value2
		update idletasks
		after $interval
	}
}

winfo exists .w

winfo children .menu

winfo screenmmheight .dialog

winfo class .w

raise .w
raise .w .x
lower .w
lower .w .x

tk colormodel . monochrome

Chapter 27:
-----------

proc dialog {w title text bitmap default args} {
	global button

	# 1. Create the top-level window and divide it into top
	# and bottom parts.

	toplevel $w -class Dialog
	wm title $w $title
	wm iconname $w Dialog
	frame $w.top -relief raised -bd 1
	pack $w.top -side top -fill both
	frame $w.bot -relief raised -bd 1
	pack $w.bot -side bottom -fill both

	# 2. Fill the top part with the bitmap and message.

	message $w.top.msg -width 3i -text $text\
			-font -Adobe-Times-Medium-R-Normal-*-180-*
	pack $w.top.msg -side right -expand 1 -fill both\
			-padx 3m -pady 3m
	if {$bitmap != ""} {
		label $w.top.bitmap -bitmap $bitmap
		pack $w.top.bitmap -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.bot.button$i -text $but -command\
				"set button $i"
		if {$i == $default} {
			frame $w.bot.default -relief sunken -bd 1
			raise $w.bot.button$i
			pack $w.bot.default -side left -expand 1\
					-padx 3m -pady 2m
			pack $w.bot.button$i -in $w.bot.default\
					-side left -padx 2m -pady 2m\
					-ipadx 2m -ipady 1m
		} else {
			pack $w.bot.button$i -side left -expand 1\
					-padx 3m -pady 3m -ipadx 2m -ipady 1m
		}
		incr i
	}

	# 4. Set up a binding for <Return>, if there`s a default,
	# set a grab, and claim the focus too.

	if {$default >= 0} {
		bind $w <Return> "$w.bot.button$default flash; \
			set button $default"
	}
	set oldFocus [focus]
	grab set $w
	focus $w

	# 5. Wait for the user to respond, then restore the focus
	# and return the index of the selected button.

	tkwait variable button
	destroy $w
	focus $oldFocus
	return $button
}

dialog .d {File Modified} {File "tcl.h" has been modified since\
the last time it was saved. Do you want to save it before\
exiting the application?} warning 0 {Save File} \
{Discard Changes} {Return To Editor}

dialog .d {Not Responding} {The file server isn`t responding\
right now; I`ll keep trying.} {} -1 OK


#!/usr/local/bin/wish -f

# 1. Create basic application structure:  menu bar on top of
# text widget, scrollbar on right.

frame .mBar -relief raised -bd 2
pack .mBar -side top -fill x
scrollbar .s -relief flat -command ".t yview"
pack .s -side right -fill y
text .t -relief raised -bd 2 -yscrollcommand ".s set" \
	-setgrid true
.t tag configure bold -font \
	*-Courier-Bold-R-Normal-*-120-*
pack .t -side left -fill both -expand 1
wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
wm minsize . 1 1

# 2. Create menu button and menus.

menubutton .mBar.file -text File -underline 0\
		-menu .mBar.file.m
menu .mBar.file.m
.mBar.file.m add cascade -label "Select Application" \
	-underline 0 -accelerator => -menu .mBar.file.m.apps
.mBar.file.m add command -label "Quit" -underline 0 \
	-command exit
menu .mBar.file.m.apps -postcommand fillAppsMenu
pack .mBar.file -side left
tk_menuBar .mBar .mBar.file

proc fillAppsMenu {} {
	catch {.mBar.file.m.apps delete 0 last}
	foreach i [lsort [winfo interps]] {
		.mBar.file.m.apps add command -label $i \
			-command [list newApp $i]
	}
}
# 3. Create bindings for text widget to allow commands to
# be entered and information to be selected.  New characters
# can only be added at the end of the text (can't ever move
# insertion point).

bind .t <1> {
	set tk_priv(selectMode) char
	.t mark set anchor @%x,%y
	if {[lindex [%W config -state] 4] == "normal"} {focus %W}
}
bind .t <Double-1> {
	set tk_priv(selectMode) word
	tk_textSelectTo .t @%x,%y
}
bind .t <Triple-1> {
	set tk_priv(selectMode) line
	tk_textSelectTo .t @%x,%y
}
bind .t <Return> {.t insert insert \n; invoke}
bind .t <BackSpace> backspace
bind .t <Control-h> backspace
bind .t <Delete> backspace
bind .t <Control-v> {
	.t insert insert [selection get]
	.t yview -pickplace insert
	if [string match *.0 [.t index insert]] {
		invoke
	}
}

# 4. Procedure to backspace over one character, as long as
# the character isn't part of the prompt.

proc backspace {} {
	if {[.t index promptEnd]
			!= [.t index {insert - 1 char}]} {
		.t delete {insert - 1 char} insert
		.t yview -pickplace insert
	}
}

# 5. Procedure that's invoked when return is typed:  if
# there`s not yet a complete command (e.g. braces are open)
# then do nothing.  Otherwise, execute command (locally or
# remotely), output the result or error message, and issue
# a new prompt.

proc invoke {} {
	global app
	set cmd [.t get {promptEnd + 1 char} insert]
	if [info complete $cmd] {
		if {$app == [winfo name .]} {
			catch [list uplevel #0 $cmd] msg
		} else {
			catch [list send $app $cmd] msg
		}
		if {$msg != ""} {
			.t insert insert $msg\n
		}
		prompt
	}
	.t yview -pickplace insert
}

proc prompt {} {
	global app
	.t insert insert "$app: "
	.t mark set promptEnd {insert - 1 char}
	.t tag add bold {insert linestart} promptEnd
}

# 6. Procedure to select a new application.  Also changes
# the prompt on the current command line to reflect the new
# name.

proc newApp appName {
	global app
	set app $appName
	.t delete {promptEnd linestart} promptEnd
	.t insert promptEnd "$appName:"
	.t tag add bold {promptEnd linestart} promptEnd
}

# 7. Miscellaneous initialization.

set app [winfo name .]
prompt
focus .t

Chapter 29:
-----------

/* simple.c -- Tcl application to evaluate script file. */
#include <stdio.h>
#include <tcl.h>

main(int argc, char *argv[]) {
	Tcl_Interp *interp;
	int code;

	if (argc != 2) {
		fprintf(stderr, "Wrong # arguments: ");
		fprintf(stderr, "should be \"%s fileName\"\n",
				argv[0]);
		exit(1);
	}

	interp = Tcl_CreateInterp();
	code = Tcl_EvalFile(interp, argv[1]);
	if (*interp->result != 0) {
		printf("%s\n", interp->result);
	}
	if (code != TCL_OK) {
		exit(1);
	}
	exit(0);
}

cc simple.c -ltcl -lm

a.out test.tcl

char cmd[] = "set a 44";
...
code = Tcl_Eval(interp, cmd);

code = Tcl_VarEval(interp, "set a ", "44",
		(char *) NULL);

char *script;
int code;
...
code = Tcl_RecordAndEval(interp, script, 0);

char part1[] = "set ";
char part2[] = "a ";
char part3[] = "44";
Tcl_Eval(interp, part1);
Tcl_Eval(interp, part2);
Tcl_Eval(interp, part3);

code = Tcl_VarEval(interp, part1, part2, part3,
		(char *) NULL);

Tcl_DeleteInterp(interp);

Chapter 30:
-----------

int EqCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (strcmp(argv[1], argv[2]) == 0) {
		interp->result = "1";
	} else {
		interp->result = "0";
	}
	return TCL_OK;
}

/* simple2.c -- define new command, then evaluate script. */
#include <stdio.h>
#include <tcl.h>

main(int argc, char *argv[]) {
	Tcl_Interp *interp;
	int code;

	if (argc != 2) {
		fprintf(stderr, "Wrong # arguments: ");
		fprintf(stderr, "should be \"%s fileName\"\n",
				argv[0]);
		exit(1);
	}

	interp = Tcl_CreateInterp();
	Tcl_CreateCommand(interp, "eq", EqCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
	code = Tcl_EvalFile(interp, argv[1]);
	if (*interp->result != 0) {
		printf("%s\n", interp->result);
	}
	if (code != TCL_OK) {
		exit(1);
	}
	exit(0);
}

eq abc def

eq 1 1

set w .dlg
set w2 .dlg.ok
eq $w.ok $w2

int NumwordsCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	sprintf(interp->result, "%d", argc);
	return TCL_OK;
}

int ConcatCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	int i;
	if (argc == 1) {
		return TCL_OK;
	}
	Tcl_AppendResult(interp, argv[1], (char *) NULL);
	for (i = 2; i < argc; i++) {
		Tcl_AppendResult(interp, " ", argv[i],
			(char *) NULL);
	}
	return TCL_OK;
}

int ListCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	int i;
	for (i = 1; i < argc; i++) {
		Tcl_AppendElement(interp, argv[i]);
	}
	return TCL_OK;
}

abc {x y} \}

Tcl_CreateCommand(interp, "counter", CounterCmd,
		(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

typedef struct {
	int value;
} Counter;

int CounterCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	Counter *counterPtr;
	static int id = 0;
	if (argc != 1) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	counterPtr = (Counter *) malloc(sizeof(Counter));
	counterPtr->value = 0;
	sprintf(interp->result, "ctr%d", id);
	id++;
	Tcl_CreateCommand(interp, interp->result, ObjectCmd,
			(ClientData) counterPtr, DeleteCounter);
	return TCL_OK;
}

int ObjectCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	Counter *counterPtr = (Counter *) clientData;
	if (argc != 2) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (strcmp(argv[1], "get") == 0) {
		sprintf(interp->result, "%d", counterPtr->value);
	} else if (strcmp(argv[1], "next") == 0) {
		counterPtr->value++;
	} else {
		Tcl_AppendResult(interp, "bad counter command \"",
				argv[1], "\": should be get or next",
				(char *) NULL);
		return TCL_ERROR;
	}
	return TCL_OK;
}

void DeleteCounter(ClientData clientData) {
	free((char *) clientData);
}

counter

ctr0 next; ctr0 next; ctr0 get

ctr1 get

ctr0 clear

Tcl_DeleteCommand(interp, "ctr0");

proc inc x {expr $x+1}
inc 23

Chapter 31:
-----------

int Tcl_AppInit(Tcl_Interp *interp) {
	if (Tcl_Init(interp) == TCL_ERROR) {
		return TCL_ERROR;
	}
	tcl_RcFileName = "~/.tclshrc";
	return TCL_OK;
}

#include "tcl.h"
extern int main();
int *tclDummyMainPtr = (int *) main;

int Cmd1Proc(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	... implementation of cmd1 ...
}

int Cmd2Proc(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	... implementation of cmd2 ...
}

int Tcl_AppInit(Tcl_Interp *interp) {
	if (Tcl_Init(interp) == TCL_ERROR) {
		return TCL_ERROR;
	}
	Tcl_CreateCommand(interp, "cmd1", Cmd1Proc,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateCommand(interp, "cmd2", Cmd2Proc,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
	tcl_RcFileName = "~/.myapprc";
	return TCL_OK;
}

cc myAppInit.c -ltk -ltcl -lX11 -lm -o myapp

int Rdb_Init(Tcl_Interp *interp) {
	Tcl_CreateCommand(interp, "rdb_connect",
			Rdb_ConnectCmd, (ClientData) NULL,
			(Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateCommand(interp, "rdb_query",
			Rdb_QueryCmd, (ClientData) NULL,
			(Tcl_CmdDeleteProc *) NULL);
	...
	return Tcl_EvalFile(interp,
			 "/usr/local/lib/rdb/init.tcl");
}

int Tcl_AppInit(Tcl_Interp *interp) {
	if (Tcl_Init(interp) == TCL_ERROR) {
		return TCL_ERROR;
	}
	if (Rdb_Init(interp) == TCL_ERROR) {
		return TCL_ERROR;
	}
	tcl_RcFileName = "~/.myapprc";
	return TCL_OK;
}

typedef struct RdbInfo {
	int numOpenConnections;
	... other state information for interpreter ...
} RdbInfo;

int Rdb_Init(Tcl_Interp *interp) {
	RdbInfo *rdbPtr;
	rdbPtr = (RdbInfo *) malloc(sizeof(RdbInfo));
	rdbPtr->numOpenConnections = 0;
	... initialize other fields of structure ...
	Tcl_CreateCommand(interp, "rdb_connect",
			Rdb_ConnectCmd, (ClientData) rdbPtr,
			(Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateCommand(interp, "rdb_query",
			Rdb_QueryCmd, (ClientData) rdbPtr,
			(Tcl_CmdDeleteProc *) NULL);
	... register other commands ...
	return Tcl_EvalFile(interp,
			 "/usr/local/lib/rdb/init.tcl");
}

int Rdb_ConnectCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	RdbInfo *rdbPtr;
	rdbPtr = (RdbInfo *) clientData;
	...
}
...

Chapter 32:
-----------

int SumCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	int num1, num2;
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[1], &num1) != TCL_OK) {
		return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[2], &num2) != TCL_OK) {
		return TCL_ERROR;
	}
	sprintf(interp->result, "%d", num1+num2);
	return TCL_OK;
}

sum 2 3

sum 011 0x14

sum 3 6z

int ExprCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	if (argc != 2) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	return Tcl_ExprString(interp, argv[1]);
}

int LindexCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	int index, listArgc;
	char **listArgv;
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
		return TCL_ERROR;
	}
	if (Tcl_SplitList(interp, argv[1], &listArgc,
			&listArgv) != TCL_OK) {
		return TCL_ERROR;
	}
	if ((index >= 0) && (index < listArgc)) {
		Tcl_SetResult(interp, listArgv[index],
				TCL_VOLATILE);
	}
	free((char *) listArgv);
	return TCL_OK;
}

int ListCmd2(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	interp->result = Tcl_Merge(argc-1, argv+1);
	interp->freeProc = (Tcl_FreeProc *) free;
	return TCL_OK;
}

Chapter 33:
-----------

int BreakCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	if (argc != 1) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	return TCL_BREAK;
}

int WhileCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	int bool;
	int code;
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	while (1) {
		Tcl_ResetResult(interp);
		if (Tcl_ExprBoolean(interp, argv[1], &bool)
				!= TCL_OK) {
			return TCL_ERROR;
		}
		if (bool == 0) {
			return TCL_OK;
		}
		code = Tcl_Eval(interp, argv[2]);
		if (code == TCL_CONTINUE) {
			continue;
		} else if (code == TCL_BREAK) {
			return TCL_OK;
		} else if (code != TCL_OK) {
			return code;
		}
	}
}

break

proc badbreak {} {break}
badbreak

proc longest list {
	set i [llength $list]
	while {$i >= 0} {
		set length [string length [lindex $list $i]]
		if {$length > $max} {
			set max $length
		}
		incr i -1
	}
	return $max
}

...
} else if (code != TCL_OK) {
	if (code == TCL_ERROR) {
		char msg[50];
		sprintf(msg, "\n(\"while\" body line %d)",
				interp->errorLine);
		Tcl_AddErrorInfo(interp, msg);
	}
	return code;
}
...

Chapter 34:
-----------

int LappendCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	int i;
	char *varValue;
	if (argc < 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	for (i = 2; i < argc; i++) {
		varValue = Tcl_SetVar(interp, argv[1], argv[i],
				TCL_LIST_ELEMENT|TCL_APPEND_VALUE
				|TCL_LEAVE_ERR_MSG);
		if (varValue == NULL) {
			return TCL_ERROR;
		}
	}
	interp->result = varValue;
	return TCL_OK;
}

char *value;
...
value = Tcl_GetVar(interp, "a", 0);

int IncrCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	int value, inc;
	char *string, *varValue, newValue[20];
	if ((argc != 2) && (argc != 3)) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (argc == 2) {
		inc = 1;
	} else if (Tcl_GetInt(interp, argv[2], &inc)
			!= TCL_OK) {
		return TCL_ERROR;
	}
	string = Tcl_GetVar(interp, argv[1],
			TCL_LEAVE_ERR_MSG);
	if (string == NULL) {
		return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, string, &value) != TCL_OK) {
		return TCL_ERROR;
	}
	sprintf(newValue, "%d", value + inc);
	varValue = Tcl_SetVar(interp, argv[1], newValue,
			TCL_LEAVE_ERR_MSG);
	if (varValue == NULL) {
		return TCL_ERROR;
	}
	interp->result = varValue;
	return TCL_OK;
}

Tcl_UnsetVar(interp, "population(Michigan)", 0);

Tcl_UnsetVar2(interp, "population", "Michigan", 0);

unset population(Michigan)

int value = 32;
...
Tcl_LinkVar(interp, "x", (char *) &value, TCL_LINK_INT);

set x red

Tcl_LinkVar(interp, "x", (char *) &value,
		TCL_LINK_INT|TCL_LINK_READ_ONLY);

Tcl_UnlinkVar(interp, "x");

Tcl_TraceVar(interp, "x", TCL_TRACE_WRITES, WriteProc,
		(ClientData) NULL);

Tcl_UntraceVar(interp, "x", TCL_TRACE_WRITES,
		WriteProc, (ClientData) NULL);

typedef char *Tcl_VarTraceProc(ClientData clientData,
		Tcl_Interp *interp, char *name1, char *name2,
		int flags);

Tcl_TraceVar(interp, "x", TCL_TRACE_WRITES, Print,
		(ClientData) NULL);
...
char *Print(ClientData clientData, Tcl_Interp *interp,
		char *name1, char *name2, int flags) {
	char *value;
	value = Tcl_GetVar2(interp, name1, name2,
			flags & TCL_GLOBAL_ONLY);
	if (value != NULL) {
		if (name2 == NULL) {
			printf("new value of %s is %s\n", name1,
					value);
		} else {
			printf("new value of %s(%s) is %s\n", name1,
					name2, value);
		}
	}
	return NULL;
}

Tcl_TraceVar(interp, "x", TCL_TRACE_WRITES, Reject,
		(ClientData) "192");
...
char *Reject(ClientData clientData, Tcl_Interp *interp,
		char *name1, char *name2, int flags) {
	char *correct = (char *) clientData;
	Tcl_SetVar2(interp, name1, name2, correct,
				flags & TCL_GLOBAL_ONLY);
	return "variable is read-only";
};

ClientData clientData;
...
clientData = Tcl_VarTraceInfo(interp, "x", 0, Reject,
		(ClientData) NULL);

ClientData clientData;
...
clientData = NULL;
while (1) {
	clientData = Tcl_VarTraceInfo(interp, "x", 0,
			Reject, clientData);
	if (clientData == NULL) {
		break;
	}
	... process trace ...
}

Chapter 35:
-----------

typedef struct Gizmo {
	... fields of gizmo object ...
} Gizmo;

Tcl_HashTable gizmoTable;
...
Tcl_InitHashTable(&gizmoTable, TCL_STRING_KEYS);

Tcl_DeleteHashTable(&gizmoTable);

int GcreateCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	static unsigned int id = 1;
	int new;
	Tcl_HashEntry *entryPtr;
	Gizmo *gizmoPtr;
	... check argc, etc ...
	do {
		sprintf(interp->result, "gizmo%u", id);
		id++;
		entryPtr = Tcl_CreateHashEntry(&gizmoTable,
				interp->result, &new);
	} while (!new);
	gizmoPtr = (Gizmo *) malloc(sizeof(Gizmo));
	Tcl_SetHashValue(entryPtr, gizmoPtr);
	... initialize *gizmoPtr, etc ...
	return TCL_OK;
}

Gizmo *GetGizmo(Tcl_Interp *interp, char *string) {
	Tcl_HashEntry *entryPtr;
	entryPtr = Tcl_FindHashEntry(&gizmoTable, string);
	if (entryPtr == NULL) {
		Tcl_AppendResult(interp, "no gizmo named \"",
				string, "\"", (char *) NULL);
		return NULL;
	}
	return (Gizmo *) Tcl_GetHashValue(entryPtr);
}

int GtwistCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	Gizmo *gizmoPtr;
	... check argc, etc ...
	gizmoPtr = GetGizmo(interp, argv[1]);
	if (gizmoPtr == NULL) {
		return TCL_ERROR;
	}
	... perform twist operation ...
	return TCL_OK;
}

int GsearchCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	Tcl_HashEntry *entryPtr;
	Tcl_HashSearch search;
	Gizmo *gizmoPtr;
	... process arguments to choose search criteria ...
	for (entryPtr = Tcl_FirstHashEntry(&gizmoTable,
			&search); entryPtr != NULL;
			entryPtr = Tcl_NextHashEntry(&search)) {
		gizmoPtr = (Gizmo *) Tcl_GetHashValue(entryPtr);
		if (...object satisfies search criteria...) {
			Tcl_AppendElement(interp,
					Tcl_GetHashKey(&gizmoTable, entryPtr));
		}
	}
	return TCL_OK;
}

int GdeleteCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	Tcl_HashEntry *entryPtr;
	Gizmo *gizmoPtr;
	int i;
	for (i = 1; i < argc; i++) {
		entryPtr = Tcl_FindHashEntry(&gizmoTable,
				argv[i]);
		if (entryPtr == NULL) {
			continue;
		}
		gizmoPtr = (Gizmo *) Tcl_GetHashValue(entryPtr);
		Tcl_DeleteHashEntry(entryPtr);
		... clean up *gizmoPtr ...
		free((char *) gizmoPtr);
	}
	return TCL_OK;
}

int GstatCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	if (argc != 1) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	interp->result = Tcl_HashStats(&gizmoTable);
	interp->freeProc = (Tcl_FreeProc *) free;
	return TCL_OK;
}

Chapter 36:
-----------

proc inc x {expr $x+1}
map {4 18 16 19 -7} inc

proc addz x {return "$x z"}
map {a b {a b c}} addz

int MapCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	Tcl_DString command, newList;
	int listArgc, i, result;
	char **listArgv;
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (Tcl_SplitList(interp, argv[1], &listArgc,
			&listArgv) != TCL_OK) {
		return TCL_ERROR;
	}
	Tcl_DStringInit(&newList);
	Tcl_DStringInit(&command);
	for (i = 0; i < listArgc; i++) {
		Tcl_DStringAppend(&command, argv[2], -1);
		Tcl_DStringAppendElement(&command, listArgv[i]);
		result = Tcl_Eval(interp,
				Tcl_DStringValue(&command));
		Tcl_DStringFree(&command);
		if (result != TCL_OK) {
			Tcl_DStringFree(&newList);
			free((char *) listArgv);
			return result;
		}
		Tcl_DStringAppendElement(&newList, interp->result);
	}
	Tcl_DStringResult(interp, &newList);
	free((char *) listArgv);
	return TCL_OK;
}

foreach i {1 2 3 4 5} {
	puts "$i*$i is [expr $i*$i]"
}

int DoOneCmd(Tcl_Interp *interp) {
	char line[200];
	Tcl_DString cmd;
	int code;
	Tcl_DStringInit(&cmd);
	while (1) {
		if (fgets(line, sizeof(line), stdin) == NULL) {
			break;
		}
		Tcl_DStringAppend(&cmd, line, -1);
		if (Tcl_CommandComplete(Tcl_DStringValue(&cmd))) {
			break;
		}
	}
	code = Tcl_RecordAndEval(interp,
			Tcl_DStringValue(&cmd), 0);
	Tcl_DStringFree(&cmd);
	return code;
}

int LsearchCmd(ClientData clientData,
		Tcl_Interp *interp, int argc, char *argv[]) {
	int listArgc, i, result;
	char **listArgv;
	if (argc != 3) {
		interp->result = "wrong # args";
		return TCL_ERROR;
	}
	if (Tcl_SplitList(interp, argv[1], &listArgc,
			&listArgv) != TCL_OK) {
		return TCL_ERROR;
	}
	result = -1;
	for (i = 0; i < listArgc; i++) {
		if (Tcl_StringMatch(listArgv[i], argv[2])) {
			result = i;
			break;
		}
	}
	sprintf(interp->result, "%d", result);
	free((char *) listArgv);
	return TCL_OK;
}

Chapter 37:
-----------

int fd;
Tcl_DString buffer;
char *fullName;
...
fullName = Tcl_TildeSubst(interp, argv[1], &buffer);
if (fullName == NULL) {
	return TCL_ERROR;
}
fd = open(fullName, ...);
Tcl_DStringFree(&buffer);
...

FILE *f;
...
f = fopen("prolog.ps", "r");
if (f == NULL) {
	Tcl_AppendResult(interp, "couldn`t open prolog.ps: ",
			Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
}

int Tcl_CreatePipeline(Tcl_Interp *interp, int argc,
		char *argv[], int **pidPtr, int *inPipePtr,
		int *outPipePtr, int *errFilePtr)

Tcl_DetachPids(int numPids, int *pidPtr);

Chapter 38:
-----------

proc center {x y} {
	set a [.s size]
	.s position [expr $x-($a/2)] [expr $y-($a/2)]
}
bind .s <ButtonPress-1> {center %x %y}
bind .s <B1-Motion> {center %x %y}

Chapter 39:
-----------

Tk_Window Tk_CreateMainWindow(Tcl_Interp *interp,
		char *screenName, char *appName, char *className);

Tk_Window Tk_CreateWindowFromPath(Tcl_Interp *interp,
		Tk_Window tkwin, char *pathName, char *screenName);

Tk_SetClass(tkwin, "Foo");

Tk_Window Tk_NameToWindow(Tcl_Interp *interp, char *pathName,
		Tk_Window tkwin);

int width;
...
width = Tk_Width(tkwin);

int SquareCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	Tk_Window main = (Tk_Window) clientData;
	Square *squarePtr;
	Tk_Window tkwin;

	if (argc < 2) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
				argv[0], " pathName ?options?\"", (char *) NULL);
		return TCL_ERROR;
	}

	tkwin = Tk_CreateWindowFromPath(interp, main, argv[1],
			(char *) NULL);
	if (tkwin == NULL) {
		return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Square");

	squarePtr = (Square *) malloc(sizeof(Square));
	squarePtr->tkwin = tkwin;
	squarePtr->display = Tk_Display(tkwin);
	squarePtr->interp = interp;
	squarePtr->x = squarePtr->y = 0;
	squarePtr->size = 20;
	squarePtr->borderWidth = 0;
	squarePtr->bgBorder = squarePtr->fgBorder = NULL;
	squarePtr->relief = TK_RELIEF_FLAT;
	squarePtr->gc = None;
	squarePtr->updatePending = 0;

	Tk_CreateEventHandler(tkwin,
			ExposureMask|StructureNotifyMask, SquareEventProc,
			(ClientData) squarePtr);
	Tcl_CreateCommand(interp, Tk_PathName(tkwin), 
		SquareWidgetCmd, (ClientData) squarePtr,
		(Tcl_CmdDeleteProc *) NULL);
	if (SquareConfigure(interp, squarePtr, argc-2, argv+2, 0)
			!= TCL_OK) {
		Tk_DestroyWindow(squarePtr->tkwin);
		return TCL_ERROR;
	}
	interp->result = Tk_PathName(tkwin);
	return TCL_OK;
}

typedef struct {
	Tk_Window tkwin;
	Display *display;
	Tcl_Interp *interp;
	int x, y;
	int size;
	int borderWidth;
	Tk_3DBorder bgBorder;
	Tk_3DBorder fgBorder;
	int relief;
	GC gc;
	int updatePending;
} Square;

Chapter 40:
-----------

Tk_ConfigSpec configSpecs[] = {
	{TK_CONFIG_BORDER, "-background", "background",
		"Background", "#cdb79e",
		Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY,
		(Tk_CustomOption *) NULL},
	{TK_CONFIG_BORDER, "-background", "background",
		"Background", "white", Tk_Offset(Square, bgBorder),
		TK_CONFIG_MONO_ONLY, (Tk_CustomOption *) NULL},
	{TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
		(char *) NULL, 0, 0, (Tk_CustomOption *) NULL},
	{TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
		(char *) NULL, 0, 0, (Tk_CustomOption *) NULL},
	{TK_CONFIG_PIXELS, "-borderwidth", "borderWidth",
		"BorderWidth", "0.5m", Tk_Offset(Square, borderWidth),
		0, (Tk_CustomOption *) NULL},
	{TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
		(char *) NULL, 0, 0, (Tk_CustomOption *) NULL},
	{TK_CONFIG_BORDER, "-foreground", "foreground",
		"Foreground", "#b03060",
		Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY,
		(Tk_CustomOption *) NULL},
	{TK_CONFIG_BORDER, "-foreground", "foreground",
		"Foreground", "black",
		Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY,
		(Tk_CustomOption *) NULL},
	{TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
		"raised", Tk_Offset(Square, relief), 0,
		(Tk_CustomOption *) NULL},
	{TK_CONFIG_END, (char *) NULL, (char *) NULL,
		(char *) NULL, (char *) NULL, 0, 0,
		(Tk_CustomOption *) NULL}
};

Tcl_Interp *interp;
Tk_Window tkwin;
char *argv[] = {"-relief", "sunken", "-bg", "blue"};
Square *squarePtr;
int code;
...
code = Tk_ConfigureWidget(interp, tkwin, configSpecs,
		4, argv, (char *) squarePtr, 0);

code = Tk_ConfigureWidget(interp, tkwin, configSpecs,
		argc, argv, (char *) squarePtr,
		TK_CONFIG_ARGV_ONLY);

.s configure -background

.s configure

code = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
		(char *) squarePtr, argv[2], 0);

void Tk_FreeOptions(Tk_ConfigSpec *specs, char *widgRec,
		Display *display, int flags);

GC Tk_GetGC(Tk_Window tkwin, unsigned long valueMask,
		XGCValues *valuePtr);

void Tk_FreeGC(Display *display, GC gc);

int SquareConfigure(Tcl_Interp *interp, Square *squarePtr,
		int argc, char *argv[], int flags) {
	if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs,
			argc, argv, (char *) squarePtr, flags) != TCL_OK) {
		return TCL_ERROR;
	}
	Tk_SetWindowBackground(squarePtr->tkwin,
			Tk_3DBorderColor(squarePtr->bgBorder)->pixel);
	if (squarePtr->gc == None) {
		XGCValues gcValues;
		gcValues.function = GXcopy;
		gcValues.graphics_exposures = False;
		squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
				GCFunction|GCGraphicsExposures, &gcValues);
	}
	Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
	Tk_SetInternalBorder(squarePtr->tkwin,
			squarePtr->borderWidth);
	if (!squarePtr->updatePending) {
		Tk_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
		squarePtr->updatePending = 1;
	}
	return TCL_OK;
}

int SquareWidgetCmd(ClientData clientData, Tcl_Interp *interp,
		int argc, char *argv[]) {
	Square *squarePtr = (Square *) clientData;
	int result = TCL_OK;

	if (argc < 2) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
				argv[0], " option ?arg arg ...?\"",
				(char *) NULL);
		return TCL_ERROR;
	}

	Tk_Preserve((ClientData) squarePtr);
	if (strcmp(argv[1], "configure") == 0) {
		if (argc == 2) {
			result = Tk_ConfigureInfo(interp, squarePtr->tkwin,
					configSpecs, (char *) squarePtr, (char *) NULL, 0);
		} else if (argc == 3) {
			result = Tk_ConfigureInfo(interp, squarePtr->tkwin,
					configSpecs, (char *) squarePtr, argv[2], 0);
		} else {
			result = SquareConfigure(interp, squarePtr, argc-2,
					argv+2, TK_CONFIG_ARGV_ONLY);
		}
	} else if (strcmp(argv[1], "position") == 0) {
		if ((argc != 2) && (argc != 4)) {
			Tcl_AppendResult(interp, "wrong # args: should be \"",
					argv[0], " position ?x y?\"", (char *) NULL);
			goto error;
		}
		if (argc == 4) {
			if ((Tk_GetPixels(interp, squarePtr->tkwin, argv[2],
					&squarePtr->x) != TCL_OK) ||
					(Tk_GetPixels(interp, squarePtr->tkwin,
					argv[3], &squarePtr->y) != TCL_OK)) {
				goto error;
			}
			KeepInWindow(squarePtr);
		}
		sprintf(interp->result, "%d %d", squarePtr->x,
				squarePtr->y);
	} else if (strcmp(argv[1], "size") == 0) {
	if ((argc != 2) && (argc != 3)) {
			Tcl_AppendResult(interp, "wrong # args: should be \"",
					argv[0], " size ?amount?\"", (char *) NULL);
			goto error;
		}
		if (argc == 3) {
			int i;
			if (Tk_GetPixels(interp, squarePtr->tkwin, argv[2],
					&i) != TCL_OK) {
				goto error;
			}
			if ((i <= 0) || (i > 100)) {
				Tcl_AppendResult(interp, "bad size \"", argv[2],
						"\"", (char *) NULL);
				goto error;
			}
			squarePtr->size = i;
			KeepInWindow(squarePtr);
		}
		sprintf(interp->result, "%d", squarePtr->size);
	} else {
		Tcl_AppendResult(interp, "bad option \"", argv[1],
				"\": must be configure, position, or size",
				(char *) NULL);
		goto error;
	}
	if (!squarePtr->updatePending) {
		Tk_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
		squarePtr->updatePending = 1;
	}
	Tk_Release((ClientData) squarePtr);
	return result;

error:
	Tk_Release((ClientData) squarePtr);
	return TCL_ERROR;
}

void KeepInWindow(Square *squarePtr) {
	int gap, bd;
	bd = 0;
	if (squarePtr->relief != TK_RELIEF_FLAT) {
		bd = squarePtr->borderWidth;
	}
	gap = (Tk_Width(squarePtr->tkwin) - bd)
			- (squarePtr->x + squarePtr->size);
	if (gap < 0) {
		squarePtr->x += gap;
	}
	gap = (Tk_Height(squarePtr->tkwin) - bd)
			- (squarePtr->y + squarePtr->size);
	if (gap < 0) {
		squarePtr->y += gap;
	}
	if (squarePtr->x < bd) {
		squarePtr->x = bd;
	}
	if (squarePtr->y < bd) {
		squarePtr->y = bd;
	}
}

Chapter 41:
-----------

typedef void Tk_EventProc(ClientData clientData,
		XEvent *eventPtr);

Tk_CreateEventHandler(squarePtr->tkwin,
		ExposureMask|StructureNotifyMask, SquareEventProc,
		(ClientData) squarePtr);

void SquareEventProc(ClientData clientData, XEvent *eventPtr) {
	Square *squarePtr = (Square *) clientData;
	if (eventPtr->type == Expose) {
		if (!squarePtr->updatePending) {
			Tk_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
			squarePtr->updatePending = 1;
		}
	} else if (eventPtr->type == ConfigureNotify) {
		KeepInWindow(squarePtr);
		if (!squarePtr->updatePending) {
			Tk_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
			squarePtr->updatePending = 1;
		}
	} else if (eventPtr->type == DestroyNotify) {
		Tcl_DeleteCommand(squarePtr->interp,
				Tk_PathName(squarePtr->tkwin));
		squarePtr->tkwin = NULL;
		if (squarePtr->updatePending) {
			Tk_CancelIdleCall(SquareDisplay,
					(ClientData) squarePtr);
		}
		Tk_EventuallyFree((ClientData) squarePtr, SquareDestroy);
	}
}

void Tk_DeleteEventHandler(Tk_Window tkwin,
		unsigned long mask, Tk_EventProc *proc,
		ClientData clientData);

void Tk_CreateFileHandler(int fd, int mask, 
		Tk_FileProc *proc, ClientData clientData);

void Tk_DeleteFileHandler(int fd);

...
Tcl_DStringInit(&command);
Tk_CreateFileHandler(0, TK_READABLE, StdinProc,
		(ClientData) NULL);
...

void StdinProc(ClientData clientData, int mask) {
	int count, code;
	char input[1000];
	count = read(0, input, 1000);
	if (count <= 0) {
		... handle errors and end of file ...
	}
	Tcl_DStringAppend(&command, input, count);
	if (Tcl_CmdComplete(Tcl_DStringValue(&command)) {
		code = Tcl_Eval(interp,
				Tcl_DStringValue(&command));
		Tcl_DStringFree(&command);
		...
	}
	...
}

Tk_TimerToken Tk_CreateTimerHandler(int milliseconds,
		Tk_TimerProc *proc, ClientData clientData);

void Tk_TimerProc(ClientData clientData);

void Tk_DeleteTimerHandler(Tk_TimerToken token);

void Tk_DoWhenIdle(Tk_IdleProc *proc, ClientData clientData);

typedef void Tk_IdleProc(ClientData clientData);

void Tk_CancelIdleCall(Tk_IdleProc *proc,
		ClientData clientData);

.s configure -foreground purple
.s size 2c
.s position 1.2c 3.1c

if (!squarePtr->updatePending) {
	Tk_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	squarePtr->updatePending = 1;
}

void Tk_CreateGenericHandler(Tk_GenericProc *proc,
		ClientData clientData);

typedef int Tk_GenericProc(ClientData clientData,
		XEvent *eventPtr);

Tk_DeleteGenericHandler(Tk_GenericProc *proc,
		ClientData clientData);

int Tk_DoOneEvent(int flags)

void Tk_MainLoop(void) {
	while (tk_NumMainWindows > 0) {
		Tk_DoOneEvent(0);
	}
}

int done;
...
Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		WaitWindowProc, (ClientData) &done);
done = 0;
while (!done) {
	Tk_DoOneEvent(0);
}
...

void WaitWindowProc(ClientData clientData, XEvent *eventPtr) {
	int *donePtr = (int *) clientData;
	if (eventPtr->type == DestroyNotify) {
		*donePtr = 1;
	}
}

while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
	/* empty loop body */
}

Chapter 42:
-----------

void SquareDisplay(ClientData clientData) {
	Square *squarePtr = (Square *) clientData;
	Tk_Window tkwin = squarePtr->tkwin;
	Display *display = Tk_Display(tkwin);
	Pixmap pm;
	squarePtr->updatePending = 0;
	if (!Tk_IsMapped(tkwin)) {
		return;
	}
	pm = XCreatePixmap(display, Tk_WindowId(tkwin),
			Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
	Tk_Fill3DRectangle(display, pm, squarePtr->bgBorder,
		0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
		squarePtr->borderWidth, squarePtr->relief);
	Tk_Fill3DRectangle(display, pm, squarePtr->fgBorder,
		squarePtr->x, squarePtr->y, squarePtr->size,
		squarePtr->size, squarePtr->borderWidth,
		squarePtr->relief);
	XCopyArea(display, pm, Tk_WindowId(tkwin),
		squarePtr->gc, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
		0, 0);
	XFreePixmap(Tk_Display(tkwin), pm);
}

void Tk_Fill3DRectangle(Display *display, Drawable drawable,
		Tk_3DBorder border, int x, int y, int width,
		int height, int borderWidth, int relief);

void Tk_Fill3DPolygon(Display *display, Drawable drawable,
		Tk_3DBorder border, XPoint *pointPtr, int numPoints,
		int borderWidth, int leftRelief);

Chapter 43:
-----------

void Tk_DestroyWindow(Tk_Window tkwin);

void SquareDestroy(ClientData clientData) {
	Square *squarePtr = (Square *) clientData;
	Tk_FreeOptions(configSpecs, (char *) squarePtr,
			squarePtr->display, 0);
	if (squarePtr->gc != None) {
		Tk_FreeGC(squarePtr->display, squarePtr->gc);
	}
	free((char *) squarePtr);
}

void Tk_Preserve(ClientData clientData);

void Tk_EventuallyFree(ClientData clientData,
		Tk_FreeProc *freeProc);

Chapter 44:
-----------

void Tk_CreateSelHandler(Tk_Window tkwin, Atom target,
		Tk_SelectionProc *proc, ClientData clientData,
		Atom format);

typedef int Tk_SelectionProc(ClientData clientData,
		int offset, char *buffer, int maxBytes);

Tk_CreateSelHandler(entryPtr->tkwin, XA_STRING,
		EntryFetchSelection, (ClientData) entryPtr,
		XA_STRING);

int EntryFetchSelection(ClientData clientData, int offset,
		char *buffer, int maxBytes) {
	Entry *entryPtr = (Entry *) clientData;
	int count;
	if (entryPtr->selectFirst < 0) {
		return -1;
	}
	count = entryPtr->selectLast + 1 - entryPtr->selectFirst
		- offset;
	if (count > maxBytes) {
		count = maxBytes;
	}
	if (count <= 0) {
		count = 0;
	} else {
		strncpy(buffer, entryPtr->string +
				entryPtr->selectFirst + offset, count);
	}
	buffer[count] = 0;	
	return count;
}

void Tk_OwnSelection(Tk_Window tkwin, Tk_LostSelProc *proc,
		(ClientData) clientData);

typedef int Tk_GetSelection(Tcl_Interp *interp,
		Tk_Window tkwin, Atom target, Tk_GetSelProc *proc,
		ClientData clientData);

typedef int Tk_GetSelProc(ClientData clientData,
		Tcl_Interp *interp, char *portion);

	...
	if (Tk_GetSelection(interp, tkwin,
			Tk_InternAtom(tkwin, "STRING"), PrintSel,
			(ClientData) stdout) != TCL_OK) {
		...
	}
	...

int PrintSel(ClientData clientData, Tcl_Interp *interp,
		char *portion) {
	FILE *f = (FILE *) clientData;
	fputs(portion, f);
	return TCL_OK;
}

Chapter 45:
-----------

void Tk_GeometryRequest(Tk_Window tkwin, int width,
		int height);

void Tk_SetGrid(Tk_Window tkwin, int gridWidth,
		int gridHeight, int widthInc, int heightInc);

void Tk_ManageGeometry(Tk_Window tkwin,
		Tk_GeometryProc *proc, ClientData clientData);

typedef void Tk_GeometryProc(ClientData clientData,
		Tk_Window tkwin);

void Tk_MapWindow(Tk_Window tkwin);

void Tk_UnmapWindow(Tk_Window tkwin);

void Tk_MoveWindow(Tk_Window tkwin, int x, int y);
void Tk_ResizeWindow(Tk_Window tkwin, unsigned int width,
		unsigned int height);
void Tk_MoveResizeWindow(Tk_Window tkwin, int x, int y,
		unsigned int width, unsigned int height);

int x, y;
Tk_Window slave, master, parent, ancestor;
...
for (ancestor = master; ancestor != Tk_Parent(slave);
		ancestor = Tk_Parent(ancestor)) {
	x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
	y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
}