version 1.1, 2011/07/21 17:40:30
|
version 1.2, 2012/02/16 17:13:04
|
Line 73 wordlist constant form-fields
|
Line 73 wordlist constant form-fields
|
cgi-field |
cgi-field |
repeat |
repeat |
2drop 2drop ; |
2drop 2drop ; |
|
|
|
s" EOF while scanning HTML" exception constant eof-on-scanning |
|
|
|
: sh-nextline ( u1 -- 0 ) |
|
\ print the current line, starting at char u1, then switch to next line |
|
source rot /string type |
|
refill 0= eof-on-scannin throw |
|
0 ; |
|
|
|
: scan-html ( -- ) |
|
\ print the input until a "<forth>" is seen; Comments from <!-- to |
|
\ --> are skipped. |
|
0 { html-comment? } |
|
>in @ begin |
|
parse-name dup 0= if \ end-of-line |
|
sh-nextline |
|
else 2dup s" <forth>" str= html-comment? 0= and if |
|
2drop source drop >in @ 7 - rot /string type exit |
|
else 2dup s" <!--" str= if |
|
2drop true to html-comment |
|
else s" -->" str= if |
|
false to html-comment |
|
then |
|
then |
|
then |
|
then |
|
again ; |
|
|
|
: </forth> ( u1 -- xt u2 ) |
|
['] scan-html >string-execute ( c-addr u ) |
|
2>r :noname 2r> ]] 2literal type ; [[ swap 1+ ; |
|
|
|
: >html> ( -- x1 1 ) |
|
0 </forth> ; |
|
|
|
: <html< ( x1 ... xu u -- ) |
|
>r :noname |
|
r@ dup 0 +do |
|
dup 5 + i - pick . compile, |
|
loop |
|
drop ]] ; [[ |
|
r> 0 +do |
|
nip |
|
loop |
|
execute ; |
|
|
|
: field-contents ( c-addr1 u1 -- c-addr2 u2 ) |
|
\ c-addr2 u2 is the CGI input string for field named c-addr1 u1 |
|
\ c-addr2 u2 is an empty string if the CGI input did not contain the field |
|
form-fields search-wordlist if |
|
execute |
|
else |
|
0 0 |
|
then ; |
|
|
|
variable input-acceptable? \ true if all the fields are acceptable |
|
|
|
: do-textfield { uwidth xt d: name -- } |
|
\ print an html text input field with width uwidth and name c-addr u |
|
\ check whether the input is satisfactory with xt ( c-addr u -- f ) |
|
.\" <input type=\"text\" name=\"" string type .\" \" size=\"" |
|
uwidth 0 .r ." >" name field-contents 2dup type ." </input> " |
|
xt execute 0= if input-acceptable? off then ; |
|
|
|
: textfield ( uwidth xt1 "name" -- xt2 ) |
|
2>r :noname parse-name 2r> ]] 2literal sliteral do-textfield; [[ ; |