Support no-quicklisp asdf systems and OCICL

This commit is contained in:
David Botton 2024-07-08 14:47:30 -04:00
parent eda76103cb
commit e189b51c87
9 changed files with 196 additions and 33 deletions

127
OCICL.md vendored Normal file
View file

@ -0,0 +1,127 @@
OCICL is a complete secure alternative to a QuickLisp CLOG install
OCICL loads dependencies with your project. Once setup the command line
tool ocicl is used to prepare a directory for a new project or to convert
and existing project to an ocicl based one. To add dependecies you just
add them to your asd file and will be downloaded as needed. A simple
run of "ocicl latest" updates your project dependecies.
Once installed either in an empty dir or existing project do:
```
ocicl setup > init
ocicl install clog
sbcl --userinit init
```
Then in SBCL
```
(asdf:load-system :clog/tools)
(clog-tools:clog-builder)
```
NOTE: With OCICL the model of dev changes where each system is its own world
so the only project in the Builder will be the one in the directory you
start in.
================================================================================
I N S T A L L
================================================================================
These are directions for getting started from scratch:
* Step 1 - Install SBCL *
Linux:
Use OS package manager like for example
```
sudo apt-get install sbcl
```
Mac:
On Mac install homebrew from https://brew.sh/
```
brew install sbcl
brew install ocicl
```
For Mac - skip step 2 - you are ready to go!
Windows:
On Windows install Windows AMD 64 from here -
https://www.sbcl.org/platform-table.html
For example:
http://prdownloads.sourceforge.net/sbcl/sbcl-2.4.6-x86-64-windows-binary.msi
* Step 2 - Install OCICL *
Create a dir for example projects and cd to it then do:
```
git clone https://github.com/ocicl/ocicl.git
```
the cd in to ocicl and run:
```
sbcl --load setup.lisp
```
Make sure the created ocicl is on your PATH
On Linux:
Close your terminal and reopen and in most distros is, as .local/bin is usually
added if exists.
On Windows:
Permanently make available, by using:
search then type env -> then pick Edit the system environment variables
click the button environment variables -> select Path under User variables
click Edit... -> New and type "%USERPROFILE%\AppData\Local\ocicl\bin\"
"Close the terminal and open a new one
* Step 3 - Create your project directory
Note: ~/common-lisp is always searched so make sure no conflicts in most cases
you do not want that directory to exist
(If converting a clog project just do in the directory with your .asd file)
For this example using projects/ctest
cd to projects/ctest
```
ocicl setup > init
ocicl install clog
```
Note for Windows: unzip https://rabbibotton.github.io/clog/clogframe.zip for
needed dlls in directory
to use sbcl any time in your own ocicl world use:
```
sbcl --userinit init
```
and to start the builder in sbcl:
```
(asdf:load-system :clog/tools)
(clog-tools:clog-builder)
```
If this is the new project a .asd file, first .lisp file and www directory
will be created as well.

View file

@ -117,13 +117,15 @@ number is chosen."
(setf *extended-routing* extended-routing) (setf *extended-routing* extended-routing)
(when on-new-window-handler (when on-new-window-handler
(set-on-new-window on-new-window-handler :path "/" :boot-file boot-file)) (set-on-new-window on-new-window-handler :path "/" :boot-file boot-file))
(unless clog-connection:*clog-running* (if clog-connection:*clog-running*
(setf clog-connection:*clog-running* t) (setf clog-connection:*static-root* static-root)
(when (or (eql port 0) (eq port nil)) (progn
(setf port (clog-connection:random-port))) (setf clog-connection:*clog-running* t)
(apply #'clog-connection:initialize (when (or (eql port 0) (eq port nil))
(append (list #'on-connect :static-root static-root :port port) (setf port (clog-connection:random-port)))
rest)))) (apply #'clog-connection:initialize
(append (list #'on-connect :static-root static-root :port port)
rest)))))
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
;; set-on-new-window ;; ;; set-on-new-window ;;

View file

@ -1,10 +1,12 @@
(defpackage #:<%= (@ sys-name) %> (defpackage #:<%= (@ sys-name) %>
(:use #:cl #:clog) (:use #:cl #:clog #:clog-gui)
(:export start-app)) (:export start-app))
(in-package :<%= (@ sys-name) %>) (in-package :<%= (@ sys-name) %>)
(defun on-new-window (body) (defun on-new-window (body)
;; To enable use of builder panels
;; (clog-gui-initialize body)
;; Use the panel-box-layout to center horizontally ;; Use the panel-box-layout to center horizontally
;; and vertically our div on the screen. ;; and vertically our div on the screen.
(let* ((layout (create-panel-box-layout body))) (let* ((layout (create-panel-box-layout body)))

View file

@ -329,7 +329,6 @@ var endRange = ~:*~A.session.doc.indexToPosition(endIndex);
(setf (text status) (string-downcase r))))))))))) (setf (text status) (string-downcase r)))))))))))
(clog-ace:set-auto-completion editor t) (clog-ace:set-auto-completion editor t)
(setf (clog-ace:theme editor) *editor-theme*) (setf (clog-ace:theme editor) *editor-theme*)
(setf (clog-ace:mode editor) *editor-mode*)
(setf (clog-ace:tab-size editor) *editor-tab-size*) (setf (clog-ace:tab-size editor) *editor-tab-size*)
(js-execute editor (js-execute editor
(format nil "~A.setKeyboardHandler('~A')" (format nil "~A.setKeyboardHandler('~A')"

View file

@ -244,21 +244,21 @@
(setf (text-value load-btn) "working") (setf (text-value load-btn) "working")
(setf (background-color load-btn) :yellow) (setf (background-color load-btn) :yellow)
(handler-case (handler-case
(progn (progn
(projects-load (format nil "~A/tools" sel)) (projects-load (format nil "~A/tools" sel))
(update-static-root app)) (update-static-root app))
(error () (error ()
(projects-load sel))) (projects-load sel)))
(setf (text-value load-btn) "loaded") (setf (text-value load-btn) "loaded")
(setf (background-color load-btn) load-np) (setf (background-color load-btn) load-np)
(window-focus win)) (window-focus win))
(on-change (obj) (on-change (obj)
(declare (ignore obj)) (declare (ignore obj))
(setf (text tree) "") (setf (text tree) "")
(browser-gc tree) (browser-gc tree)
(let* ((sel (value projects))) (let* ((sel (value projects)))
(setf entry-point "") (setf entry-point "")
(cond ((equal sel "") (cond ((or (equal sel "") (equal sel "NIL"))
(setf (text-value load-btn) "no project") (setf (text-value load-btn) "no project")
(setf (advisory-title load-btn) "Choose project in drop down") (setf (advisory-title load-btn) "Choose project in drop down")
(setf (background-color load-btn) load-np) (setf (background-color load-btn) load-np)
@ -349,10 +349,12 @@
(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 (projects-list-local-systems) #'string-lessp)) (let ((pl (projects-list-local-systems)))
(add-select-option projects n n :selected (equalp n (current-project app))) (when pl
(when (equalp n (current-project app)) (dolist (n (sort pl #'string-lessp))
(on-change (current-project app)))) (add-select-option projects n n :selected (equalp n (current-project app)))
(when (equalp n (current-project app))
(on-change (current-project app))))))
(add-select-option projects "" "Select Project" :selected (not (current-project app))))) (add-select-option projects "" "Select Project" :selected (not (current-project app)))))
(set-on-click load-btn (lambda (obj) (set-on-click load-btn (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))

View file

@ -25,12 +25,12 @@
(defun projects-list-local-systems () (defun projects-list-local-systems ()
(if *no-quicklisp* (if *no-quicklisp*
(list *start-project*) (last (pathname-directory (uiop:getcwd)))
(funcall (read-from-string "ql:list-local-systems")))) (funcall (read-from-string "ql:list-local-systems"))))
(defun projects-local-directories () (defun projects-local-directories ()
(if *no-quicklisp* (if *no-quicklisp*
nil (symbol-value (read-from-string "asdf:*central-registry*"))
(symbol-value (read-from-string "ql:*local-project-directories*")))) (symbol-value (read-from-string "ql:*local-project-directories*"))))
(defun projects-setup (panel) (defun projects-setup (panel)

View file

@ -11,7 +11,7 @@
(dolist (d dlist) (dolist (d dlist)
(walk-files-and-directories d process)))) (walk-files-and-directories d process))))
(defun template-copy (sys-name start-dir filename &key panel) (defun template-copy (sys-name start-dir filename &key panel (base-dir t))
"Copy START-DIR to FILENAME processing .lt files as cl-template files, "Copy START-DIR to FILENAME processing .lt files as cl-template files,
if PANEL each copy produces a <b>source</b> to destination added as if PANEL each copy produces a <b>source</b> to destination added as
create-div's" create-div's"
@ -21,9 +21,10 @@ create-div's"
(let* ((tmpl-ext "lt") (let* ((tmpl-ext "lt")
(src-file (format nil "~A~A" (src-file (format nil "~A~A"
path file)) path file))
(out-dir (format nil "~A/~A/~A" (out-dir (format nil "~A/~A"
filename (if base-dir
sys-name (format nil "~A/~A" filename sys-name)
filename)
(subseq (format nil "~A" path) (subseq (format nil "~A" path)
(length start-dir)))) (length start-dir))))
(out-file (format nil "~A~A" (out-file (format nil "~A~A"
@ -52,6 +53,25 @@ create-div's"
:content (format nil "<b>~A</b> -> ~A" :content (format nil "<b>~A</b> -> ~A"
src-file out-file))))))))) src-file out-file)))))))))
(defun fill-template (code dir fname)
(let* ((tmpl-rec (find-if (lambda (x)
(equal (getf x :code) code))
*supported-templates*))
(start-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :loc)))
(www-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :www))))
(format t "Template copy ~A with www ~A to ~A~%"
start-dir
www-dir
dir)
(template-copy fname start-dir dir :base-dir nil)
(when (getf tmpl-rec :www)
(template-copy fname www-dir dir :base-dir nil))
(asdf:clear-source-registry)))
;; Handle panel-clog-templates events ;; Handle panel-clog-templates events
(defun fill-button-clicked (panel) (defun fill-button-clicked (panel)

View file

@ -593,8 +593,6 @@ clog-builder window.")
(setf (title (html-document body)) (file-namestring open-file))) (setf (title (html-document body)) (file-namestring open-file)))
(on-open-file body :open-file open-file :maximized t)) (on-open-file body :open-file open-file :maximized t))
(t (t
(when *start-project*
(projects-load *start-project*))
(on-project-tree body :project *start-project*) (on-project-tree body :project *start-project*)
(when *start-dir* (when *start-dir*
(handler-case (handler-case
@ -634,7 +632,8 @@ 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 no-quicklisp) app project dir static-root system clogframe
(new-template "ncp") 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
@ -644,6 +643,7 @@ clog-builder window.")
and it will be batch rerendered and shutdown after. and it will be batch rerendered and shutdown after.
:STATIC-ROOT - set static-root dir manually. :STATIC-ROOT - set static-root dir manually.
:SYSTEM - Use projects's asdf system's static root." :SYSTEM - Use projects's asdf system's static root."
(declare (ignorable new-template))
(setf *preferances-file* (setf *preferances-file*
(format nil "~A/preferences.lisp" (format nil "~A/preferences.lisp"
(merge-pathnames "tools" (merge-pathnames "tools"
@ -654,13 +654,23 @@ clog-builder window.")
(load *preferances-file* (load *preferances-file*
:if-does-not-exist nil :if-does-not-exist nil
:verbose t) :verbose t)
(setf *start-dir* nil)
#-quicklisp
(progn
(setf no-quicklisp t)
(unless project
(setf project (car (last (pathname-directory (uiop:getcwd))))))
(let ((fname (format nil "~A~A.asd" (uiop:getcwd) project)))
(format t "Starting non-quicklisp dir based system - ~A~%" project)
(unless (uiop:file-exists-p fname)
(format t "New System - Creating Project ~A~%" fname)
(fill-template new-template (uiop:getcwd) project))))
(when no-quicklisp (when no-quicklisp
(setf *no-quicklisp* (or project no-quicklisp))) (setf *no-quicklisp* (or project no-quicklisp)))
(setf *start-project* nil)
(setf *start-dir* nil)
(if project (if project
(progn (progn
(setf *start-project* (string-downcase (format nil "~A" project))) (setf *start-project* (string-downcase (format nil "~A" project)))
(projects-load *start-project*)
(setf static-root (merge-pathnames "./www/" (format nil "~A" (asdf:system-source-directory project))))) (setf static-root (merge-pathnames "./www/" (format nil "~A" (asdf:system-source-directory project)))))
(setf *start-project* nil)) (setf *start-project* nil))
(when dir (when dir
@ -704,11 +714,11 @@ clog-builder window.")
(format t "~%If browser does not start go to http://127.0.0.1:~A/builder~%~%" port) (format t "~%If browser does not start go to http://127.0.0.1:~A/builder~%~%" port)
(open-browser :url (format nil "http://127.0.0.1:~A/builder" port)))) (open-browser :url (format nil "http://127.0.0.1:~A/builder" port))))
#+windows #+(and windows quicklisp)
(in-package #:quicklisp-client) (in-package #:quicklisp-client)
;; patch, if-exists of :rename-and-delete does not work well on windows ;; patch, if-exists of :rename-and-delete does not work well on windows
#+windows #+(and windows quicklisp)
(defun make-system-index (pathname) (defun make-system-index (pathname)
"Create a system index file for all system files under "Create a system index file for all system files under
PATHNAME. Current format is one native namestring per line." PATHNAME. Current format is one native namestring per line."

View file

@ -2,6 +2,8 @@
;; Add directories to use custom directoires for storing projects ;; Add directories to use custom directoires for storing projects
;; (pushnew #P"/path/of/projects" ql:*local-project-directories* :test #'equalp) ;; (pushnew #P"/path/of/projects" ql:*local-project-directories* :test #'equalp)
;; For non-quicklisp based systems
;; (pushnew #P"/path/of/projects" asdf:*central-registry* :test #'equalp)
;; Preferences loaded on next call to clog-tools:clog-builder or [Eval All] ;; Preferences loaded on next call to clog-tools:clog-builder or [Eval All]
@ -61,7 +63,6 @@
(setf *editor-theme* "ace/theme/iplastic") (setf *editor-theme* "ace/theme/iplastic")
;; Best Dark Theme for Lisp ;; Best Dark Theme for Lisp
;;(setf *editor-theme* "ace/theme/terminal") ;;(setf *editor-theme* "ace/theme/terminal")
(setf *editor-mode* "ace/mode/lisp")
;;(setf *editor-keybinding* "ace/keyboard/emacs") ;;(setf *editor-keybinding* "ace/keyboard/emacs")
(setf *editor-keybinding* "ace/keyboard/ace") (setf *editor-keybinding* "ace/keyboard/ace")
(setf *editor-tab-size* 2) (setf *editor-tab-size* 2)