Add lem-extesion-manager

lem.asd

@@ -35,7 +35,8 @@
                ;; "lem-encodings"
                #+sbcl
                sb-concurrency
-               "lem-mailbox")
+               "lem-mailbox"
+               "lem-extension-manager")
   :pathname "src"
   :serial t
   :components ((:module "common"
@@ -201,7 +202,8 @@
                              (:file "filer")
                              (:file "deepl")
                              (:file "themes")
-                             (:file "detective")))))
+                             (:file "detective")
+                             (:file "extension-commands")))))
 
 (defsystem "lem/extensions"
   :depends-on (#+sbcl

qlfile

@@ -8,3 +8,4 @@ git cl-sdl2 https://github.com/lem-project/cl-sdl2.git
 git cl-sdl2-ttf https://github.com/lem-project/cl-sdl2-ttf.git
 git cl-sdl2-image https://github.com/lem-project/cl-sdl2-image.git
 git jsonrpc https://github.com/cxxxr/jsonrpc.git
+git lem-extension-manager https://github.com/lem-project/lem-extension-manager.git

qlfile.lock

@@ -41,4 +41,4 @@
 ("jsonrpc" .
  (:class qlot/source/git:source-git
   :initargs (:remote-url "https://github.com/cxxxr/jsonrpc.git")
-  :version "git-bb3a536beb22112e544321dc7f3a8822413f9bac"))
+  :version "git-bb3a536beb22112e544321dc7f3a8822413f9bac"))

src/ext/extension-commands.lisp

@@ -0,0 +1,67 @@
+(defpackage :lem/extension-commands
+  (:use :cl :lem-extension-manager
+        :lem :ql)
+  #+sbcl
+  (:lock t)
+  (:export))
+
+(in-package :lem/extension-commands)
+
+(defun %select-ql-package ()
+  (let* ((packages (mapcar #'ql-dist:short-description
+                           (system-list))))
+    (prompt-for-string "Select package: "
+                       :completion-function
+                       (lambda (string)
+                         (completion string packages)))))
+
+(define-command extension-manager-test-ql-package () ()
+  (alexandria:if-let ((lpackage (%select-ql-package)))
+    (progn (package-test
+            (make-instance 'simple-package
+                           :name lpackage
+                           :source (make-quicklisp :name lpackage))))
+    (editor-error "There was an error loading ~a!" lpackage)))
+
+(define-command extension-manager-install-ql-package () ()
+  (let* ((lpackage (%select-ql-package)))
+
+    (lem-use-package lpackage :source '(:type :quicklisp))
+    (message "Package ~a installed!" lpackage)))
+
+(define-command extension-manager-remove-package () ()
+  (if *installed-packages*
+      (let* ((packages (and *installed-packages*
+                            (mapcar #'simple-package-name
+                                    *installed-packages*)))
+             (rpackage
+               (prompt-for-string "Select package: "
+                                  :completion-function
+                                  (lambda (string)
+                                    (completion string packages)))))
+        (package-remove
+         (find rpackage *installed-packages*
+               :key #'simple-package-name
+               :test #'string=))
+        (message "Package remove from system!"))
+
+      (message "No packages installed!")))
+
+
+(define-command extension-manager-purge-packages () ()
+  (let* ((plist (packages-list))
+         (extra-packages
+           (set-difference
+            (mapcar (lambda (p)
+                      (first (last (pathname-directory p))))
+                    plist)
+            (mapcar #'simple-package-name *installed-packages*)
+            :test #'string=)))
+    (loop for e in extra-packages
+          for dir = (find e plist
+                          :key (lambda (p) (first (last (pathname-directory p))))
+                          :test #'string=)
+          do (and (uiop:directory-exists-p dir)
+                  (uiop:delete-directory-tree
+                   (uiop:truename* dir)
+                   :validate t)))))