+ Splitting file surflets.scm into several packages
- Removing surflets.scm
+ The surflets package remains and collects the most usual used packages
It does not export any more the outdaters, the access to IDs
(like session-id), callbacks, form-query-list.
(and maybe some other stuff I've forgot to mention here, see list
below).
The new packages are (not included in surflets are marked (*)):
+ surflets/addresses: MAKE-ADDRESS, MAKE-ANNOTATED-ADDRESS
+ surflets/bindings: GET-BINDINGS, EXTRACT-BINDINGS and stuff
+ surflets/ids (*): MY-SESSION-ID, .., INSTANCE-SESSION-ID
+ surflets/input-fields: MAKE-INPUT-FIELD, MAKE-NUMBER-INPUT-FIELD...
+ surflets/outdaters(*): MAKE-OUTDATER, OUTDATER?...
+ surflets/returned-via: RETURNED-VIA, CASE-RETURNED-VIA
+ surflets/send-html: SEND-HTML/SUSPEND...
+ surflets/surflet-sxml: URL-RULE,..., SURLFET-SXML-RULES, ...
+ surflets/sxml: SXML->STRING, DEFAULT-RULE,...
+ surflets/typed-optionals(*): TYPED-OPTIONALS, OPTIONALS
+ surflets/utilities(*): MAKE-CALLBACK, FORM-QUERY-LIST,
GENERATE-UNIQUE-NAME...
2003-03-10 11:29:32 -05:00
|
|
|
(define url-rule
|
|
|
|
(cons 'url
|
|
|
|
(lambda (tag uri . maybe-text)
|
|
|
|
(list "<a href=\"" uri "\">"
|
|
|
|
(if (null? maybe-text)
|
|
|
|
uri
|
|
|
|
maybe-text)
|
|
|
|
"</a>"))))
|
|
|
|
|
|
|
|
(define plain-html-rule
|
|
|
|
`(plain-html
|
|
|
|
*preorder*
|
|
|
|
. ,(lambda (tag . text) text)))
|
|
|
|
|
|
|
|
(define default-rules
|
|
|
|
`(,attribute-rule
|
|
|
|
,default-rule
|
|
|
|
,text-rule
|
|
|
|
,url-rule
|
|
|
|
,plain-html-rule))
|
|
|
|
|
|
|
|
(define surflet-form-rule
|
|
|
|
`(surflet-form
|
|
|
|
;; Must do something to prevent the k-url string to be HTML
|
|
|
|
;; escaped.
|
|
|
|
*preorder*
|
|
|
|
. ,(lambda (trigger k-url . args)
|
|
|
|
(receive (parameters elems)
|
|
|
|
(typed-optionals (list symbol? sxml-attribute?) args)
|
|
|
|
(make-surflet-form k-url ; k-url
|
|
|
|
(car parameters) ; POST, GET or #f=GET
|
|
|
|
(cadr parameters); attributes
|
|
|
|
elems)))))
|
|
|
|
|
|
|
|
(define (make-surflet-form k-url method attributes elems)
|
|
|
|
(let ((real-method (case method
|
|
|
|
((get GET) "GET")
|
|
|
|
((post POST) "POST")
|
|
|
|
((#f) "GET")
|
|
|
|
(else
|
|
|
|
(error "invalid method type" method)))))
|
|
|
|
(surflet-sxml->low-level-sxml
|
|
|
|
`(form (@ ((method ,real-method)
|
|
|
|
(action ,k-url)
|
|
|
|
,@(if attributes (cdr attributes) '())))
|
|
|
|
,@elems))))
|
|
|
|
|
|
|
|
(define input-field-rule
|
|
|
|
`(,*input-field-trigger*
|
|
|
|
*preorder*
|
|
|
|
. ,(lambda (trigger input-field)
|
|
|
|
(surflet-sxml->low-level-sxml
|
|
|
|
(input-field-html-tree input-field)))))
|
|
|
|
|
|
|
|
(define surflet-sxml-rules
|
|
|
|
`(,@default-rules
|
|
|
|
;; form contents:
|
|
|
|
,input-field-rule
|
|
|
|
,surflet-form-rule))
|
|
|
|
|
|
|
|
;; Low-Level-SXML is a list that can be understood by
|
2003-03-13 06:32:38 -05:00
|
|
|
;; display-low-level-sxml. In contains only characters, strings, and
|
+ Splitting file surflets.scm into several packages
- Removing surflets.scm
+ The surflets package remains and collects the most usual used packages
It does not export any more the outdaters, the access to IDs
(like session-id), callbacks, form-query-list.
(and maybe some other stuff I've forgot to mention here, see list
below).
The new packages are (not included in surflets are marked (*)):
+ surflets/addresses: MAKE-ADDRESS, MAKE-ANNOTATED-ADDRESS
+ surflets/bindings: GET-BINDINGS, EXTRACT-BINDINGS and stuff
+ surflets/ids (*): MY-SESSION-ID, .., INSTANCE-SESSION-ID
+ surflets/input-fields: MAKE-INPUT-FIELD, MAKE-NUMBER-INPUT-FIELD...
+ surflets/outdaters(*): MAKE-OUTDATER, OUTDATER?...
+ surflets/returned-via: RETURNED-VIA, CASE-RETURNED-VIA
+ surflets/send-html: SEND-HTML/SUSPEND...
+ surflets/surflet-sxml: URL-RULE,..., SURLFET-SXML-RULES, ...
+ surflets/sxml: SXML->STRING, DEFAULT-RULE,...
+ surflets/typed-optionals(*): TYPED-OPTIONALS, OPTIONALS
+ surflets/utilities(*): MAKE-CALLBACK, FORM-QUERY-LIST,
GENERATE-UNIQUE-NAME...
2003-03-10 11:29:32 -05:00
|
|
|
;; thunks.
|
|
|
|
(define (surflet-sxml->low-level-sxml sxml-tree)
|
|
|
|
(pre-post-order sxml-tree surflet-sxml-rules))
|
|
|
|
|
|
|
|
;;; adapted from Oleg's SXML-to-HTML.scm
|
|
|
|
;;; extended by additional port argument (see FORMATED-REPLY)
|
|
|
|
;(define (surflet-xml->html port html-tree)
|
|
|
|
; (let ((fragments (reformat html-tree)))
|
|
|
|
; (cond
|
|
|
|
; ((not port)
|
|
|
|
; (call-with-string-output-port
|
|
|
|
; (lambda (port)
|
|
|
|
; (formated-reply port fragments))))
|
|
|
|
; ((eq? port #t)
|
|
|
|
; (formated-reply (current-output-port) fragments))
|
|
|
|
; ((output-port? port)
|
|
|
|
; (formated-reply port fragments))
|
|
|
|
; (else
|
|
|
|
; (error "Invalid port argument to FORMATED-REPLY" port)))))
|
|
|
|
|
|
|
|
|