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

clog-tree

Browse source
This commit is contained in:
David Botton 2024-05-04 23:41:34 -04:00
parent db767d1469
commit 358b4b1309
7 changed files with 149 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

2
README.md vendored
View file

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

1
clog.asd vendored
View file

@ -49,6 +49,7 @@
(:file "clog-webgl")
;; CLOG Extensions
(:file "clog-panel")
(:file "clog-tree")
(:file "clog-presentations")
(:file "clog-data")
(:file "clog-dbi")

108
source/clog-tree.lisp Normal file
View file

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

12
source/clog.lisp
View file

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

102
tools/clog-builder-project-tree.lisp
View file

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

3
tools/clog-builder-settings.lisp
View file

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

17
tools/preferences.lisp.sample vendored
View file

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