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