cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 61c7ed4988beaf4188f8df6555577f95780d0fb9
parent 0104080f47cd4ac780533e7d4c8d0be749960ccf
Author: Tomas Hlavaty <tom@logand.com>
Date:   Tue, 18 Feb 2014 22:04:29 +0100

rename counter to demo-counter

Diffstat:
Dcounter.lisp | 75---------------------------------------------------------------------------
Ademo-counter.lisp | 78++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 78 insertions(+), 75 deletions(-)

diff --git a/counter.lisp b/counter.lisp @@ -1,75 +0,0 @@ -(defpackage :rw.example.counter - (:use :cl)) - -(in-package :rw.example.counter) - -(defun counter-widget (i rvar) - (let ((n 0)) ;;rw.ui:slet ((n 0 rvar)) - (lambda () - `(:p ,i ": " - " " ,(rw.ui:link "up" (lambda () (incf n))) - " " ,(rw.ui:link "down" (lambda () (decf n))) - " " (:b ,n))))) - -(defun toplevel-widget () - (let ((w (mapcar 'counter-widget '(1 2 3 4) '(i j x y))) - (w2 (rw.ui:calendar-widget 2012 7))) - (lambda () - `(:html - (:head - ((:meta :http-equiv "content-type" - :content "text/html;charset=utf-8")) - ((:meta :http-equiv "cache-control" :content "no-cache,no-store")) - ((:meta :http-equiv "pragma" :content "no-cache")) - ((:meta :http-equiv "expires" :content -1)) - (:title "counter")) - (:body ,@(mapcar #'funcall w) ,(funcall w2)))))) - -(defun construct (sid aid renv) - (let ((prefix "/")) - (with-output-to-string (s) - (format s "~a?s=~a&a=~a" prefix sid aid) - (loop - for (k v) on renv by #'cddr - when v - do (format s "&~(~a~)=~a" k v))))) - -(defvar *query-parameters*) - -(defun query-parameter (key) - (cdr (assoc key *query-parameters* :test #'equal))) - -(defun deconstruct () - (values (query-parameter "s") - (query-parameter "a"))) - -(defun draw-counter () - (rw.ui:draw (lambda () - (let ((w (toplevel-widget))) - (lambda () - `(:http-1.0 - :code 200 - :headers (("Content-Type" . "text/html;charset=utf-8") - ("cache-control" . "no-cache,no-store") - ("pragma" . "no-cache") - ("expires" . "-1")) - :body ,(funcall w))))) - 'construct - 'deconstruct)) - -(defun counter-handler (msg stream method query protocol headers &optional body) - (declare (ignore protocol headers)) - (ecase msg - (:read (rw:till (rw:peek-reader stream))) - (:write - (let ((rw.ui:*http-server* - (let ((pp (rw.http::post-parameters method body))) - (lambda (msg &rest args) - (declare (ignore args)) - (ecase msg - (:method method) - (:post-parameters pp))))) - (*query-parameters* (nth-value 1 (rw.uri:parse-query-string query)))) - (draw-counter))))) - -(rw.http:server "0.0.0.0" 2349 'counter-handler :quit (lambda () nil)) diff --git a/demo-counter.lisp b/demo-counter.lisp @@ -0,0 +1,78 @@ +(defpackage :rw.demo.counter + (:use :cl)) + +(in-package :rw.demo.counter) + +(defun counter-widget (i rvar) + (let ((n 0)) ;;rw.ui:slet ((n 0 rvar)) + (lambda () + `(:p ,i ": " + " " ,(rw.ui:link "up" (lambda () (incf n))) + " " ,(rw.ui:link "down" (lambda () (decf n))) + " " (:b ,n))))) + +(defun toplevel-widget () + (let ((w (mapcar 'counter-widget '(1 2 3 4) '(i j x y))) + (w2 (rw.ui:calendar-widget 2012 7))) + (lambda () + `(:html + (:head + ((:meta :http-equiv "content-type" + :content "text/html;charset=utf-8")) + ((:meta :http-equiv "cache-control" :content "no-cache,no-store")) + ((:meta :http-equiv "pragma" :content "no-cache")) + ((:meta :http-equiv "expires" :content -1)) + (:title "counter")) + (:body ,@(mapcar #'funcall w) ,(funcall w2)))))) + +(defun construct (sid aid renv) + (let ((prefix "/")) + (with-output-to-string (s) + (format s "~a?s=~a&a=~a" prefix sid aid) + (loop + for (k v) on renv by #'cddr + when v + do (format s "&~(~a~)=~a" k v))))) + +(defvar *query-parameters*) + +(defun query-parameter (key) + (cdr (assoc key *query-parameters* :test #'equal))) + +(defun deconstruct () + (values (query-parameter "s") + (query-parameter "a"))) + +(defun draw-counter () + (rw.ui:draw (lambda () + (let ((w (toplevel-widget))) + (lambda () + `(:http-1.0 + :code 200 + :headers (("Content-Type" . "text/html;charset=utf-8") + ("cache-control" . "no-cache,no-store") + ("pragma" . "no-cache") + ("expires" . "-1")) + :body ,(funcall w))))) + 'construct + 'deconstruct)) + +(defun counter-handler (msg stream method query protocol headers &optional body) + (declare (ignore protocol headers)) + (ecase msg + (:read (rw:till (rw:peek-reader stream))) + (:write + (let ((rw.ui:*http-server* + (let ((pp (rw.http::post-parameters method body))) + (lambda (msg &rest args) + (declare (ignore args)) + (ecase msg + (:method method) + (:post-parameters pp))))) + (*query-parameters* (nth-value 1 (rw.uri:parse-query-string query)))) + (draw-counter))))) + +(defun start () + (rw.http:server "0.0.0.0" 2349 'counter-handler :quit (lambda () nil))) + +;;(start)