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

  1. # hello-direct - a hello world example of a Direct domain
  2. namespace eval ::Hello {
  3.  
  4. proc / {r args} {
  5. # this is the default
  6. set content {
  7. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  8. <html>
  9. <head>
  10. <title>Hello World</title>
  11. </head>
  12. <body>
  13. <h1>Hello World</h1>
  14. <ul>
  15. <li><a href='text'>Plain Text</a></li>
  16. <li><a href='html'>Html Fragment</a></li>
  17. <li><a href='error'>Intentional Error</a></li>
  18. <li><a href='redirect'>Redirection</a></li>
  19. <li><a href='form'>Form sample</a></li>
  20. <li><a href='show'>Display arguments passed in.</a></li>
  21. </body>
  22. </html>
  23. }
  24. return [Http Ok $r $content text/html]
  25. }
  26.  
  27. proc /text {r args} {
  28. # [Http Ok] can return other mime types:
  29. # Here, text/plain can be used to return just the literal text
  30. set content {
  31. <p>Hello World</p>
  32. }
  33. return [Http Ok $r $content text/plain]
  34. }
  35.  
  36. proc /html {r args} {
  37. # Here, content is returned as an x-text/html-fragment
  38. # which is wrapped and filled in by the Convert module
  39. # to present an HTML page to the client
  40. set content {
  41. <p>Hello World</p>
  42. }
  43. return [Http Ok $r $content x-text/html-fragment]
  44. }
  45.  
  46. proc /html2 {r args} {
  47. }
  48.  
  49. proc /show {r args} {
  50. # Here we display the args passed from the client
  51. # we use the utilities from [Html] to construct the page
  52. append content [<p> "Form Submission Result"]
  53. set vartable ""
  54. foreach {n v} $args {
  55. append vartable [<tr> "[<td> $n] [<td> $v]"]
  56. }
  57. append content [<table> $vartable]
  58. return [Http Ok $r $content] ;# we default mime type
  59. }
  60.  
  61. proc /form {r args} {
  62. # here we will display whatever args are passed in.
  63. # we also use the [Form] utility to construct the page
  64. dict with args {
  65. set content [<form> xxx action show {
  66. [<p> "This is a form to enter your account details"]
  67. [<fieldset> details vertical 1 title "Account Details" {
  68. [<legend> "Account Details"]
  69. [<text> user label "User name" title "Your preferred username (only letters, numbers and spaces)"]
  70. [<text> email label "Email Address" title "Your email address" moop]
  71. [<hidden> hidden moop]
  72. }]
  73. [<fieldset> passwords maxlength 16 size 16 {
  74. [<legend> "Passwords"]
  75. [<p> "Type in your preferred password, twice. Leaving it blank will generate a random password for you."]
  76. [<password> password]
  77. [<password> repeat]
  78. }]
  79. [<radioset> illness legend "Personal illnesses" {
  80. +none 0
  81. lameness 1
  82. haltness 2
  83. blindness 2
  84. }]
  85. [<checkset> illness vertical 1 legend "Personal illnesses" {
  86. +none 0
  87. lameness 1
  88. haltness 2
  89. blindness 2
  90. }]
  91. [<select> selname legend "Shoe Size" title "Security dictates that we know your approximate shoe size" {
  92. [<option> value moop1 label moop1 value 1 "Petit"]
  93. [<option> label moop2 value moop2 value 2 "Massive"]
  94. }]
  95. [<fieldset> personal tabular 1 legend "Personal Information" {
  96. [<text> fullname label "full name" title "Full name to be used in email."] [<text> phone label phone title "Phone number for official contact"]
  97. }]
  98. [<p> "When you create the account instructions will be emailed to you. Make sure your email address is correct."]
  99. [<textarea> te compact 1 {
  100. This is some default text to be getting on with
  101. It's fairly cool. Note how it's left aligned.
  102. }]
  103. <br>[<submit> submit "Create New Account"]
  104.  
  105. [<br>]
  106. [<fieldset> permissions -legend Permissions {
  107. [<fieldset> gpermF style "float:left" title "Group Permissions." {
  108. [<legend> Group]
  109. [<checkbox> gperms title "Can group members read this page?" value 1 checked 1 read]
  110. [<checkbox> gperms title "Can group members modify this page?" value 2 checked 1 modify]
  111. [<checkbox> gperms title "Can group members add to this page?" value 4 checked 1 add]
  112. [<br>][<text> group title "Which group owns this page?" label "Group: "]
  113. }]
  114. [<fieldset> opermF style "float:left" title "Default Permissions." {
  115. [<legend> Anyone]
  116. [<checkbox> operms title "Can anyone read this page?" value 1 checked 1 read]
  117. [<checkbox> operms title "Can anyone modify this page?" value 2 modify]
  118. [<checkbox> operms title "Can anyone add to this page?" value 4 add]
  119. }]
  120. }]
  121. [<br>]
  122. [<div> class buttons [subst {
  123. [<submit> class positive {
  124. [<img> src /images/icons/tick.png alt ""] Save
  125. }]
  126.  
  127. [<a> href /password/reset/ [subst {
  128. [<img> src /images/icons/textfield_key.png alt ""] Change Password
  129. }]]
  130.  
  131. [<a> href "#" class negative [subst {
  132. [<img> src /images/icons/cross.png alt ""] Cancel
  133. }]]
  134. }]]
  135. }]
  136. }
  137. return [Http Ok $r $content x-text/html-fragment]
  138. }
  139.  
  140. proc /error {r args} {
  141. # errors are caught and presented to the client
  142. error "This is an intentional error."
  143. }
  144.  
  145. proc /redirect {r args} {
  146. # You can redirect URLs using the facilities of the Http utility
  147. return [Http Moved $r hello] ;# this redirects you to /hello
  148. }
  149.  
  150. # Nub will call this with args presented to the Nub
  151. proc new {args} {
  152. # we do nothing with the args
  153. }
  154.  
  155. namespace export -clear *
  156. namespace ensemble create -subcommands {}
  157. }
  158.  
  159. # this Nub inserts the Hello namespace into the URL space at /hello/
  160. Nub domain /hello/ Direct namespace ::Hello