cvs commit: tcl-rivet/rivet/packages/form form.tcl pkgIndex.tcl

[da...@apache.org]

damonc      02/03/26 15:20:25

  Modified:    .        ChangeLog
  Added:       rivet/packages/form form.tcl pkgIndex.tcl
  Log:
  * rivet/packages/form
      Added a new package for handling forms in Rivet.
  
  Revision  Changes    Path
  1.53      +5 -0      tcl-rivet/ChangeLog
  
  Index: ChangeLog
  ===================================================================
  RCS file: /home/cvs/tcl-rivet/ChangeLog,v
  retrieving revision 1.52
  retrieving revision 1.53
  diff -u -r1.52 -r1.53
  --- ChangeLog	26 Mar 2002 19:39:26 -0000	1.52
  +++ ChangeLog	26 Mar 2002 23:20:25 -0000	1.53
  @@ -1,5 +1,10 @@
   2002-03-26  Damon J. Courtney <da...@unreality.com>
   
  +	* rivet/packages/form
  +	    Added a new package for handling forms in Rivet.
  +
  +2002-03-26  Damon J. Courtney <da...@unreality.com>
  +
   	* src/TclWebapache.c
   	    Moved the setting of include variables from LoadEnv to the
   	    InitEnv command.  This will allow us to retrieve these variables
  
  
  
  1.1                  tcl-rivet/rivet/packages/form/form.tcl
  
  Index: form.tcl
  ===================================================================
  package require Itcl
  
  package provide form 1.0
  
  ::itcl::class form {
  
      constructor {args} {
  	set arguments(METHOD) POST
  	set arguments(ACTION) [env DOCUMENT_URI]
  
  	import_data form $this arguments $args
  
  	if {[info exists arguments(DEFAULTS)]} {
  	    upvar 1 $arguments(DEFAULTS) defaults
  	    array set DefaultValues [array get defaults]
  	    unset arguments(DEFAULTS)
  	}
  	start
      }
  
      destructor {
  
      }
  
      protected method import_data {type name arrayName list} {
  	upvar 1 $arrayName data
  
  	if {[info exists DefaultArgs($type)]} {
  	    set list [concat $DefaultArgs($type) $list]
  	}
  
  	if {[info exists DefaultValues($name)]} {
  	    set data(VALUE) $DefaultValues($name)
  	}
  
  	if {[expr [llength $list] % 2]} {
  	    return -code error "Unmatched key-value pairs"
  	}
  
  	set return ""
  	foreach {var val} $list {
  	    set var [string range [string toupper $var] 1 end]
  	    set data($var) $val
  	    if {$var == "VALUES"} { continue }
  	    lappend return -$var $val
  	}
  	return $return
      }
  
      protected method argstring {arrayName} {
  	upvar 1 $arrayName data
  	set string ""
  	foreach arg [lsort [array names data]] {
  	    append string " $arg=\"$data($arg)\""
  	}
  	return $string
      }
  
      method default_value {name {newValue ""}} {
  	if {[lempty $newValue]} {
  	    if {![info exists DefaultValues($name)]} { return }
  	    return $DefaultValues($name)
  	}
  	return [set DefaultValues($name) $newValue]
      }
  
      method default_args {type args} {
  	if {[lempty $args]} {
  	    if {![info exists DefaultArgs($type)]} { return }
  	    return $DefaultArgs($type)
  	}
  	if {[expr [llength $args] % 2]} {
  	    return -code error "Unmatched key-value pairs"
  	}
  	return [set DefaultArgs($type) $args]
      }
  
      method start {} {
  	puts "<FORM [argstring arguments]>"
      }
  
      method end {} {
  	puts "</FORM>"
      }
  
      method field {type name args} {
  	import_data $type $name data $args
  	set string "<INPUT TYPE=\"$type\" NAME=\"$name\""
  	append string [argstring data]
  	switch -- $type {
  	    "radio" -
  	    "checkbox" {
  		if {![info exists data(VALUE)]} { set data(VALUE) "" }
  		if {[info exists DefaultValues($name)]} {
  		    if {$data(VALUE) == $DefaultValues($name)} {
  			append string " CHECKED"
  		    }
  		}
  	    }
  	}
  	append string ">"
  	if {$type == "radio"} {
  	    puts $string$data(VALUE)
  	} else {
  	    puts $string
  	}
      }
  
      method text {name args} {
  	eval field text $name $args
      }
  
      method password {name args} {
  	eval field password $name $args
      }
  
      method hidden {name args} {
  	eval field hidden $name $args
      }
  
      method submit {name args} {
  	eval field submit $name $args
      }
  
      method reset {name args} {
  	eval field reset $name $args
      }
  
      method image {name args} {
  	eval field image $name $args
      }
  
      method checkbox {name args} {
  	eval field checkbox $name $args
      }
  
      method radiobuttons {name args} {
  	set list [import_data radiobuttons $name data $args]
  	if {![info exists data(VALUES)]} {
  	    return -code error "No -values specified for radiobuttons"
  	}
  	foreach value $data(VALUES) {
  	    eval field radio $name $list -value $value
  	}
      }
  
      method select {name args} {
  	import_data select $name data $args
  	set values $data(VALUES)
  	unset data(VALUES)
  	set default ""
  	if {[info exists DefaultValues($name)]} {
  	    set default $DefaultValues($name)
  	}
  	puts "<SELECT NAME=\"$name\" [argstring data]>"
  	foreach value $values {
  	    if {$value == $default} {
  		set string "<OPTION SELECTED>"
  	    } else {
  		set string "<OPTION>"
  	    }
  	    puts $string$value
  	}
  	puts "</SELECT>"
      }
  
      method textarea {name args} {
  	import_data textarea $name data $args
  	set value ""
  	if {[info exists data(VALUE)]} {
  	    set value $data(VALUE)
  	    unset data(VALUE)
  	}
  	puts "<TEXTAREA NAME=\"$name\" [argstring data]>$value</TEXTAREA>"
      }
  
      private variable DefaultValues
      private variable DefaultArgs
  
      private variable arguments
  
  } ; ## ::itcl::class form
  
  
  
  1.1                  tcl-rivet/rivet/packages/form/pkgIndex.tcl
  
  Index: pkgIndex.tcl
  ===================================================================
  package ifneeded form 1.0 [list source [file join $dir form.tcl]]
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-dev-help@tcl.apache.org