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

right click files

Browse source
This commit is contained in:
David Botton 2024-05-08 16:50:24 -04:00
parent 362d5038af
commit a13bf5098f
6 changed files with 374 additions and 338 deletions
Download patch file Download diff file Expand all files Collapse all files

651
source/clog-base.lisp
View file

File diff suppressed because it is too large Load diff

35
source/clog-tree.lisp
View file

@ -15,7 +15,8 @@
(defclass clog-tree (clog-div) (defclass clog-tree (clog-div)
((tree-root :accessor tree-root) ((tree-root :accessor tree-root)
(indent-level :accessor indent-level)) (indent-level :accessor indent-level)
(content :accessor content))
(:documentation "CLOG-Tree object - a collapsible tree component")) (:documentation "CLOG-Tree object - a collapsible tree component"))
(defgeneric tree-root (clog-tree) (defgeneric tree-root (clog-tree)
@ -29,6 +30,7 @@ on the tree-root or other clog-tree's."))
(defmethod create-clog-tree ((obj clog-obj) &key (content "") (defmethod create-clog-tree ((obj clog-obj) &key (content "")
(indent-level 0) (indent-level 0)
(node-html "📁") ; folder icon (node-html "📁") ; folder icon
(on-context-menu nil)
(fill-function nil) (fill-function nil)
(visible t) (visible t)
(class nil) (class nil)
@ -43,6 +45,7 @@ and when not visible (such as clicked to close) the children are destroyed."
:auto-place auto-place)) :auto-place auto-place))
(header (create-span new-obj :content content))) (header (create-span new-obj :content content)))
(change-class new-obj 'clog-tree) (change-class new-obj 'clog-tree)
(setf (content new-obj) header)
(setf (indent-level new-obj) indent-level) (setf (indent-level new-obj) indent-level)
(setf (tree-root new-obj) (create-span header)) (setf (tree-root new-obj) (create-span header))
(dotimes (n indent-level) (dotimes (n indent-level)
@ -60,16 +63,20 @@ and when not visible (such as clicked to close) the children are destroyed."
(setf visible (not visible)))))) (setf visible (not visible))))))
(setf visible (not visible)) (setf visible (not visible))
(toggle-tree) (toggle-tree)
(set-on-mouse-down new-obj (when on-context-menu
(lambda (obj data) (set-on-context-menu new-obj (lambda (obj)
(declare (ignore obj data)) (declare (ignore))
(toggle-tree)) (funcall on-context-menu obj))))
:cancel-event t)) ; prevent event bubble up tree (set-on-click new-obj (lambda (obj)
(declare (ignore obj))
(toggle-tree))
:cancel-event t)) ; prevent event bubble up tree
new-obj)) new-obj))
(defclass clog-tree-item (clog-div) (defclass clog-tree-item (clog-div)
((tree-item :accessor tree-item) ((tree-item :accessor tree-item)
(indent-level :accessor indent-level)) (indent-level :accessor indent-level)
(content :accessor content))
(:documentation "CLOG-tree-item object - a tree list item")) (:documentation "CLOG-tree-item object - a tree list item"))
(defgeneric tree-item (clog-tree-item) (defgeneric tree-item (clog-tree-item)
@ -79,6 +86,7 @@ and when not visible (such as clicked to close) the children are destroyed."
(indent-level nil) (indent-level nil)
(node-html "📄") ; file icon (node-html "📄") ; file icon
(on-click nil) (on-click nil)
(on-context-menu nil)
(class nil) (class nil)
(html-id nil) (html-id nil)
(auto-place t)) (auto-place t))
@ -90,6 +98,7 @@ icon. If INDENT-LEVEL is nil get parent's INDENT-LEVEL from obj if is a clog-tre
:auto-place auto-place)) :auto-place auto-place))
(header (create-span new-obj :content content))) (header (create-span new-obj :content content)))
(change-class new-obj 'clog-tree-item) (change-class new-obj 'clog-tree-item)
(setf (content new-obj) header)
(unless indent-level (unless indent-level
(when (parent obj) (when (parent obj)
(when (parent obj) (when (parent obj)
@ -100,9 +109,13 @@ icon. If INDENT-LEVEL is nil get parent's INDENT-LEVEL from obj if is a clog-tre
(create-span new-obj :content "  " :auto-place :top)) (create-span new-obj :content "  " :auto-place :top))
(setf (indent-level new-obj) indent-level) (setf (indent-level new-obj) indent-level)
(setf (tree-item new-obj) (create-span header)) (setf (tree-item new-obj) (create-span header))
(when on-context-menu
(set-on-context-menu new-obj (lambda (obj)
(declare (ignore))
(funcall on-context-menu obj))))
(when on-click (when on-click
(set-on-mouse-down new-obj (lambda (obj data) (set-on-click new-obj (lambda (obj)
(declare (ignore data)) (declare (ignore))
(funcall on-click obj)) (funcall on-click obj))
:cancel-event t)) :cancel-event t))
new-obj)) new-obj))

1
source/clog.lisp
View file

@ -654,6 +654,7 @@ embedded in a native template application.)"
(create-clog-tree generic-function) (create-clog-tree generic-function)
(tree-root generic-function) (tree-root generic-function)
(indent-level generic-function) (indent-level generic-function)
(content generic-function)
(clog-tree-item class) (clog-tree-item class)
(create-clog-tree-item generic-function) (create-clog-tree-item generic-function)

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

@ -114,6 +114,27 @@
(unless (and (ppcre:scan *project-tree-file-filter* (string-downcase (file-namestring item))) (unless (and (ppcre:scan *project-tree-file-filter* (string-downcase (file-namestring item)))
filter) filter)
(create-clog-tree-item (tree-root node) (create-clog-tree-item (tree-root node)
:on-context-menu
(lambda (obj)
(let* ((disp (text-value (content obj)))
(menu (create-panel obj
:left (left obj) :top (top obj)
:width (width obj)
:class *builder-window-desktop-class*))
(title (create-div menu :content disp))
(op (create-div menu :content "Open" :class *builder-menu-context-item-class*))
(del (create-div menu :content "Delete" :class *builder-menu-context-item-class*)))
(set-on-click menu (lambda (i)
(declare (ignore i))
(project-tree-select obj (format nil "~A" item)))
:cancel-event t)
(set-on-click del (lambda (i)
(confirm-dialog i (format nil "Delete ~A?" disp)
(lambda (result)
(when result
(destroy obj)))))
:cancel-event t)
(set-on-mouse-leave menu (lambda (obj) (destroy obj)))))
:on-click (lambda (obj) :on-click (lambda (obj)
(project-tree-select obj (format nil "~A" item))) (project-tree-select obj (format nil "~A" item)))
:content (file-namestring item)))))) :content (file-namestring item))))))
@ -175,4 +196,4 @@
(when (equalp n project) (when (equalp n project)
(on-change projects))) (on-change projects)))
(add-select-option projects "" "Select Project" :selected (not project)) (add-select-option projects "" "Select Project" :selected (not project))
(set-on-change projects #'on-change)))))) (set-on-change projects #'on-change))))))

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

@ -82,6 +82,7 @@
(defparameter *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4") (defparameter *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4")
(defparameter *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button") (defparameter *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button")
(defparameter *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button") (defparameter *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button")
(defparameter *builder-menu-context-item-class* "w3-button w3-bar")
;; Window treatements ;; Window treatements
(defparameter *builder-title-class* "w3-blue-grey w3-round") (defparameter *builder-title-class* "w3-blue-grey w3-round")

1
tools/preferences.lisp.sample vendored
View file

@ -93,6 +93,7 @@
(setf *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4") (setf *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4")
(setf *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button") (setf *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button")
(setf *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button") (setf *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button")
(setf *builder-menu-context-item-class* "w3-button w3-bar")
;; Window treatements ;; Window treatements
(setf *builder-title-class* "w3-blue-grey w3-round") (setf *builder-title-class* "w3-blue-grey w3-round")