[REBOL] Form dialect
From: al::bri::xtra::co::nz at: 18-Aug-2002 11:34
Andreas Bolka wrote:
> Any chance to have a look at the current state of the form manipulation
dialect :) ?
Currently, I'm still very unhappy with it. It really should link directly to
the database; there's too many intermediate forms. It also doesn't handle
the round trip between showing the user the form and getting the results
back from a submitted form.
#! C:\Rebol\Core\rebol.exe -cs
[
Rebol [
Name: 'Forms
Title: "Forms"
File: %Forms.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Web: http://valley.150m.com
Date: 8/July/2002
Version: 1.0.0
Purpose: {Forms is a dialect for HTML forms.}
Category: [util 1]
]
Remote: %/c/Xitami/cgi-bin/
if Remote <> what-dir [
write join Remote Rebol/script/header/File read Rebol/script/header/File
]
if not value? 'Values [
do %/C/Rebol/Values/Values.r
]
if none? Rebol/options/cgi/script-name [
browse http://localhost/cgi-bin/Forms.r
quit
]
CGI: make object! [
Post?: "POST" = Rebol/options/cgi/request-method
Get?: "GET" = Rebol/options/cgi/request-method
Script-File: to-file Rebol/options/cgi/script-name
Script-URL: join make url! compose [
http (join Rebol/options/cgi/server-name
Rebol/options/cgi/script-name)
] #"?"
Query: Rebol/options/cgi/query-string
all [
string? Query
Query: dehex replace/all copy Query #"+" #" "
]
]
[
; datatype!
decimal!
integer!
binary!
block! ; Maybe?
email!
file!
issue!
paren! ; Maybe?
path! ; Maybe?
string! ; Default for text fields.
tag!
url!
character!
date!
logic!
money!
none! ; Maybe?
pair!
time!
tuple!
word! ; Maybe?
]
Forms: function [
Rebol_Forms [block!] Instance [object!]
] [
Block Form_Element Get_Value Label Name Value Size Choices
] [
Block: make block! 1000
Form_Element: func [Label [string!] ML [block!]] [
append Block compose/deep [
label [
span/class "Label" (join Label ": ")
(ML)
]
]
]
Form_Element "Test" compose/deep [
input/id/type/datatype "test" "text" string!
]
Get_Value: does [
get in Instance to-word Name
]
parse Rebol_Forms [
any [
'Logic set Label string! set Name refinement! (
Form_Element Label compose either Get_Value [
[
input/type/name/checked "checkbox" (to-string Name)
checked
]
] [
[
input/type/name "checkbox" (to-string Name)
]
]
)
| 'Field set Label string! set Name refinement! set Size
integer! (
Form_Element Label compose [
input/type/name/size/value "text" (to-string Name)
(Size)
(any [Get_Value ""])
]
)
| 'Integer set Label string! set Name refinement! (
Form_Element Label compose [
input/type/name/size/datatype/value "text" (to-string
Name) 8 integer!
(any [Get_Value ""])
]
)
| 'Secret set Label string! set Name refinement! set Size
integer! (
Form_Element Label compose [
input/type/name/size "password" (to-string Name) (Size)
]
)
| 'Area set Label string! set Name refinement! set Size pair! (
Form_Element Label compose [
textarea/name/wrap/cols/rows (to-string Name) "virtual"
(Size/X) (Size/Y) (any [Get_Value ""])
]
)
| 'SelectOne set Label string! set Name refinement! set Choices
block! (
Form_Element Label compose/deep [
select/name (to-string Name) [
(
use [Block Selected] [
Selected: Get_Value
Block: make block! 20
foreach [Value Label] Choices [
append Block compose either Value Selected [
[option/value/selected (Value)
selected
(Label)]
] [
[option/value (Value) (Label)]
]
]
]
)
]
]
)
| 'Output set Label string! set Name refinement! (
Form_Element Label compose [(any [Get_Value ""])]
)
| 'Submit set Label string! (
append Block compose/deep [
label [
span/class "Label" ""
input/type/value "submit" (Label)
]
]
)
| 'Date set Label string! set Name refinement! (
use [Date Block] [
Date: any [Get_Value now]
Form_Element Label compose/deep [
select/name (join to-string Name "/Day") [
(
Block: make block! 31 * 3 + 1
repeat Day 31 [
append Block compose either Day Date/Day [
[option/value/selected (Day)
selected
(Day)]
] [
[option/value (Day) (Day)]
]
]
)
]
select/name (join to-string Name "/Month") [
(
Block: make block! 12 * 3 + 1
repeat Month 12 [
append Block compose either Month Date/Month [
[
option/value/selected (Month)
selected
(pick system/locale/months
Month)
]
] [
[
option/value (Month)
(pick system/locale/months
Month)
]
]
]
)
]
select/name (join to-string Name "/Year") [
(
Block: make block! 100 * 3 * 2 + 4
for Year -100 + Date/Year 100 + Date/Year 1
[
append Block compose either Year Date/Year [
[option/value/selected (Year)
selected
(Year)]
] [
[option/value (Year) (Year)]
]
]
)
]
]
]
)
]
end
]
Block
]
X: Forms [
Logic "Truth?" /Truth
Logic "Falsey?" /Falsey
Field "Line" /Line 10
Secret "Password" /Password 10
Area "Paragraphs" /Paragraphs 40x4
SelectOne "Gender" /Gender [
#"F" "Female"
#"M" "Male"
]
SelectOne "Relationship" /Relationship [
#"F" "Father"
#"G" "Guardian"
#"M" "Mother"
]
SelectOne "Invoices?" /Invoices? [
#"N" "No"
#"Y" "Yes"
]
Date "Birth" /DoB
Output "Age" /Age
Integer "Number" /Number
Output "Total" /Total
Submit "Enter"
] make object! [
Truth: true
Falsey: false
Line: "string!"
Password: none
Paragraphs: trim {A long line of text,
that is several lines long.
It has several lines indeed!
And here's another!}
Gender: #"F"
Relationship: #"M"
Invoices?: #"Y"
DoB: 25/10/1960
Age: has [YMD] [
YMD: system/words/Age now DoB
rejoin [
YMD/Years " years, " YMD/Months " months, " YMD/Days " days."
]
]
Number: 123456
Total: $123.45
]
content-type text/html
print ML compose/deep [
<?xml version="1.0" encoding="ISO-8859-1"?>
<!DOCTYPE html PUBLIC
"-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN"
"http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">
html [
title "Test"
link/rel/type/href "stylesheet" "text/css" %/Pupils.css
]
body [
h1 "Forms Demo!"
form/name/method/action "RebolForms" "POST" (CGI/Script-File) [
(X)
]
script/language "JavaScript" {
alert (document.RebolForms.test.getAttribute("datatype"));
alert (document.RebolForms.Number.getAttribute("datatype"));
alert (document.RebolForms.Number.type);
}
]
]
]
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
