#!/home/bwelch/bin/wish -f
# Tkexample chapter
# browse1.tcl --
#	Browser for the Tcl and Tk examples in the book.
#	Version 1 - designed to work with evalServe.tcl
#
# The directory containing all the tcl files and evalServe.tcl
set browse(dir) /home/bwelch/tclbook/examples

# Set up the main display
wm minsize . 30 5
wm title . "Tcl Example Browser, v1"

frame .menubar
pack .menubar -fill x
button .menubar.quit -text Quit -command exit
pack .menubar.quit -side right

# Added for interaction with eval server
button .menubar.load -text Load -command Load
pack .menubar.load -side right

# Button to step each example
button .menubar.next -text Next -command Next
pack .menubar.next -side right

# Button to clean up the eval server of excess widgets
button .menubar.clean -text Clean -command Clean
pack .menubar.clean -side right

# Start up the eval.tcl script.
proc StartEvalServer {} {
	global browse tk_version
	# Start the shell and pass it our name.
	if {$tk_version >= 4.0} {
	    exec $browse(dir)/evalServe.tcl [tk appname] &
	} else {
	    exec $browse(dir)/evalServe.tcl [winfo name .] &
	}
	# Wait for eval.tcl to send us its name
	tkwait variable browse(evalInterp)
}
proc Load {} {
	global browse
	if {[lsearch [winfo interps] evalServe.tcl] < 0} {
		StartEvalServer
	}
	if [catch {send $browse(evalInterp) {info vars}} err] {
		# It probably died - restart it.
		StartEvalServer
	}
	send $browse(evalInterp) \
		[list after 1 [list \
		    _EvalServe [list source $browse(current)]]]
}
proc Clean {} {
    global browse
    catch {send $browse(evalInterp) _Cleanup}
}
# A label identifies the current example
label .menubar.label -textvariable browse(current)
pack .menubar.label -side right -fill x -expand true

# The browse(list) and browse(cur)
# variables are used to step through the examples with the Next button.
set browse(list) {}
set browse(cur) -1
proc Next {} {
	global browse
	incr browse(cur)
	set f [lindex $browse(list) $browse(cur)]
	if {$f == ""} {
	    set browse(cur) 0
	    set f [lindex $browse(list) 0]
	}
	Browse $f
}
# Look through the .tcl files for the keywords
# that group the examples.
foreach f [glob $browse(dir)/*.tcl] {
	if [catch {open $f} in] {
		puts stderr "Cannot open $f: $in"
		continue
	}
	while {[gets $in line] >= 0} {
		if [regexp -nocase {^# ([^ ]+) chapter} $line \
				x keyword] {
			lappend examples($keyword) $f
			lappend browse(list) $f
			close $in
			break
		}
	}
}
# Create the menubutton and menu
menubutton .menubar.ex -text Examples -menu .menubar.ex.m
pack .menubar.ex -side left
set m [menu .menubar.ex.m]

# Create a cascaded menu for each group of examples
option add *Menu.tearoff 0
set i 0
foreach key [lsort [array names examples]] {
	$m add cascade -label $key -menu $m.sub$i
	set sub [menu $m.sub$i ]
	incr i
	foreach item [lsort $examples($key)] {
		$sub add command -label [file tail $item] \
			-command [list Browse $item]
	}
}

# Create the text to display the example
frame .body
text .body.t -setgrid true -width 80 -height 25 \
	-yscrollcommand {.body.s set}
scrollbar .body.s -command {.body.t yview} -orient vertical
pack .body.s -side left -fill y
pack .body.t -side right -fill both -expand true
pack .body -side top -fill both -expand true
set browse(text) .body.t

# Display a specified file. The label is updated to
# reflect what is displayed, and the text is left
# in a read-only mode after the example is inserted.
proc Browse { file } {
	global browse
	set browse(current) [file tail $file]
	set browse(cur) [lsearch $browse(list) $file]
	set t $browse(text)
	$t config -state normal
	$t delete 1.0 end
	if [catch {open $file} in] {
		$t insert end $in
	} else {
		$t insert end [read $in]
		close $in
	}
	$t config -state disabled
}
if {$tk_version < 4.0} {
    $browse(text) insert insert \
"Warning: the book and the examples are based on Tk 4.0.  You have
Tk $tk_version, so some examples may not work.
"
}
$browse(text) insert insert \
"Select a file to browse from the Examples menu.

The Load button loads the file into another
process, which is a simple Tcl shell.

The Next button cycles to the next example (alphabetically).

The Clean button destroys extra widgets that accumulate in
the eval server as a result of running examples.
"

