wiki.tcl.tk 
formkit
Updated 2005-12-01 17:20:05 by escargo ▲
The following package uses tclhttpd templates (tml pages)and metakit to store and retrieve web form information. Tclhttpd "proxies" form submissions/requests, thus giving a multiuser and pseudo "acidity" to metakit.
Formkit's main use is to create webforms are sequentially used either to submit information or to display information retrived from a metakit database. Usually, one would create a "nice" looking form in an html editor, and then add the formkit-specific stuff into it.
Also demonstrated is the use of cookies within tclhttpd, wherein the table position is stored and passed around from form to form. The demo provided uses one table per form, although that could be modified, and works under the premise that tables are related through their row position, e.g., "record 5 in table a is related to record 5 in table b".
Note there is minimal error checking, and that the procs could be cleaned up a lot, and the approach used is that a form is either "referred" or "self-posted". If referred, it is either a new entry, or an "edit" thus it should display information based on row position (extracted from the cookie). If self-posted, the form has to write its contents, and re-direct.....
So to run the demo stuff,
Put the pkgIndex and formkit files in tclhttpd's lib or custom dir
Package require formkit
source demo.tcl to create an empty db
Point your browser to the htdocs directory where the index, zero, first and second .tml files reside
Anyway,
hope this is of use, and happy new year
nicolas boretos
pkgIndex.tcl
 package ifneeded formkit 0.1 [list source [file join $dir formkit.tcl]]
end of pkgIndex.tcl
formkit.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.tcl
demo.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.tcl
Sample forms
index.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.tml
zero.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.tml
first.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.tml
second.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.tml

Jeff 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.2
I 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 | ]

* Home 
* Recent changes 
* Help 
* Edit 
* History 
* References
窗體頂端

窗體底端
窗體頂端

窗體底端
Getting started 
What is Tcl?
What is Tk?
Getting Tcl/Tk
Getting help
Learning Tcl
The Tcl Dev Xchange
About the Wiki
Community 
Advocacy
Conferences
Chat, news, lists
History
Humor
People
Tcl websites
Reference 
Companies
Getting help
Online books
Online tutorials
Manual pages
Tcl roadmap
Acronyms
Tcl software 
Applications
The Tcl core
Development tools
Documentation
Extensions
Toys and games
Tcl in the wild 
Major applications
Businesses
Education
Engineering
Government
Medical
Other
Home ? Recent changes ? Help ? Edit ? History ? References ? Search ? Toggle Menu
DO NOT CLICK THIS LINK. It is a trap for badly behaved bots. If you follow this link, you will be unable to use the site afterwards.