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:
D | counter.lisp | | | 75 | --------------------------------------------------------------------------- |
A | demo-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)