Posted to tcl by colin at Thu May 06 05:18:49 GMT 2010view raw
- # hello-direct - a hello world example of a Direct domain
- namespace eval ::Hello {
- proc / {r args} {
- # this is the default
- set content {
- <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
- <html>
- <head>
- <title>Hello World</title>
- </head>
- <body>
- <h1>Hello World</h1>
- <ul>
- <li><a href='text'>Plain Text</a></li>
- <li><a href='html'>Html Fragment</a></li>
- <li><a href='error'>Intentional Error</a></li>
- <li><a href='redirect'>Redirection</a></li>
- <li><a href='form'>Form sample</a></li>
- <li><a href='show'>Display arguments passed in.</a></li>
- </body>
- </html>
- }
- return [Http Ok $r $content text/html]
- }
- proc /text {r args} {
- # [Http Ok] can return other mime types:
- # Here, text/plain can be used to return just the literal text
- set content {
- <p>Hello World</p>
- }
- return [Http Ok $r $content text/plain]
- }
- proc /html {r args} {
- # Here, content is returned as an x-text/html-fragment
- # which is wrapped and filled in by the Convert module
- # to present an HTML page to the client
- set content {
- <p>Hello World</p>
- }
- return [Http Ok $r $content x-text/html-fragment]
- }
- proc /html2 {r args} {
- }
- proc /show {r args} {
- # Here we display the args passed from the client
- # we use the utilities from [Html] to construct the page
- append content [<p> "Form Submission Result"]
- set vartable ""
- foreach {n v} $args {
- append vartable [<tr> "[<td> $n] [<td> $v]"]
- }
- append content [<table> $vartable]
- return [Http Ok $r $content] ;# we default mime type
- }
- proc /form {r args} {
- # here we will display whatever args are passed in.
- # we also use the [Form] utility to construct the page
- dict with args {
- set content [<form> xxx action show {
- [<p> "This is a form to enter your account details"]
- [<fieldset> details vertical 1 title "Account Details" {
- [<legend> "Account Details"]
- [<text> user label "User name" title "Your preferred username (only letters, numbers and spaces)"]
- [<text> email label "Email Address" title "Your email address" moop]
- [<hidden> hidden moop]
- }]
- [<fieldset> passwords maxlength 16 size 16 {
- [<legend> "Passwords"]
- [<p> "Type in your preferred password, twice. Leaving it blank will generate a random password for you."]
- [<password> password]
- [<password> repeat]
- }]
- [<radioset> illness legend "Personal illnesses" {
- +none 0
- lameness 1
- haltness 2
- blindness 2
- }]
- [<checkset> illness vertical 1 legend "Personal illnesses" {
- +none 0
- lameness 1
- haltness 2
- blindness 2
- }]
- [<select> selname legend "Shoe Size" title "Security dictates that we know your approximate shoe size" {
- [<option> value moop1 label moop1 value 1 "Petit"]
- [<option> label moop2 value moop2 value 2 "Massive"]
- }]
- [<fieldset> personal tabular 1 legend "Personal Information" {
- [<text> fullname label "full name" title "Full name to be used in email."] [<text> phone label phone title "Phone number for official contact"]
- }]
- [<p> "When you create the account instructions will be emailed to you. Make sure your email address is correct."]
- [<textarea> te compact 1 {
- This is some default text to be getting on with
- It's fairly cool. Note how it's left aligned.
- }]
- <br>[<submit> submit "Create New Account"]
- [<br>]
- [<fieldset> permissions -legend Permissions {
- [<fieldset> gpermF style "float:left" title "Group Permissions." {
- [<legend> Group]
- [<checkbox> gperms title "Can group members read this page?" value 1 checked 1 read]
- [<checkbox> gperms title "Can group members modify this page?" value 2 checked 1 modify]
- [<checkbox> gperms title "Can group members add to this page?" value 4 checked 1 add]
- [<br>][<text> group title "Which group owns this page?" label "Group: "]
- }]
- [<fieldset> opermF style "float:left" title "Default Permissions." {
- [<legend> Anyone]
- [<checkbox> operms title "Can anyone read this page?" value 1 checked 1 read]
- [<checkbox> operms title "Can anyone modify this page?" value 2 modify]
- [<checkbox> operms title "Can anyone add to this page?" value 4 add]
- }]
- }]
- [<br>]
- [<div> class buttons [subst {
- [<submit> class positive {
- [<img> src /images/icons/tick.png alt ""] Save
- }]
- [<a> href /password/reset/ [subst {
- [<img> src /images/icons/textfield_key.png alt ""] Change Password
- }]]
- [<a> href "#" class negative [subst {
- [<img> src /images/icons/cross.png alt ""] Cancel
- }]]
- }]]
- }]
- }
- return [Http Ok $r $content x-text/html-fragment]
- }
- proc /error {r args} {
- # errors are caught and presented to the client
- error "This is an intentional error."
- }
- proc /redirect {r args} {
- # You can redirect URLs using the facilities of the Http utility
- return [Http Moved $r hello] ;# this redirects you to /hello
- }
- # Nub will call this with args presented to the Nub
- proc new {args} {
- # we do nothing with the args
- }
- namespace export -clear *
- namespace ensemble create -subcommands {}
- }
- # this Nub inserts the Hello namespace into the URL space at /hello/
- Nub domain /hello/ Direct namespace ::Hello