From eda76103cb2f514ba73202a3501e7a80e484596e Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 7 Jul 2024 21:18:50 -0400 Subject: [PATCH] no-quickslip option --- tools/clog-builder-project-tree.lisp | 20 +++++++++++--------- tools/clog-builder-projects.lisp | 27 ++++++++++++++++----------- tools/clog-builder-search.lisp | 6 ++++++ tools/clog-builder.lisp | 8 ++++++-- 4 files changed, 39 insertions(+), 22 deletions(-) diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp index 95fbd8a..99bbb63 100644 --- a/tools/clog-builder-project-tree.lisp +++ b/tools/clog-builder-project-tree.lisp @@ -3,7 +3,7 @@ (defun project-tree-select (panel item &key method) (unless (equal item "") (cond ((and (> (length item) 5) - (equal (subseq item (- (length item) 5)) ".clog")) + (equalp (subseq item (- (length item) 5)) ".clog")) (if (or (eq method :tab) (and (not (eq method :here)) *open-external*)) (on-new-builder-panel-ext panel :open-file item) ;; need ext for both @@ -29,7 +29,7 @@ (setf (height obj) (height obj)))))))))))))) (defun update-static-root (app) (setf *static-root* - (merge-pathnames (if (equal (current-project app) "clog") + (merge-pathnames (if (equalp (current-project app) "clog") "./static-root/" "./www/") (format nil "~A" (asdf:system-source-directory (current-project app))))) @@ -38,10 +38,11 @@ (defun on-project-tree (obj &key project) (let ((app (connection-data-item obj "builder-app-data"))) - (when (uiop:directory-exists-p #P"~/common-lisp/") - (pushnew #P"~/common-lisp/" - (symbol-value (read-from-string "ql:*local-project-directories*")) - :test #'equalp)) + (unless *no-quicklisp* + (when (uiop:directory-exists-p #P"~/common-lisp/") + (pushnew #P"~/common-lisp/" + (symbol-value (read-from-string "ql:*local-project-directories*")) + :test #'equalp))) (when project (setf (current-project app) project)) (if (project-tree-win app) @@ -266,8 +267,9 @@ (setf (text-value load-btn) "working") (setf (background-color load-btn) :yellow) (setf (advisory-title load-btn) "") - (let* ((root (quicklisp:where-is-system sel)) - (dir (directory-namestring (uiop:truename* root)))) + (let* ((system (asdf:find-system sel nil)) + (root (when system (asdf:system-source-directory system))) + (dir (directory-namestring (uiop:truename* root)))) (cond (root (setf (text-value load-btn) "not loaded") (setf (advisory-title load-btn) "Click to load") @@ -347,7 +349,7 @@ (setf (background-color load-btn) :load-np)))))))) (fill-projects () (setf (text projects) "") - (dolist (n (sort (quicklisp:list-local-systems) #'string-lessp)) + (dolist (n (sort (projects-list-local-systems) #'string-lessp)) (add-select-option projects n n :selected (equalp n (current-project app))) (when (equalp n (current-project app)) (on-change (current-project app)))) diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp index e737a84..e59b24d 100644 --- a/tools/clog-builder-projects.lisp +++ b/tools/clog-builder-projects.lisp @@ -24,10 +24,14 @@ (funcall (read-from-string "asdf:load-system") fname)) (defun projects-list-local-systems () - (funcall (read-from-string "ql:list-local-systems"))) + (if *no-quicklisp* + (list *start-project*) + (funcall (read-from-string "ql:list-local-systems")))) (defun projects-local-directories () - (symbol-value (read-from-string "ql:*local-project-directories*"))) + (if *no-quicklisp* + nil + (symbol-value (read-from-string "ql:*local-project-directories*")))) (defun projects-setup (panel) (let* ((app (connection-data-item panel "builder-app-data"))) @@ -35,10 +39,11 @@ (setf (checkedp (open-ext panel)) t)) (when *open-panels-as-popups* (setf (checkedp (pop-panel panel)) t)) - (when (uiop:directory-exists-p #P"~/common-lisp/") - (pushnew #P"~/common-lisp/" - (symbol-value (read-from-string "ql:*local-project-directories*")) - :test #'equalp)) + (unless *no-quicklisp* + (when (uiop:directory-exists-p #P"~/common-lisp/") + (pushnew #P"~/common-lisp/" + (symbol-value (read-from-string "ql:*local-project-directories*")) + :test #'equalp))) (add-select-option (project-list panel) "None" "None") (dolist (n (sort (projects-list-local-systems) #'string-lessp)) (add-select-option (project-list panel) n n)) @@ -123,7 +128,7 @@ (let ((name (format nil "~A" (asdf:component-relative-pathname n))) (file-name (asdf:component-pathname n))) (when (and (> (length name) 5) - (equal (subseq name (- (length name) 5)) ".clog")) + (equalp (subseq name (- (length name) 5)) ".clog")) (let* ((win (create-gui-window panel :top 40 :left 225 :width 645 :height 430)) (box (create-panel-box-layout (window-content win) @@ -180,7 +185,7 @@ nil sel)) (when (current-project app) - (cond ((member sel already :test #'equal) + (cond ((member sel already :test #'equalp) (let ((fs (asdf:find-system sel))) ;; entry point (setf (text-value (entry-point panel)) @@ -206,7 +211,7 @@ (add-select-option (designtime-list panel) path name))) (dolist (n (asdf:system-depends-on sys)) (add-select-option (design-deps panel) n n)) - (when (member "clog" (asdf:system-defsystem-depends-on sys) :test #'equal) + (when (member "clog" (asdf:system-defsystem-depends-on sys) :test #'equalp) (setf (disabledp (runtime-add-lisp panel)) nil) (setf (disabledp (runtime-delete panel)) nil) (setf (disabledp (designtime-add-lisp panel)) nil) @@ -372,7 +377,7 @@ (when (equalp (format nil "~A" (second line)) system) (let (new-comp) (dolist (n (getf line :components)) - (unless (and (equal (first n) ftype) + (unless (and (equalp (first n) ftype) (equalp (second n) file)) (push n new-comp))) (setf (getf line :components) (reverse new-comp)))) @@ -398,7 +403,7 @@ (path (asdf:component-pathname n))) (add-select-option list path name)))) ((and (> (length item) 5) - (equal (subseq item (- (length item) 5)) ".clog")) + (equalp (subseq item (- (length item) 5)) ".clog")) (if (checkedp (open-ext panel)) (on-new-builder-panel-ext target :open-file item :open-ext (checkedp (pop-panel panel))) (on-new-builder-panel target :open-file item :open-ext (checkedp (pop-panel panel))))) diff --git a/tools/clog-builder-search.lisp b/tools/clog-builder-search.lisp index 28d5137..9afe1a0 100644 --- a/tools/clog-builder-search.lisp +++ b/tools/clog-builder-search.lisp @@ -10,6 +10,12 @@ :width 1040 :height 600 :client-movement *client-side-movement*)) (panel (create-panel-search (window-content win)))) + (set-on-click (create-span (window-icon-area win) + :content "- " + :auto-place :top) + (lambda (obj) + (declare (ignore obj)) + (setf (hiddenp win) t))) (set-on-window-size win (lambda (obj) (declare (ignore obj)) (clog-ace:resize (preview-ace panel)))) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index eb66958..bf0a051 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -19,6 +19,7 @@ clog-builder window.") (defparameter *start-project* nil "Set the project to start with") (defparameter *start-dir* nil "Set the directory the dir win should start with") (defparameter *client-side-movement* nil "Use javascript for window movement") +(defparameter *no-quicklisp* nil "Do not use quicklisp") (defvar *scope* nil "The last evaluated scope object") @@ -499,7 +500,8 @@ clog-builder window.") "This window will be used for future default debug alerts." :color-class "w3-green" :time-out 2))) - (create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog) + (unless *no-quicklisp* + (create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog)) ;; Menu -> Windows (create-gui-menu-item win :content "Maximize" :on-click (lambda (obj) @@ -632,7 +634,7 @@ clog-builder window.") (open-browser :url (format nil "http://127.0.0.1:~A~A" clog:*clog-port* open-url)))) (defun clog-builder (&key (host "0.0.0.0") (port 8080) (start-browser t) - app project dir static-root system clogframe) + app project dir static-root system clogframe no-quicklisp) "Start clog-builder. :PROJECT - load ASDF Project, start its static root and set as current :DIR - Start with directory tree set to dir @@ -652,6 +654,8 @@ clog-builder window.") (load *preferances-file* :if-does-not-exist nil :verbose t) + (when no-quicklisp + (setf *no-quicklisp* (or project no-quicklisp))) (setf *start-project* nil) (setf *start-dir* nil) (if project