Change argument order in EXTRACT-BINDINGS and EXTRACT-SINGLE-BINDING to
fit the one of the equivalent PLT procedure.
This commit is contained in:
		
							parent
							
								
									26683bd822
								
							
						
					
					
						commit
						a49fbee71f
					
				|  | @ -102,15 +102,15 @@ | ||||||
| 	(else  | 	(else  | ||||||
| 	 (error "No Content-length specified for POST data.")))) | 	 (error "No Content-length specified for POST data.")))) | ||||||
| 
 | 
 | ||||||
| (define (extract-bindings bindings key) | (define (extract-bindings key bindings) | ||||||
|   (let ((key (if (symbol? key) (symbol->string key) key))) |   (let ((key (if (symbol? key) (symbol->string key) key))) | ||||||
|     (map cdr |     (map cdr | ||||||
| 	 (filter (lambda (binding)  | 	 (filter (lambda (binding)  | ||||||
| 		   (equal? (car binding) key)) | 		   (equal? (car binding) key)) | ||||||
| 		 bindings)))) | 		 bindings)))) | ||||||
| 
 | 
 | ||||||
| (define (extract-single-binding bindings key) | (define (extract-single-binding key bindings) | ||||||
|   (let ((key-bindings (extract-bindings bindings key))) |   (let ((key-bindings (extract-bindings key bindings))) | ||||||
|     (if (= 1 (length key-bindings)) |     (if (= 1 (length key-bindings)) | ||||||
| 	(car key-bindings) | 	(car key-bindings) | ||||||
| 	(error "extract-one-binding: more than one or zero bindings found" | 	(error "extract-one-binding: more than one or zero bindings found" | ||||||
|  |  | ||||||
|  | @ -28,7 +28,7 @@ | ||||||
| 	(let* ((bindings (form-query | 	(let* ((bindings (form-query | ||||||
| 			  (http-url:search (request:url result)))) | 			  (http-url:search (request:url result)))) | ||||||
| 	       (number (string->number  | 	       (number (string->number  | ||||||
| 			(extract-single-binding bindings "number")))) | 			(extract-single-binding "number" bindings)))) | ||||||
| 	  (if number | 	  (if number | ||||||
| 	      number | 	      number | ||||||
| 	      (get-number input-text "Please enter a valid number"))))) | 	      (get-number input-text "Please enter a valid number"))))) | ||||||
|  |  | ||||||
|  | @ -12,15 +12,26 @@ | ||||||
| 		    `(html (body (h1 "This is from servlet") | 		    `(html (body (h1 "This is from servlet") | ||||||
| 				 (servlet-form | 				 (servlet-form | ||||||
| 				  ,new-url | 				  ,new-url | ||||||
|  | 				  POST | ||||||
| 				  ,select | 				  ,select | ||||||
| 				  ,(make-submit-button)) | 				  ,(make-submit-button)) | ||||||
| 				 (hr) | 				 (hr) | ||||||
| 				 (p (URL "/" "Return to main menu.")) | 				 (p (URL "/" "Return to main menu.")) | ||||||
| 				 )))))) | 				 )))))) | ||||||
| 	(send-html/finish | 	(send-html/suspend | ||||||
|  | 	 (lambda (continue) | ||||||
| 	   `(html (body (h1 "Result") | 	   `(html (body (h1 "Result") | ||||||
|  | 			,(format #f "~s" (get-bindings req)) (br) | ||||||
|  | 			(URL ,continue "show results again") | ||||||
|  | 			(hr) | ||||||
|  | 			(p (URL "test.scm" "Test again.") (br) | ||||||
|  | 			   (URL "/" "Return to main menu.")))))) | ||||||
|  | 
 | ||||||
|  | 	(send-html/finish | ||||||
|  | 	 `(html (body (h1 "Result 2") | ||||||
| 		      ,(format #f "~s" (get-bindings req)) | 		      ,(format #f "~s" (get-bindings req)) | ||||||
| 		      (hr) | 		      (hr) | ||||||
| 		      (p (URL "test.scm" "Test again.") (br) | 		      (p (URL "test.scm" "Test again.") (br) | ||||||
| 			 (URL "/" "Return to main menu."))))))) | 			 (URL "/" "Return to main menu."))))))) | ||||||
|  | 
 | ||||||
|     )) |     )) | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue
	
	 interp
						interp