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

directory options

Browse source
This commit is contained in:
David Botton 2024-05-10 15:09:50 -04:00
parent d78aa1f586
commit 90b9b9e06e
3 changed files with 67 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -113,11 +113,25 @@
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
:width (width obj) :width (width obj)
:class *builder-window-desktop-class*)) :class *builder-window-desktop-class*
:auto-place :top))
(title (create-div menu :content disp)) (title (create-div menu :content disp))
(op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*)) (op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
(opd (create-div menu :content "Open in Dir Viewer" :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))
(set-on-click menu (lambda (i)
(declare (ignore i))
(destroy menu)))
(set-on-click opd (lambda (i)
(declare (ignore i))
(on-dir-win obj :dir item))
:cancel-event t)
(set-on-click ops (lambda (i)
(declare (ignore i))
(on-shell obj :dir item))
:cancel-event t)
(set-on-click opo (lambda (i) (set-on-click opo (lambda (i)
(declare (ignore i)) (declare (ignore i))
(open-file-with-os item)) (open-file-with-os item))
@ -140,7 +154,8 @@
(menu (create-panel obj (menu (create-panel obj
:left (left obj) :top (top obj) :left (left obj) :top (top obj)
:width (width obj) :width (width obj)
:class *builder-window-desktop-class*)) :class *builder-window-desktop-class*
:auto-place :top))
(title (create-div menu :content disp)) (title (create-div menu :content disp))
(op (create-div menu :content "Open" :class *builder-menu-context-item-class*)) (op (create-div menu :content "Open" :class *builder-menu-context-item-class*))
(oph (create-div menu :content "Open this tab" :class *builder-menu-context-item-class*)) (oph (create-div menu :content "Open this tab" :class *builder-menu-context-item-class*))
@ -151,8 +166,7 @@
(declare (ignore title op)) (declare (ignore title op))
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(project-tree-select obj (format nil "~A" item))) (destroy menu)))
:cancel-event t)
(set-on-click oph (lambda (i) (set-on-click oph (lambda (i)
(declare (ignore i)) (declare (ignore i))
(project-tree-select obj (format nil "~A" item) :method :here)) (project-tree-select obj (format nil "~A" item) :method :here))
@ -205,8 +219,49 @@
(create-clog-tree tree (create-clog-tree tree
:fill-function (lambda (obj) :fill-function (lambda (obj)
(project-tree-dir-select obj dir)) (project-tree-dir-select obj dir))
:node-html "🦎" :node-html "🦎" ; lizard
:content root) :content root
:on-context-menu
(lambda (obj)
(let* ((disp sel)
(item root)
(menu (create-panel obj
:left (left obj) :top (top obj)
:width (width obj)
:class *builder-window-desktop-class*
:auto-place :top))
(title (create-div menu :content disp))
(op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
(opd (create-div menu :content "Open in Dir Viewer" :class *builder-menu-context-item-class*))
(ops (create-div menu :content "Open Pseudo Shell" :class *builder-menu-context-item-class*))
(opa (create-div menu :content "Open in ASDF Browser" :class *builder-menu-context-item-class*))
(opr (create-div menu :content "Open REPL" :class *builder-menu-context-item-class*))
(opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*)))
(declare (ignore title op))
(set-on-click menu (lambda (i)
(declare (ignore i))
(destroy menu)))
(set-on-click opd (lambda (i)
(declare (ignore i))
(on-dir-win obj :dir item))
:cancel-event t)
(set-on-click ops (lambda (i)
(declare (ignore i))
(on-shell obj :dir item))
:cancel-event t)
(set-on-click opa (lambda (i)
(declare (ignore i))
(on-new-asdf-browser obj))
:cancel-event t)
(set-on-click opr (lambda (i)
(declare (ignore i))
(on-repl obj))
:cancel-event t)
(set-on-click opo (lambda (i)
(declare (ignore i))
(open-file-with-os item))
:cancel-event t)
(set-on-mouse-leave menu (lambda (obj) (destroy obj))))))
(let ((already (asdf:already-loaded-systems))) (let ((already (asdf:already-loaded-systems)))
(if (member sel already :test #'equalp) (if (member sel already :test #'equalp)
(setf (text-value load-btn) "loaded") (setf (text-value load-btn) "loaded")

4
tools/clog-builder-repl.lisp
View file

@ -11,7 +11,7 @@
nil)) nil))
win)) win))
(defun on-repl (obj) (defun on-repl (obj &key package)
"Open a REPL" "Open a REPL"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(*default-title-class* *builder-title-class*) (*default-title-class* *builder-title-class*)
@ -23,6 +23,8 @@
:width 700 :height 480 :width 700 :height 480
:client-movement *client-side-movement*)) :client-movement *client-side-movement*))
(repl (create-clog-builder-repl (window-content win)))) (repl (create-clog-builder-repl (window-content win))))
(when package
(setf (text-value (package-div repl)) package))
(when *clog-repl-private-console* (when *clog-repl-private-console*
(let ((pcon (on-open-repl-console obj win))) (let ((pcon (on-open-repl-console obj win)))
(setf (window-param win) pcon) (setf (window-param win) pcon)

4
tools/clog-builder-shell.lisp
View file

@ -1,6 +1,6 @@
(in-package :clog-tools) (in-package :clog-tools)
(defun on-shell (obj) (defun on-shell (obj &key dir)
"Open a shell" "Open a shell"
(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*)
@ -10,6 +10,8 @@
:top 40 :left 225 :top 40 :left 225
:width 600 :height 400 :width 600 :height 400
:client-movement *client-side-movement*))) :client-movement *client-side-movement*)))
(when dir
(uiop:chdir (uiop:native-namestring dir)))
(set-geometry (create-clog-builder-shell (window-content win)) (set-geometry (create-clog-builder-shell (window-content win))
:units "%" :width 100 :height 100))) :units "%" :width 100 :height 100)))