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

custom inspectors

Browse source
This commit is contained in:
David Botton 2024-05-28 20:23:08 -04:00
parent 13077e6928
commit cc0555b35f
3 changed files with 43 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

10
source/clog-helpers.lisp
View file

@ -9,19 +9,21 @@
(cl:in-package :clog)
(defpackage #:clog-user
(:use #:cl #:clog #:clog-gui #:clog-web)
(:export :*body* :clog-repl))
(defpackage #:clog-tools
(:use #:cl #:clog #:clog-gui #:clog-web)
(:export :clog-builder
:clog-open
:add-supported-controls
:control-info
:add-inspector
:clog-builder-probe
:clog-db-admin))
(defpackage #:clog-user
(:use #:cl #:clog #:clog-gui #:clog-web)
(:import-from :clog-tools #:clog-builder-probe)
(:export :*body* :clog-repl))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - CLOG Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

9
tools/clog-builder-api.lisp
View file

@ -1,6 +1,6 @@
(in-package :clog-tools)
;; Control Record Utilities / Plugin API for controls
;; Control Record Utilities / Plugin APIs
(defun control-info (control-type-name)
"Return the control-record for CONTROL-TYPE-NAME from supported controls. (Exported)"
@ -33,6 +33,10 @@ replaced. (Exported)"
*supported-controls*)
(list r)))))
(defun add-inspector (name func)
"Add a custom inspector with NAME and (FUNC symbol title value clog-obj)"
(push (list :name name :func func) *inspectors*))
(defun reset-control-pallete (panel)
(let* ((app (connection-data-item panel "builder-app-data"))
(pallete (select-tool app)))
@ -41,5 +45,4 @@ replaced. (Exported)"
(dolist (control *supported-controls*)
(if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description)))))))
(add-select-option pallete (getf control :name) (getf control :description)))))))

34
tools/clog-builder-probe.lisp
View file

@ -1,5 +1,21 @@
(in-package :clog-tools)
(defparameter *inspectors*
`((:name "Print to Console"
:func ,(lambda (symbol title value clog-obj)
(declare (ignore symbol))
(on-open-console clog-obj)
(print title)
(print value)))
(:name "Console Inspector"
:func ,(lambda (symbol title value clog-obj)
(declare (ignore title value))
(on-open-console clog-obj)
(let ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)
(*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj)))
(inspect symbol))))))
(defun on-probe-panel (obj)
(let ((app (connection-data-item obj "builder-app-data")))
(let* ((*default-title-class* *builder-title-class*)
@ -71,9 +87,21 @@ used for title."
(set-on-click (create-button probe :content "Inspect")
(lambda (obj)
(declare (ignore obj))
(on-open-console body)
(let ((*standard-input* (make-instance 'console-in-stream :clog-obj body)))
(inspect ,symbol))))
(let* ((menu (create-panel probe
:left (left probe) :top (top probe)
:width (width probe)
:class *builder-window-desktop-class*
:auto-place :bottom)))
(set-on-mouse-leave menu (lambda (obj) (destroy obj)))
(mapcar (lambda (inspector)
(set-on-click (create-div menu :content (getf inspector :name) :class *builder-menu-context-item-class*)
(lambda (obj)
(declare (ignore obj))
(destroy menu)
(funcall (getf inspector :func)
,symbol title (format nil "~A" ,symbol)
body))))
*inspectors*))))
(set-on-click (create-button probe :content "Remove")
(lambda (obj)
(declare (ignore obj))