SERVLET-FORM accepts a method specifier:

SERVLET-FORM return-address [method] [attributes] [elements]
This commit is contained in:
interp 2002-10-04 14:31:28 +00:00
parent a6b499426a
commit 7b81dbdd98
1 changed files with 22 additions and 13 deletions

View File

@ -136,22 +136,31 @@
;; Must do something to prevent the callback-function string to
;; be HTML escaped.
*preorder*
. ,(lambda (trigger call-back-function . elems)
(if (and (pair? elems)
(XML-attribute? (car elems)))
(make-servlet-form call-back-function (cdar elems) (cdr elems))
(make-servlet-form call-back-function'() elems)))))
. ,(lambda (trigger call-back-function . args)
(receive (parameters elems)
(typed-optionals (list symbol? XML-attribute?) args)
(make-servlet-form call-back-function
(car parameters)
(cadr parameters)
elems)))))
))
(define (make-servlet-form call-back-function attributes elems)
(define (make-servlet-form call-back-function method attributes elems)
(let ((real-method (case method
((get GET) "GET")
((post POST) "POST")
((#f) "GET")
(else
(error "invalid method type" method)))))
`("<form" ,@(map (lambda (attribute-value)
((enattr (car attribute-value)) (cadr attribute-value)))
`((method "POST")
`((method ,real-method)
(action ,call-back-function)
,@attributes))
;; We have to divide attributes explicitly.
,@(if attributes (cdr attributes) '())))
#\> #\newline
,(reformat elems)
"</form>"))
"</form>")))
(define (XML-attribute? thing)
(and (pair? thing)