Merge pull request #12 from kinofsolmorrow/main

Integrate trivial-system-loader and also list ocicl systems

contrib/micros-systems.lisp

@@ -1,17 +1,34 @@
 (in-package :micros)
 
+(defun find-quicklisp-systems ()
+  "If Quicklisp is available, extract all system names."
+  (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<))

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)))

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))

micros.asd

@@ -59,7 +59,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")