--- 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; [[ ;