Posted to tcl by colin at Thu May 06 05:18:49 GMT 2010view pretty

# 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