right click files

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

View file

@ -16,7 +16,7 @@
(pushnew :clog *features*)
(defvar *connection-cache* nil
"Dynamic variable containing optional cache. Every thread has its
"Dynamic variable containing optional cache. Every thread has its
own context and therefore its own copy of this variable when
dynamically bound. As a result no thread protection is needed to
access. To use dynamically bind the *connection-cache* and set it
@ -847,14 +847,13 @@ form action to be run. See CLOG-Form SUBMIT for more details."))
;; set-on-context-menu ;;
;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric set-on-context-menu (clog-obj on-context-menu-handler
&key one-time)
(defgeneric set-on-context-menu (clog-obj on-context-menu-handler &key one-time)
(:documentation "Set the ON-CONTEXT-MENU-HANDLER for CLOG-OBJ. If
ON-CONTEXT-MENU-HANDLER is nil unbind the event. Setting
on-mouse-right-click will replace this handler. If :ONE-TIME unbind
event on right click."))
(defmethod set-on-context-menu ((obj clog-obj) handler &key (one-time nil))
(defmethod set-on-context-menu ((obj clog-obj) handler &key one-time)
(set-event obj "contextmenu"
(when handler
(lambda (data)

View file

@ -15,7 +15,8 @@
(defclass clog-tree (clog-div)
((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"))
(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 "")
(indent-level 0)
(node-html "📁") ; folder icon
(on-context-menu nil)
(fill-function nil)
(visible t)
(class nil)
@ -43,6 +45,7 @@ and when not visible (such as clicked to close) the children are destroyed."
:auto-place auto-place))
(header (create-span new-obj :content content)))
(change-class new-obj 'clog-tree)
(setf (content new-obj) header)
(setf (indent-level new-obj) indent-level)
(setf (tree-root new-obj) (create-span header))
(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))
(toggle-tree)
(set-on-mouse-down new-obj
(lambda (obj data)
(declare (ignore obj data))
(when on-context-menu
(set-on-context-menu new-obj (lambda (obj)
(declare (ignore))
(funcall on-context-menu obj))))
(set-on-click new-obj (lambda (obj)
(declare (ignore obj))
(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))
(indent-level :accessor indent-level)
(content :accessor content))
(:documentation "CLOG-tree-item object - a tree list 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)
(node-html "📄") ; file icon
(on-click nil)
(on-context-menu nil)
(class nil)
(html-id nil)
(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))
(header (create-span new-obj :content content)))
(change-class new-obj 'clog-tree-item)
(setf (content new-obj) header)
(unless indent-level
(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))
(setf (indent-level new-obj) indent-level)
(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
(set-on-mouse-down new-obj (lambda (obj data)
(declare (ignore data))
(set-on-click new-obj (lambda (obj)
(declare (ignore))
(funcall on-click obj))
:cancel-event t))
new-obj))

View file

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

View file

@ -114,6 +114,27 @@
(unless (and (ppcre:scan *project-tree-file-filter* (string-downcase (file-namestring item)))
filter)
(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)
(project-tree-select obj (format nil "~A" item)))
:content (file-namestring item))))))

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-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-context-item-class* "w3-button w3-bar")
;; Window treatements
(defparameter *builder-title-class* "w3-blue-grey w3-round")

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-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-context-item-class* "w3-button w3-bar")
;; Window treatements
(setf *builder-title-class* "w3-blue-grey w3-round")