Change names in surflet-input-fields.scm, so that they are both short and
descriptive and not misleading. If you have written SUrflets that use the input field feature, you must rename your input field commands to get them work with this change. Contact me, if you want to have a small script that does this for you.
This commit is contained in:
interp
parent
e66223b666
commit
c1d14a06a0
|
|
@ -309,44 +309,44 @@
|
|||
(define-interface surflets/surflet-input-fields-interface
|
||||
(compound-interface
|
||||
surflets/input-field-value-interface
|
||||
(export make-text-input-field
|
||||
set-text-input-field-value!
|
||||
(export make-text-field
|
||||
set-text-field-value!
|
||||
|
||||
make-number-input-field
|
||||
set-number-input-field-value!
|
||||
make-number-field
|
||||
set-number-field-value!
|
||||
|
||||
make-hidden-input-field
|
||||
set-hidden-input-field-value!
|
||||
make-hidden-field
|
||||
set-hidden-field-value!
|
||||
|
||||
make-password-input-field
|
||||
set-password-input-field-value!
|
||||
make-password-field
|
||||
set-password-field-value!
|
||||
|
||||
make-textarea-input-field
|
||||
set-textarea-input-field-value!
|
||||
make-textarea
|
||||
set-textarea-value!
|
||||
|
||||
make-select-input-field
|
||||
make-annotated-select-input-field
|
||||
make-simple-sel-if-option
|
||||
make-annotated-sel-if-option
|
||||
sel-if-option?
|
||||
select-sel-if-option!
|
||||
unselect-sel-if-option!
|
||||
add-sel-if-option!
|
||||
delete-sel-if-option!
|
||||
set-sel-if-option-selected?!
|
||||
make-select
|
||||
make-annotated-select
|
||||
make-simple-select-option
|
||||
make-annotated-select-option
|
||||
select-option?
|
||||
select-select-option!
|
||||
unselect-select-option!
|
||||
add-select-option!
|
||||
delete-select-option!
|
||||
set-select-option-selected?!
|
||||
|
||||
make-radio-input-field-group
|
||||
make-annotated-radio-input-field-group
|
||||
make-radio-input-fields
|
||||
check-radio-input-field!
|
||||
uncheck-radio-input-field!
|
||||
set-radio-input-field-checked?!
|
||||
make-radio-group
|
||||
make-annotated-radio-group
|
||||
make-radios
|
||||
check-radio!
|
||||
uncheck-radio!
|
||||
set-radio-checked?!
|
||||
|
||||
make-checkbox-input-field
|
||||
make-annotated-checkbox-input-field
|
||||
check-checkbox-input-field!
|
||||
uncheck-checkbox-input-field!
|
||||
set-checkbox-input-field-checked?!
|
||||
make-checkbox
|
||||
make-annotated-checkbox
|
||||
check-checkbox!
|
||||
uncheck-checkbox!
|
||||
set-checkbox-checked?!
|
||||
|
||||
make-submit-button
|
||||
make-reset-button
|
||||
|
|
|
|||
|
|
@ -116,16 +116,16 @@
|
|||
(else (no-method message)))))
|
||||
|
||||
(define (make-text text)
|
||||
(standard-query text (make-text-input-field) "No bad input possible"))
|
||||
(standard-query text (make-text-field) "No bad input possible"))
|
||||
|
||||
(define (make-password text)
|
||||
(standard-query text (make-password-input-field) "No bad input possible"))
|
||||
(standard-query text (make-password-field) "No bad input possible"))
|
||||
|
||||
(define (make-number text)
|
||||
(standard-query text (make-number-input-field) "Please respond with a valid number"))
|
||||
(standard-query text (make-number-field) "Please respond with a valid number"))
|
||||
|
||||
(define (make-boolean text)
|
||||
(let* ((input-field (make-checkbox-input-field))
|
||||
(let* ((input-field (make-checkbox))
|
||||
(standard (standard-query text input-field "No bad input possible")))
|
||||
(lambda (message)
|
||||
(case message
|
||||
|
|
@ -139,7 +139,7 @@
|
|||
|
||||
(define (make-radio text choices . maybe-insist)
|
||||
(let* ((insist (:optional maybe-insist ""))
|
||||
(radios (make-radio-input-fields choices))
|
||||
(radios (make-radios choices))
|
||||
(standard (standard-query text (car radios)
|
||||
(string-append "Please respond" insist))))
|
||||
(lambda (message)
|
||||
|
|
|
|||
|
|
@ -8,17 +8,17 @@
|
|||
;; The interface for input-fields does not prescribe what the type of
|
||||
;; attributes has to be. We choose a record here.
|
||||
|
||||
(define-record-type input-field-attributes :input-field-attributes
|
||||
(make-input-field-attributes default others)
|
||||
input-field-attributes?
|
||||
(default input-field-attributes-default set-input-field-attributes-default!)
|
||||
(others input-field-attributes-others set-input-field-attributes-others!))
|
||||
(define-record-type field-attributes :field-attributes
|
||||
(make-field-attributes default others)
|
||||
field-attributes?
|
||||
(default field-attributes-default set-field-attributes-default!)
|
||||
(others field-attributes-others set-field-attributes-others!))
|
||||
|
||||
;; A simple input-field is a prototype for other input-fields.
|
||||
;; REPORTED-TYPE is the type of the input-field in HTML, TYPE the
|
||||
;; internal referenced type and TRANSFORMER the function that
|
||||
;; translates the HTTP-string of the request into a scheme value.
|
||||
(define (simple-input-field-maker reported-type type default-pred transformer)
|
||||
(define (simple-field-maker reported-type type default-pred transformer)
|
||||
(lambda maybe-further-attributes
|
||||
(let ((name (generate-input-field-name type)))
|
||||
(optionals maybe-further-attributes
|
||||
|
|
@ -26,24 +26,23 @@
|
|||
(attributes sxml-attribute?))
|
||||
(make-input-field name type
|
||||
transformer
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(and default `(value ,default))
|
||||
(sxml-attribute-attributes attributes))
|
||||
(simple-input-field-maker-html-tree-maker
|
||||
reported-type))))))
|
||||
(simple-html-tree-maker reported-type))))))
|
||||
|
||||
(define (simple-input-field-maker-html-tree-maker reported-type)
|
||||
(define (simple-html-tree-maker reported-type)
|
||||
(lambda (input-field)
|
||||
(let ((attributes (input-field-attributes input-field)))
|
||||
`(input (@ (type ,reported-type)
|
||||
(name ,(input-field-name input-field))
|
||||
,(input-field-attributes-default attributes)
|
||||
,(input-field-attributes-others attributes))))))
|
||||
,(field-attributes-default attributes)
|
||||
,(field-attributes-others attributes))))))
|
||||
|
||||
(define (make-simple-input-field-default-setter default-pred? wrap?)
|
||||
(define (make-simple-default-setter default-pred? wrap?)
|
||||
(lambda (input-field value)
|
||||
(if (default-pred? value)
|
||||
(set-input-field-attributes-default!
|
||||
(set-field-attributes-default!
|
||||
(input-field-attributes input-field)
|
||||
(if wrap? `(value ,value) value))
|
||||
(error "Default value must be a number or a string or a symbol."
|
||||
|
|
@ -54,58 +53,54 @@
|
|||
(or (string? thing) (symbol? thing)))
|
||||
(define simple-default? string-or-symbol?)
|
||||
|
||||
(define set-simple-input-field-default!
|
||||
(make-simple-input-field-default-setter simple-default? #t))
|
||||
(define set-simple-field-default!
|
||||
(make-simple-default-setter simple-default? #t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Text input field
|
||||
(define make-text-input-field
|
||||
(simple-input-field-maker "text" "text"
|
||||
simple-default? identity))
|
||||
(define set-text-input-field-value! set-simple-input-field-default!)
|
||||
(define make-text-field
|
||||
(simple-field-maker "text" "text" simple-default? identity))
|
||||
(define set-text-field-value! set-simple-field-default!)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Number input field
|
||||
(define (number-input-field-default? value)
|
||||
(define (number-field-default? value)
|
||||
(or (number? value)
|
||||
(simple-default? value)))
|
||||
(define (number-input-field-transformer string)
|
||||
(define (number-field-transformer string)
|
||||
(or (string->number string)
|
||||
(error "wrong type")))
|
||||
(define make-number-input-field
|
||||
(simple-input-field-maker "text" "number"
|
||||
number-input-field-default?
|
||||
number-input-field-transformer))
|
||||
(define set-number-input-field-value!
|
||||
(make-simple-input-field-default-setter number-input-field-default? #t))
|
||||
(define make-number-field
|
||||
(simple-field-maker "text" "number"
|
||||
number-field-default? number-field-transformer))
|
||||
(define set-number-field-value!
|
||||
(make-simple-default-setter number-field-default? #t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; hidden input-field
|
||||
;; Little workaraound, as a hidden input-field needs a value. This
|
||||
;; value is propagated in the slot "default value".
|
||||
(define make-hidden-input-field
|
||||
(let ((hidden-input-field-generator
|
||||
(simple-input-field-maker "hidden" "text"
|
||||
simple-default? identity)))
|
||||
(define make-hidden-field
|
||||
(let ((hidden-field-generator
|
||||
(simple-field-maker "hidden" "text"
|
||||
simple-default? identity)))
|
||||
(lambda (value . maybe-further-attributes)
|
||||
(apply hidden-input-field-generator
|
||||
(apply hidden-field-generator
|
||||
(cons value maybe-further-attributes)))))
|
||||
(define set-hidden-input-field-value!
|
||||
set-simple-input-field-default!)
|
||||
(define set-hidden-field-value! set-simple-field-default!)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Password input field
|
||||
(define make-password-input-field
|
||||
(simple-input-field-maker "password" "password"
|
||||
simple-default? identity))
|
||||
(define set-password-input-field-value!
|
||||
set-simple-input-field-default!)
|
||||
(define make-password-field
|
||||
(simple-field-maker "password" "password"
|
||||
simple-default? identity))
|
||||
(define set-password-field-value! set-simple-field-default!)
|
||||
|
||||
;;; That's it for simple input fields.
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Textarea input field
|
||||
(define (make-textarea-input-field . maybe-further-attributes)
|
||||
(define (make-textarea . maybe-further-attributes)
|
||||
(let ((name (generate-input-field-name "textarea")))
|
||||
(optionals maybe-further-attributes
|
||||
((default-text simple-default?)
|
||||
|
|
@ -121,34 +116,33 @@
|
|||
(make-input-field
|
||||
name "textarea"
|
||||
identity
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(and default-text)
|
||||
(cons extra-attributes (sxml-attribute-attributes attributes)))
|
||||
make-textarea-input-field-html-tree)))))
|
||||
make-textarea-html-tree)))))
|
||||
|
||||
(define (make-textarea-input-field-html-tree input-field)
|
||||
(let ((attributes (input-field-attributes input-field)))
|
||||
(define (make-textarea-html-tree textarea)
|
||||
(let ((attributes (input-field-attributes textarea)))
|
||||
`(textarea (@ (type "textarea")
|
||||
(name ,(input-field-name input-field))
|
||||
,(input-field-attributes-others attributes))
|
||||
,(input-field-attributes-default attributes))))
|
||||
(name ,(input-field-name textarea))
|
||||
,(field-attributes-others attributes))
|
||||
,(field-attributes-default attributes))))
|
||||
|
||||
(define set-textarea-input-field-value!
|
||||
(define set-textarea-value!
|
||||
(let ((textarea-default-setter!
|
||||
(make-simple-input-field-default-setter simple-default? #f)))
|
||||
(lambda (textarea-input-field value)
|
||||
(textarea-default-setter! textarea-input-field value))))
|
||||
(make-simple-default-setter simple-default? #f)))
|
||||
(lambda (textarea value)
|
||||
(textarea-default-setter! textarea value))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Selection input field
|
||||
;;; Select input field
|
||||
|
||||
;; sel-if == select-input-field
|
||||
;(make-select-input-fields '("this" "that" "those") '(@ ((id "sushi"))))
|
||||
;(make-select-input-fields '("this" ("that" '(@ (selected))) "those"))
|
||||
;(make-select '("this" "that" "those") '(@ ((id "sushi"))))
|
||||
;(make-select '("this" ("that" '(@ (selected))) "those"))
|
||||
;; dropdown: (size 1)
|
||||
|
||||
;;; A selection input field shows a list of options that can be
|
||||
;;; selected. For this purpose, we introduce an sel-if-option record,
|
||||
;;; A select input field shows a list of options that can be
|
||||
;;; selected. For this purpose, we introduce an select-option record,
|
||||
;;; that contains all the information for each option. This is
|
||||
;;; justified by the fact, that the options list is seperated in HTML,
|
||||
;;; too. The TAG is the string that is displayed in the website, the
|
||||
|
|
@ -156,187 +150,187 @@
|
|||
;;; option was selected. TAG is assumed to be unique by some functions
|
||||
;;; (e.g. select and unselect) SELECTED? tells us, if this option is
|
||||
;;; preselected.
|
||||
(define-record-type sel-if-option :sel-if-option
|
||||
(really-make-sel-if-option tag value selected? attributes)
|
||||
sel-if-option?
|
||||
(tag sel-if-option-tag)
|
||||
(value sel-if-option-value)
|
||||
(selected? sel-if-option-selected? set-sel-if-option-selected?!)
|
||||
(attributes sel-if-option-attributes set-sel-if-option-attributes!))
|
||||
(define-record-type select-option :select-option
|
||||
(really-make-select-option tag value selected? attributes)
|
||||
select-option?
|
||||
(tag select-option-tag)
|
||||
(value select-option-value)
|
||||
(selected? select-option-selected? really-set-select-option-selected?!)
|
||||
(attributes select-option-attributes set-select-option-attributes!))
|
||||
|
||||
(define (make-sel-if-option tag value selected? attributes)
|
||||
(define (make-select-option tag value selected? attributes)
|
||||
(if (string? tag)
|
||||
(really-make-sel-if-option tag value selected?
|
||||
(really-make-select-option tag value selected?
|
||||
(sxml-attribute-attributes attributes))
|
||||
(error "Select-input-field-option's tag must be a string." tag)))
|
||||
(error "Select-option's tag must be a string." tag)))
|
||||
|
||||
;; Constructor for valued select input-field option.
|
||||
(define (make-annotated-sel-if-option tag value . maybe-attributes)
|
||||
(define (make-annotated-select-option tag value . maybe-attributes)
|
||||
(optionals maybe-attributes
|
||||
((selected? boolean?)
|
||||
(attributes sxml-attribute?))
|
||||
(make-sel-if-option tag value selected? attributes)))
|
||||
(make-select-option tag value selected? attributes)))
|
||||
|
||||
;; Constructor for a simple select input-field option (not annotated).
|
||||
(define (make-simple-sel-if-option tag . maybe-attributes)
|
||||
(define (make-simple-select-option tag . maybe-attributes)
|
||||
(optionals maybe-attributes
|
||||
((selected? boolean?)
|
||||
(attributes sxml-attribute?))
|
||||
(make-sel-if-option tag tag selected? attributes)))
|
||||
(make-select-option tag tag selected? attributes)))
|
||||
|
||||
(define-record-discloser :sel-if-option
|
||||
(lambda (sel-if-option)
|
||||
(list 'select-input-field-option
|
||||
(sel-if-option-tag sel-if-option)
|
||||
(sel-if-option-value sel-if-option)
|
||||
(sel-if-option-selected? sel-if-option)
|
||||
(sel-if-option-attributes sel-if-option)
|
||||
(define-record-discloser :select-option
|
||||
(lambda (select-option)
|
||||
(list 'select-option
|
||||
(select-option-tag select-option)
|
||||
(select-option-value select-option)
|
||||
(select-option-selected? select-option)
|
||||
(select-option-attributes select-option)
|
||||
)))
|
||||
|
||||
;; Selecting / Unselecting of an option in an select input-field,
|
||||
;; chosen by tag.
|
||||
(define (select-sel-if-option! tag sel-if)
|
||||
(set-select-input-field-option-selected?! tag sel-if #t))
|
||||
(define (select-select-option! tag select)
|
||||
(set-select-option-selected?! tag select #t))
|
||||
|
||||
(define (unselect-sel-if-option! tag sel-if)
|
||||
(set-select-input-field-option-selected?! tag sel-if #f))
|
||||
(define (unselect-select-option! tag select)
|
||||
(set-select-option-selected?! tag select #f))
|
||||
|
||||
(define (set-select-input-field-option-selected?! tag sel-if selected?)
|
||||
(let ((options (input-field-attributes-default
|
||||
(input-field-attributes sel-if))))
|
||||
(define (set-select-option-selected?! tag select selected?)
|
||||
(let ((options (field-attributes-default
|
||||
(input-field-attributes select))))
|
||||
(if (number? tag) ; is tag an index?
|
||||
(set-sel-if-option-selected?! (list-ref options tag)
|
||||
selected?)
|
||||
(really-set-select-option-selected?! (list-ref options tag)
|
||||
selected?)
|
||||
(let lp ((options options))
|
||||
(if (null? options)
|
||||
(error "No such option" tag sel-if)
|
||||
(if (tag=sel-if-option? tag (car options))
|
||||
(set-sel-if-option-selected?! (car options) selected?)
|
||||
(error "No such option" tag select)
|
||||
(if (tag=select-option? tag (car options))
|
||||
(really-set-select-option-selected?! (car options)
|
||||
selected?)
|
||||
(lp (cdr options))))))
|
||||
(touch-input-field! sel-if)))
|
||||
(touch-input-field! select)))
|
||||
|
||||
;; Find sel-if-option in a list by its tag.
|
||||
(define (tag=sel-if-option? tag sel-if-option)
|
||||
(string=? tag (sel-if-option-tag sel-if-option)))
|
||||
;; Find select-option in a list by its tag.
|
||||
(define (tag=select-option? tag select-option)
|
||||
(string=? tag (select-option-tag select-option)))
|
||||
|
||||
(define (find-sel-if-option tag sel-if-options)
|
||||
(cond ((member/srfi-1 tag sel-if-options tag=sel-if-option?)
|
||||
(define (find-select-option tag select-options)
|
||||
(cond ((member/srfi-1 tag select-options tag=select-option?)
|
||||
=> car)
|
||||
;; MEMBER/SRFI-1 returns the sublist that starts with the
|
||||
;; searched element.
|
||||
(else #f)))
|
||||
|
||||
(define (find-sel-if-option-value tag sel-if-options)
|
||||
(cond ((find-sel-if-option tag sel-if-options)
|
||||
=> sel-if-option-value)
|
||||
(define (find-select-option-value tag select-options)
|
||||
(cond ((find-select-option tag select-options)
|
||||
=> select-option-value)
|
||||
(else #f)))
|
||||
|
||||
(define (add-sel-if-option! sel-if sel-if-option)
|
||||
(let ((attributes (input-field-attributes sel-if)))
|
||||
(set-input-field-attributes-default!
|
||||
(define (add-select-option! select select-option)
|
||||
(let ((attributes (input-field-attributes select)))
|
||||
(set-field-attributes-default!
|
||||
attributes
|
||||
(cons sel-if-option
|
||||
(input-field-attributes-default attributes)))
|
||||
(touch-input-field! sel-if)))
|
||||
(cons select-option
|
||||
(field-attributes-default attributes)))
|
||||
(touch-input-field! select)))
|
||||
|
||||
(define (delete-sel-if-option! sel-if sel-if-option)
|
||||
(let* ((attributes (input-field-attributes sel-if))
|
||||
(sel-if-options (input-field-attributes-default attributes)))
|
||||
(if (sel-if-option? sel-if-option)
|
||||
(set-input-field-attributes-default!
|
||||
(define (delete-select-option! select select-option)
|
||||
(let* ((attributes (input-field-attributes select))
|
||||
(select-options (field-attributes-default attributes)))
|
||||
(if (select-option? select-option)
|
||||
(set-field-attributes-default!
|
||||
attributes
|
||||
(delete sel-if-option sel-if-options))
|
||||
(let ((tag sel-if-option))
|
||||
(set-input-field-attributes-default!
|
||||
(delete select-option select-options))
|
||||
(let ((tag select-option))
|
||||
(set-field-attributes-default!
|
||||
attributes
|
||||
(delete tag sel-if-options tag=sel-if-option?))))
|
||||
(touch-input-field! sel-if)))
|
||||
(delete tag select-options tag=select-option?))))
|
||||
(touch-input-field! select)))
|
||||
|
||||
;; To be compatible with previous versions of MAKE-SELECT-INPUT-FIELD,
|
||||
;; we accept also a simple list as an option-list. New programs should
|
||||
;; use sel-if-options-list (easily createable with
|
||||
;; (map make-simple-sel-if-option option-list))
|
||||
(define (tolerate-old-sel-if-options sel-if-options)
|
||||
(if (and (list? sel-if-options)
|
||||
(every sel-if-option? sel-if-options))
|
||||
sel-if-options
|
||||
(map make-simple-sel-if-option sel-if-options)))
|
||||
;; use select-options-list (easily createable with
|
||||
;; (map make-simple-select-option option-list))
|
||||
(define (tolerate-old-select-options select-options)
|
||||
(if (and (list? select-options)
|
||||
(every select-option? select-options))
|
||||
select-options
|
||||
(map make-simple-select-option select-options)))
|
||||
|
||||
(define (make-select-input-field sel-if-options . maybe-further-attributes)
|
||||
(really-make-select-input-field (tolerate-old-sel-if-options sel-if-options)
|
||||
maybe-further-attributes))
|
||||
(define (make-select select-options . maybe-further-attributes)
|
||||
(really-make-select (tolerate-old-select-options select-options)
|
||||
maybe-further-attributes))
|
||||
|
||||
(define (make-annotated-select-input-field sel-if-options .
|
||||
maybe-further-attributes)
|
||||
(really-make-select-input-field sel-if-options maybe-further-attributes))
|
||||
(define (make-annotated-select select-options .
|
||||
maybe-further-attributes)
|
||||
(really-make-select select-options maybe-further-attributes))
|
||||
|
||||
(define (really-make-select-input-field sel-if-options
|
||||
maybe-further-attributes)
|
||||
(let ((real-sel-if-options (tolerate-old-sel-if-options sel-if-options)))
|
||||
(define (really-make-select select-options maybe-further-attributes)
|
||||
(let ((real-select-options (tolerate-old-select-options select-options)))
|
||||
(optionals maybe-further-attributes
|
||||
((multiple? boolean?)
|
||||
(attributes sxml-attribute?))
|
||||
(let ((name (generate-input-field-name "select")))
|
||||
(if multiple?
|
||||
(make-multiple-select-input-field name sel-if-options attributes)
|
||||
(make-single-select-input-field name sel-if-options
|
||||
attributes))))))
|
||||
(make-multiple-select name select-options attributes)
|
||||
(make-single-select name select-options
|
||||
attributes))))))
|
||||
|
||||
;; internal
|
||||
(define (make-multiple-select-input-field name sel-if-options attributes)
|
||||
(define (make-multiple-select name select-options attributes)
|
||||
(make-multi-input-field name "mult-select"
|
||||
sel-if-multiple-transformer
|
||||
(make-input-field-attributes
|
||||
sel-if-options
|
||||
select-multiple-transformer
|
||||
(make-field-attributes
|
||||
select-options
|
||||
(list '(multiple)
|
||||
(sxml-attribute-attributes attributes)))
|
||||
make-sel-if-html-tree))
|
||||
make-select-html-tree))
|
||||
|
||||
;; internal
|
||||
(define (make-single-select-input-field name sel-if-options attributes)
|
||||
(define (make-single-select name select-options attributes)
|
||||
(make-input-field name "select"
|
||||
(lambda (tag)
|
||||
(cond ((find-sel-if-option-value tag sel-if-options)
|
||||
(cond ((find-select-option-value tag select-options)
|
||||
=> identity)
|
||||
(else (error "no such option." tag))))
|
||||
(make-input-field-attributes
|
||||
sel-if-options
|
||||
(make-field-attributes
|
||||
select-options
|
||||
(sxml-attribute-attributes attributes))
|
||||
make-sel-if-html-tree))
|
||||
make-select-html-tree))
|
||||
|
||||
(define (sel-if-multiple-transformer input-field bindings)
|
||||
(let ((name (input-field-name input-field))
|
||||
(sel-if-options (input-field-attributes-default
|
||||
(input-field-attributes input-field))))
|
||||
(define (select-multiple-transformer select bindings)
|
||||
(let ((name (input-field-name select))
|
||||
(select-options (field-attributes-default
|
||||
(input-field-attributes select))))
|
||||
(let* ((my-bindings (filter (lambda (binding)
|
||||
(equal? (car binding) name))
|
||||
bindings))
|
||||
(equal? (car binding) name))
|
||||
bindings))
|
||||
(tags (map cdr my-bindings)))
|
||||
(filter-map (lambda (tag)
|
||||
(find-sel-if-option-value tag sel-if-options))
|
||||
(find-select-option-value tag select-options))
|
||||
tags))))
|
||||
|
||||
(define (make-sel-if-html-tree sel-if)
|
||||
(let ((attributes (input-field-attributes sel-if)))
|
||||
`(select (@ (name ,(input-field-name sel-if))
|
||||
,(input-field-attributes-others attributes))
|
||||
(define (make-select-html-tree select)
|
||||
(let ((attributes (input-field-attributes select)))
|
||||
`(select (@ (name ,(input-field-name select))
|
||||
,(field-attributes-others attributes))
|
||||
#\newline
|
||||
,@(make-sel-if-options-html-tree
|
||||
(input-field-attributes-default attributes)))))
|
||||
,@(make-select-options-html-tree
|
||||
(field-attributes-default attributes)))))
|
||||
|
||||
(define (make-sel-if-options-html-tree sel-if-options)
|
||||
(map (lambda (sel-if-option)
|
||||
`(option (@ ,(and (sel-if-option-selected? sel-if-option) '(selected))
|
||||
,(sel-if-option-attributes sel-if-option))
|
||||
,(sel-if-option-tag sel-if-option)))
|
||||
sel-if-options))
|
||||
(define (make-select-options-html-tree select-options)
|
||||
(map (lambda (select-option)
|
||||
`(option (@ ,(and (select-option-selected? select-option) '(selected))
|
||||
,(select-option-attributes select-option))
|
||||
,(select-option-tag select-option)))
|
||||
select-options))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; radio input-fields
|
||||
;; Because grouped radio input-fields must use the same name, we
|
||||
;; cannot just return one radio input-field object, but we must
|
||||
;; generate several ones with the same name.
|
||||
(define (make-radio-input-field-group)
|
||||
(define (make-radio-group)
|
||||
(let ((name (generate-input-field-name "radio")))
|
||||
(lambda (value-string . maybe-further-attributes)
|
||||
(optionals maybe-further-attributes
|
||||
|
|
@ -344,16 +338,16 @@
|
|||
(attributes sxml-attribute?))
|
||||
(make-input-field name "radio"
|
||||
identity
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(if checked? '(checked) #f)
|
||||
(list `(value ,value-string)
|
||||
(sxml-attribute-attributes attributes)))
|
||||
radio-input-field-html-tree-maker)))))
|
||||
radio-html-tree-maker)))))
|
||||
|
||||
(define (make-annotated-radio-input-field-group)
|
||||
(define (make-annotated-radio-group)
|
||||
(let* ((name (generate-input-field-name "radio"))
|
||||
(value-table (make-integer-table))
|
||||
(transformer (make-radio-input-field-transformer value-table)))
|
||||
(transformer (make-radio-transformer value-table)))
|
||||
(lambda (value . maybe-further-attributes)
|
||||
(optionals maybe-further-attributes
|
||||
((checked? boolean?)
|
||||
|
|
@ -362,16 +356,16 @@
|
|||
(table-set! value-table number value)
|
||||
(make-input-field name "radio"
|
||||
transformer
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(if checked? '(checked) #f)
|
||||
(list`(value ,(number->string number))
|
||||
(sxml-attribute-attributes attributes)))
|
||||
radio-input-field-html-tree-maker))))))
|
||||
radio-html-tree-maker))))))
|
||||
|
||||
(define (make-radio-input-fields values . maybe-further-attributes)
|
||||
(define (make-radios values . maybe-further-attributes)
|
||||
(optionals maybe-further-attributes
|
||||
((attributes sxml-attribute?))
|
||||
(let ((radio-gen (make-annotated-radio-input-field-group)))
|
||||
(let ((radio-gen (make-annotated-radio-group)))
|
||||
(map (lambda (value)
|
||||
(if attributes
|
||||
(radio-gen value attributes)
|
||||
|
|
@ -379,7 +373,7 @@
|
|||
values))))
|
||||
|
||||
|
||||
(define (make-radio-input-field-transformer value-table)
|
||||
(define (make-radio-transformer value-table)
|
||||
(lambda (tag)
|
||||
(cond
|
||||
((string->number tag) =>
|
||||
|
|
@ -391,48 +385,46 @@
|
|||
(else
|
||||
(error "Unknown tag number for radio input-field" tag)))))
|
||||
|
||||
(define (radio-input-field-html-tree-maker radio-input-field)
|
||||
(let* ((attributes (input-field-attributes radio-input-field)))
|
||||
(define (radio-html-tree-maker radio)
|
||||
(let* ((attributes (input-field-attributes radio)))
|
||||
`(input (@ ((type "radio")
|
||||
(name ,(input-field-name radio-input-field))
|
||||
,(input-field-attributes-default attributes)
|
||||
,(input-field-attributes-others attributes))))))
|
||||
(name ,(input-field-name radio))
|
||||
,(field-attributes-default attributes)
|
||||
,(field-attributes-others attributes))))))
|
||||
|
||||
(define (set-input-field-checked?! input-field checked?)
|
||||
(let ((attributes (input-field-attributes input-field)))
|
||||
(set-input-field-attributes-default!
|
||||
(set-field-attributes-default!
|
||||
attributes
|
||||
(if checked? '(checked) #f))
|
||||
(touch-input-field! input-field)))
|
||||
|
||||
(define set-radio-input-field-checked?! set-input-field-checked?!)
|
||||
(define (check-radio-input-field! radio)
|
||||
(set-radio-input-field-checked?! radio #t))
|
||||
(define (uncheck-radio-input-field! radio)
|
||||
(set-radio-input-field-checked?! radio #f))
|
||||
|
||||
(define set-radio-checked?! set-input-field-checked?!)
|
||||
(define (check-radio! radio) (set-radio-checked?! radio #t))
|
||||
(define (uncheck-radio! radio) (set-radio-checked?! radio #f))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; checkbox input-field
|
||||
(define (make-checkbox-input-field . maybe-further-attributes)
|
||||
(really-make-checkbox-input-field #t
|
||||
checkbox-transformer
|
||||
maybe-further-attributes))
|
||||
(define (make-checkbox . maybe-further-attributes)
|
||||
(really-make-checkbox #t
|
||||
checkbox-transformer
|
||||
maybe-further-attributes))
|
||||
|
||||
(define (make-annotated-checkbox-input-field value . maybe-further-attributes)
|
||||
(really-make-checkbox-input-field value
|
||||
(make-checkbox-transformer value)
|
||||
maybe-further-attributes))
|
||||
(define (make-annotated-checkbox value . maybe-further-attributes)
|
||||
(really-make-checkbox value
|
||||
(make-checkbox-transformer value)
|
||||
maybe-further-attributes))
|
||||
|
||||
(define (really-make-checkbox-input-field value transformer attributes)
|
||||
(define (really-make-checkbox value transformer attributes)
|
||||
(let ((name (generate-input-field-name "checkbox")))
|
||||
(optionals attributes
|
||||
((checked? boolean?)
|
||||
(attributes sxml-attribute?))
|
||||
(make-input-field name "checkbox"
|
||||
transformer
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(if checked? '(checked) #f)
|
||||
(sxml-attribute-attributes attributes))
|
||||
checkbox-input-field-html-tree-maker))))
|
||||
checkbox-html-tree-maker))))
|
||||
|
||||
(define (make-checkbox-transformer value)
|
||||
(lambda (tag)
|
||||
|
|
@ -440,37 +432,36 @@
|
|||
value
|
||||
#f)))
|
||||
|
||||
(define checkbox-transformer
|
||||
(make-checkbox-transformer #t))
|
||||
(define checkbox-transformer (make-checkbox-transformer #t))
|
||||
|
||||
(define (checkbox-input-field-html-tree-maker cb-if)
|
||||
(let ((attributes (input-field-attributes cb-if)))
|
||||
(define (checkbox-html-tree-maker checkbox)
|
||||
(let ((attributes (input-field-attributes checkbox)))
|
||||
`(input (@ ((type "checkbox")
|
||||
(name ,(input-field-name cb-if))
|
||||
,(input-field-attributes-default attributes)
|
||||
,(input-field-attributes-others attributes))))))
|
||||
(name ,(input-field-name checkbox))
|
||||
,(field-attributes-default attributes)
|
||||
,(field-attributes-others attributes))))))
|
||||
|
||||
(define set-checkbox-checked?! set-input-field-checked?!)
|
||||
(define (check-checkbox! checkbox) (set-checkbox-checked?! checkbox #t))
|
||||
(define (uncheck-checkbox! checkbox) (set-checkbox-checked?! checkbox #f))
|
||||
|
||||
|
||||
(define set-checkbox-input-field-checked?! set-input-field-checked?!)
|
||||
(define (check-checkbox-input-field! checkbox)
|
||||
(set-checkbox-input-field-checked?! checkbox #t))
|
||||
(define (uncheck-checkbox-input-field! checkbox)
|
||||
(set-checkbox-input-field-checked?! checkbox #f))
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; button input-fields
|
||||
(define (make-button type name button-caption attributes)
|
||||
(make-input-field name type
|
||||
identity
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
(and button-caption `(value ,button-caption))
|
||||
(sxml-attribute-attributes attributes))
|
||||
make-button-html-tree))
|
||||
|
||||
(define (make-button-html-tree button-input-field)
|
||||
(let ((attributes (input-field-attributes button-input-field)))
|
||||
`(input (@ (type ,(input-field-type button-input-field))
|
||||
(name ,(input-field-name button-input-field))
|
||||
,(input-field-attributes-default attributes)
|
||||
,(input-field-attributes-others attributes)))))
|
||||
(define (make-button-html-tree button)
|
||||
(let ((attributes (input-field-attributes button)))
|
||||
`(input (@ (type ,(input-field-type button))
|
||||
(name ,(input-field-name button))
|
||||
,(field-attributes-default attributes)
|
||||
,(field-attributes-others attributes)))))
|
||||
|
||||
(define (make-submit-button . maybe-further-attributes)
|
||||
(optionals maybe-further-attributes
|
||||
|
|
@ -502,7 +493,7 @@
|
|||
(make-multi-input-field (generate-input-field-name "imgbtn")
|
||||
"image"
|
||||
image-button-transformer
|
||||
(make-input-field-attributes
|
||||
(make-field-attributes
|
||||
`(src ,image-source)
|
||||
(sxml-attribute-attributes attributes))
|
||||
make-button-html-tree)))
|
||||
|
|
@ -514,10 +505,10 @@
|
|||
(y (find-image-button-coordinate image-button bindings ".y")))
|
||||
(let ((x-number (string->number x))
|
||||
(y-number (string->number y)))
|
||||
(and x y
|
||||
(if (and x-number y-number)
|
||||
(cons x-number y-number)
|
||||
(error "Image button coordinates aren't numbers. " x y))))))
|
||||
(and x y
|
||||
(if (and x-number y-number)
|
||||
(cons x-number y-number)
|
||||
(error "Image button coordinates aren't numbers. " x y))))))
|
||||
|
||||
(define (find-image-button-coordinate image-button bindings suffix)
|
||||
(let* ((name (input-field-name image-button)))
|
||||
|
|
@ -526,6 +517,6 @@
|
|||
=> (lambda (pair)
|
||||
(cdr pair)))
|
||||
(else #f))))
|
||||
|
||||
|
||||
|
||||
;;EOF
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
scheme-with-scsh)
|
||||
(begin
|
||||
|
||||
(define number-input (make-number-input-field))
|
||||
(define number-input (make-number-field))
|
||||
|
||||
(define (create-input-page title input-text number-input)
|
||||
(lambda (new-url)
|
||||
|
|
|
|||
|
|
@ -44,8 +44,8 @@
|
|||
(let* ((update-text `(font (@ (color "red"))
|
||||
,(:optional maybe-update-text "")))
|
||||
(number-field
|
||||
(make-number-input-field (options-session-lifetime)))
|
||||
(cache-checkbox (make-checkbox-input-field (options-cache-surflets?)))
|
||||
(make-number-field (options-session-lifetime)))
|
||||
(cache-checkbox (make-checkbox (options-cache-surflets?)))
|
||||
(options `(("Current session lifetime: " ,number-field ,submit-timeout)
|
||||
("Cache SUrflets?" ,cache-checkbox ,submit-cache)))
|
||||
(req (get-option-change return-address update-text options))
|
||||
|
|
|
|||
|
|
@ -39,10 +39,10 @@
|
|||
|
||||
(define (profile req . maybe-update-text)
|
||||
(let* ((update-text (:optional maybe-update-text ""))
|
||||
(gnuplot-input-field (make-text-input-field gnuplot '(@ (size 20))))
|
||||
(gnuplot-input-field (make-text-field gnuplot '(@ (size 20))))
|
||||
(gnuplot-change-button (make-submit-button "Change"))
|
||||
(convert-check-box (make-checkbox-input-field use-convert?))
|
||||
(convert-input-field (make-text-input-field convert '(@ (size 20))))
|
||||
(convert-check-box (make-checkbox use-convert?))
|
||||
(convert-input-field (make-text-field convert '(@ (size 20))))
|
||||
(convert-change-button (make-submit-button "Change"))
|
||||
(new-profile-address (make-address))
|
||||
(result-address (make-address))
|
||||
|
|
|
|||
|
|
@ -26,10 +26,10 @@
|
|||
(define (select-table title header header-row
|
||||
table-elements selector actions footer)
|
||||
(let* ((checkboxes (map (lambda (_)
|
||||
(make-checkbox-input-field))
|
||||
(make-checkbox))
|
||||
table-elements))
|
||||
(action-title "Choose an action")
|
||||
(select (make-select-input-field (cons action-title actions)
|
||||
(select (make-select (cons action-title actions)
|
||||
'(@ (size 1))))
|
||||
(req
|
||||
(send-html/suspend
|
||||
|
|
|
|||
|
|
@ -26,9 +26,9 @@
|
|||
;; list of selected elements out of TABLE-ELEMENTS.
|
||||
(define (select-table title header header-row
|
||||
table-elements selector actions footer)
|
||||
(let* ((checkboxes (map make-annotated-checkbox-input-field
|
||||
(let* ((checkboxes (map make-annotated-checkbox
|
||||
table-elements))
|
||||
(select (make-annotated-select-input-field
|
||||
(select (make-annotated-select
|
||||
actions '(@ (size 1))))
|
||||
(req
|
||||
(send-html/suspend
|
||||
|
|
@ -98,7 +98,7 @@
|
|||
(body ,header ,(no-surflets callback) ,footer)))
|
||||
(let ((actions
|
||||
(map (lambda (action-pair)
|
||||
(make-annotated-sel-if-option
|
||||
(make-annotated-select-option
|
||||
(car action-pair)
|
||||
(cdr action-pair)))
|
||||
`(("Choose an action" . ,(choose-an-action show-surflets))
|
||||
|
|
@ -200,7 +200,7 @@
|
|||
(body ,@header ,(no-current-sessions) ,footer)))
|
||||
(let ((actions
|
||||
(map (lambda (action-pair)
|
||||
(make-annotated-sel-if-option
|
||||
(make-annotated-select-option
|
||||
(car action-pair)
|
||||
(cdr action-pair)))
|
||||
`(("Choose an action" . ,(choose-an-action show-sessions))
|
||||
|
|
@ -301,7 +301,7 @@
|
|||
,footer)))
|
||||
(let ((actions
|
||||
(map (lambda (action-pair)
|
||||
(make-annotated-sel-if-option
|
||||
(make-annotated-select-option
|
||||
(car action-pair)
|
||||
(cdr action-pair)))
|
||||
`(("Choose an action" .
|
||||
|
|
|
|||
|
|
@ -7,8 +7,6 @@
|
|||
scheme-with-scsh)
|
||||
(begin
|
||||
|
||||
;; This doesn't use c-a-l-l-b-a-c-k-s anymore.
|
||||
|
||||
(define (make-byte-input-fields bits)
|
||||
(let ((checkboxes
|
||||
(reverse
|
||||
|
|
@ -17,9 +15,10 @@
|
|||
(if (= count bits)
|
||||
'()
|
||||
(cons
|
||||
(make-annotated-checkbox-input-field order)
|
||||
(make-annotated-checkbox order)
|
||||
(loop (+ 1 count)
|
||||
(* 2 order))))))))
|
||||
|
||||
(make-multi-input-field
|
||||
#f "byte-input"
|
||||
(lambda (input-field bindings)
|
||||
|
|
|
|||
|
|
@ -43,15 +43,15 @@
|
|||
))
|
||||
|
||||
|
||||
(define (make-number-input-field/default default)
|
||||
(define (make-number-field/default default)
|
||||
(if default
|
||||
(make-number-input-field `(@ (value ,default)))
|
||||
(make-number-input-field)))
|
||||
(make-number-field `(@ (value ,default)))
|
||||
(make-number-field)))
|
||||
|
||||
(define (show-page operator-pair number1 number2 . maybe-update-text)
|
||||
(let* ((update-text (:optional maybe-update-text ""))
|
||||
(number-field1 (make-number-input-field/default number1))
|
||||
(number-field2 (make-number-input-field/default number2))
|
||||
(number-field1 (make-number-field/default number1))
|
||||
(number-field2 (make-number-field/default number2))
|
||||
(req
|
||||
(send-html/suspend
|
||||
(lambda (new-url)
|
||||
|
|
|
|||
|
|
@ -35,15 +35,15 @@
|
|||
*operator-alist*))))))
|
||||
|
||||
|
||||
(define (make-number-input-field/default default)
|
||||
(define (make-number-field/default default)
|
||||
(if default
|
||||
(make-number-input-field default)
|
||||
(make-number-input-field)))
|
||||
(make-number-field default)
|
||||
(make-number-field)))
|
||||
|
||||
(define (show-page operator-pair number1 number2 . maybe-update-text)
|
||||
(let* ((update-text (:optional maybe-update-text ""))
|
||||
(number-field1 (make-number-input-field/default number1))
|
||||
(number-field2 (make-number-input-field/default number2))
|
||||
(number-field1 (make-number-field/default number1))
|
||||
(number-field2 (make-number-field/default number2))
|
||||
(calculate-button (make-submit-button "Calculate"))
|
||||
(change-button (make-submit-button "Change operator"))
|
||||
(req
|
||||
|
|
|
|||
|
|
@ -109,12 +109,12 @@
|
|||
(def-armed? #f)
|
||||
(def-shields? #f)
|
||||
(def-drive #f))
|
||||
(let* ((class-radios (make-radio-input-fields
|
||||
(let* ((class-radios (make-radios
|
||||
(checked-radio classes def-class)))
|
||||
(drive-radios (make-radio-input-fields
|
||||
(drive-radios (make-radios
|
||||
(checked-radio drives def-drive)))
|
||||
(armed-checkbox (make-checkbox-input-field def-armed?))
|
||||
(shield-checkbox (make-checkbox-input-field def-shields?))
|
||||
(armed-checkbox (make-checkbox def-armed?))
|
||||
(shield-checkbox (make-checkbox def-shields?))
|
||||
(req (send-html/suspend
|
||||
(lambda (new-url)
|
||||
(generate-main-page new-url update-text
|
||||
|
|
@ -163,19 +163,19 @@
|
|||
(and armed?
|
||||
(map (lambda (type)
|
||||
(let ((text (cdr (assoc type arm-types))))
|
||||
(cons (make-annotated-checkbox-input-field
|
||||
(cons (make-annotated-checkbox
|
||||
text
|
||||
(and def-weapons (member? text def-weapons)))
|
||||
text)))
|
||||
(ship-data-arm-types (ship-ref class)))))
|
||||
(energy-input (and armed?
|
||||
(if def-energy
|
||||
(make-number-input-field def-energy)
|
||||
(make-number-input-field))))
|
||||
(make-number-field def-energy)
|
||||
(make-number-field))))
|
||||
(shield-input (and shields?
|
||||
(if def-shield
|
||||
(make-number-input-field def-shield)
|
||||
(make-number-input-field))))
|
||||
(make-number-field def-shield)
|
||||
(make-number-field))))
|
||||
(req (send-html/suspend
|
||||
(lambda (new-url)
|
||||
(generate-armed+shield-page new-url update-text
|
||||
|
|
@ -215,7 +215,7 @@
|
|||
;;; items are taken from the ship data list.
|
||||
(define (get-extras req class)
|
||||
(let* ((checkboxes+text (map (lambda (extra)
|
||||
(cons (make-annotated-checkbox-input-field extra)
|
||||
(cons (make-annotated-checkbox extra)
|
||||
(cdr (assoc extra extras))))
|
||||
(ship-data-extras (ship-ref class))))
|
||||
(req (send-html/suspend
|
||||
|
|
@ -269,7 +269,7 @@
|
|||
;;; and the maximum crew member for a class is not exceeded.
|
||||
(define (get-size req class . maybe-update-text)
|
||||
(let* ((update-text (:optional maybe-update-text #f))
|
||||
(size-input (make-number-input-field))
|
||||
(size-input (make-number-field))
|
||||
(req (send-html/suspend
|
||||
(lambda (new-url)
|
||||
(generate-size-page new-url update-text
|
||||
|
|
|
|||
|
|
@ -14,23 +14,23 @@
|
|||
(define selections (cons '("a" "b" "c")
|
||||
'("Andreas" "Bernd" "Clara")))
|
||||
(define radio-elements '(1 2 3 "a" *))
|
||||
(define select (make-annotated-select-input-field
|
||||
(map make-annotated-sel-if-option
|
||||
(define select (make-annotated-select
|
||||
(map make-annotated-select-option
|
||||
(car selections)
|
||||
(cdr selections))
|
||||
#t '(@ (size 2))))
|
||||
(define select2 (make-select-input-field (car selections)))
|
||||
(define text (make-text-input-field "yoho"))
|
||||
(define number (make-number-input-field 23))
|
||||
(define hidden (make-hidden-input-field "value"))
|
||||
(define password (make-password-input-field "asdf"))
|
||||
(define textarea (make-textarea-input-field "This
|
||||
(define select2 (make-select (car selections)))
|
||||
(define text (make-text-field "yoho"))
|
||||
(define number (make-number-field 23))
|
||||
(define hidden (make-hidden-field "value"))
|
||||
(define password (make-password-field "asdf"))
|
||||
(define textarea (make-textarea "This
|
||||
is
|
||||
a
|
||||
test"))
|
||||
(define radio (make-annotated-radio-input-field-group))
|
||||
(define radio (make-annotated-radio-group))
|
||||
(define radios (map radio radio-elements))
|
||||
(define checkbox (make-annotated-checkbox-input-field "hooray!"))
|
||||
(define checkbox (make-annotated-checkbox "hooray!"))
|
||||
|
||||
(define submit (make-submit-button))
|
||||
(define image (make-image-button "/img/221.gif"))
|
||||
|
|
@ -124,26 +124,26 @@ test"))
|
|||
(lambda (string)
|
||||
(format #f "returned via annotated string ~s" string)))
|
||||
(else
|
||||
(set-text-input-field-value! text text-entered)
|
||||
(set-text-field-value! text text-entered)
|
||||
(only-select-selected! select selected (cdr selections))
|
||||
(only-select-selected! select2 (list selected2) (car selections))
|
||||
(if number-entered
|
||||
(set-number-input-field-value! number number-entered))
|
||||
(set-hidden-input-field-value!
|
||||
(set-number-field-value! number number-entered))
|
||||
(set-hidden-field-value!
|
||||
hidden
|
||||
(string-append "value" (number->string global)))
|
||||
(set-password-input-field-value! password password-text)
|
||||
(set-textarea-input-field-value! textarea textarea-text)
|
||||
(set-password-field-value! password password-text)
|
||||
(set-textarea-value! textarea textarea-text)
|
||||
(if radio-result
|
||||
(begin
|
||||
(map uncheck-radio-input-field! radios)
|
||||
(check-radio-input-field!
|
||||
(map uncheck-radio! radios)
|
||||
(check-radio!
|
||||
(list-ref radios
|
||||
(list-index (lambda (a) (equal? a radio-result))
|
||||
radio-elements)))))
|
||||
(if checkbox-result
|
||||
(check-checkbox-input-field! checkbox)
|
||||
(uncheck-checkbox-input-field! checkbox))
|
||||
(check-checkbox! checkbox)
|
||||
(uncheck-checkbox! checkbox))
|
||||
`(p ,(cond
|
||||
(image-result (format #f "Returned via image ~s" image-result))
|
||||
(submit-result "Returned via submit")
|
||||
|
|
@ -189,10 +189,10 @@ test"))
|
|||
|
||||
(define (only-select-selected! sel-if selected indices)
|
||||
(for-each (lambda (index)
|
||||
(unselect-sel-if-option! index sel-if))
|
||||
(unselect-select-option! index sel-if))
|
||||
(iota (length (cdr selections))))
|
||||
(for-each (lambda (selected)
|
||||
(select-sel-if-option!
|
||||
(select-select-option!
|
||||
(list-index (lambda (s) (string=? s selected))
|
||||
indices)
|
||||
sel-if))
|
||||
|
|
|
|||
Loading…
Reference in New Issue