mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
clog-group for keeping groups of clog-objs
This commit is contained in:
parent
d2b0b4bf2f
commit
18b160fb2c
4 changed files with 61 additions and 18 deletions
|
|
@ -101,3 +101,12 @@ function. If BOOT-FILE is nil path is removed."
|
||||||
(defun debug-mode (obj)
|
(defun debug-mode (obj)
|
||||||
"Turn on browser console debugging for OBJ's connection."
|
"Turn on browser console debugging for OBJ's connection."
|
||||||
(cc:debug-mode (connection-id obj)))
|
(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))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,14 +3,44 @@
|
||||||
;;;; (c) 2020-2021 David Botton ;;;;
|
;;;; (c) 2020-2021 David Botton ;;;;
|
||||||
;;;; License BSD 3 Clause ;;;;
|
;;;; License BSD 3 Clause ;;;;
|
||||||
;;;; ;;;;
|
;;;; ;;;;
|
||||||
;;;; clog-system.lisp ;;;;
|
;;;; clog-utilities.lisp ;;;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(cl:in-package :clog)
|
(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"
|
"on"
|
||||||
"off"))
|
"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 ;;
|
;; escape-string ;;
|
||||||
;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
@ -71,6 +93,10 @@
|
||||||
(setf res (ppcre:regex-replace-all "\\x0D" res "\\x0D"))
|
(setf res (ppcre:regex-replace-all "\\x0D" res "\\x0D"))
|
||||||
res))
|
res))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Implementation - Color Utilities
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;;;;;;;;;
|
;;;;;;;;;
|
||||||
;; rgb ;;
|
;; rgb ;;
|
||||||
;;;;;;;;;
|
;;;;;;;;;
|
||||||
|
|
|
||||||
14
clog.lisp
14
clog.lisp
|
|
@ -52,16 +52,24 @@ embedded in a native template application.)"
|
||||||
(initialize function)
|
(initialize function)
|
||||||
(set-on-new-window function)
|
(set-on-new-window function)
|
||||||
(shutdown function)
|
(shutdown function)
|
||||||
(debug-mode function))
|
(debug-mode function)
|
||||||
|
(open-browser function))
|
||||||
|
|
||||||
(defsection @clog-utilities (:title "CLOG Utilities")
|
(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)
|
(js-true-p function)
|
||||||
(p-true-js function)
|
(p-true-js function)
|
||||||
(js-on-p function)
|
(js-on-p function)
|
||||||
(p-on-js function)
|
(p-on-js function)
|
||||||
(open-browser function)
|
|
||||||
(escape-string function)
|
(escape-string function)
|
||||||
|
|
||||||
|
"CLOG Color utilities"
|
||||||
(rgb function)
|
(rgb function)
|
||||||
(rgba function)
|
(rgba function)
|
||||||
(hsl function)
|
(hsl function)
|
||||||
|
|
|
||||||
|
|
@ -25,16 +25,16 @@
|
||||||
(name-entry (create-form-element start-form :input :label
|
(name-entry (create-form-element start-form :input :label
|
||||||
(create-label start-form :content "Chat Handle:")))
|
(create-label start-form :content "Chat Handle:")))
|
||||||
(ok-button (create-button start-form :content "OK"))
|
(ok-button (create-button start-form :content "OK"))
|
||||||
(tmp (create-p start-form))
|
(p (create-p start-form))
|
||||||
(chat-box (create-form form-box))
|
(chat-box (create-form form-box))
|
||||||
(tmp (create-br chat-box))
|
(br (create-br chat-box))
|
||||||
(messages (create-div 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-entry (create-form-element chat-box :input))
|
||||||
(out-ok (create-button chat-box :content "OK"))
|
(out-ok (create-button chat-box :content "OK"))
|
||||||
(tmp (create-p chat-box))
|
(p (create-p chat-box))
|
||||||
(user-name))
|
(user-name))
|
||||||
(declare (ignore caption)(ignore tmp))
|
(declare (ignore caption)(ignore br)(ignore p))
|
||||||
(setf (hiddenp chat-box) t)
|
(setf (hiddenp chat-box) t)
|
||||||
(setf (background-color backdrop) :blue)
|
(setf (background-color backdrop) :blue)
|
||||||
(setf (height backdrop) "100vh")
|
(setf (height backdrop) "100vh")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue