From 358b4b1309dbd1301913c9a86e926dc961a79d5c Mon Sep 17 00:00:00 2001 From: David Botton Date: Sat, 4 May 2024 23:41:34 -0400 Subject: [PATCH] clog-tree --- README.md | 2 + clog.asd | 1 + source/clog-tree.lisp | 108 +++++++++++++++++++++++++++ source/clog.lisp | 12 +++ tools/clog-builder-project-tree.lisp | 102 +++---------------------- tools/clog-builder-settings.lisp | 3 + tools/preferences.lisp.sample | 17 +++-- 7 files changed, 149 insertions(+), 96 deletions(-) create mode 100644 source/clog-tree.lisp diff --git a/README.md b/README.md index d886aca..8ebbc81 100644 --- a/README.md +++ b/README.md @@ -275,6 +275,8 @@ High Order Extensions to CLOG - clog-panels - Quick application layouts +- clog-tree - Collapsable tree control + - clog-presentations - bi-directional linking of Lisp Objects and CLOG Objects diff --git a/clog.asd b/clog.asd index b10e5b8..bd88734 100644 --- a/clog.asd +++ b/clog.asd @@ -49,6 +49,7 @@ (:file "clog-webgl") ;; CLOG Extensions (:file "clog-panel") + (:file "clog-tree") (:file "clog-presentations") (:file "clog-data") (:file "clog-dbi") diff --git a/source/clog-tree.lisp b/source/clog-tree.lisp new file mode 100644 index 0000000..9988029 --- /dev/null +++ b/source/clog-tree.lisp @@ -0,0 +1,108 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) David Botton ;;;; +;;;; ;;;; +;;;; clog-tree.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + +;; CLOG-TREEs are used to display a collapsable tree structure like directory + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-tree +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-tree (clog-div) + ((tree-root :accessor tree-root) + (indent-level :accessor indent-level)) + (:documentation "CLOG-Tree object - a collapsible tree component")) + +(defgeneric tree-root (clog-tree) + (:documentation "Accessor for clog-tree root, create clog-tree-items +on the tree-root or other clog-tree's.")) + +(defgeneric indent-level (clog-tree) + (:documentation "Accessor for clog-tree root, create clog-tree-items +on the tree-root or other clog-tree's.")) + +(defmethod create-clog-tree ((obj clog-obj) &key (content "") + (indent-level 0) + (node-html "📁") ; folder icon + (fill-function nil) + (visible t) + (class nil) + (html-id nil) + (auto-place t)) + "Creates a clog-tree node labeled CONTENT with INDENT-LEVEL using NODE-HTML +icon. When FILL-FUNCTION, when clog-tree is visible the FILL-FUNCTION is called +and when not visible (such as clicked to close) the children are destroyed." + (let* ((new-obj (create-div obj :content (format nil "~A " node-html) + :class class + :html-id html-id + :auto-place auto-place)) + (header (create-span new-obj :content content))) + (change-class new-obj 'clog-tree) + (setf (indent-level new-obj) indent-level) + (setf (tree-root new-obj) (create-span header)) + (dotimes (n indent-level) + (create-span new-obj :content "  " :auto-place :top)) + (flet ((toggle-tree () + (cond (fill-function + (if visible + (setf (text (tree-root new-obj)) "") + (funcall fill-function new-obj)) + (setf visible (not visible))) + (t + (if visible + (setf (hiddenp (tree-root new-obj)) t) + (setf (hiddenp (tree-root new-obj)) nil)) + (setf visible (not visible)))))) + (setf visible (not visible)) + (toggle-tree) + (set-on-mouse-down new-obj + (lambda (obj data) + (declare (ignore obj data)) + (toggle-tree)) + :cancel-event t)) ; prevent event bubble up tree + new-obj)) + +(defclass clog-tree-item (clog-div) + ((tree-item :accessor tree-item) + (indent-level :accessor indent-level)) + (:documentation "CLOG-tree-item object - a tree list item")) + +(defgeneric tree-item (clog-tree-item) + (:documentation "Accessor for clog-tree-item item.")) + +(defmethod create-clog-tree-item ((obj clog-obj) &key (content "") + (indent-level nil) + (node-html "📄") ; file icon + (on-click nil) + (class nil) + (html-id nil) + (auto-place t)) + "Creates a clog-tree-item node labeled CONTENT with INDENT-LEVEL using NODE-HTML +icon. If INDENT-LEVEL is nil get parent's INDENT-LEVEL from obj if is a clog-tree." + (let* ((new-obj (create-div obj :content (format nil "~A " node-html) + :class class + :html-id html-id + :auto-place auto-place)) + (header (create-span new-obj :content content))) + (change-class new-obj 'clog-tree-item) + (unless indent-level + (when (parent obj) + (when (parent obj) + (if (typep (parent (parent obj)) 'clog-tree) + (setf indent-level (1+ (indent-level (parent (parent obj))))) + (setf indent-level 0))))) + (dotimes (n indent-level) + (create-span new-obj :content "  " :auto-place :top)) + (setf (indent-level new-obj) indent-level) + (setf (tree-item new-obj) (create-span header)) + (when on-click + (set-on-mouse-down new-obj (lambda (obj data) + (declare (ignore data)) + (funcall on-click obj)) + :cancel-event t)) + new-obj)) diff --git a/source/clog.lisp b/source/clog.lisp index 91a4fc3..03c1d61 100644 --- a/source/clog.lisp +++ b/source/clog.lisp @@ -52,6 +52,7 @@ embedded in a native template application.)" (@clog-data section) (@clog-dbi section) (@clog-panels section) + (@clog-tree section) (@clog-style-block section) (@clog-form section) (@clog-canvas section) @@ -647,6 +648,17 @@ embedded in a native template application.)" (bottom-panel generic-function) (fit-layout generic-function)) +(defsection @clog-tree (:title "CLOG Tree") + "CLOG-Tree - CLOG Trees" + (clog-tree class) + (create-clog-tree generic-function) + (tree-root generic-function) + (indent-level generic-function) + + (clog-tree-item class) + (create-clog-tree-item generic-function) + (tree-item generic-function)) + (defsection @clog-style-block (:title "CLOG Style Blocks") "CLOG-Style-Block - CLOG Style Blocks" (clog-style-block class) diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp index b93bb71..5ea9ac7 100644 --- a/tools/clog-builder-project-tree.lisp +++ b/tools/clog-builder-project-tree.lisp @@ -1,84 +1,5 @@ (in-package :clog-tools) -(defclass clog-tree (clog-div) - ((tree-root :accessor tree-root) - (indent-level :accessor indent-level)) - (:documentation "CLOG-Tree object - a collapsible tree component")) - -(defgeneric tree-root (clog-tree) - (:documentation "Accessor for clog-tree root, create clog-tree-items -on the tree-root or other clog-tree's.")) - -(defmethod create-clog-tree ((obj clog-obj) &key (content "") - (indent-level 0) - (node-html "📁") - (fill-function nil) - (visible t) - (class nil) - (html-id nil) - (auto-place t)) - (let* ((new-obj (create-div obj :content (format nil "~A " node-html) - :class class - :html-id html-id - :auto-place auto-place)) - (header (create-span new-obj :content content))) - (change-class new-obj 'clog-tree) - (setf (indent-level new-obj) indent-level) - (setf (tree-root new-obj) (create-span header)) - (dotimes (n indent-level) - (create-span new-obj :content "  " :auto-place :top)) - (flet ((toggle-tree () - (cond (fill-function - (if visible - (setf (text (tree-root new-obj)) "") - (funcall fill-function new-obj)) - (setf visible (not visible))) - (t - (if visible - (setf (hiddenp (tree-root new-obj)) t) - (setf (hiddenp (tree-root new-obj)) nil)) - (setf visible (not visible)))))) - (setf visible (not visible)) - (toggle-tree) - (set-on-mouse-down new-obj - (lambda (obj data) - (declare (ignore obj data)) - (toggle-tree)) - :cancel-event t)) ; prevent event bubble up tree - new-obj)) - -(defclass clog-tree-item (clog-div) - ((tree-item :accessor tree-item) - (indent-level :accessor indent-level)) - (:documentation "CLOG-tree-item object - a tree list item")) - -(defgeneric tree-item (clog-tree-item) - (:documentation "Accessor for clog-tree-item item.")) - -(defmethod create-clog-tree-item ((obj clog-obj) &key (content "") - (indent-level 0) - (node-html "📄") - (on-click nil) - (class nil) - (html-id nil) - (auto-place t)) - (let* ((new-obj (create-div obj :content (format nil "~A " node-html) - :class class - :html-id html-id - :auto-place auto-place)) - (header (create-span new-obj :content content))) - (change-class new-obj 'clog-tree-item) - (dotimes (n indent-level) - (create-span new-obj :content "  " :auto-place :top)) - (setf (indent-level new-obj) indent-level) - (setf (tree-item new-obj) (create-span header)) - (when on-click - (set-on-mouse-down new-obj (lambda (obj data) - (declare (ignore data)) - (funcall on-click obj)) - :cancel-event t)) - new-obj)) - (defun project-tree-select (panel item) (unless (equal item "") (cond ((and (> (length item) 5) @@ -91,16 +12,17 @@ on the tree-root or other clog-tree's.")) (on-open-file-ext panel :open-file item) (progn (let ((win (on-open-file panel :open-file item))) - (when win - (set-geometry win - :top (menu-bar-height win) - :left 300 - :height "" :width "" - :bottom 5 :right 0) - (clog-ace:resize (window-param win)) - (set-on-window-move win (lambda (obj) - (setf (width obj) (width obj)) - (setf (height obj) (height obj)))))))))))) + (when *project-tree-sticky-open* + (when win + (set-geometry win + :top (menu-bar-height win) + :left 300 + :height "" :width "" + :bottom 5 :right 0) + (clog-ace:resize (window-param win)) + (set-on-window-move win (lambda (obj) + (setf (width obj) (width obj)) + (setf (height obj) (height obj))))))))))))) (defun project-tree-dir-select (panel dir) (dolist (item (uiop:subdirectories dir)) @@ -114,7 +36,7 @@ on the tree-root or other clog-tree's.")) (create-clog-tree-item (tree-root panel) :on-click (lambda (obj) (project-tree-select obj (format nil "~A" item))) - :indent-level (1+ (indent-level panel)) + ; :indent-level (1+ (indent-level panel)) :content (file-namestring item)))) (defun on-project-tree (obj &key project) diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 037f505..0a8bbad 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -48,6 +48,9 @@ (defparameter *editor-delay-on-eval-form* 30) (defparameter *editor-delay-on-eval-file* 60) +;; CLOG Panels +(defparameter *project-tree-sticky-open* t) + ;; CLOG Builder REPL (defparameter *clog-repl-use-console* t) (defparameter *clog-repl-open-console-on-start* nil) diff --git a/tools/preferences.lisp.sample b/tools/preferences.lisp.sample index 5a0dd61..c7899bb 100644 --- a/tools/preferences.lisp.sample +++ b/tools/preferences.lisp.sample @@ -5,7 +5,7 @@ ;; Preferences loaded on next call to clog-tools:clog-builder or [Eval All] -;; Builder Desktop +;; CLOG Builder Desktop ;; Open panels and files in new browser tabs by default (setf *open-external* nil) @@ -14,10 +14,14 @@ ;; CLOG Panels -;; Open panel editors in browser popus instead of tabs if browser allows +;; Open panel editors in browser popups instead of tabs if browser allows (setf *open-external-panels-in-popup* nil) -;; Open panels as popups by default -(setf *open-panels-as-popups* nil) + +;; CLOG Project Tree + +;; When opennning source editors not external, open to fill right of tree to +;; browser edge +(setf *project-tree-sticky-open* t) ;; CLOG Source Editor @@ -63,12 +67,13 @@ (setf *clog-repl-send-result-to-console* nil) (setf *clog-repl-private-console* t) -;; Panel Builder +;; CLOG Panel Builder (setf *builder-render-right-margin* 80) (setf *builder-render-case* :downcase) -;; Builder Look and Feel +;; CLOG Builder Look and Feel +;; General (setf *builder-window-desktop-class* "w3-blue-grey") (setf *builder-window-show-static-root-class* "w3-grey") (setf *builder-show-callers-class* "w3-orange")