diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp index ab6efc1..a791121 100644 --- a/tools/clog-builder-control-list.lisp +++ b/tools/clog-builder-control-list.lisp @@ -46,7 +46,10 @@ (unless (controls-win app) (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) - (win (create-gui-window obj :title "Controls" :has-pinner t :width 220)) + (win (create-gui-window obj :title "Controls" + :has-pinner t + :keep-on-top t + :width 220)) (content (window-content win)) (sheight (floor (/ (height content) 2))) (swidth (floor (width content))) diff --git a/tools/clog-builder-control-properties.lisp b/tools/clog-builder-control-properties.lisp index 1fa5c66..d3897bd 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -6,7 +6,10 @@ (unless (control-properties-win app) (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) - (win (create-gui-window obj :title "Properties" :has-pinner t :width 400)) + (win (create-gui-window obj :title "Properties" + :has-pinner t + :keep-on-top t + :width 400)) (content (window-content win)) (control-list (create-table content))) (add-class content *builder-pallete-class*) diff --git a/tools/clog-builder-dir-win.lisp b/tools/clog-builder-dir-win.lisp index 273673d..85d603c 100644 --- a/tools/clog-builder-dir-win.lisp +++ b/tools/clog-builder-dir-win.lisp @@ -8,6 +8,7 @@ :top top :left left :width 600 :height 400 :has-pinner t + :keep-on-top t :client-movement *client-side-movement*)) (d (create-dir-view (window-content win)))) (set-geometry d :top 0 :left 0 :right 0 :bottom 0 :width "" :height "") diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 47c3ff1..dd81e77 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -94,6 +94,8 @@ (win (create-gui-window obj :title title :title-class title-class :width 700 :height 480 + :has-pinner is-console + :keep-on-top is-console :client-movement *client-side-movement*)) (box (create-panel-box-layout (window-content win) :left-width 0 :right-width 0 @@ -104,9 +106,11 @@ (m-save (create-gui-menu-item m-file :content "save (cmd/ctrl-s)")) (m-saveas (create-gui-menu-item m-file :content "save as..")) (m-revert (create-gui-menu-item m-file :content "revert")) - (m-emacs (unless (in-clog-popup-p obj) + (m-emacs (unless (or (in-clog-popup-p obj) + is-console) (create-gui-menu-item m-file :content "open in emacs"))) - (m-ntab (unless (in-clog-popup-p obj) + (m-ntab (unless (or (in-clog-popup-p obj) + is-console) (create-gui-menu-item m-file :content "open in new tab"))) (m-edit (create-gui-menu-drop-down menu :content "Edit")) (m-undo (create-gui-menu-item m-edit :content "undo (cmd/ctrl-z)")) diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp index 5ea9ac7..b2bcb9f 100644 --- a/tools/clog-builder-project-tree.lisp +++ b/tools/clog-builder-project-tree.lisp @@ -24,21 +24,6 @@ (setf (width obj) (width obj)) (setf (height obj) (height obj))))))))))))) -(defun project-tree-dir-select (panel dir) - (dolist (item (uiop:subdirectories dir)) - (create-clog-tree (tree-root panel) - :fill-function (lambda (obj) - (project-tree-dir-select obj (format nil "~A" item))) - :indent-level (1+ (indent-level panel)) - :visible nil - :content (first (last (pathname-directory item))))) - (dolist (item (uiop:directory-files (directory-namestring dir))) - (create-clog-tree-item (tree-root panel) - :on-click (lambda (obj) - (project-tree-select obj (format nil "~A" item))) - ; :indent-level (1+ (indent-level panel)) - :content (file-namestring item)))) - (defun on-project-tree (obj &key project) (let ((app (connection-data-item obj "builder-app-data"))) (when (uiop:directory-exists-p #P"~/common-lisp/") @@ -51,61 +36,124 @@ (window-focus (project-tree-win app)) (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) - (win (create-gui-window obj :title "Project Tree" - :width 300 - :has-pinner t - :client-movement *client-side-movement*)) - (projects (create-select (window-content win))) - (dir-loc (create-panel (window-content win) :background-color :silver - :height 27 :top 30 :left 0 :right 0)) - (tree (create-panel (window-content win) :overflow :scroll - :top 60 :bottom 0 :left 0 :right 0))) + (win (create-gui-window obj :title "Project Tree" + :width 300 + :has-pinner t + :keep-on-top t + :client-movement *client-side-movement*)) + (projects (create-select (window-content win))) + (panel (create-panel (window-content win) :background-color :silver + :style "text-align:center;" + :class "w3-tiny" + :height 27 :top 30 :left 0 :right 0)) + (load-btn (create-button panel :content "no project" :style "height:27px;width:72px")) + (run-btn (create-button panel :content "run" :style "height:27px;width:72px")) + (entry-point "") + (filter-btn (create-button panel :content "filter" :style "height:27px;width:72px")) + (asd-btn (create-button panel :content "asd edit" :style "height:27px;width:72px")) + (tree (create-panel (window-content win) + :class "w3-small" + :overflow :scroll + :top 60 :bottom 0 :left 0 :right 0))) (setf (project-tree-win app) win) (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "") + (set-on-click asd-btn (lambda (obj) + (on-show-project obj))) (set-on-window-move win (lambda (obj) (setf (height obj) (height obj)))) (set-on-window-close win (lambda (obj) (declare (ignore obj)) (setf (project-tree-win app) nil))) (setf (positioning projects) :absolute) - (set-geometry projects :height 27 :width "" :top 0 :left 0 :right 0) - (add-class dir-loc "w3-tiny") - (add-class tree "w3-small") - (flet ((on-change (obj) - (declare (ignore obj)) - (let* ((sel (value projects)) - (root (quicklisp:where-is-system sel)) - (dir (directory-namestring (uiop:truename* root)))) - (cond (root - (setf (text dir-loc) "Not Loaded") - (setf (text tree) "") - (create-clog-tree tree - :fill-function (lambda (obj) - (project-tree-dir-select obj dir)) - :node-html "🦎" - :content root) - (let ((already (asdf:already-loaded-systems))) - (if (member sel already :test #'equalp) - (setf (text dir-loc) "Loaded") - (flet ((load-proj (answer) - (cond (answer - (setf (current-project app) sel) - (handler-case - (projects-load (format nil "~A/tools" sel)) - (error () - (projects-load sel))) - (setf (text dir-loc) "Loaded") - (window-focus win)) - (t - (setf (current-project app) nil))))) - (let* ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*)) - (confirm-dialog win "Load project?" - (lambda (answer) - (load-proj answer)) - :title "System not loaded")))))) - (t - (setf (text dir-loc) "")))))) + (set-geometry projects :height 27 :width "100%" :top 0 :left 0 :right 0) + (set-on-click filter-btn (lambda (obj) + (declare (ignore obj)) + (if (equalp (text-value filter-btn) + "filter") + (setf (text-value filter-btn) "filter off") + (setf (text-value filter-btn) "filter")))) + (set-on-click run-btn + (lambda (obj) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (input-dialog obj "Run form:" + (lambda (result) + (when result + (setf clog:*clog-debug* + (lambda (event data) + (with-clog-debugger (panel :standard-output (stdout app)) + (funcall event data)))) + (capture-eval result + :clog-obj obj + :capture-console nil + :capture-result nil + :eval-in-package "clog-user"))) + :default-value entry-point)))) + (labels ((project-tree-dir-select (node dir) + (let ((filter (equalp (text-value filter-btn) + "filter"))) + (dolist (item (uiop:subdirectories dir)) + (unless (and (ppcre:scan *project-tree-dir-filter* (format nil "~A" item)) + filter) + (create-clog-tree (tree-root node) + :fill-function (lambda (obj) + (project-tree-dir-select obj (format nil "~A" item))) + :indent-level (1+ (indent-level node)) + :visible nil + :content (first (last (pathname-directory item)))))) + (dolist (item (uiop:directory-files (directory-namestring dir))) + (unless (and (ppcre:scan *project-tree-file-filter* (file-namestring item)) + filter) + (create-clog-tree-item (tree-root node) + :on-click (lambda (obj) + (project-tree-select obj (format nil "~A" item))) + :content (file-namestring item)))))) + (load-proj (sel) + (handler-case + (projects-load (format nil "~A/tools" sel)) + (error () + (projects-load sel))) + (setf (text-value load-btn) "loaded") + (window-focus win)) + (on-change (obj) + (declare (ignore obj)) + (let* ((sel (value projects)) + (root (quicklisp:where-is-system sel)) + (dir (directory-namestring (uiop:truename* root)))) + (cond (root + (setf (current-project app) sel) + (setf (text-value load-btn) "not loaded") + (setf (text tree) "") + (create-clog-tree tree + :fill-function (lambda (obj) + (project-tree-dir-select obj dir)) + :node-html "🦎" + :content root) + (let ((already (asdf:already-loaded-systems))) + (if (member sel already :test #'equalp) + (setf (text-value load-btn) "loaded") + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (setf (text-value load-btn) "loading") + (confirm-dialog win "Load project?" + (lambda (answer) + (if answer + (load-proj sel) + (setf (text-value load-btn) "not loaded"))) + :title "System not loaded")))) + (setf entry-point (format nil "(~A)" + (or (asdf/system:component-entry-point (asdf:find-system sel)) + "")))) + (t + (setf entry-point "") + (setf (text-value load-btn) "no project")))))) + (set-on-click load-btn (lambda (obj) + (declare (ignore obj)) + (cond ((equalp (text-value load-btn) "loaded") + (asdf:clear-system (value projects)) + (setf (text-value load-btn) "not loaded")) + ((equalp (text-value load-btn) "not loaded") + (load-proj (value projects)))))) (dolist (n (quicklisp:list-local-systems)) (add-select-option projects n n :selected (equalp n project)) (when (equalp n project) diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp index 576a2c1..bb73467 100644 --- a/tools/clog-builder-projects.lisp +++ b/tools/clog-builder-projects.lisp @@ -11,7 +11,9 @@ (win (create-gui-window obj :title "ASD Project Window" :top 60 :left 325 :width 643 :height 625 - :has-pinner t :client-movement *client-side-movement*))) + :has-pinner t + :keep-on-top t + :client-movement *client-side-movement*))) (create-projects (window-content win)) (setf (project-win app) win) (set-on-window-close win (lambda (obj) diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 0a8bbad..5b64b11 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -50,6 +50,8 @@ ;; CLOG Panels (defparameter *project-tree-sticky-open* t) +(defparameter *project-tree-dir-filter* "(\\\\|\\/)\\..*(\\\\|\\/)$") +(defparameter *project-tree-file-filter* "(^\\..*)|(.*~$)|(.*\\.bak$)") ;; CLOG Builder REPL (defparameter *clog-repl-use-console* t) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 16cebec..953028f 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -337,7 +337,7 @@ clog-builder window.") (with-clog-debugger (body :standard-output (stdout app)) (when *builder-window-show-static-root-class* (setf (z-index (create-panel body :positioning :fixed - :bottom 0 :left 0 + :bottom 0 :right 0 :class *builder-window-show-static-root-class* :content (format nil "static-root: ~A" clog:*static-root*))) -9999)) @@ -392,7 +392,7 @@ clog-builder window.") (create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer) (create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl) (create-gui-menu-item tools :content "CLOG Builder Console" :on-click 'on-open-console) - (create-gui-menu-item tools :content "OS Shell" :on-click 'on-shell) + (create-gui-menu-item tools :content "OS Pseudo Shell" :on-click 'on-shell) (create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win) (unless *clogframe-mode* (create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data)) @@ -496,7 +496,6 @@ clog-builder window.") (t (when *start-project* (projects-load *start-project*)) - (on-show-project body :project *start-project*) (on-project-tree body :project *start-project*) (when *start-dir* (when *start-project* diff --git a/tools/preferences.lisp.sample b/tools/preferences.lisp.sample index c7899bb..b7fe933 100644 --- a/tools/preferences.lisp.sample +++ b/tools/preferences.lisp.sample @@ -22,6 +22,9 @@ ;; When opennning source editors not external, open to fill right of tree to ;; browser edge (setf *project-tree-sticky-open* t) +;; Regex filters to use when set to remove from project directories +(setf *project-tree-dir-filter* "(\\\\|\\/)\\..*(\\\\|\\/)$") +(setf *project-tree-file-filter* "(^\\..*)|(.*~$)|(.*\\.bak$)") ;; CLOG Source Editor