mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-15 15:00:24 -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

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)