#
#  Tk/Tcl widget tour, Version 1.0
#
#	Andrew Payne
#	payne@crl.dec.com
#

option add Tk.geometry 	"+25+405" startupFile
option add Tk.demo-geometry "300x300+25+25" startupFile

if {$argc < 1} {
	puts stderr "wtour:  lesson directory expected"
	exit 1
}
set lessondir [lindex $argv 0]

#
#  Find and load support scripts
#
set appdir [file dirname [info script]]
foreach f {general2.tcl emacs.tcl dialog.tcl } {
	if {![file exists $appdir/$f]} {
		puts stdout "wtour:  can't find support file $appdir/$f"
		exit
	}
	source $appdir/$f
}

#
#  Start up the demo proces
#
set wdemo "[winfo name .]-demo"
if {[lsearch [winfo interps] $wdemo] != -1} {
	catch "send $wdemo {after 1 destroy .}"
}	
set wish_bin wish
catch {set wish_bin $env(WISH)}
exec $wish_bin -name $wdemo -file /dev/null &

#
#  Set up main window
#
wm title . "Tk Widget Tour"
wm geometry . [option get . geometry Wtour]

set mframe [mkFrame .menu {top fillx} -relief raised -borderwidth 1]

menubutton $mframe.help -text "Help" -menu $mframe.help.menu
pack append $mframe $mframe.help {right}
set m [menu $mframe.help.menu]
$m add command -label "Help!" -command {mkHelp}

menubutton $mframe.file -text "File" -menu $mframe.file.menu
pack append $mframe $mframe.file {left}
set m [menu $mframe.file.menu]
$m add command -label "New" -command {do-new}
$m add command -label "Open..." -command {do-open}
$m add command -label "Save..." -command {do-saveas}
$m add separator
$m add command -label "Exit Program" -command {do-exit}

set t [mkText .text {top expand fill} -height 25]
bind $t <Any-Key-Menu> "apply-changes"
bind $t <Any-Key-Prior> "adjust-lesson -1"
bind $t <Any-Key-Next> "adjust-lesson 1"
focus $t

set f [mkFrame .buttons {bottom fillx} -relief raised -borderw 1]

mkButton $f.apply " Apply " {apply-changes} {left padx 7 pady 7}
mkButton $f.next " Next  " {adjust-lesson 1} {left padx 7 pady 7}
mkButton $f.prev " Prev " {adjust-lesson -1} {left padx 7 pady 7}

#
#  Supply of unique identifiers
#
set uid 0
proc uid {} {
	global uid

	incr uid
	return "uid$uid"
}

#
#  Show a help window
#
proc mkHelp {} {
	set w .help

	catch "destroy $w"
        toplevel $w
        wm title $w "Window Tour Help"

        set t [mkText $w.t {top} -height 25]
        set f [mkFrame $w.buttons {fillx bottom} -relief raised -borderw 1]
        mkButton $f.close  " Close " "destroy $w" {right padx 7 pady 7}
        $t insert current {
Wtour is an interactive tour of Tk widgets.

The main window displays a short Tcl/Tk program, and the demo window
displays the results of runniing the program.

You can make changes to the program and apply those changes by clicking
on the "Apply" button or pressing the "Do" button.

You can navigate through the tour with the "Prev" and "Next" buttons.  Or,
you can go directly to a specified lesson with the drop down menus.

Andrew Payne
payne@crl.dec.com
	}
}

#
#  Make a file name query dialog box
#
proc mkFileQuery {w msg var cmd} {
	mkDialogWindow $w
	mkFrame $w.top {top fill expand} -relief raised -border 1
	mkMessage $w.top.msg $msg {top expand padx 20 pady 20} \
		-aspect 1000 -font -Adobe-times-medium-r-normal--*-180*

	set e [mkEntry $w.top.file {top expand padx 20 pady 20} -textvar $var]
	mkFrame $w.bot {top fill expand} -relief raised -border 1
	mkButtonBar $w.bot "destroy $w" [list "OK \{$cmd\}" "Cancel {}"]

	focus $e
	bind $e <Any-Return> "destroy $w; $cmd"
}

#
#  Write the edit buffer to the specified file
#
proc write-file {fname} {
	global t errorCode

	if [catch {set f [open $fname w]}] {
		set msg "Can't write the file `$fname'"
		if {[lindex $errorCode 0] == "UNIX"} {
			append msg " -- [lindex $errorCode 2]"
		}
		mkErrorDialog .[uid] $msg "Retry \{write-file $fname\}" \
			{Cancel ""}
	} {
		puts $f [$t get 1.0 end]
		close $f
	}
}

#
#  Write the edit buffer out to a file, first checking for file existence
#
proc do-save-file {fname} {
	if [file exists $fname] {
		mkInfoDialog .[uid] "File `$fname' exists.  Overwrite?" \
			"OK \{write-file $fname\}" {Cancel ""}
	} {
		write-file $fname
	}
}

#
#  Clear everything out
#
proc do-new {} {
	global t

	$t delete 1.0 end
	apply-changes
}

#
# Save contents to a named file
#
proc do-saveas {} {
	mkFileQuery .[uid] "Enter save file name:" filename \
		{do-save-file $filename}
}

#
#  Load the edit buffer from a file
#
proc do-open-file {fname} {
	global t filename errorCode

	if [catch {set f [open $fname]}] {
		set msg "Error: can't open the file `$fname'"
		if {[lindex $errorCode 0] == "UNIX"} {
			append msg " -- [lindex $errorCode 2]"
		}
		mkErrorDialog .[uid] $msg [list Retry "do-open-file $fname"]\
			 {Cancel ""}
	} {
		set filename $fname
		$t delete 1.0 end
		$t insert current [read $f]
		close $f
	}
	apply-changes
}

#
# Prompt user for filename and load a file
#
proc do-open {} {
	mkFileQuery .[uid] "Enter file name to load:" filename \
		{do-open-file $filename}
}

#
#  Apply the changes to the demo process
#
proc apply-changes {} {
	global t wdemo

	send $wdemo {
		foreach w [winfo children .] {
			destroy $w
		}
	}
	send $wdemo [$t get 1.0 end]
}

#
#  Define a new lesson
#
proc lesson {mname name file} {
	global Lessons nlessons mframe Menus menu_bar

	set Lessons($nlessons) $file
	if {[catch {set mb $Menus($mname)}]} {
		set mb $mframe.[uid]
		mkMenubutton $mb $mname $mb.menu left
		set Menus($mname) [menu $mb.menu]
		lappend menu_bar $mb
	}
	if {$name != ""} {
		$Menus($mname) add command -label $name \
			-command "set-lesson $nlessons"
		incr nlessons
	} {
		$mb add separator
	}
}

#
#  Set the current lesson
#
proc set-lesson {n} {
	global Lessons curlesson

	set curlesson $n
	do-open-file $Lessons($n)
}

#
#  Adjust the current lesson by some increment
#
proc adjust-lesson {i} {
	global curlesson nlessons

	incr curlesson $i
	if {$curlesson < 0} {
		set curlesson 0
	}
	if {$curlesson >= $nlessons} {
		mkInfoDialog .[uid] "That was the last lesson!" {Dismiss ""}
		set curlesson [expr $nlessons-1]
	}
	set-lesson $curlesson
}


#
# Clean up and exit
#
proc do-exit {} {
	global wdemo

	send $wdemo {after 1 {destroy .}}
	destroy .
}

#
# Configure the demo process
#
while {[lsearch [winfo interps] $wdemo] == -1} {
	after 50
}

send $wdemo {
	wm title . "Demo Window"
	wm iconname . "Demo Window"
	wm minsize . 100 100
}
send $wdemo "wm geometry . [option get . demo-geometry Wtour]"

#
#  Load in the lesson index
#
set nlessons 0
cd $lessondir
send $wdemo "cd $lessondir"
source ./index
set-lesson 0
eval "tk_menuBar $mframe $mframe.file $menu_bar $mframe.help"
