# Pre-process a simple form.
# The form has three fields:
#  name is a text field which should contain two alphabetic words.
#  job is a text field which may be anything
#  age is a text field which should be an integer 0 < age <= 100
# The checks may be performed on-the-fly, but this version just does them
# at form submission.

proc HMreset_form {args} {
    puts "HMreset_form $args"
}

proc HMend_form {args} {
    puts "HMendform $args"
}

proc HMsubmit_form {method query} {
    global namewin agewin
    puts "HMsubmit_form $method $query"

    # Check name field
    if {$namewin == {}} {
	puts "no item for name"
    } else {
	set name [$namewin get]
	if {[llength $name] < 2} {
	    tk_dialog .errmsg "Form Entry Error" "You must specify both names" {} 0 "OK"
	    # Flash the offending field
	    flash $namewin
	    error "bad form input"
	} elseif {[llength $name] > 2} {
	    tk_dialog .errmsg "Form Entry Error" "You may only specify first name and surname" {} 0 "OK"
	    # Flash the offending field
	    flash $namewin
	    error "bad form input"
	} elseif {[regexp {[A-Z][a-z]+ [A-Z][a-z]+} $name] != 1} {
	    tk_dialog .errmsg "Form Entry Error" "You must specify a proper name" {} 0 "OK"
	    # Flash the offending field
	    flash $namewin
	    error "bad form input"
	}
    }

    # Check age field
    if {$agewin == {}} {
	puts "no item for age"
    } else {
	set age [$agewin get]
	if {[catch {expr abs(int($age)) == $age} same]} {
	    tk_dialog .errmsg "Form Entry Error" "You must specify a number for your age" {} 0 "OK"
	    # Flash the offending field
	    flash $agewin
	    error "bad form input"
	} elseif {!$same || $age > 100} {
	    tk_dialog .errmsg "Form Entry Error" "How can you be $age years old?" {} 0 "OK"
	    # Flash the offending field
	    flash $agewin
	    error "bad form input"
	}
    }

    # If we get to here then everything is OK
    return $query
}

proc flash {item} {
    global flashcnt flashid flashprevbg

    if {[info exists flashid($item)]} {
	# Stop previous call to flash
	after cancel $flashid($item)
    }

    set flashcnt($item) 3
    set flashprevbg($item) [$item cget -background]
    set flashid($item) [after 250 do_flash on $item]
}

proc do_flash {toggle item} {
    global flashcnt flashid flashprevbg

    if {$toggle} {
	[applet embedwindow] see [[applet embedwindow] index $item] ;# Make sure flashing can be seen
	$item configure -background orange
	incr flashcnt($item) -1
	set flashid($item) [after 250 do_flash off $item]
    } else {
	$item configure -background $flashprevbg($item)
	if {$flashcnt($item)} {
	    set flashid($item) [after 250 do_flash on $item]
	}
    }
}

set items {}
set namewin {}
set agewin {}

proc HMapplet_item {type name item} {
    global items namewin agewin
    puts "HMapplet_item type \"$type\" name \"$name\" item \"$item\""
    lappend items [list $type $name $item]
    display_items

    # Find the interesting widgets
    if {$name == "name"} {
	set namewin $item
    } elseif {$name == "age"} {
	set agewin $item
    }
}

proc display_items {} {
    global items

    destroy .f.items
    frame .f.items
    pack .f.items -side top
    set cnt 0
    foreach i $items {
	label .f.items.$cnt -text "[lindex $i 0] [lindex $i 1] [lindex $i 2]"
	pack .f.items.$cnt
	incr cnt
    }
}

frame .f
label .f.lab -text "Form has items:"
frame .f.items
pack .f.lab .f.items -side top
pack .f
