;; Structures and interfaces for servlets.
;; NOTE: SSAX/lib/packages.scm must be loaded before you can use this
;; downloadable from http://sourceforge.net/project/showfiles.php?group_id=30687
;; (take the r5rs compliant version (ssax-sr5rs-plt200-4.9.tar.gz))
(define-interface rt-module-language-interface
(export ((lambda-interface
with-names-from-rt-structure)
:syntax)
reify-structure
load-structure
load-config-file
rt-structure-binding))
(define-interface rt-modules-interface
(export interface-value-names
reify-structure
load-config-file
rt-structure-binding
load-structure))
(define-structure rt-module-language rt-module-language-interface
(open scheme
rt-modules)
(for-syntax (open scheme
rt-modules))
(begin
(define-syntax lambda-interface
(lambda (expr rename compare)
(let ((%lambda (rename 'lambda))
(interface-name (cadr expr))
(body (cddr expr)))
`(,%lambda ,(interface-value-names interface-name) ,@body))))
;(with-names-from-rt-structure servlet servlet-interface (main))
(define-syntax with-names-from-rt-structure
(lambda (expr rename compare)
(let ((%lambda (rename 'lambda))
(%let (rename 'let))
(%rt-structure-value (rename 'rt-structure-value))
(%rt-structure-binding (rename 'rt-structure-binding))
(rt-structure (cadr expr))
(interface-name (caddr expr))
(body (cdddr expr)))
(let ((ivn (interface-value-names interface-name)))
`(,%let ((,%rt-structure-value ,rt-structure))
((,%lambda ,ivn ,@body)
,@(map (lambda (name)
`(,%rt-structure-binding ,%rt-structure-value ',name))
ivn)))))))))
(define-structure rt-modules rt-modules-interface
(open scheme
meta-types ; syntax-type
interfaces ; for-each-declaration
define-record-types
records
signals
bindings
packages
packages-internal
locations
environments
ensures-loaded
package-commands-internal)
(files rt-module))
(define-interface servlet-handler-interface
(export servlet-handler))
(define-interface servlet-handler/servlet-interface
(export send/suspend ;send and suspend
send/finish ;send and finish
send ;just send (no finish, no suspend)
set-servlet-data!
get-servlet-data
))
(define-interface servlet-handler/admin-interface
(export get-loaded-servlets
unload-servlet
set-options-instance-lifetime
options-instance-lifetime
set-options-cache-servlets?
options-cache-servlets?
options-servlet-path
options-servlet-prefix
get-instances
instance-servlet-name
instance-memo
instance-continuation-table
instance-continuation-table-lock
instance-continuation-counter
delete-instance!
instance-adjust-timeout!
get-continuations
delete-continuation!
session-instance-id))
(define-structures
((servlet-handler servlet-handler-interface)
(servlet-handler/servlet servlet-handler/servlet-interface)
(servlet-handler/admin servlet-handler/admin-interface))
(open httpd-responses
httpd-request
httpd-error
uri ;URI-PATH-LIST->PATH
tables ;HASH-TABLES
define-record-types ;DEFINE-RECORD-TYPE
rt-module-language ;get structures dynamically
; srfi-13 ;string
srfi-14 ;CHAR-SET:DIGIT
handle-fatal-error ;WITH-FATAL-ERROR-HANDLER* et al.
srfi-27 ;random numbers
locks ;MAKE-LOCK et al.
thread-cells ;THREAD-CELL et al.
profiling ;PROFILE-SPACE
httpd-logging ;HTTP-SYSLOG
shift-reset ;SHIFT and RESET
conditions ;exception
defrec-package ;DEFINE-RECORD
threads ;SLEEP
thread-fluids ;FORK-THREAD
sxml-to-html ;SXML->HTML
scsh ;regexp et al.
; httpd-file-directory-handlers ;send-file-response
handle
scheme
)
(files servlet-handler))
(define-interface servlets-interface
(export send/suspend
send/finish
send
send-html/suspend
send-html/finish
send-html
form-query
get-bindings
extract-bindings
extract-single-binding
make-outdater
(if-outdated :syntax)
show-outdated
generate-input-field-name
make-input-field
make-upper-input-field
make-text-input-field
make-hidden-input-field
make-password-input-field
make-number-input-field
make-textarea-input-field
make-select-input-field
make-checkbox-input-field
make-radio-input-fields
make-submit-button
make-reset-button
make-image-button
input-field-value
input-field-binding
make-address
returned-via?
make-callback
set-servlet-data!
get-servlet-data))
(define-structure servlets servlets-interface
(open servlet-handler/servlet
httpd-responses
httpd-request ; HTTP-URL:SEARCH
url ; REQUEST:URL
parse-html-forms
sxml-to-html ; SXML->HTML
srfi-1 ; FILTER
(subset rfc822 (get-header))
(subset srfi-13 (string-index))
sxml-tree-trans
url
httpd-request
define-record-types
scsh
scheme)
(files servlets))
(define-interface servlet-interface
(export main)) ; MAIN gets one parameter, the REQUEST
(define-interface shift-reset-interface
(export (reset :syntax)
(shift :syntax)))
(define-structure shift-reset shift-reset-interface
(open scheme
signals
escapes
thread-cells)
(files shift-reset))
(define-interface profiling-interface
(export profile-space
profile-result
profile-results
write-gnuplot-data-file
space-info-pair space-info-symbol
space-info-vector space-info-closure
space-info-location space-info-cell
space-info-channel space-info-port
space-info-ratnum space-info-record
space-info-continuation space-info-extended-number
space-info-template space-info-weak-pointer
space-info-shared-binding space-info-unused-d-header1
space-info-unused-d-header2 space-info-string
space-info-byte-vector space-info-double
space-info-bignum space-info-total
set-space-info-pair! set-space-info-symbol!
set-space-info-vector! set-space-info-closure!
set-space-info-location! set-space-info-cell!
set-space-info-channel! set-space-info-port!
set-space-info-ratnum! set-space-info-record!
set-space-info-continuation! set-space-info-extended-number!
set-space-info-template! set-space-info-weak-pointer!
set-space-info-shared-binding! set-space-info-unused-d-header1!
set-space-info-unused-d-header2! set-space-info-string!
set-space-info-byte-vector! set-space-info-double!
set-space-info-bignum! set-space-info-total!
pure-count pure-bytes
impure-count impure-bytes
total-count total-bytes
))
(define-structure profiling profiling-interface
(open let-opt
define-record-types
spatial
srfi-13
srfi-1
locks
scsh
scheme)
(files profile))