Add MY-SESSION-ID, MY-CONTINUATION-ID and MY-IDS to surflets, that return the respective IDs out from an request object. There are restrictions on their use.
This commit is contained in:
parent
e64b57f540
commit
b12070e349
|
@ -60,6 +60,7 @@
|
||||||
|
|
||||||
get-continuations
|
get-continuations
|
||||||
delete-continuation!
|
delete-continuation!
|
||||||
|
|
||||||
instance-session-id
|
instance-session-id
|
||||||
|
|
||||||
resume-url?
|
resume-url?
|
||||||
|
@ -115,7 +116,11 @@
|
||||||
|
|
||||||
(case-returned-via :syntax)
|
(case-returned-via :syntax)
|
||||||
|
|
||||||
make-callback)))
|
make-callback
|
||||||
|
|
||||||
|
my-session-id
|
||||||
|
my-continuation-id
|
||||||
|
my-ids)))
|
||||||
|
|
||||||
;; THE interface that SUrflets use.
|
;; THE interface that SUrflets use.
|
||||||
(define-interface surflet-interface
|
(define-interface surflet-interface
|
||||||
|
@ -257,6 +262,7 @@
|
||||||
(define-structure surflets surflets-interface
|
(define-structure surflets surflets-interface
|
||||||
(open surflet-handler/surflets
|
(open surflet-handler/surflets
|
||||||
surflet-handler/responses
|
surflet-handler/responses
|
||||||
|
surflet-handler/admin
|
||||||
httpd-responses ; STATUS-CODE
|
httpd-responses ; STATUS-CODE
|
||||||
surflet-requests ; HTTP-URL:SEARCH
|
surflet-requests ; HTTP-URL:SEARCH
|
||||||
url ; REQUEST:URL
|
url ; REQUEST:URL
|
||||||
|
|
|
@ -692,6 +692,25 @@
|
||||||
;; values or string values as well. So let us have both names.
|
;; values or string values as well. So let us have both names.
|
||||||
(define returned-via? returned-via)
|
(define returned-via? returned-via)
|
||||||
|
|
||||||
|
(define (surflet-file-name req)
|
||||||
|
(last (http-url-path (surflet-request-url req))))
|
||||||
|
|
||||||
|
;; This works for all requests except for the initial one. For the
|
||||||
|
;; initial one (main's arg) think about using instance-session-id.
|
||||||
|
(define (my-session-id req)
|
||||||
|
(resume-url-session-id (surflet-file-name req)))
|
||||||
|
|
||||||
|
;; This works for all requests except for the initial one: we don't
|
||||||
|
;; have a continuation at this time.
|
||||||
|
(define (my-continuation-id req)
|
||||||
|
(resume-url-continuation-id (surflet-file-name req)))
|
||||||
|
|
||||||
|
;; Returns two values: session-id and continuation-id. The
|
||||||
|
;; restrictions from my-session-id and my-continuation-id apply here
|
||||||
|
;; as well.
|
||||||
|
(define (my-ids req)
|
||||||
|
(resume-url-ids (surflet-file-name req)))
|
||||||
|
|
||||||
;; This is from Martin Gasbichler
|
;; This is from Martin Gasbichler
|
||||||
(define-syntax case-returned-via
|
(define-syntax case-returned-via
|
||||||
(syntax-rules (else =>)
|
(syntax-rules (else =>)
|
||||||
|
|
|
@ -151,8 +151,7 @@
|
||||||
(let* ((update-text (:optional maybe-update-text ""))
|
(let* ((update-text (:optional maybe-update-text ""))
|
||||||
(current-sessions (sort-list! (get-sessions) session-surflet-name<?)))
|
(current-sessions (sort-list! (get-sessions) session-surflet-name<?)))
|
||||||
(real-sessions current-sessions update-text
|
(real-sessions current-sessions update-text
|
||||||
(resume-url-session-id
|
(my-session-id req))))
|
||||||
(last (http-url-path (surflet-request-url req)))))))
|
|
||||||
|
|
||||||
(define (real-sessions current-sessions update-text this-session-id)
|
(define (real-sessions current-sessions update-text this-session-id)
|
||||||
(let ((outdated? (make-outdater))
|
(let ((outdated? (make-outdater))
|
||||||
|
@ -257,8 +256,7 @@
|
||||||
(let* ((session-pair (car sessions))
|
(let* ((session-pair (car sessions))
|
||||||
(session-id (car session-pair))
|
(session-id (car session-pair))
|
||||||
(session-entry (cdr session-pair))
|
(session-entry (cdr session-pair))
|
||||||
(this-continuation-id (resume-url-continuation-id
|
(this-continuation-id (my-continuation-id req))
|
||||||
(last (http-url-path (surflet-request-url req)))))
|
|
||||||
(update-text (:optional maybe-update-text "")))
|
(update-text (:optional maybe-update-text "")))
|
||||||
(let* ((current-continuations
|
(let* ((current-continuations
|
||||||
(sort-list! (get-continuations session-id)
|
(sort-list! (get-continuations session-id)
|
||||||
|
|
Loading…
Reference in New Issue