From 2fa7d22d63baea8d48412925145961698972b3e3 Mon Sep 17 00:00:00 2001 From: amartens Date: Sat, 16 Mar 2024 05:49:19 +0100 Subject: [PATCH 1/3] Integrate trivial-system-loader into micros This ensures that no external dependencies need to be introduced. --- lsp-api-load-systems.lisp | 47 +++++++++++++++++++++++++++++++++++++++ lsp-api.lisp | 3 --- micros.asd | 3 ++- 3 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 lsp-api-load-systems.lisp diff --git a/lsp-api-load-systems.lisp b/lsp-api-load-systems.lisp new file mode 100644 index 0000000..9f58415 --- /dev/null +++ b/lsp-api-load-systems.lisp @@ -0,0 +1,47 @@ +;;; trivial-system-loader.lisp +;;; +;;; SPDX-License-Identifier: MIT +;;; +;;; Copyright (C) 2024 Anthony Green and Michał 'phoe' Herda +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining a copy +;;; of this software and associated documentation files (the "Software"), to deal +;;; in the Software without restriction, including without limitation the rights +;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;;; copies of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be included in all +;;; copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;;; SOFTWARE. +;;; + +(in-package :micros/lsp-api) + +(defun load-systems (systems &key (verbose nil) (silent t)) + "Load system SYSTEMS, potentially downloading them from an external + repository. SYSTEMS may be a single system or a list of + systems. Loader behavior is modified by VERBOSE and SILENT." + (unless (listp systems) + (setf systems (list systems))) + (flet ((try-load-system (system) + (or + (when (find-package '#:OCICL-RUNTIME) + (progv (list (find-symbol "*DOWNLOAD*" '#:OCICL-RUNTIME) + (find-symbol "*VERBOSE*" '#:OCICL-RUNTIME)) + (list t (or verbose (not silent))) + (funcall (find-symbol "LOAD-SYSTEM" '#:asdf) system))) + (when (find-package '#:QUICKLISP) + (funcall (find-symbol "QUICKLOAD" '#:QUICKLISP) + system :verbose verbose :silent silent)) + (when (find-package '#:ASDF) + (funcall (find-symbol "LOAD-SYSTEM" '#:ASDF) system)) + (error "Unable to find any system-loading mechanism.")))) + (mapcar #'try-load-system systems))) diff --git a/lsp-api.lisp b/lsp-api.lisp index 0175a9c..7e41537 100644 --- a/lsp-api.lisp +++ b/lsp-api.lisp @@ -203,9 +203,6 @@ :kind (when symbol (symbol-kind symbol)))))) ;;; -(defun load-systems (system-names) - (ql:quickload system-names)) - (defun compile-and-load-file (filename) (uiop:with-temporary-file (:pathname output-file :type "fasl") (let* ((stream (make-broadcast-stream)) diff --git a/micros.asd b/micros.asd index aeb5d87..b8b84ca 100644 --- a/micros.asd +++ b/micros.asd @@ -57,7 +57,8 @@ (:file "defmethod-form") (:file "loop-form") (:file "data-and-control-flow"))))) - (:file "lsp-api"))) + (:file "lsp-api") + (:file "lsp-api-load-systems"))) (defsystem "micros/tests" :depends-on ("rove" "micros") From 62d4bece5158376ff6ec40ac5a36c6ebd193bea5 Mon Sep 17 00:00:00 2001 From: amartens Date: Sat, 16 Mar 2024 05:50:25 +0100 Subject: [PATCH 2/3] Also list systems for ocicl --- contrib/micros-systems.lisp | 43 ++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/contrib/micros-systems.lisp b/contrib/micros-systems.lisp index 13396ee..cfaa8a4 100644 --- a/contrib/micros-systems.lisp +++ b/contrib/micros-systems.lisp @@ -1,17 +1,34 @@ (in-package :micros) +(defun find-quicklisp-systems () + "If Quicklisp is available, extract all system names from the current directory's systems.csv." + (when (find-package '#:QUICKLISP) + (mapcar (lambda (dist) + (uiop:symbol-call '#:ql-dist '#:name dist)) + (uiop:symbol-call '#:quicklisp '#:system-list)))) + +(defun find-ocicl-systems () + "If the Ocicl runtime is available, extract all system names from the current directory's systems.csv." + (when (find-package '#:OCICL-RUNTIME) + (with-open-file (in-stream (merge-pathnames (uiop:getcwd) "systems.csv") :direction :input) + (unwind-protect + (loop :for line = (read-line in-stream nil) + :while line + :collect (subseq line 0 (position #\, line))) + (close in-stream))))) + +(defun find-asdf-systems () + "If ASDF is available, extract system names by collecting all keys from the *source-registry* hash lists." + (when (find-package '#:ASDF) + (loop :for system-name :being :each :hash-key :of asdf/source-registry:*source-registry* + :collect system-name))) + (defslimefun list-systems () - "Returns the Quicklisp and ASDF systems list." - (unless (member :quicklisp *features*) - (error "Could not find Quicklisp already loaded.")) + "Returns a list of all locally available Quicklisp, Ocicl and ASDF systems." (asdf:ensure-source-registry) - (let ((asdf-systems - (sort (loop :for system-name :being :each :hash-key :of asdf/source-registry:*source-registry* - :collect system-name) - #'string<)) - (quicklisp-systems - (mapcar (lambda (dist) - (uiop:symbol-call '#:ql-dist '#:name dist)) - (uiop:symbol-call '#:quicklisp '#:system-list)))) - (append asdf-systems - quicklisp-systems))) + (sort (delete-duplicates + (append (find-quicklisp-systems) + (find-ocicl-systems) + (find-asdf-systems)) + :test #'string=) + #'string<)) From 95d7f73686ba66b769a6ab0935cde8c930ba2a00 Mon Sep 17 00:00:00 2001 From: kinofsolmorrow Date: Sat, 16 Mar 2024 15:53:40 +0100 Subject: [PATCH 3/3] Update find-quicklisp-systems docstring --- contrib/micros-systems.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/contrib/micros-systems.lisp b/contrib/micros-systems.lisp index cfaa8a4..c57f6bc 100644 --- a/contrib/micros-systems.lisp +++ b/contrib/micros-systems.lisp @@ -1,7 +1,7 @@ (in-package :micros) (defun find-quicklisp-systems () - "If Quicklisp is available, extract all system names from the current directory's systems.csv." + "If Quicklisp is available, extract all system names." (when (find-package '#:QUICKLISP) (mapcar (lambda (dist) (uiop:symbol-call '#:ql-dist '#:name dist))