scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Drop WITH-REAL-INPUT-FIELD. Use INPUT-FIELD-REAL-INPUT-FIELD instead (and instead of CADR).

This commit is contained in:
interp 2003-07-23 13:45:34 +00:00
parent 4ec94f293e
commit 2cc9c209f0
1 changed files with 9 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
scheme/httpd/surflets/input-fields.scm
View File

@ -31,22 +31,6 @@
(real-input-field-type input-field) (real-input-field-type input-field)
(real-input-field-name input-field)))) (real-input-field-name input-field))))
(define-syntax with-real-input-field
(lambda (expr rename compare)
(let ((%if (rename 'if))
(%let (rename 'let))
(%cadr (rename 'cadr))
(%input-field? (rename 'input-field?))
(%error (rename 'error))
(input-field (cadr expr))
(body (cddr expr)))
`(,%if (,%input-field? ,input-field)
(,%let ((real-input-field (,%cadr ,input-field)))
,@body)
(,%error "Invalid argument. Function wants an input-field."
,input-field)))))
;;; Fake input-field record. This is necessary, as the trigger in SXML ;;; Fake input-field record. This is necessary, as the trigger in SXML
;;; may only be symbols, not arbitrary values. Thus, our input-fields ;;; may only be symbols, not arbitrary values. Thus, our input-fields
;;; must be preceeded by a trigger symbol to get recognized by the ;;; must be preceeded by a trigger symbol to get recognized by the
@ -79,20 +63,21 @@
(define (make-sxml-input-field real-input-field) (define (make-sxml-input-field real-input-field)
(list *input-field-trigger* real-input-field)) (list *input-field-trigger* real-input-field))
(define input-field-real-input-field cadr)
(define (input-field? input-field) (define (input-field? input-field)
(and (pair? input-field) (and (pair? input-field)
(eq? *input-field-trigger* (car input-field)) (eq? *input-field-trigger* (car input-field))
(real-input-field? (cadr input-field)))) (real-input-field? (input-field-real-input-field input-field))))
(define (make-input-field-selector selector) (define (make-input-field-selector selector)
(lambda (input-field) (lambda (input-field)
(with-real-input-field input-field (selector (input-field-real-input-field input-field))))
(selector real-input-field))))
(define (make-input-field-setter setter reset?) (define (make-input-field-setter setter reset?)
(lambda (input-field value) (lambda (input-field value)
(with-real-input-field input-field (let ((real-input-field (input-field-real-input-field input-field)))
(if reset? (if reset?
(set-real-input-field-html-tree! real-input-field #f)) (set-real-input-field-html-tree! real-input-field #f))
(setter real-input-field value)))) (setter real-input-field value))))
@ -106,7 +91,7 @@
(define input-field-html-tree-maker (define input-field-html-tree-maker
(make-input-field-selector real-input-field-html-tree-maker)) (make-input-field-selector real-input-field-html-tree-maker))
(define (input-field-html-tree input-field) (define (input-field-html-tree input-field)
(with-real-input-field input-field (let ((real-input-field (input-field-real-input-field input-field)))
(cond (cond
((real-input-field-html-tree real-input-field) ((real-input-field-html-tree real-input-field)
=> identity) => identity)
@ -133,7 +118,7 @@
;; <input-field>: '(input-field <real-input-field>) ;; <input-field>: '(input-field <real-input-field>)
;; <real-input-field>: #{Real-input-field "name"} ;; <real-input-field>: #{Real-input-field "name"}
(define (raw-input-field-value input-field bindings) (define (raw-input-field-value input-field bindings)
(with-real-input-field input-field (let ((real-input-field (input-field-real-input-field input-field)))
(cond (cond
((real-input-field-multi? real-input-field) ((real-input-field-multi? real-input-field)
((real-input-field-transformer real-input-field) input-field bindings)) ((real-input-field-transformer real-input-field) input-field bindings))
@ -167,7 +152,8 @@
;; input-field's name. If your input-field will have another name in ;; input-field's name. If your input-field will have another name in
;; the bindings than it was created with, use a multi-input-field. ;; the bindings than it was created with, use a multi-input-field.
(define (input-field-binding input-field bindings) (define (input-field-binding input-field bindings)
(real-input-field-binding (cadr input-field) bindings)) (real-input-field-binding (input-field-real-input-field input-field)
bindings))
;;EOF ;;EOF