commit 201c2392b46055655ebbbce3fc33d4dd14b34dd3
parent cba736387f928cc08ca00863fb68c81c423fc817
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 15 Jan 2017 12:12:42 +0100
better url encoding and minor refactoring
Diffstat:
| M | demo-counter3.lisp | | | 83 | +++++++++++++++++++++++++++++++++++++------------------------------------------ |
1 file changed, 39 insertions(+), 44 deletions(-)
diff --git a/demo-counter3.lisp b/demo-counter3.lisp
@@ -33,7 +33,6 @@
(defvar *action-index*)
(defvar *var-index*)
(defvar *slet-getters*)
-(defvar *mode*)
(defun encode-url (state action)
(with-output-to-string (s)
@@ -52,21 +51,23 @@
(when path
(princ (car path) s)
(dolist (x (cdr path))
- (write-char #\: s)
+ (write-char #\! s)
(princ x s)))
- (write-char #\; s)
+ (write-char #\! s)
(princ i s)))
(defun var-reader (r)
(lambda ()
(when (rw:peek r)
(assert (eql #\! (rw:next r)))
- (cons (let ((x (rw:till r '(#\$))))
+ (cons (let ((x (rw:till r '(#\.))))
(when x
(coerce x 'string)))
(progn
- (assert (eql #\$ (rw:next r)))
- (assert (member (rw:peek r) '(nil #\! #\+ #\-)))
+ (assert (eql #\. (rw:next r)))
+ (assert (member
+ (rw:peek r)
+ '(nil #\! #\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
(let ((x (rw:till r '(#\!))))
(when x
(parse-integer (coerce x 'string)))))))))
@@ -74,7 +75,18 @@
(defun decode-state (state)
(rw:till (rw:peek-reader (var-reader (rw:peek-reader (rw:reader state))))))
-;;(decode-state "!1;1$!1;2$+3!2;1$-1")
+;;(decode-state "!1!1.!1!2.3!2!1.-1")
+
+(defun encode-state ()
+ (with-output-to-string (s)
+ (dolist (x *slet-getters*)
+ (multiple-value-bind (k v) (funcall x)
+ (write-char #\! s)
+ (write-string k s)
+ (write-char #\. s)
+ (etypecase v
+ (null)
+ (integer (princ v s)))))))
(defun lookup-var (path)
(cdr (assoc path *slet-state-decoded* :test #'equal)))
@@ -82,7 +94,8 @@
(defun widget-var (default get set)
(let ((path (encode-path *widget-path* (incf *var-index*))))
(funcall set (or (lookup-var path) default))
- (when (eq :step *mode*)
+ (when *sflet-action*
+ ;; TODO when == default => dont put into state
(push (lambda () (values path (funcall get))) *slet-getters*))))
(defun widget (thunk)
@@ -96,19 +109,16 @@
(defun widget-action (thunk)
(let ((path (encode-path *widget-path* (incf *action-index*))))
(lambda ()
- (ecase *mode*
- (:draw
- (encode-url *slet-state* path))
- (:step
- (when (equal *sflet-action* path)
- (funcall thunk))
- nil)))))
-
+ (if *sflet-action*
+ (when (equal *sflet-action* path)
+ (funcall thunk)
+ nil)
+ (encode-url *slet-state* path)))))
(defun counter-widget (i)
(let ((n 0))
- (flet ((up () (incf n) (print (list :@@@ :up i n)))
- (down () (decf n) (print (list :@@@ :down i n))))
+ (flet ((up () (incf n))
+ (down () (decf n)))
(widget
(lambda ()
(widget-var 0 (lambda () n) (lambda (x) (setq n x)))
@@ -199,35 +209,20 @@
*widget-path*
(*widget-child* 0)
*slet-getters*
- (*mode* (if *sflet-action* :step :draw))
(rw.ui::*click-link* (lambda (click) (funcall click)))
#+nil(rw.ui::*click-form* (lambda (set) "TODO")))
(let ((w (toplevel-widget)))
- (ecase *mode*
- (:step
- (funcall w)
- (rw.ui::http-redirect
- (encode-url (with-output-to-string (s)
- (dolist (x *slet-getters*)
- (multiple-value-bind (k v) (funcall x)
- (write-char #\! s)
- (write-string k s)
- (write-char #\$ s)
- (etypecase v
- (null)
- (integer
- (unless (minusp v)
- (write-char #\+ s))
- (princ v s))))))
- nil)))
- (:draw
- `(: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))))))
+ (if *sflet-action*
+ (progn
+ (funcall w)
+ (rw.ui::http-redirect (encode-url (encode-state) nil)))
+ `(: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)))))
#+nil
(rw.ui:draw (lambda ()
(let ((w (toplevel-widget)))
