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

downcase! even more identifiers

This commit is contained in:
interp 2003-03-07 18:45:12 +00:00
parent 78a1d2e633
commit cacf6aeaa8
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
scheme/httpd/surflets/surflets.scm
View File

@ -170,7 +170,7 @@
(,input-field-trigger (,input-field-trigger
*preorder* *preorder*
. ,(lambda (trigger input-field) . ,(lambda (trigger input-field)
(reformat (input-field-HTML-tree input-field)))) (reformat (input-field-html-tree input-field))))
(surflet-form (surflet-form
;; Must do something to prevent the k-url string to be HTML ;; Must do something to prevent the k-url string to be HTML
@ -178,7 +178,7 @@
*preorder* *preorder*
. ,(lambda (trigger k-url . args) . ,(lambda (trigger k-url . args)
(receive (parameters elems) (receive (parameters elems)
(typed-optionals (list symbol? XML-attribute?) args) (typed-optionals (list symbol? xml-attribute?) args)
(make-surflet-form k-url ; k-url (make-surflet-form k-url ; k-url
(car parameters) ; POST, GET or #f=GET (car parameters) ; POST, GET or #f=GET
(cadr parameters); attributes (cadr parameters); attributes
@ -220,7 +220,7 @@
. ,(lambda (trigger str) . ,(lambda (trigger str)
(if (string? str) (string->goodHTML str) str)))) (if (string? str) (string->goodHTML str) str))))
(define URL-rule (define url-rule
(cons 'URL (cons 'URL
(lambda (tag URI . maybe-text) (lambda (tag URI . maybe-text)
(list "<a href=\"" URI "\">" (list "<a href=\"" URI "\">"
@ -239,7 +239,7 @@
(*default* (*default*
. ,(lambda (tag . elems) (apply (entag tag) elems))) . ,(lambda (tag . elems) (apply (entag tag) elems)))
,text-rule ,text-rule
,URL-rule ,url-rule
,plain-html-rule)) ,plain-html-rule))
(define (make-callback function) (define (make-callback function)
@ -288,12 +288,12 @@
;; get-bindings: Transformer will get all bindings of request, not ;; get-bindings: Transformer will get all bindings of request, not
;; only the one concerning the input-field. ;; only the one concerning the input-field.
(define-record-type input-field :input-field (define-record-type input-field :input-field
(real-make-input-field name transformer HTML-tree get-bindings?) (real-make-input-field name transformer html-tree get-bindings?)
real-input-field? real-input-field?
(name input-field-name) (name input-field-name)
(transformer input-field-transformer) (transformer input-field-transformer)
(attributes input-field-attributes) (attributes input-field-attributes)
(HTML-tree input-field-HTML-tree) (html-tree input-field-html-tree)
(get-bindings? input-field-get-bindings?)) (get-bindings? input-field-get-bindings?))
(define-record-discloser :input-field (define-record-discloser :input-field
@ -321,11 +321,11 @@
(define identity (lambda (a) a)) (define identity (lambda (a) a))
;; See note at input-field? for reasons for the list. ;; See note at input-field? for reasons for the list.
(define (make-input-field name transformer HTML-tree) (define (make-input-field name transformer html-tree)
(list input-field-trigger (real-make-input-field name transformer HTML-tree #f))) (list input-field-trigger (real-make-input-field name transformer html-tree #f)))
(define (make-higher-input-field transformer HTML-tree) (define (make-higher-input-field transformer html-tree)
(list input-field-trigger (real-make-input-field #f transformer HTML-tree #t))) (list input-field-trigger (real-make-input-field #f transformer html-tree #t)))
;; PRED-LIST contains list of predicates that recognizes optional ;; PRED-LIST contains list of predicates that recognizes optional
;; leading parameters. FURTHER-ATTRIBUTES is the optional parameter ;; leading parameters. FURTHER-ATTRIBUTES is the optional parameter
@ -478,7 +478,7 @@
((multiple? boolean?) ((multiple? boolean?)
(attributes xml-attribute?)) (attributes xml-attribute?))
(let* ((name (generate-input-field-name "select")) (let* ((name (generate-input-field-name "select"))
(SXML-options (sxml-options
(map (lambda (option) (map (lambda (option)
(cond (cond
((string-or-symbol? option) ((string-or-symbol? option)
@ -494,14 +494,14 @@
(else (else
(error "not an option" option)))) (error "not an option" option))))
options)) options))
(SXML `(select (@ ((name ,name) (sxml `(select (@ ((name ,name)
,(if multiple? '(multiple) '()) ,(if multiple? '(multiple) '())
,(and attributes (cdr attributes)))) ,(and attributes (cdr attributes))))
#\newline #\newline
,SXML-options))) ,sxml-options)))
(if multiple? (if multiple?
(make-higher-input-field (make-multiple-transformer name) SXML) (make-higher-input-field (make-multiple-transformer name) sxml)
(make-input-field name identity SXML))))))) (make-input-field name identity sxml)))))))
;; returns a *list* of radio buttons ;; returns a *list* of radio buttons
(define (make-radio-input-fields values . maybe-further-attributes) (define (make-radio-input-fields values . maybe-further-attributes)