mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity

no-quickslip option

Browse source
This commit is contained in:
David Botton 2024-07-07 21:18:50 -04:00
parent 21bbda5a18
commit eda76103cb
4 changed files with 39 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -3,7 +3,7 @@
(defun project-tree-select (panel item &key method) (defun project-tree-select (panel item &key method)
(unless (equal item "") (unless (equal item "")
(cond ((and (> (length item) 5) (cond ((and (> (length item) 5)
(equal (subseq item (- (length item) 5)) ".clog")) (equalp (subseq item (- (length item) 5)) ".clog"))
(if (or (eq method :tab) (if (or (eq method :tab)
(and (not (eq method :here)) *open-external*)) (and (not (eq method :here)) *open-external*))
(on-new-builder-panel-ext panel :open-file item) ;; need ext for both (on-new-builder-panel-ext panel :open-file item) ;; need ext for both
@ -29,7 +29,7 @@
(setf (height obj) (height obj)))))))))))))) (setf (height obj) (height obj))))))))))))))
(defun update-static-root (app) (defun update-static-root (app)
(setf *static-root* (setf *static-root*
(merge-pathnames (if (equal (current-project app) "clog") (merge-pathnames (if (equalp (current-project app) "clog")
"./static-root/" "./static-root/"
"./www/") "./www/")
(format nil "~A" (asdf:system-source-directory (current-project app))))) (format nil "~A" (asdf:system-source-directory (current-project app)))))
@ -38,10 +38,11 @@
(defun on-project-tree (obj &key project) (defun on-project-tree (obj &key project)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(unless *no-quicklisp*
(when (uiop:directory-exists-p #P"~/common-lisp/") (when (uiop:directory-exists-p #P"~/common-lisp/")
(pushnew #P"~/common-lisp/" (pushnew #P"~/common-lisp/"
(symbol-value (read-from-string "ql:*local-project-directories*")) (symbol-value (read-from-string "ql:*local-project-directories*"))
:test #'equalp)) :test #'equalp)))
(when project (when project
(setf (current-project app) project)) (setf (current-project app) project))
(if (project-tree-win app) (if (project-tree-win app)
@ -266,7 +267,8 @@
(setf (text-value load-btn) "working") (setf (text-value load-btn) "working")
(setf (background-color load-btn) :yellow) (setf (background-color load-btn) :yellow)
(setf (advisory-title load-btn) "") (setf (advisory-title load-btn) "")
(let* ((root (quicklisp:where-is-system sel)) (let* ((system (asdf:find-system sel nil))
(root (when system (asdf:system-source-directory system)))
(dir (directory-namestring (uiop:truename* root)))) (dir (directory-namestring (uiop:truename* root))))
(cond (root (cond (root
(setf (text-value load-btn) "not loaded") (setf (text-value load-btn) "not loaded")
@ -347,7 +349,7 @@
(setf (background-color load-btn) :load-np)))))))) (setf (background-color load-btn) :load-np))))))))
(fill-projects () (fill-projects ()
(setf (text 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))) (add-select-option projects n n :selected (equalp n (current-project app)))
(when (equalp n (current-project app)) (when (equalp n (current-project app))
(on-change (current-project app)))) (on-change (current-project app))))

21
tools/clog-builder-projects.lisp
View file

@ -24,10 +24,14 @@
(funcall (read-from-string "asdf:load-system") fname)) (funcall (read-from-string "asdf:load-system") fname))
(defun projects-list-local-systems () (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 () (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) (defun projects-setup (panel)
(let* ((app (connection-data-item panel "builder-app-data"))) (let* ((app (connection-data-item panel "builder-app-data")))
@ -35,10 +39,11 @@
(setf (checkedp (open-ext panel)) t)) (setf (checkedp (open-ext panel)) t))
(when *open-panels-as-popups* (when *open-panels-as-popups*
(setf (checkedp (pop-panel panel)) t)) (setf (checkedp (pop-panel panel)) t))
(unless *no-quicklisp*
(when (uiop:directory-exists-p #P"~/common-lisp/") (when (uiop:directory-exists-p #P"~/common-lisp/")
(pushnew #P"~/common-lisp/" (pushnew #P"~/common-lisp/"
(symbol-value (read-from-string "ql:*local-project-directories*")) (symbol-value (read-from-string "ql:*local-project-directories*"))
:test #'equalp)) :test #'equalp)))
(add-select-option (project-list panel) "None" "None") (add-select-option (project-list panel) "None" "None")
(dolist (n (sort (projects-list-local-systems) #'string-lessp)) (dolist (n (sort (projects-list-local-systems) #'string-lessp))
(add-select-option (project-list panel) n n)) (add-select-option (project-list panel) n n))
@ -123,7 +128,7 @@
(let ((name (format nil "~A" (asdf:component-relative-pathname n))) (let ((name (format nil "~A" (asdf:component-relative-pathname n)))
(file-name (asdf:component-pathname n))) (file-name (asdf:component-pathname n)))
(when (and (> (length name) 5) (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 (let* ((win (create-gui-window panel :top 40 :left 225
:width 645 :height 430)) :width 645 :height 430))
(box (create-panel-box-layout (window-content win) (box (create-panel-box-layout (window-content win)
@ -180,7 +185,7 @@
nil nil
sel)) sel))
(when (current-project app) (when (current-project app)
(cond ((member sel already :test #'equal) (cond ((member sel already :test #'equalp)
(let ((fs (asdf:find-system sel))) (let ((fs (asdf:find-system sel)))
;; entry point ;; entry point
(setf (text-value (entry-point panel)) (setf (text-value (entry-point panel))
@ -206,7 +211,7 @@
(add-select-option (designtime-list panel) path name))) (add-select-option (designtime-list panel) path name)))
(dolist (n (asdf:system-depends-on sys)) (dolist (n (asdf:system-depends-on sys))
(add-select-option (design-deps panel) n n)) (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-add-lisp panel)) nil)
(setf (disabledp (runtime-delete panel)) nil) (setf (disabledp (runtime-delete panel)) nil)
(setf (disabledp (designtime-add-lisp panel)) nil) (setf (disabledp (designtime-add-lisp panel)) nil)
@ -372,7 +377,7 @@
(when (equalp (format nil "~A" (second line)) system) (when (equalp (format nil "~A" (second line)) system)
(let (new-comp) (let (new-comp)
(dolist (n (getf line :components)) (dolist (n (getf line :components))
(unless (and (equal (first n) ftype) (unless (and (equalp (first n) ftype)
(equalp (second n) file)) (equalp (second n) file))
(push n new-comp))) (push n new-comp)))
(setf (getf line :components) (reverse new-comp)))) (setf (getf line :components) (reverse new-comp))))
@ -398,7 +403,7 @@
(path (asdf:component-pathname n))) (path (asdf:component-pathname n)))
(add-select-option list path name)))) (add-select-option list path name))))
((and (> (length item) 5) ((and (> (length item) 5)
(equal (subseq item (- (length item) 5)) ".clog")) (equalp (subseq item (- (length item) 5)) ".clog"))
(if (checkedp (open-ext panel)) (if (checkedp (open-ext panel))
(on-new-builder-panel-ext target :open-file item :open-ext (checkedp (pop-panel 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))))) (on-new-builder-panel target :open-file item :open-ext (checkedp (pop-panel panel)))))

6
tools/clog-builder-search.lisp
View file

@ -10,6 +10,12 @@
:width 1040 :height 600 :width 1040 :height 600
:client-movement *client-side-movement*)) :client-movement *client-side-movement*))
(panel (create-panel-search (window-content win)))) (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) (set-on-window-size win (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:resize (preview-ace panel)))) (clog-ace:resize (preview-ace panel))))

8
tools/clog-builder.lisp
View file

@ -19,6 +19,7 @@ clog-builder window.")
(defparameter *start-project* nil "Set the project to start with") (defparameter *start-project* nil "Set the project to start with")
(defparameter *start-dir* nil "Set the directory the dir win should 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 *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") (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." "This window will be used for future default debug alerts."
:color-class "w3-green" :color-class "w3-green"
:time-out 2))) :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 ;; Menu -> Windows
(create-gui-menu-item win :content "Maximize" :on-click (create-gui-menu-item win :content "Maximize" :on-click
(lambda (obj) (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)))) (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) (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. "Start clog-builder.
:PROJECT - load ASDF Project, start its static root and set as current :PROJECT - load ASDF Project, start its static root and set as current
:DIR - Start with directory tree set to dir :DIR - Start with directory tree set to dir
@ -652,6 +654,8 @@ clog-builder window.")
(load *preferances-file* (load *preferances-file*
:if-does-not-exist nil :if-does-not-exist nil
:verbose t) :verbose t)
(when no-quicklisp
(setf *no-quicklisp* (or project no-quicklisp)))
(setf *start-project* nil) (setf *start-project* nil)
(setf *start-dir* nil) (setf *start-dir* nil)
(if project (if project