thread viewer

This commit is contained in:
David Botton 2022-07-26 17:45:46 -04:00
parent 1aa4d396c9
commit 130192ad5c
4 changed files with 40 additions and 0 deletions

View file

@ -58,4 +58,5 @@
(:file "clog-builder-repl") (:file "clog-builder-repl")
(:file "image-to-data") (:file "image-to-data")
(:file "quick-start") (:file "quick-start")
(:file "threads")
(:file "clog-builder-images"))) (:file "clog-builder-images")))

View file

@ -2045,6 +2045,15 @@ of controls and double click to select control."
:client-movement t))) :client-movement t)))
(create-quick-start (window-content win)))) (create-quick-start (window-content win))))
(defun on-show-thread-viewer (obj)
"Open quick start"
(let* ((win (create-gui-window obj :title "Thread Viewer"
:top 40 :left 225
:width 600 :height 400
:client-movement t)))
(create-thread-list (window-content win))))
(defun on-open-file (obj) (defun on-open-file (obj)
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(win (create-gui-window obj :title "New Source Editor" (win (create-gui-window obj :title "New Source Editor"
@ -2194,6 +2203,7 @@ of controls and double click to select control."
(create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template) (create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template)
(create-gui-menu-item src :content "New Source Editor" :on-click 'on-open-file) (create-gui-menu-item src :content "New Source Editor" :on-click 'on-open-file)
(create-gui-menu-item tools :content "Control Events" :on-click 'on-show-control-events-win) (create-gui-menu-item tools :content "Control Events" :on-click 'on-show-control-events-win)
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer)
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl) (create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
(create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win) (create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win)
(create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data) (create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data)

10
tools/threads.clog Normal file
View file

@ -0,0 +1,10 @@
<data id="I3867860650" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="2" data-clog-title="thread-list"></data><table data-clog-type="w3-table" class="w3-table w3-striped w3-border w3-bordered w3-hoverable w3-small" data-clog-name="w3-table-1" style="box-sizing: content-box; position: static; inset: 0px 0px 0px 1px; width: 100%; height: 100%;" data-on-create="(loop
(let ((threads (swank:list-threads)))
(dolist (thread threads)
(let ((tr (create-table-row target)))
(create-table-column tr :content (second thread))
(create-table-column tr :content (third thread)))))
(sleep 1)
(setf (inner-html target) &quot;&quot;)
(unless (visiblep target)
(return)))"></table>

19
tools/threads.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package "CLOG-TOOLS")
(defclass thread-list (clog:clog-panel)
( (w3-table-1 :reader w3-table-1)
))
(defun create-thread-list (clog-obj &key (hidden nil) (class nil) (html-id nil) (auto-place t))
(let ((panel (change-class (clog:create-div clog-obj :content "<table class=\"w3-table w3-striped w3-border w3-bordered w3-hoverable w3-small\" style=\"box-sizing: content-box; position: static; inset: 0px 0px 0px 1px; width: 100%; height: 100%;\" id=\"CLOGB3867860624\" data-clog-name=\"w3-table-1\"></table>"
:hidden hidden :class class :html-id html-id :auto-place auto-place) 'thread-list)))
(setf (slot-value panel 'w3-table-1) (attach-as-child clog-obj "CLOGB3867860624" :clog-type 'CLOG:CLOG-TABLE :new-id t))
(let ((target (w3-table-1 panel))) (declare (ignorable target)) (loop
(let ((threads (swank:list-threads)))
(dolist (thread threads)
(let ((tr (create-table-row target)))
(create-table-column tr :content (second thread))
(create-table-column tr :content (third thread)))))
(sleep 1)
(setf (inner-html target) "")
(unless (visiblep target)
(return))))
panel))