# register.tcl
#	User registration
#
proc Register_Init {win0 {how reuse}} {
    global WebTk Register
    trace variable Register w RegisterTrace
    if {[info exists Register(version)]} {
	regexp {^([0-9]+)\.([0-9]+)} $Register(version) x major1 minor1
	regexp {^([0-9]+)\.([0-9]+)} $WebTk(version) x major2 minor2
	if {$major1 > $major2} {
	    return 0
	} elseif {$major1 == $major2} {
	    if {$minor1 >= $minor2} {
		return 0
	    }
	}
    }
    Register $win0 $how
    return 1
}
proc Register_CheckPoint {out} {
    global Register
    puts $out [list array set Register [array get Register]]
}
proc Register {win {how new}} {
    RegisterInner $win register.html $how
}
proc Register_Bug {win {how new}} {
    upvar #0 HM$win var
    global Register
    # Set up some state used by the client side Tcl in the reg form
    if [info exists var(S_url)] {
	set Register(url) $var(S_url)
    }
    RegisterInner $win bugrpt.html $how
}
proc RegisterInner {win file how} {
    global Register WebTk tcl_platform
    if {$tcl_platform(platform) != "unix" ||
	[catch {exec uname -a} uname]} {
	set uname ""
	foreach x [lsort [array names tcl_platform]] {
	    lappend uname $x=$tcl_platform($x)
	}
    }
    set Register(system) $uname
    set local [file join $WebTk(html) $file]
    if [file exists $local] {
	set url file:$local
    } else {
	set url http://www.sunlabs.com/~bwelch/editor/$file
    }
    if {$how == "new"} {
	Url_DisplayNew $url $win
    } else {
	Url_Display $win $url
    }
}

# The registration and bug report use client side Tcl microscripting
# This runs in a safe interpreter, so here we initialize and
# save the state from the safe child.
proc Register_SafeInit {interp win} {
    global WebTk
    global Register
    $interp eval [list array set WebTk [array get WebTk]]
    $interp eval [list array set Register [array get Register]]
    interp alias $interp RegistrationNumber {} RegistrationNumber
}
proc Register_SafeDelete {interp win} {
    global Register
    array set Register [$interp eval [list array get Register]]
}
proc RegisterTrace {args} {
    global Register
    foreach interp [interp slaves] {
	$interp eval [list array set Register [array get Register]]
    }
}
proc RegistrationNumber {} {
    global Register
    if [info exists Register(serial)] {
	return $Register(serial)
    } else {
	return (unregistered)
    }
}
# Handler for the response to the registration form
proc Content_application/x-register {win url} {
    upvar #0 $url data
    foreach {key value} $data(mime) {
	switch -- [string tolower $key] {
	    x-registration {
		global Register WebTk
		set Register(serial) [string trim $value]
		set Register(version) $WebTk(version)
	    }
	    x-bugid {
		global Register
		set Register(lastbugid) [string trim $value]
	    }
	}
    }
    regsub {\?.*} $url {} var(S_url)
    if ![catch {
	Url_DisplayHtml $win $var(S_url) [UrlGetFile $data(file)]
	CheckPoint
    }] then {
	return 1	;# we displayed something
    }
    return 0
}
proc Register_Save {} {
    global Register WebTk
    set Register(version) $WebTk(version)
    CheckPoint
    set html "<h3>Registration Saved</h3>\n<dl>"
    foreach item [lsort [array names Register]] {
	append html "<dt>$item<dd>$Register($item)"
    }
    append html </dl>
    DialogHtmlInfo {} $html
}
