Move

Pascal J. Bourguignon [2021-05-12 15:06]
Move
Filename
tools/asdf-tools.lisp
diff --git a/tools/asdf-tools.lisp b/tools/asdf-tools.lisp
index 1a6b5c2..1c455cd 100644
--- a/tools/asdf-tools.lisp
+++ b/tools/asdf-tools.lisp
@@ -43,6 +43,8 @@
   (:export "ASDF-LOAD"
            "ASDF-LOAD-SOURCE"
            "ASDF-INSTALL"
+           "ASDF-SYSTEM-NAME"
+           "ASDF-SYSTEM-LICENSE"
            "ASDF-DELETE-SYSTEM"
            "FIND-ASDF-SUBDIRECTORIES"
            "UPDATE-ASDF-REGISTRY")
@@ -51,6 +53,25 @@

 ;; (asdf:output-files 'asdf:program-op "my-system")

+(defun asdf-system-name (system)
+  "Return the name of the ASDF system."
+  (slot-value system 'asdf::name))
+
+(defparameter *system-licenses*
+  '(("cl-ppcre"       . "bsd-2")
+    ("split-sequence" . :unknown)
+    ("terminfo"       . "mit")
+    ("closer-mop"     . "MIT")))
+
+(defun asdf-system-license (system-name)
+  "Return the license of the ASDF system."
+  (let ((system  (asdf:find-system system-name)))
+    (or (cdr (assoc system-name *system-licenses* :test 'string-equal))
+        (and (slot-boundp system 'asdf::licence)
+             (slot-value system 'asdf::licence))
+        :unknown)))
+
+
 (defun asdf-load (&rest systems)
   "Load the ASDF systems.  See also (QL:QUICKLOAD system) to install them."
   (dolist (system systems systems)
ViewGit