clog-group for keeping groups of clog-objs

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

View file

@ -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))

View file

@ -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 ;;
;;;;;;;;; ;;;;;;;;;

View file

@ -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)

View file

@ -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")