mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

clog-group for keeping groups of clog-objs

Browse source
This commit is contained in:
David Botton 2021-02-02 19:27:37 -05:00
parent d2b0b4bf2f
commit 18b160fb2c
4 changed files with 61 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

9
clog-system.lisp
View file

@ -101,3 +101,12 @@ function. If BOOT-FILE is nil path is removed."
(defun debug-mode (obj)
"Turn on browser console debugging for OBJ's connection."
(cc:debug-mode (connection-id obj)))
;;;;;;;;;;;;;;;;;;
;; open-browser ;;
;;;;;;;;;;;;;;;;;;
(defun open-browser (&key (url "http://127.0.0.1:8080"))
"Open a web browser to URL."
(trivial-open-browser:open-browser url))

46
clog-utilities.lisp
View file

@ -3,14 +3,44 @@
;;;; (c) 2020-2021 David Botton ;;;;
;;;; License BSD 3 Clause ;;;;
;;;; ;;;;
;;;; clog-system.lisp ;;;;
;;;; clog-utilities.lisp ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl:in-package :clog)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - CLOG Utilities
;; Implementation - clog-group
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-group ()
((controls
:accessor controls
:initform (make-hash-table :test 'equalp))))
(defun create-group ()
"Return a new CLOG-GROUP object for storing CLOG-OBJs. They are indexed by
their HTML-ID."
(make-instance 'clog-group))
(defgeneric add (clog-group clog-obj &key name)
(:documentation "Add CLOG-OBJ to a CLOG-GROUP indexed by the html-id of
CLOG-OBJ unless :NAME is set and is used instead."))
(defmethod add ((group clog-group) clog-obj &key (name nil))
(let ((id (if name
name
(html-id clog-obj))))
(setf (gethash id (controls group)) clog-obj)))
(defmethod obj (clog-group name)
(:documentation "Retrieve from CLOG-GROUP the CLOG-OBJ with name"))
(defmethod obj ((group clog-group) name)
(gethash name (controls group)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - JS Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;
@ -49,14 +79,6 @@
"on"
"off"))
;;;;;;;;;;;;;;;;;;
;; open-browser ;;
;;;;;;;;;;;;;;;;;;
(defun open-browser (&key (url "http://127.0.0.1:8080"))
"Open a web browser to URL."
(trivial-open-browser:open-browser url))
;;;;;;;;;;;;;;;;;;;
;; escape-string ;;
;;;;;;;;;;;;;;;;;;;
@ -71,6 +93,10 @@
(setf res (ppcre:regex-replace-all "\\x0D" res "\\x0D"))
res))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - Color Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;
;; rgb ;;
;;;;;;;;;

14
clog.lisp
View file

@ -52,16 +52,24 @@ embedded in a native template application.)"
(initialize function)
(set-on-new-window function)
(shutdown function)
(debug-mode function))
(debug-mode function)
(open-browser function))
(defsection @clog-utilities (:title "CLOG Utilities")
"CLOG utilities"
"CLOG-Group - Utility Class for CLOG-Obj storage"
(clog-group class)
(create-group function)
(add generic-function)
(obj generic-function)
"CLOG JS utilities"
(js-true-p function)
(p-true-js function)
(js-on-p function)
(p-on-js function)
(open-browser function)
(escape-string function)
"CLOG Color utilities"
(rgb function)
(rgba function)
(hsl function)

10
demos/02-demo.lisp
View file

@ -25,16 +25,16 @@
(name-entry (create-form-element start-form :input :label
(create-label start-form :content "Chat Handle:")))
(ok-button (create-button start-form :content "OK"))
(tmp (create-p start-form))
(p (create-p start-form))
(chat-box (create-form form-box))
(tmp (create-br chat-box))
(br (create-br chat-box))
(messages (create-div chat-box))
(tmp (create-br chat-box))
(br (create-br chat-box))
(out-entry (create-form-element chat-box :input))
(out-ok (create-button chat-box :content "OK"))
(tmp (create-p chat-box))
(p (create-p chat-box))
(user-name))
(declare (ignore caption)(ignore tmp))
(declare (ignore caption)(ignore br)(ignore p))
(setf (hiddenp chat-box) t)
(setf (background-color backdrop) :blue)
(setf (height backdrop) "100vh")