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

wm title . "TKGRABBER INSTALL"

set WISH /usr/local/bin
set CWD [pwd]
pack [frame .1 -relief ridge -bd 2] -fill both -padx 2m -pady 2m

########## Entry widgets 
pack [frame .1.wish] -fill x
pack [label .1.wish.label -text "Wish Interpreter path -> " -width 25 \
	-anchor e] -side left
pack [entry .1.wish.entry -relief sunken -textvariable WISH] \
	-side left -padx 2m -pady 1m -expand 1 -fill x
focus .1.wish.entry
bind .1.wish.entry <Tab> {focus .1.tkgrabber.entry}
bind .1.wish.entry <Return> {focus .1.tkgrabber.entry}

set TKGRABBER /usr/local/lib
pack [frame .1.tkgrabber] -fill x
pack [label .1.tkgrabber.label -text "Tkgrabber Parent Directory -> " \
	-width 25 -anchor e] -side left
pack [entry .1.tkgrabber.entry -relief sunken -textvariable TKGRABBER] \
	-side left -padx 2m -pady 1m -expand 1 -fill x
bind .1.tkgrabber.entry <Tab> {focus .3.install}
bind .1.tkgrabber.entry <Return> {focus .3.install}
########## Entry widgets 

########## Status box
pack [frame .2] -padx 2m -pady 2m -fill both
pack [label .2.label -text "STATUS OF INSTALL" -bg grey -relief sunken] -fill x
pack [scrollbar .2.scroll -relief sunken -command ".2.status yview"] -fill y \
	-side right
pack [text .2.status -bd 2 -relief sunken -yscroll ".2.scroll set"] -fill both
.2.status config -width 70 -height 10
########## Status box

########## Button box
pack [frame .3] -padx 2m -pady 2m -fill both
pack [button .3.install -text INSTALL] -padx 2m -pady 2m -fill x -side left \
	-expand 1
pack [button .3.cancel -text CANCEL -command exit] \
	-padx 2m -pady 2m -fill x -side left -expand 1
bind .3.install <Tab> {focus .3.cancel}
bind .3.install <Return> {.3.install flash; .3.install invoke}
bind .3.install <FocusIn> {.3.install config -state active}
bind .3.install <FocusOut> {.3.install config -state normal}
bind .3.cancel <Tab> {focus .1.wish.entry}
bind .3.cancel <Return> {.3.cancel flash; .3.cancel invoke}
bind .3.cancel <FocusIn> {.3.cancel config -state active}
bind .3.cancel <FocusOut> {.3.cancel config -state normal}
.3.install config -command ".3.install config -state disabled;install;\
	.3.install config -state normal"
########## Button box

proc status {message} {
        .2.status config -state normal
        .2.status insert end "$message\n"
        .2.status yview {end -9 lines}
        .2.status config -state disabled
        update
}

proc install {} {
	global WISH TKGRABBER

	set_cursor watch
	if {! [file readable ./tkgrabber-1.tz]} {
		set msg "./tkgrabber-1.tz is not accessable.\n\tPlease make \
			sure tkgrabber-1.tz is located in current directory."
		status "$msg"
		dialog .d Error "$msg" error 0 OK
		set_cursor arrow
		return 1
	}
		
	foreach dir "$WISH $TKGRABBER" {
		# make sure user gives a value.
		if {"$dir" == ""} {
			status "\nUser did not supply a value for $dir.\n"
			dialog .d Error "You must supply a value for $dir" \
                	error 0 OK
			set_cursor arrow
			return 1
		}
		# create the directory if it does not exist
		if {! [file isdirectory $dir]} {
			set answer [dialog .d Question "$dir does not\
                        exist." questhead 0 "CREATE IT" CANCEL]
                	if {$answer} {set_cursor arrow;return}
			status "Creating $dir ..."
			if {[catch {exec mkdir -p $dir} error]} {
			  status "\nFailed to create $dir.\n"
			  dialog .d Error "Failed to create $dir\n$error" \
				error 0 OK
			  set_cursor arrow
			  return 1
			}
		}
	}
	# copy tar ball to TKGRABBER directory and unpack it.
	status "Copying ./tkgrabber-1.tz to $TKGRABBER"
	if {[catch {exec cp ./tkgrabber-1.tz $TKGRABBER} error]} {
		status "\nFailed to copy ./tkgrabber-1.tz to $TKGRABBER\n"
		dialog .d Error "Failed to copy ./tkgrabber-1.tz to \
			$TKGRABBER\n $error" error 0 OK
		set_cursor arrow
		return 1
	}
	status "Uncompressing $TKGRABBER/tkgrabber-1.tz into tkgrabber-1.tar..."
	cd $TKGRABBER
	if {[catch {exec cat [pwd]/tkgrabber-1.tz | uncompress > \
		tkgrabber-1.tar} error]} {
		status "\nFailed to uncompress [pwd]/tkgrabber-1.tz into \
			tkgrabber-1.tar\n"
		dialog .d Error "Failed to uncompress [pwd]/tkgrabber-1.tz \
			into tkgrabber-1.tar\n$error" error 0 OK
		set_cursor arrow
		global CWD; cd $CWD
		return 1
	}
	catch {exec rm tkgrabber-1.tz}
	status "Untarring $TKGRABBER/tkgrabber-1.tar ..."
	if {[catch {exec tar xvf tkgrabber-1.tar} return]} {
		status "\nFailed to untar [pwd]/tkgrabber-1.tar.\n$return\n"
		dialog .d Error "Failed to untar [pwd]/tkgrabber-1.tar." \
			error 0 OK
		set_cursor arrow
		global CWD; cd $CWD
		return 1
	}
	catch {exec rm tkgrabber-1.tar}
	status "$return"

	# create top template for tkgrabber executable
	cd tkgrabber-1
	foreach one "tkgrabber open.tcl" {
	  status "Modifying the $one executable ..."
	  set id [open ./$one w]
	  puts $id "#!$WISH/wish -f"
	  puts $id {# MAKE SURE THAT THE LINE ABOVE POINTS TO YOUR COPY OF WISH}
	  puts $id {}
	  puts $id {# MAKE SURE THAT THE LINE BELOW POINTS TO WHERE YOU UNPACK\
		  THE TKGRABBER PACKAGE}
	  puts $id "set lib $TKGRABBER/tkgrabber-1"
	  puts $id {}
	  flush $id
	  close $id
	  if {[catch {exec cat $one.template >> $one} error]} {
		status "\nFailed to modify $one executable.\n$error\n"
		dialog .d Error "Failed to modify $one executable.\n$error" \
			error 0 OK
		set_cursor arrow
		global CWD; cd $CWD
		return 1
	  }
	  catch {exec chmod +x $one}
	}

	# Link tkgrabber executable to the WISH dir.
	status "Linking [pwd]/tkgrabber to $WISH/tkgrabber ..."
	if {[file exists $WISH/tkgrabber]} {catch {exec rm -f $WISH/tkgrabber}}
	if {[catch {exec ln -s [pwd]/tkgrabber $WISH/tkgrabber} error]} {
		status "\nFailed to link [pwd]/tkgrabber to $WISH/tkgrabber\n"
		status "You should copy [pwd]/tkgrabber to a dir. in your path"
		dialog .d Error "Failed to link tkgrabber to $WISH\n$error" \
			error 0 OK
	}
	set_cursor arrow
	dialog .d "SUCCESSFUL INSTALL" "Install complete." info 0 OK
	focus .3.cancel
}
		

# dialog procedure taken/enhanced from the Ousterhout book that creates 
# dialog boxes with bitmaps and messages.
proc dialog {w title text bitmap default args} {
	global button

	catch {destroy $w}
	toplevel $w -class Dialog
	wm transient $w .
	wm title $w $title
	wm geom $w +500+400
	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

	message $w.top.msg -width 10c -text $text 
	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
	}

	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
	}

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

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

proc set_cursor {cursor} {
	foreach widget [winfo children .] {$widget config -cursor $cursor}
	.2.status config -cursor $cursor
}

bind Entry <Any-Key> "
	# Use the regexp to make sure that the user is not using a 
	# Ctrl key combination to access a menu.
	if {! \[regexp -nocase control %K\]} {
		catch {%W delete sel.first sel.last}
	}
	[bind Entry <Any-Key>]"

status "Awaiting user command to begin install...\n"
