browser-gc no longer on ping by default, manual do after menus and trees

This commit is contained in:
David Botton 2024-06-10 21:40:06 -04:00
parent 9d7d58c3b8
commit dd1ed6580c
6 changed files with 23 additions and 10 deletions

View file

@ -97,11 +97,13 @@
connection)) connection))
(websocket-driver:close-connection connection)) ; don't send the reason for better security (websocket-driver:close-connection connection)) ; don't send the reason for better security
((equal (first ml) "0") ((equal (first ml) "0")
;; a ping - run browser gc ;; a ping
(when *browser-gc-on-ping*
;; run browser gc
(execute connection-id (execute connection-id
"Object.entries(clog).forEach(function(c,i,a) "Object.entries(clog).forEach(function(c,i,a)
{if ((c[1] !== null) && (typeof c[1] === 'object') && (c[1].nodeType===1)) {if ((c[1] !== null) && (typeof c[1] === 'object') && (c[1].nodeType===1))
{if (c[1].isConnected===false) {delete clog[c[0]]}}})") {if (c[1].isConnected===false) {delete clog[c[0]]}}})"))
(when *verbose-output* (when *verbose-output*
(format t "Connection ~A Ping~%" connection-id))) (format t "Connection ~A Ping~%" connection-id)))
((equal (first ml) "E") ((equal (first ml) "E")

View file

@ -35,6 +35,7 @@ script."
"CLOG system startup and shutdown" "CLOG system startup and shutdown"
(*verbose-output* variable) (*verbose-output* variable)
(*browser-gc-on-ping* variable)
(*break-on-error* variable) (*break-on-error* variable)
(*disable-clog-debugging* variable) (*disable-clog-debugging* variable)
@ -83,6 +84,7 @@ script."
#-(or sbcl ecl mezzano) (apply #'make-hash-table args)) #-(or sbcl ecl mezzano) (apply #'make-hash-table args))
(defvar *verbose-output* nil "Verbose server output (default false)") (defvar *verbose-output* nil "Verbose server output (default false)")
(defvar *browser-gc-on-ping* nil "Run a browser-gc on every ping")
(defvar *break-on-error* t "Allow invoking debugger (default true)") (defvar *break-on-error* t "Allow invoking debugger (default true)")
(defvar *disable-clog-debugging* nil "When true turns off debug hooks") (defvar *disable-clog-debugging* nil "When true turns off debug hooks")

View file

@ -114,7 +114,8 @@ possible tag and keywords."))
(:documentation "Create a new CLOG-ELEMENT or sub-type of CLOG-TYPE from HTML (:documentation "Create a new CLOG-ELEMENT or sub-type of CLOG-TYPE from HTML
as child of CLOG-OBJ and if :AUTO-PLACE (default t) place-inside-bottom-of as child of CLOG-OBJ and if :AUTO-PLACE (default t) place-inside-bottom-of
CLOG-OBJ, you can also set auto-place to :bottom or :top. If HTML-ID is nil one CLOG-OBJ, you can also set auto-place to :bottom or :top. If HTML-ID is nil one
will be generated.")) will be generated. If auto-place is nil, note that if browser-gc is called
or clog-connect:*browser-gc-on-ping* is t the browser side will be destroyed."))
(defmethod create-child ((obj clog-obj) html &key (html-id nil) (defmethod create-child ((obj clog-obj) html &key (html-id nil)
(auto-place t) (auto-place t)
@ -2277,9 +2278,11 @@ on browser."))
(defgeneric browser-gc (clog-element) (defgeneric browser-gc (clog-element)
(:documentation "Remove any clog cache items on browser not in DOM. (:documentation "Remove any clog cache items on browser not in DOM.
This gc is generally done during websocket pings. When clearing out If clog-connect:*browser-gc-on-ping* is set this is done during websocket pings.
large amounts of DOM objects not using CLOG would be the main reason Care should be taken as any clog-element not placed in the DOM will be deleted
to consider running this earlier.")) on the browser side (for examle :auto-place nil set and not later placed.)
The main use is when clearing out large amounts of DOM objects not using CLOG
destroy."))
(defmethod browser-gc ((obj clog-element)) (defmethod browser-gc ((obj clog-element))
(js-execute obj (js-execute obj

View file

@ -35,6 +35,7 @@
:visible nil :visible nil
:on-context-menu :on-context-menu
(lambda (obj) (lambda (obj)
(browser-gc obj)
(let* ((disp (text-value (content obj))) (let* ((disp (text-value (content obj)))
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
@ -129,6 +130,7 @@
(create-clog-tree-item (tree-root node) (create-clog-tree-item (tree-root node)
:on-context-menu :on-context-menu
(lambda (obj) (lambda (obj)
(browser-gc obj)
(let* ((disp (text-value (content obj))) (let* ((disp (text-value (content obj)))
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
@ -198,8 +200,8 @@
(project-tree-select obj (format nil "~A" item))) (project-tree-select obj (format nil "~A" item)))
:content (file-namestring item)))) :content (file-namestring item))))
(on-change (obj) (on-change (obj)
(declare (ignore obj))
(setf (text tree) "") (setf (text tree) "")
(browser-gc obj)
(let* ((root (text-value root-dir)) (let* ((root (text-value root-dir))
(tname (truename root)) (tname (truename root))
(dir (format nil "~A" (uiop:native-namestring (if tname (dir (format nil "~A" (uiop:native-namestring (if tname

View file

@ -68,7 +68,7 @@
(set-on-window-move win (lambda (obj) (set-on-window-move win (lambda (obj)
(setf (height obj) (height obj)))) (setf (height obj) (height obj))))
(set-on-window-close win (lambda (obj) (set-on-window-close win (lambda (obj)
(declare (ignore obj)) (browser-gc obj)
(setf (project-tree-win app) nil))) (setf (project-tree-win app) nil)))
(setf (positioning projects) :absolute) (setf (positioning projects) :absolute)
(set-geometry projects :height 27 :width "100%" :top 0 :left 0 :right 0) (set-geometry projects :height 27 :width "100%" :top 0 :left 0 :right 0)
@ -116,6 +116,7 @@
:visible nil :visible nil
:on-context-menu :on-context-menu
(lambda (obj) (lambda (obj)
(browser-gc obj)
(let* ((disp (text-value (content obj))) (let* ((disp (text-value (content obj)))
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
@ -166,6 +167,7 @@
(create-clog-tree-item (tree-root node) (create-clog-tree-item (tree-root node)
:on-context-menu :on-context-menu
(lambda (obj) (lambda (obj)
(browser-gc obj)
(let* ((disp (text-value (content obj))) (let* ((disp (text-value (content obj)))
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
@ -232,8 +234,8 @@
(setf (background-color load-btn) load-np) (setf (background-color load-btn) load-np)
(window-focus win)) (window-focus win))
(on-change (obj) (on-change (obj)
(declare (ignore obj))
(setf (text tree) "") (setf (text tree) "")
(browser-gc obj)
(let* ((sel (value projects))) (let* ((sel (value projects)))
(setf entry-point "") (setf entry-point "")
(cond ((equal sel "") (cond ((equal sel "")
@ -256,6 +258,7 @@
:content root :content root
:on-context-menu :on-context-menu
(lambda (obj) (lambda (obj)
(browser-gc obj)
(let* ((disp sel) (let* ((disp sel)
(item root) (item root)
(menu (create-panel obj (menu (create-panel obj

View file

@ -317,6 +317,7 @@ name. If CLOG-BODY not set use *clog-debug-instance*"
(closer-mop:class-direct-slots dclass)))) (closer-mop:class-direct-slots dclass))))
(on-change (object &key is-list) (on-change (object &key is-list)
(setf (text tree) "") (setf (text tree) "")
(browser-gc object)
(create-div tree :class "w3-tiny w3-center" (create-div tree :class "w3-tiny w3-center"
:content "left-click - drill down / right-click - system browse<br><br>") :content "left-click - drill down / right-click - system browse<br><br>")
(if is-list (if is-list