commit bbe01ccfd33a9ff1c9832109a016d83cced97ef8 Spenser Truex <web@spensertruex.com> 2019-11-04 19:41:30 -0800 clapt:add.
clapt.asd | 4 +++- code/add.lisp | 30 ++++++++++++++++++++++++++++++ code/conditions.lisp | 6 ++++++ code/install.lisp | 30 ++++++++++++++---------------- code/save.lisp | 22 ++++++++-------------- package.lisp | 2 +- 6 files changed, 62 insertions(+), 32 deletions(-)
diff --git a/clapt.asd b/clapt.asd index 95f8a53..c17cdf8 100644 --- a/clapt.asd +++ b/clapt.asd @@ -5,7 +5,9 @@ :version "0.0.2" :serial t :components ((:file "package") + (:file "conditions") (:file "code/util") (:file "code/defaults") (:file "code/save") - (:file "code/install"))) + (:file "code/install") + (:file "code/add"))) diff --git a/code/add.lisp b/code/add.lisp new file mode 100644 index 0000000..724bd23 --- /dev/null +++ b/code/add.lisp @@ -0,0 +1,30 @@ +(in-package #:clapt) + +;; TODO: Use actual conditions properly for the user. +;; Use this when checking if the package exists. +;; (warner error "~@{~a~}~%" "Could not add the " package " package.") + +(defun add (manager &rest packages) + (add-signal manager packages) + (warner user "~a~%" "run (clapt:update) to install them and die.")) + +(defun add-signal (manager packages) + "Assumes already installed." + (with-open-file (f *init-file* + :direction :output + :if-exists :append) + (loop for p in packages + do (add-once manager p f)))) + +(defun add-once (manager package stream) + (let ((pn (equalp (manager-packages manager) + (pushnew-package manager package)))) + (when (not pn) + (print + `(pushnew ',package ,(manager-packages-variable manager)) + stream)) + (if pn + (warner user "~@{~a~}~%" "Ignored the " package " package, " + "since it is already installed.") + (warner user "~@{~a~}~%" "Added the " package " package.")) + package)) diff --git a/code/conditions.lisp b/code/conditions.lisp new file mode 100644 index 0000000..1687343 --- /dev/null +++ b/code/conditions.lisp @@ -0,0 +1,6 @@ +(in-package #:clapt) + +(define-condition packager (simple-condition) ()) +(define-condition package-added (packager) ()) +(define-condition package-ignored (packager) ()) +(define-condition package-not-found (packager) ()) diff --git a/code/install.lisp b/code/install.lisp index 6b228a2..a736733 100644 --- a/code/install.lisp +++ b/code/install.lisp @@ -4,17 +4,6 @@ (defparameter *logstream* t) (defparameter *userstream* t) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun packages-doc (manager) - (format - nil - "~A~A~A" - "User configured Packages for " - (string-downcase (symbol-name manager)) - ". `clapt:add' is a convenience wrapper for it."))) -;; (packages-doc :quicklisp) - - (defun install (&key (sbclrc *sbclrc-path*) (core *core-path*) (add '(:quicklisp :asdf))) "Install clapt." @@ -94,18 +83,27 @@ installed. Provides persistence even when a new version is built." (defun init (stream init) (print - `(defvar *init-file* ,init) + `(setf *init-file* ,init) stream)) - (defun manager-packages-variable (manager) (intern (concatenate 'string "*" (symbol-name manager) "-PACKAGES*") (find-package :clapt))) +(defun manager-packages (manager) + (symbol-value (manager-packages-variable manager))) +(defun pushnew-package (manager package) + ;; Needs EVAL because the interface -- anaphoric interning -- is not very + ;; good. + (eval (let ((packages (manager-packages manager))) + `(setf ,(manager-packages-variable manager) + ',(pushnew package packages))))) +;; (let ((q :quicklisp)) (pushnew-package q 'bogus)) +;; (manager-packages :quicklisp) + (defun package-parameter (packages manager) - `(defvar ,(manager-packages-variable manager) - ',packages - ,(packages-doc manager))) + `(setf ,(manager-packages-variable manager) + ',packages)) ;; (package-parameter '(petalisp) :quicklisp) (defun self-install (sbclrc) diff --git a/code/save.lisp b/code/save.lisp index 38b29c5..1229b98 100644 --- a/code/save.lisp +++ b/code/save.lisp @@ -4,8 +4,15 @@ (defvar *asdf-packages* nil) (defvar *init-file* nil) +(defun install-ql (packages) + (mapcar #'ql:quickload (mapcar #'symbol-name packages))) +(defun install-asdf (packages) + (mapcar #'asdf:load-system packages)) + + (defun update (&optional (core *core-path*)) - (load-configs) + (install-ql *quicklisp-packages*) + (install-asdf *asdf-packages*) (save core)) (defun save (&optional (core *core-path*)) @@ -24,18 +31,5 @@ (manager-packages-variable ,manager)))) s))) -(defun load-configs () - (mapcar #'(lambda (fn pkg) - (when pkg - (mapc fn pkg) - (require pkg))) - (list #'ql:quickload - #'asdf:load-system) - (list (verify-ql *quicklisp-packages*) - (verify-asdf *asdf-packages*)))) - -(defun verify-ql (packages) (mapcar #'symbol-name packages)) -(defun verify-asdf (packages) (mapcar #'symbol-name packages)) - ;;; Would be nice to have an interface here with continuations, friendly output ;;; and warnings, etc. diff --git a/package.lisp b/package.lisp index df0aae4..6bea25f 100644 --- a/package.lisp +++ b/package.lisp @@ -1,3 +1,3 @@ (defpackage #:clapt (:use #:cl) - (:export #:update #:install)) + (:export #:update #:install #:add))