--- gforth/webform.fs 2011/07/21 17:40:30 1.1
+++ gforth/webform.fs 2012/12/31 15:25:18 1.3
@@ -1,6 +1,6 @@
\ Webform and CGI handling
\
-\ Copyright (C) 2011 Free Software Foundation, Inc.
+\ Copyright (C) 2011,2012 Free Software Foundation, Inc.
\ This file is part of Gforth.
@@ -73,3 +73,69 @@ wordlist constant form-fields
cgi-field
repeat
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 "" is seen; Comments from are skipped.
+ 0 { html-comment? }
+ >in @ begin
+ parse-name dup 0= if \ end-of-line
+ sh-nextline
+ else 2dup s" " str= html-comment? 0= and if
+ 2drop source drop >in @ 7 - rot /string type exit
+ else 2dup s" " str= if
+ false to html-comment
+ then
+ then
+ then
+ then
+ again ;
+
+: ( u1 -- xt u2 )
+ ['] scan-html >string-execute ( c-addr u )
+ 2>r :noname 2r> ]] 2literal type ; [[ swap 1+ ;
+
+: >html> ( -- x1 1 )
+ 0 ;
+
+: 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 )
+ .\" " name field-contents 2dup type ." "
+ xt execute 0= if input-acceptable? off then ;
+
+: textfield ( uwidth xt1 "name" -- xt2 )
+ 2>r :noname parse-name 2r> ]] 2literal sliteral do-textfield; [[ ;