# wince-install.tcl --
#
#	Install Tcl/Tk onto a CE device
#

package require Tk 8.4
package require BWidget
package require fileutil ; # for 'find' to do recursive install

set INSTDIR	"\\Tcl"
set USER	"tcl"
set HOST	"pocketpc"
set HERE	[file dirname [info script]]
set CEBINDIR	[file join $HERE cebin]
set CEREG	[file join $CEBINDIR cereg.exe]
set CEMKDIR	[file join $CEBINDIR cemkdir.exe]
set CECOPY	[file join $CEBINDIR cecopy.exe]

proc reg {args} {
    eval [list exec $::CEREG] $args
}

proc cemkdir {dir} {
    if {[catch {exec $::CEMKDIR $dir} err]
	&& ![string match "*already exists*" $err]} {
	return -code error $err
    }
}

proc cecopy {src dst} {
    # must take file as arg
    exec $::CECOPY pc:$src ce:$dst
}

proc ui {root} {
    wm withdraw $root
    wm title $root "WinCE Tcl/Tk Installer"
    if {$root eq "."} { set w "" } else { set w $root }

    set f ""

    label $f.instl -anchor e -text "Installation Directory:"
    entry $f.inste -textvariable INSTDIR

    label $f.userl -anchor e -text "User Name:"
    entry $f.usere -textvariable USER

    label $f.hostl -anchor e -text "Computer Name:"
    entry $f.hoste -textvariable HOST

    grid $f.instl $f.inste -padx 2 -pady {4 0} -sticky ew
    grid $f.userl $f.usere -padx 2 -pady {4 0} -sticky ew
    grid $f.hostl $f.hoste -padx 2 -pady {4 0} -sticky ew

    set f [frame .btn]
    button $f.inst -width 8 -text "Install" -command install
    button $f.exit -width 8 -text "Exit" -command exit

    grid $f.inst $f.exit -row 1 -sticky e -padx 6 -pady 8
    grid $f - -sticky nes

    ProgressBar $w.bar -variable ::PROGRESS -type infinite \
	-height 15 -borderwidth 1
    grid $w.bar - -sticky ew -padx 2 -pady 2

    grid columnconfigure $root 1 -weight 1
    grid rowconfigure $root 5 -weight 1

    wm deiconify $root
}

proc progress {{len 5}} {
    set ::PROGRESS $len
    update idle
}

proc install-dir {src dst} {
    if {![file isdirectory $src]} {
	return -code error "'$src' is not a directory"
    }
    set src   [file normalize $src]
    set len   [string len $src]
    set last  [file tail $src]
    foreach file [fileutil::find $src] {
	# This assumes we never jump out of src dir
	set file [file normalize $file]
	if {[file isdir $file]} {
	    cemkdir $dst[string range $file $len end]
	} else {
	    cecopy $file $dst[string range $file $len end]
	}
	progress
    }
}

proc install {} {
    global INSTDIR USER HOST

    set INSTDIR [file nativename $INSTDIR]
    set wish "$INSTDIR\\bin\\wish84.exe"

    #not necessary for properly installed Tcl
    #set libdir /Tcl/lib
    #reg -k "HKLM\\Environment" -n "TCL_LIBRARY" -v "%libdir%/tcl8.4"
    #reg -k "HKLM\\Environment" -n "TK_LIBRARY" -v "%libdir%/tk8.4"

    if {[catch {
	progress
	cemkdir $INSTDIR
	cemkdir $INSTDIR/bin
	cemkdir $INSTDIR/lib
	progress
	install-dir [pwd]/bin $INSTDIR/bin
	install-dir [pwd]/lib $INSTDIR/lib

	progress
	reg -k "HKCR\\.tcl" -n "" -v "tclfile"
	reg -k "HKCR\\tclfile" -n "" -v "TclTk Script"
	reg -k "HKCR\\tclfile\\DefaultIcon" -n "" -v "$wish,0"
	reg -k "HKCR\\tclfile\\Shell\\open\\command" -n "" \
	    -v "\"$wish\" \"%1\""

	progress
	reg -k HKLM\\Environment -n COMPUTERNAME -v $HOST
	reg -k HKLM\\Environment -n HOME         -v \\Temp\\$USER
	reg -k HKLM\\Environment -n PATH         -v $INSTDIR\\bin
	reg -k HKLM\\Environment -n TEMP         -v \\Temp
	reg -k HKLM\\Environment -n TMP          -v \\Temp
	reg -k HKLM\\Environment -n TMPDIR       -v \\Temp
	reg -k HKLM\\Environment -n USERNAME     -v $USER
	reg -k HKLM\\Environment -n CELIBSTDLOGDIR -v \\Temp
	progress
    } err]} {
	tk_messageBox -title "Install Error" -type ok -icon error \
	    -message "Error installing Tcl/Tk to $INSTDIR:\n$err"
    } else {
	tk_messageBox -title "Install Successful" -type ok \
	    -message "Successfully installed Tcl/Tk to $INSTDIR"
	progress 0
    }
}

set root .
ui $root
