## Table of Contents

FormBooleanElement
FormChoicesElement
FormElement
FormHiddenElement
FormPasswordElement
FormTextAreaElement
FormTextElement
WebForm
cgi_import_form
cgi_pkg_attrs
cgi_subhex
html
html_field_description
neo_cgi_import_form

[next] [TOC]

## Command

FormBooleanElement - an [incr tcl] class

### Synopsis

FormBooleanElement object

inherits FormElement

object configure config
object build_form_element config
object getf args
object setf value
object blank

### Description

    #
    # boolean element (checkbutton) form element class
    #

        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 ""
        }

[next] [prev] [TOC]

## Command

FormChoicesElement - an [incr tcl] class

### Synopsis

FormChoicesElement object -choices something

inherits FormElement

object configure config
object build_form_element config
object getf args
object setf value
object blank

### Description

    #
    # multiple choices (radiobutton widgets) form element class
    #

        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

[next] [prev] [TOC]

## Command

FormElement - an [incr tcl] class

### Synopsis

FormElement object -array something -text something -form something -name something -errorwidget {} -labelWidth 20

inherits

object name
object build_table_field_description config
object build_table_element config
object error
object normal

### Description

    #
    # generic form element class subclass
    #

        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"
        }

        # 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 "."
    	} else {
    	    html "$myArray($name)"
    	}
        }

        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

[next] [prev] [TOC]

## Command

FormHiddenElement - an [incr tcl] class

### Synopsis

FormHiddenElement object

inherits FormTextElement

object build_form_element config

### Description

    #
    # hidden element form element class
    #

        inherit FormTextElement

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

[next] [prev] [TOC]

## Command

FormPasswordElement - an [incr tcl] class

### Synopsis

FormPasswordElement object

inherits FormTextElement

object build_form_element config

### Description

    #
    # password element form element class
    #

        inherit FormTextElement

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

[next] [prev] [TOC]

## Command

FormTextAreaElement - an [incr tcl] class

### Synopsis

FormTextAreaElement object -rows 5 -cols 60

inherits FormTextElement

object build_form_element config

### Description

    #
    # text area element (entry widget) form element class
    #

        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)\n"
        }
        public rows 5
        public cols 60

[next] [prev] [TOC]

## Command

FormTextElement - an [incr tcl] class

### Synopsis

FormTextElement object -width 30

inherits FormElement

object configure config
object build_form_element config
object getf
object setf value
object blank

### Description

    #
    # text element (entry widget) form element class
    #

        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

[next] [prev] [TOC]

## Command

WebForm - an [incr tcl] class

### Synopsis

WebForm object -namesToObjects something -elementNames {}

inherits

object screen_to_array arrayName
object array_to_screen arrayName
object boolean name args
object text name args
object hidden name args
object password name args
object choices name args
object textarea name args
object emit_form args
object start_table args
object emit_table_record args
object end_table
object access_object name args
object normal
object blank
object add elementName

### Description

    #
    # form superclass
    #

        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>"
            foreach element $elementNames {
                eval $element build_form_element $args
            }
    	html ""
    	html ""
        }

        method start_table {args} {
    	html ""
    	foreach element $elementNames {
    	    eval $element build_table_field_description $args
    	}
    	html "\n"
        }

        method emit_table_record {args} {
    	html ""
    	foreach element $elementNames {
    	    eval $element build_table_element $args
    	}
    	html "\n"
        }

        method end_table {} {
    	html "\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

[next] [prev] [TOC]

## Command

cgi_import_form

### Synopsis

cgi_import_form argArrayName argTypeArrayName responseArrayName

### Description

        upvar $argArrayName ar
        upvar $argTypeArrayName artype
        upvar $responseArrayName response
        global env
        set bigarg ""
        #join words with +'s
        if [info exists env(PATH_INFO)] {
    	set args [split [crange $env(PATH_INFO) 1 end] /]
        } else {
    	set args {}
        }
        if [info exists env(QUERY_STRING)] {
    	set bigarg [split $env(QUERY_STRING) &]
        } else {
    	set bigarg {}
        }

        foreach arg [concat $bigarg $args] {
    	if [regexp {(.*)=(.*)} $arg foo name value] {
    	    set name [cgi_subhex $name]
    	    if ![info exists argcount($name)] {
    		set argcount($name) 1
    	    } else {
    		incr argcount($name)
    	    }
    	}
        }

        #split assignments on the '&'
        foreach arg [concat $bigarg $args] {
    	if [regexp {(.*)=(.*)} $arg foo name value] {
    	    regsub -all {\+} $value { } newval
    	    set name [cgi_subhex $name]
    	    set val [cgi_subhex $newval]
    	    if ![info exists ar($name)] {
    		if [info exists artype($name)] {
    		    if {$artype($name)=="list"} {
    			if {$val!=""} {
    			    set ar($name) [list $val]
    			} else {
    			    set ar($name) {}
    			}
    		    } else {
    			set ar($name) $val
    		    }
    		} else {
    		    set ar($name) $val
    		}
    	    } else {
    		# multiple selection
    		lappend ar($name) $val
    	    }
    	}
        }

        if [info exists env(CONTENT_LENGTH)] {
            set message [split [read stdin $env(CONTENT_LENGTH)] &]
            foreach pair $message {
    	    lassign [split $pair =] name val
    	    regsub -all {\+} [cgi_subhex $val] { } val
    	    set response($name) $val
            }
        }

[next] [prev] [TOC]

## Command

cgi_pkg_attrs

### Synopsis

cgi_pkg_attrs var attrs

### Description

    #makes URL extended pathname to encode current state

        upvar $var ar
        set al ""
        foreach i $attrs {
            if [info exists ar($i)] {
                regsub { } $ar($i) {+} att
                set al "$al/$i=$att"
            }
        }
        return $al

[next] [prev] [TOC]

## Command

cgi_subhex

### Synopsis

cgi_subhex v

### Description

    #@package: www_cgi_interface cgi_import_form neo_cgi_import_form
    #
    # Copyright (C) 1992-1997 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    # $Id: neo-www.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    # Hoarked around from web-found tcl-proc-args.tar.Z
    #arguments are passed on command line. '&' separates assignments
    #assignments have the form name=value
    #'+'s are spaces and spaces separating words on command line are
    #actually part of the word
    #In our environment, if argument starts with /, then pathname
    #components are assignments
    # global variable artype(i) defines what type ar(i) should be.  Currently,
    # list or not.

        set nv $v
        while {[regexp {%[0-9A-Fa-f][0-9A-Fa-f]} $v blah]} {
    	scan $blah "%%%x" cv
    	if {[ctype char $cv]=="&"} {
    	    regsub -all $blah $v \\& nv
    	} else {
    	    regsub -all $blah $v [ctype char $cv] nv
    	}
    	set v $nv
        }
        return $v

[next] [prev] [TOC]

## Command

html

### Synopsis

html stuff

### Description

    #@package: iwebforms IWebForm
    #
    # Web-based forms manager class library
    # by Karl Lehenbauer
    #
    # Copyright (C) 1993-1997 NeoSoft, All Rights Reserved
    #
    #
    # $Id: neo-www.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    #
    # emit some html stuff
    #

        puts stdout $stuff nonewline

[next] [prev] [TOC]

## Command

html_field_description

### Synopsis

html_field_description text

### Description

    #
    # emit an html form field description.  we do it in one place
    # to make changing the appearance for all of the fields easy
    #

        html "[format %15s $text]  "

[prev] [TOC]

## Command

neo_cgi_import_form

### Synopsis

neo_cgi_import_form argArrayName argTypeArrayName responseArrayName {fieldOrderVarName ""}

### Description

        upvar $argArrayName ar
        upvar $argTypeArrayName artype
        upvar $responseArrayName response
        if {$fieldOrderVarName != ""} {upvar $fieldOrderVarName fieldOrder}
        set fieldOrder ""
        global env
        set bigarg ""
        #join words with +'s
        if [info exists env(PATH_INFO)] {
    	set args [split [crange $env(PATH_INFO) 1 end] /]
        } else {
    	set args {}
        }
        if [info exists env(QUERY_STRING)] {
    	set bigarg [split $env(QUERY_STRING) &]
        } else {
    	set bigarg {}
        }

        foreach arg [concat $bigarg $args] {
    	if [regexp {(.*)=(.*)} $arg foo name value] {
    	    set name [www_unescape_string $name]
    	    if ![info exists argcount($name)] {
    		set argcount($name) 1
    	    } else {
    		incr argcount($name)
    	    }
    	}
        }

        #split assignments on the '&'
        foreach arg [concat $bigarg $args] {
    	if [regexp {(.*)=(.*)} $arg foo name value] {
    	    regsub -all {\+} $value { } newval
    	    set name [www_unescape_string $name]
    	    lappend fieldOrder $name
    	    set val [www_unescape_string $newval]
    	    if ![info exists ar($name)] {
    		if [info exists artype($name)] {
    		    if {$artype($name)=="list"} {
    			if {$val!=""} {
    			    set ar($name) [list $val]
    			} else {
    			    set ar($name) {}
    			}
    		    } else {
    			set ar($name) $val
    		    }
    		} else {
    		    set ar($name) $val
    		}
    	    } else {
    		# multiple selection
    		lappend ar($name) $val
    	    }
    	}
        }

        if [info exists env(CONTENT_LENGTH)] {
            set message [split [read stdin $env(CONTENT_LENGTH)] &]
            foreach pair $message {
    	    lassign [split $pair =] name val
    	    set response($name) [www_unescape_string $val]
    	    lappend fieldOrder $name
            }
        }