cl-rw

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

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:
Mdemo-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)))