diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index a1965a9..c96f5f3 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -17,6 +17,7 @@ ;; Responses from SUrflets (define-interface surflet-handler/responses-interface (export make-surflet-response + valid-surflet-response-data? surflet-response? surflet-response-status surflet-response-content-type @@ -423,7 +424,6 @@ (surflet-handler/resume-url surflet-handler/resume-url-interface) (surflet-handler/admin surflet-handler/admin-interface) (surflet-handler/primitives surflet-handler/primitives-interface) - (surflet-handler/responses surflet-handler/responses-interface) (surflets/sessions surflets/sessions-interface) (surflets/continuations surflets/continuations-interface) (surflets/error surflets/error-interface) @@ -447,6 +447,7 @@ srfi-14 ;CHAR-SET:DIGIT srfi-27 ;random numbers surflet-requests ;requests for surflets + surflet-responses ;responses from surflets sxml-to-html ;SXML->HTML tables ;HASH-TABLES thread-cells ;THREAD-CELL et al. @@ -542,6 +543,14 @@ httpd-requests) (files surflet-request)) +(define-structures + ((surflet-handler/responses surflet-handler/responses-interface) + (surflet-responses surflet-handler/responses-interface)) + (open scheme-with-scsh + define-record-types) + (files surflet-response)) + + ;; With the help of TYPED-OPTIONALS you can define a function ;; like (make-submit-button [string] args) (define-structure typed-optionals typed-optionals-interface diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index f2f9f62..a7cbce2 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -725,37 +725,6 @@ (define set-options-make-session-timeout-text (make-fluid-setter set-surflet-options-make-session-timeout-text!)) -;;; SURFLET-RESPONSE: Surflets are expected to return this object type. -;;; STATUS is the status code, an exact integer. See httpd/response.scm -;;; e.g. (status-code ok) -;;; CONTENT-TYPE is a string, most probably "text/html". -;;; HEADERS is a (maybe empty) list of pairs of (string or symbol); -;;; Additional headers to send, e.g. '(("Cache-Control" . "no-cache")) or -;;; '((Cache-Control . "no-cache")) etc. -;;; DATA is either -;;; * a string -;;; * a list of strings -;;; This list maybe extended to vectors later. -(define-record-type surflet-response :surflet-response - (make-surflet-response status content-type headers data) - surflet-response? - (status surflet-response-status) - (content-type surflet-response-content-type) - (headers surflet-response-headers) - (data surflet-response-data)) - -;; Allowed type for the data field. -(define (valid-surflet-response-data? data) - (or (string? data) (list? data))) - -;; For debug purposes -(define (surflet-response->string surflet-response) - (format #f "#{SUrflet-response Status: ~a Content-Type: ~s Headers: ~s~%~s~%" - (surflet-response-status surflet-response) - (surflet-response-content-type surflet-response) - (surflet-response-headers surflet-response) - (surflet-response-data surflet-response))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; RANDOM SOURCE diff --git a/scheme/httpd/surflets/surflet-response.scm b/scheme/httpd/surflets/surflet-response.scm new file mode 100644 index 0000000..bb851b7 --- /dev/null +++ b/scheme/httpd/surflets/surflet-response.scm @@ -0,0 +1,31 @@ +;;; SURFLET-RESPONSE: Surflets are expected to return this object type. +;;; STATUS is the status code, an exact integer. See httpd/response.scm +;;; e.g. (status-code ok) +;;; CONTENT-TYPE is a string, most probably "text/html". +;;; HEADERS is a (maybe empty) list of pairs of (string or symbol); +;;; Additional headers to send, e.g. '(("Cache-Control" . "no-cache")) or +;;; '((Cache-Control . "no-cache")) etc. +;;; DATA is either +;;; * a string +;;; * a list of strings +;;; This list maybe extended to vectors later. +(define-record-type surflet-response :surflet-response + (make-surflet-response status content-type headers data) + surflet-response? + (status surflet-response-status) + (content-type surflet-response-content-type) + (headers surflet-response-headers) + (data surflet-response-data)) + +;; Allowed type for the data field. +(define (valid-surflet-response-data? data) + (or (string? data) (list? data))) + +;; For debug purposes +(define (surflet-response->string surflet-response) + (format #f "#{SUrflet-response Status: ~a Content-Type: ~s Headers: ~s~%~s~%" + (surflet-response-status surflet-response) + (surflet-response-content-type surflet-response) + (surflet-response-headers surflet-response) + (surflet-response-data surflet-response))) +