#@package: iwebforms IWebForm

package require Itcl

#
# Web-based forms manager class library
# by Karl Lehenbauer
#
# Copyright (C) 1993-1997 NeoSoft, All Rights Reserved
#

#
# $Id: iwebforms.tcl,v 1.1.1.1 1999/03/31 20:34:38 damon Exp $
#

#
# emit some html stuff
#
proc html {stuff} {
    puts stdout $stuff nonewline
}

#
# emit an html form field description.  we do it in one place
# to make changing the appearance for all of the fields easy
#
proc html_field_description {text} {
    html "[format %15s $text]  "
}

#
# generic form element class subclass
#
itcl_class FormElement {

    constructor {config} {
        global currentForm
        $currentForm add $this

	if ![info exists name] {
	    error "-name must be specified"
	}

	if ![info exists text] {
	    set text [translit "_" " " $name]
	}
    }

    destructor {}

    method name {} {
	return $name
    }

    # When outputting tables, this will output the field description
    # as the column header.
    method build_table_field_description {config} {
	html "<th>$text</th>"
    }

    # When outputting tables, this will output the data corresponding
    # to the array element for this element as table data.
    #
    # Output a dot in empty fields to prevent netscape from
    # spanning them, which looks confusing.

    method build_table_element {config} {
	upvar #0 $array myArray

	if {[clength $myArray($name)] == 0} {
	    html "<td align=center>.</td>"
	} else {
	    html "<td>$myArray($name)</td>"
	}
    }

    method error {} {
	if {$error == 1 || $errorwidget == ""} return
	set error 1
	$errorwidget configure -background red
    }

    method normal {} {
	if {$error == 0 || $errorwidget == ""} return
	set error 0
	$errorwidget configure -background [option get . background Tk]
    }

    protected error 0

    public array
    public text
    public form
    public name
    public errorwidget ""
    public labelWidth 20
}

#
# boolean element (checkbutton) form element class
#
itcl_class FormBooleanElement {
    inherit FormElement

    method configure {config} {}

    method build_form_element {config} {
	upvar #0 $array myArray
	html_field_description $text
	set checked ""
	if {$myArray($name)} {
	    set checked " checked"
	}
	html "<input type=\"checkbox\" name=\"$array:$name\" value=\"$myArray($name)\"$checked>\n"
    }

    method getf {args} {
        global $array
        return [set ${array}($name)]
    }

    method setf {value} {
        global $array
        set ${array}($name) $value
	return
    }

    method blank {} {
	setf ""
    }
}

#
# text element (entry widget) form element class
#
itcl_class FormTextElement {
    inherit FormElement

    method configure {config} {}

    destructor {
	catch {unset lastElementCreated($form)}
	catch {unset firstElementCreated($form)}
    }

    method build_form_element {config} {
	upvar #0 $array myArray
	html_field_description $text
	html "<input type=\"text\" name=\"$array:$name\" value=\"$myArray($name)\">\n"
    }

    method getf {} {
	global $array
        return [set ${array}($name)]
    }

    method setf {value} {
	global $array
	set ${array}($name) $value
    }

    method blank {} {
        setf ""
    }

    protected widget
    common lastElementCreated
    common firstElementCreated

    public width 30
}

#
# text area element (entry widget) form element class
#
itcl_class FormTextAreaElement {
    inherit FormTextElement

    method build_form_element {config} {
	upvar #0 $array myArray
	html "$text:\n"
	html "<textarea name=\"$array:$name\" rows=$rows cols=$cols>$myArray($name)</textarea>\n"
    }
    public rows 5
    public cols 60
}

#
# hidden element form element class
#
itcl_class FormHiddenElement {
    inherit FormTextElement

    method build_form_element {config} {
        upvar #0 $array myArray
        html "<input type=\"hidden\" name=\"$array:$name\" value=\"$myArray($name)\">"
    }
}

#
# password element form element class
#
itcl_class FormPasswordElement {
    inherit FormTextElement

    method build_form_element {config} {
        upvar #0 $array myArray
	html_field_description $text
        html "<input type=\"password\" name=\"$array:$name\">\n"
    }
}


#
# multiple choices (radiobutton widgets) form element class
#
itcl_class FormChoicesElement {
    inherit FormElement

    method configure {config} {}

    method build_form_element {config} {
	set choiceNumber 0

	upvar #0 $array myArray

        html_field_description "$text"
        foreach choice $choices {
	    set checked ""
	    if {$myArray($name) == $choice} {
		set checked " checked"
	    }
	    html "<input type=\"radio\" name=\"$array:$name\" value=\"$choice\"$checked> $choice"
        }
	html "\n"
    }

    method getf {args} {
        global $array
        return [set ${array}($name)]
    }

    method setf {value} {
        global $array
        set ${array}($name) $value
	return
    }

    method blank {} {
	setf ""
    }

    public choices
}

#
# form superclass
#
itcl_class WebForm {

    constructor {config} {
        global currentForm
        set currentForm $this
    }

    destructor {
	foreach element $elementNames {
	    $element delete
	}
    }

    method screen_to_array {arrayName} {
	upvar $arrayName array

        foreach element $elementNames {
            set array([$element name]) [$element getf]
        }
    }

    method array_to_screen {arrayName} {
	upvar $arrayName array

        foreach element $elementNames {
            $element setf $array([$element name])
        }
    }

    method boolean {name args} {
        set object [eval FormBooleanElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method text {name args} {
        set object [eval FormTextElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method hidden {name args} {
        set object [eval FormHiddenElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method password {name args} {
        set object [eval FormPasswordElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method choices {name args} {
        set object [eval FormChoicesElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method textarea {name args} {
        set object [eval FormTextAreaElement #auto -form $this -name $name $args]
	set namesToObjects($name) $object
    }

    method emit_form {args} {
	html "<form><pre>"
        foreach element $elementNames {
            eval $element build_form_element $args
        }
	html "<input type=submit>"
	html "</pre></form>"
    }

    method start_table {args} {
	html "<table border><tr>"
	foreach element $elementNames {
	    eval $element build_table_field_description $args
	}
	html "</tr>\n"
    }

    method emit_table_record {args} {
	html "<tr>"
	foreach element $elementNames {
	    eval $element build_table_element $args
	}
	html "</tr>\n"
    }

    method end_table {} {
	html "</table>\n"
    }

    method access_object {name args} {
	eval $namesToObjects($name) $args
    }

    method normal {} {
	foreach element $elementNames {
	    $element normal
	}
    }

    method blank {} {
	foreach element $elementNames {
	    $element blank
	}
	normal
    }

    method add {elementName} {
        lappend elementNames $elementName
    }

    public namesToObjects
    public elementNames ""
    global currentForm
}

