Cosmetic changes to code
This commit is contained in:
parent
6edd64bc5d
commit
49dbc4599e
3 changed files with 20 additions and 17 deletions
|
@ -31,39 +31,41 @@
|
|||
(import scheme chicken data-structures extras posix)
|
||||
(use awful spiffy intarweb)
|
||||
|
||||
(define (add-sse-resource! path proc vhost-root-path redirect-path)
|
||||
(add-resource! path
|
||||
(define (add-sse-resource! sse-path sse-proc vhost-root-path client-path)
|
||||
(add-resource! sse-path
|
||||
(or vhost-root-path (root-path))
|
||||
(lambda (#!optional given-path)
|
||||
(let ((accept (header-values 'accept
|
||||
(request-headers (current-request)))))
|
||||
;; If client 'EventSource' JS code requested SSE page...
|
||||
(if (memq 'text/event-stream accept)
|
||||
(lambda ()
|
||||
;; ...complete handshake and keep connection alive with 'sse-proc'.
|
||||
(lambda ()
|
||||
(with-headers '((content-type text/event-stream)
|
||||
(cache-control no-cache)
|
||||
(connection keep-alive))
|
||||
(lambda ()
|
||||
(write-logged-response)
|
||||
(proc))))
|
||||
(redirect-to redirect-path))))
|
||||
(sse-proc))))
|
||||
(redirect-to client-path))))
|
||||
'GET))
|
||||
|
||||
(define (define-page/sse path contents sse-path sse-proc #!rest rest)
|
||||
(apply define-page (append (list path contents) rest))
|
||||
(add-sse-resource! sse-path sse-proc (get-keyword vhost-root-path: rest) path))
|
||||
|
||||
(define (write-body data)
|
||||
(display data (response-port (current-response)))
|
||||
(finish-response-body (current-response)))
|
||||
|
||||
(define (send-sse-data data #!key event id)
|
||||
(let ((msg (conc (if id (conc "id: " id "\n") "")
|
||||
(if event (conc "event: " event "\n") "")
|
||||
"data: " data "\n\n")))
|
||||
(if event (conc "event: " event "\n") "")
|
||||
"data: " data "\n\n")))
|
||||
(write-body msg)))
|
||||
|
||||
(define (send-sse-retry retry)
|
||||
(write-body (conc "retry: " retry "\n\n")))
|
||||
|
||||
(define (define-page/sse path contents sse-path sse-proc #!rest rest)
|
||||
(apply define-page (append (list path contents) rest))
|
||||
(add-sse-resource! sse-path sse-proc (get-keyword vhost-root-path: rest) path))
|
||||
|
||||
) ; End of module
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;; Run with {{awful example1.scm}}.
|
||||
;; On web browser open [[http://localhost:8080/client]] and watch the
|
||||
;; Run with 'awful example1.scm'.
|
||||
;; On web browser open http://localhost:8080/client and watch the
|
||||
;; new time coming each second from the server.
|
||||
(use awful-sse awful spiffy posix srfi-18)
|
||||
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
;; Run with {{awful example2.scm}}.
|
||||
;; Open two web browsers and point both to [[http://localhost:8080/client]].
|
||||
;; Try clicking on the blue and the red div and see them changing their
|
||||
;; Run with 'awful example2.scm'.
|
||||
;; Open two web browsers and point both to http://localhost:8080/client.
|
||||
;; Try clicking on the blue and the red divs and see them changing their
|
||||
;; boolean values on BOTH browsers.
|
||||
(use awful-sse awful spiffy json posix srfi-18)
|
||||
|
||||
;; Global variables are not good practice, but will suffice for the moment.
|
||||
; Global variables are not good practice, but will suffice for the moment.
|
||||
(define one #t)
|
||||
(define two #f)
|
||||
|
||||
|
@ -39,6 +39,7 @@
|
|||
(ajax "one" 'one 'click
|
||||
(lambda ()
|
||||
(swap1!)))
|
||||
|
||||
(ajax "two" 'two 'click
|
||||
(lambda ()
|
||||
(swap2!)))
|
||||
|
|
Loading…
Reference in a new issue