work in progress: sc-hx:render-content; provide macro for looping over property list
This commit is contained in:
parent
5ee58b2437
commit
a404e8ee88
6 changed files with 32 additions and 16 deletions
|
@ -5,9 +5,14 @@
|
||||||
(defpackage :scopes/frontend/cs-hx
|
(defpackage :scopes/frontend/cs-hx
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:dom :scopes/web/dom)
|
(:local-nicknames (:dom :scopes/web/dom)
|
||||||
|
(:message :scopes/core/message)
|
||||||
(:response :scopes/web/response))
|
(:response :scopes/web/response))
|
||||||
(:export #:render-content #:response))
|
(:export #:render-content #:response))
|
||||||
|
|
||||||
(in-package :scopes/frontend/cs-hx)
|
(in-package :scopes/frontend/cs-hx)
|
||||||
|
|
||||||
(defclass response (response:html-response) ())
|
(defclass response (response:html-response) ())
|
||||||
|
|
||||||
|
(defmethod render-content ((resp response) msg)
|
||||||
|
(dom:render (dom:dlist nil (message:data msg))))
|
||||||
|
|
||||||
|
|
|
@ -4,19 +4,22 @@
|
||||||
|
|
||||||
(config:root :env-keys '(:address :port))
|
(config:root :env-keys '(:address :port))
|
||||||
|
|
||||||
(config:add :logger :class 'logging:config
|
(config:add :logger
|
||||||
|
:class 'logging:config
|
||||||
:loglevel :debug
|
:loglevel :debug
|
||||||
:logfile (t:test-path "scopes-test.log" "log")
|
:logfile (t:test-path "scopes-test.log" "log")
|
||||||
:console nil)
|
:console nil)
|
||||||
|
|
||||||
(config:add :server :class 'server:config
|
(config:add :server
|
||||||
|
:class 'server:config
|
||||||
:port "8899"
|
:port "8899"
|
||||||
:routes
|
:routes
|
||||||
`((("api") server:message-handler)
|
`((("api") server:message-handler :html-responder cs-hx:response)
|
||||||
(() server:fileserver
|
(() server:fileserver
|
||||||
:doc-root ,(t:test-path "" "docs"))))
|
:doc-root ,(t:test-path "" "docs"))))
|
||||||
(config:add-action '(:test :data) #'core:echo)
|
(config:add-action '(:test :data) #'core:echo)
|
||||||
|
|
||||||
(config:add :client :class 'client:config
|
(config:add :client
|
||||||
|
:class 'client:config
|
||||||
:base-url "http://localhost:8899"
|
:base-url "http://localhost:8899"
|
||||||
:doc-path "/" :api-path "/api/")
|
:doc-path "/" :api-path "/api/")
|
||||||
|
|
|
@ -61,7 +61,8 @@
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(deftest test-util ()
|
(deftest test-util ()
|
||||||
(== (util:to-keyword "hello-kitty") :hello-kitty))
|
(== (util:to-keyword "hello-kitty") :hello-kitty)
|
||||||
|
(== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B")))
|
||||||
|
|
||||||
(deftest test-send ()
|
(deftest test-send ()
|
||||||
(let ((rcvr (receiver t:*test-suite*))
|
(let ((rcvr (receiver t:*test-suite*))
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
(:local-nicknames (:config :scopes/config)
|
(:local-nicknames (:config :scopes/config)
|
||||||
(:core :scopes/core)
|
(:core :scopes/core)
|
||||||
(:client :scopes/web/client)
|
(:client :scopes/web/client)
|
||||||
|
(:cs-hx :scopes/frontend/cs-hx)
|
||||||
(:dom :scopes/web/dom)
|
(:dom :scopes/web/dom)
|
||||||
(:logging :scopes/logging)
|
(:logging :scopes/logging)
|
||||||
(:message :scopes/core/message)
|
(:message :scopes/core/message)
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
(defpackage :scopes/util
|
(defpackage :scopes/util
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:flatten-str #:to-keyword #:to-string
|
(:export #:flatten-str #:to-keyword #:to-string
|
||||||
|
#:loop-plist
|
||||||
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
||||||
#:relative-path #:runtime-path #:system-path))
|
#:relative-path #:runtime-path #:system-path))
|
||||||
|
|
||||||
|
@ -22,6 +23,9 @@
|
||||||
(defun to-keyword (s)
|
(defun to-keyword (s)
|
||||||
(intern (string-upcase s) :keyword))
|
(intern (string-upcase s) :keyword))
|
||||||
|
|
||||||
|
(defmacro loop-plist (plist kvar vvar &body body)
|
||||||
|
`(loop for (,kvar ,vvar . _) on ,plist by #'cddr ,@body))
|
||||||
|
|
||||||
;;;; directory and pathname utilities
|
;;;; directory and pathname utilities
|
||||||
|
|
||||||
(defun split-filename (name)
|
(defun split-filename (name)
|
||||||
|
|
|
@ -50,7 +50,8 @@
|
||||||
|
|
||||||
(defun dlist (attrs plist)
|
(defun dlist (attrs plist)
|
||||||
(elem :dl attrs
|
(elem :dl attrs
|
||||||
(loop for (key val . r) on plist by #'cddr append
|
;(loop for (key val . r) on plist by #'cddr append
|
||||||
|
(util:loop-plist plist key val append
|
||||||
(cons (element :dt nil (string-downcase key)) (dds nil val)))))
|
(cons (element :dt nil (string-downcase key)) (dds nil val)))))
|
||||||
|
|
||||||
(defun dds (attrs cont)
|
(defun dds (attrs cont)
|
||||||
|
@ -88,7 +89,8 @@
|
||||||
(write-char c *output*))
|
(write-char c *output*))
|
||||||
|
|
||||||
(defun put-attrs (plist)
|
(defun put-attrs (plist)
|
||||||
(loop for (key val . r) on plist by #'cddr do
|
;(loop for (key val . r) on plist by #'cddr do
|
||||||
|
(util:loop-plist plist key val do
|
||||||
(put-char #\Space)
|
(put-char #\Space)
|
||||||
(when val
|
(when val
|
||||||
(put-string (string-downcase key))
|
(put-string (string-downcase key))
|
||||||
|
|
Loading…
Add table
Reference in a new issue