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

all for file extensions

Browse source
This commit is contained in:
David Botton 2024-06-05 16:21:33 -04:00
parent 7bb252d80e
commit a92d3b1402
4 changed files with 49 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

1
source/clog-helpers.lisp
View file

@ -16,6 +16,7 @@
:add-supported-controls :add-supported-controls
:control-info :control-info
:add-inspector :add-inspector
:add-file-extension
:clog-builder-probe :clog-builder-probe
:clog-db-admin)) :clog-db-admin))

9
tools/clog-builder-api.lisp
View file

@ -40,6 +40,13 @@ replaced. (Exported)"
*inspectors*)) *inspectors*))
(push (list :name name :func func) *inspectors*)) (push (list :name name :func func) *inspectors*))
(defun add-file-extension (name func)
"Add a custom file extension with NAME and (FUNC file dir project clog-obj)"
(setf *file-extensions* (remove-if (lambda (x)
(equalp name (getf x :name)))
*file-extensions*))
(push (list :name name :func func) *file-extensions*))
(defun reset-control-pallete (panel) (defun reset-control-pallete (panel)
(let* ((app (connection-data-item panel "builder-app-data")) (let* ((app (connection-data-item panel "builder-app-data"))
(pallete (select-tool app))) (pallete (select-tool app)))
@ -48,4 +55,4 @@ replaced. (Exported)"
(dolist (control *supported-controls*) (dolist (control *supported-controls*)
(if (equal (getf control :name) "group") (if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description)) (add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description))))))) (add-select-option pallete (getf control :name) (getf control :description)))))))

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

@ -1,5 +1,8 @@
(in-package :clog-tools) (in-package :clog-tools)
(defparameter *file-extensions*
'())
(defun on-dir-tree (obj &key dir) (defun on-dir-tree (obj &key dir)
(let* ((*default-title-class* *builder-title-class*) (let* ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*) (*default-border-class* *builder-border-class*)
@ -48,6 +51,15 @@
(ren (create-div menu :content "Rename Director" :class *builder-menu-context-item-class*)) (ren (create-div menu :content "Rename Director" :class *builder-menu-context-item-class*))
(del (create-div menu :content "Delete Directory" :class *builder-menu-context-item-class*))) (del (create-div menu :content "Delete Directory" :class *builder-menu-context-item-class*)))
(declare (ignore title op)) (declare (ignore title op))
(mapcar (lambda (file-extension)
(set-on-click (create-div menu :content (getf file-extension :name) :class *builder-menu-context-item-class*)
(lambda (obj)
(destroy menu)
(funcall (getf file-extension :func)
nil item nil
obj))
:cancel-event t))
*file-extensions*)
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(destroy menu))) (destroy menu)))
@ -132,6 +144,15 @@
(ren (create-div menu :content "Rename" :class *builder-menu-context-item-class*)) (ren (create-div menu :content "Rename" :class *builder-menu-context-item-class*))
(del (create-div menu :content "Delete" :class *builder-menu-context-item-class*))) (del (create-div menu :content "Delete" :class *builder-menu-context-item-class*)))
(declare (ignore title op)) (declare (ignore title op))
(mapcar (lambda (file-extension)
(set-on-click (create-div menu :content (getf file-extension :name) :class *builder-menu-context-item-class*)
(lambda (obj)
(destroy menu)
(funcall (getf file-extension :func)
item nil nil
obj))
:cancel-event t))
*file-extensions*)
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(destroy menu))) (destroy menu)))
@ -229,4 +250,4 @@
:cancel-event t) :cancel-event t)
(set-on-mouse-leave menu (lambda (obj) (destroy obj))))))))) (set-on-mouse-leave menu (lambda (obj) (destroy obj)))))))))
(set-on-change root-dir #'on-change) (set-on-change root-dir #'on-change)
(on-change obj)))) (on-change obj))))

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

@ -128,6 +128,15 @@
(ops (create-div menu :content "Open in Pseudo Shell" :class *builder-menu-context-item-class*)) (ops (create-div menu :content "Open in Pseudo Shell" :class *builder-menu-context-item-class*))
(opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*))) (opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*)))
(declare (ignore title op)) (declare (ignore title op))
(mapcar (lambda (file-extension)
(set-on-click (create-div menu :content (getf file-extension :name) :class *builder-menu-context-item-class*)
(lambda (obj)
(destroy menu)
(funcall (getf file-extension :func)
nil item (current-project app)
obj))
:cancel-event t))
*file-extensions*)
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(destroy menu))) (destroy menu)))
@ -171,6 +180,15 @@
(opo (create-div menu :content "Open OS default" :class *builder-menu-context-item-class*)) (opo (create-div menu :content "Open OS default" :class *builder-menu-context-item-class*))
(del (create-div menu :content "Delete" :class *builder-menu-context-item-class*))) (del (create-div menu :content "Delete" :class *builder-menu-context-item-class*)))
(declare (ignore title op)) (declare (ignore title op))
(mapcar (lambda (file-extension)
(set-on-click (create-div menu :content (getf file-extension :name) :class *builder-menu-context-item-class*)
(lambda (obj)
(destroy menu)
(funcall (getf file-extension :func)
item nil (current-project app)
obj))
:cancel-event t))
*file-extensions*)
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(destroy menu))) (destroy menu)))