package ifneeded formkit 0.1 [list source [file join $dir formkit.tcl]]end of pkgIndex.tclformkit.tcl
package provide formkit 0.1
#Boretos, 2002
namespace eval formkit {
namespace export *
}
proc formkit::lock {db view} {
#####This HTTP_REFERER stuff really should become a proc of its own####
if {$::env(HTTP_REFERER) != "[eval join {http://$::env(HTTP_HOST)$::page(url)}]"}
{
####Form is refered, so lock record####
mk::row append locked.records db $db view $view position [Doc_Cookie position]
} else {
####Form is self-posted, data has been written, so unlock record#####
catch {mk::row delete locked.records![mk::select locked.records db $db view $view position [Doc_Cookie position]]}
}
}
proc formkit::init {db view next_page} {
if {$::env(HTTP_REFERER) == "[eval join {http://$::env(HTTP_HOST)$::page(url)}]"}
{
if {[lindex $::page(query) 1] == ""} {
#####Means a new record, so set a table position cookie ####
Doc_SetCookie -name position -value [mk::view size $db.$view]
#####Write this record into the locked.records table#####
#####It will have to be unlocked in the form_done proc
::formkit::lock $db $view
#####mk::row append locked.records db $db view $view position [mk::view size $db.$view]
##### and write the position, thus incrementing the actual table sizefor the next access#####
mk::row append $db.$view position [mk::view size $db.$view]
#####Redirect to the next page#####
Doc_Redirect $next_page
} else {
#####Check to see if desired record exists#####
#####This relies on the record position being first in the query data#####
if {[expr {[lindex $::page(query) 1] >= [mk::view size $db.$view]}]} {
set html ""
append html "No Such Record"
return $html
} else {
#####Check to see if desired record is locked, if not lock it#####
if {[mk::select locked.records db $db view $view position [lindex $::page(query) 1]] == ""} {
mk::row append locked.records db $db view $view position [lindex $::page(query) 1]
} else {
set html ""
append html "Record Is Currently Locked, Try Another Record"
return $html
}
#####Set a table position cookie###
#####The position cookie relies on having the position as the first element
#####in the query data, so design page accordingly###
Doc_SetCookie -name position -value [lindex $::page(query) 1]
#####Redirect to the next page#####
Doc_Redirect $next_page
}
}
}
}
####This is used in all subsequent forms/pages excluding the last form
proc formkit::page {db view next_page} {
if {$::env(HTTP_REFERER) != "[eval join {http://$::env(HTTP_HOST)$::page(url)}]"}
{
####Form is refered, lock the record and read values from the db.view to be displayed on the form####
::formkit::lock $db $view
eval mk::set $db.$view![Doc_Cookie position] position [Doc_Cookie position]
foreach {name value} [mk::get $db.$view![Doc_Cookie position]] {
upvar $name $name
set $name $value
}
} else {
####Form is self-posted, so read the page values, write to the db, and redirect#####
####Add for correct display checkbox state and edit (resubmit) the value if necessary####
foreach i [mk::view info $db.$view] {
set before($i) ""
}
eval mk::set $db.$view![Doc_Cookie position] [array get before]
foreach {name value} $::page(query) {
set $name $value
lappend field_values $name $value
}
eval mk::set $db.$view![Doc_Cookie position] $field_values
#####Comment the following if a commit is not desired for every page
mk::file commit $db
unset field_values
unset before
#####Unlock current record
::formkit::lock $db $view
Doc_Redirect $next_page
}
}
####This is used in the last form/page
proc formkit::done {db view next_page unlock_view} {
if {$::env(HTTP_REFERER) != "[eval join {http://$::env(HTTP_HOST)$::page(url)}]"}
{
####Form is refered, lock the record and read values from the db.view to be displayed on the form####
::formkit::lock $db $view
mk::set $db.$view![Doc_Cookie position] position [Doc_Cookie position]
foreach {name value} [mk::get $db.$view![Doc_Cookie position]] {
upvar $name $name
set $name $value
}
} else {
####Form is self-posted, so write the page values, unlock record and redirect#####
####Add for correct display of checkbox state and edit (resubmit) the value if necessary####
foreach i [mk::view info $db.$view] {
set before($i) ""
}
eval mk::set $db.$view![Doc_Cookie position] [array get before]
foreach {name value} $::page(query) {
set $name $value
lappend field_values $name $value
}
eval mk::set $db.$view![Doc_Cookie position] $field_values
#####Comment the following if a commit is not desired for every page
mk::file commit $db
unset field_values
unset before
#####Unlock current record
::formkit::lock $db $view
#####Unlock the "main" view that was locked with formkit_init######
catch {mk::row delete locked.records![mk::select locked.records db $db view $unlock_view position [Doc_Cookie position]]}
Doc_Redirect $next_page
}
}
#####Helper procs for check/radio box###
proc formkit::checkbox {db view name value} {
if {[mk::get $db.$view![Doc_Cookie position] $name] == $value} {return checked}
}
proc formkit::radio {db view name value} {
if {[mk::get $db.$view![Doc_Cookie position] $name] == $value} {return checked}
}end of formkit.tcldemo.tcl
package require Mk4tcl
#Open an in-memory file to store locked metakit records
mk::file open locked
mk::view layout locked.records {db view position}
#Open and define our datafile
mk::file open people people.dat
mk::view layout people.names {position first last c1 c2}
mk::view layout people.information {position email notes}end of demo.tclSample formsindex.tml[ Doc_Dynamic ] <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Welcome</title> </head> <body> <H3>Enter Record Number to Edit, Or Submit to Add a New Record</H3> <form method="POST" action="zero.tml"> <p><input type="submit" value="Add/Edit a Record" ></p> </form> </form> </body> </html>end of index.tmlzero.tml
[ Doc_Dynamic ] [ ::formkit::init people names first.tml ] <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Zero.tml</title> </head> <body> <form method="POST" action="$page(url)"> <p><input type="submit" value="Add/Edit a Record" ><input type="text" name="position" size="3"></p> </form> </form> </body> </html>end of zero.tmlfirst.tml
[
Doc_Dynamic
]
[
::formkit::page people names second.tml
]
[
puts $page(query)
]
<html>
<head>
<title>First.tml</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-7">
</head>
<body bgcolor="#FFFFFF" text="#000000">
<form>
<p>
<input type="text" name="position" value="[Doc_Cookie position]"></p>
<p>
<input type="text" name="first" value="$first">
First Name </p>
<p>
<input type="text" name="last" value="$last">
Last Name</p>
<p>
<input type="checkbox" name="c1" value="checked"[::formkit::radio people names c1 checked]>OK
</p>
<input type="radio" name="c2" value="male" [::formkit::checkbox people names c2 male]>
male</p>
<p>
<input type="radio" name="c2" value="female" [::formkit::checkbox people names c2 female]>
female</p>
<p>
<input type="submit" value="Continue">
</p>
</form>
</body>
</html>
<method="post" action="$page(url)">end of first.tmlsecond.tml
[
Doc_Dynamic
]
[
::formkit::done people information index.tml names
]
<html>
<head>
<title>Second</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-7">
</head>
<body bgcolor="#FFFFFF" text="#000000">
<form>
<p>
<input type="text" name="position" value="[Doc_Cookie position]"></p>
<p>
<input type="text" name="email" value="$email" >email</p>
<p>
<p><textarea rows="10" name="notes" cols="20">$notes</textarea>notes</p>
<input type="submit" name="Submit" value="Submit">
</p>
</form>
</body>
</html>
<method="post" action="$page(url)">end of second.tmlJeff Smith I am having a spot of bother trying formkit. When I do a package require the first time I get "missing close-brace" but thereafter it gives the version. When I do package require on say "html" it gives the version straight away.
% package require formkit missing close-brace % package require formkit 0.1 % package require html 1.2I was wondering if something was missed when you copied and paste to the wiki?NB I just checked and removed some "garbage" that included a couple of braces. I hope its ok now (it pastes correctly into a shell). BTW, thanks to whoever formatted this page nicely.
[ Category Package | Category Internet | ]

