commit 4d318c00657169aa03a6084a6b11d6c06c584263 Spenser Truex <web@spensertruex.com> 2019-11-04 17:45:28 -0800 Installing.
TODO.org | 3 +-- code/install.lisp | 30 +++++++++++++++++++++++------- code/save.lisp | 18 ++++++++++++++++-- code/util.lisp | 2 -- 4 files changed, 40 insertions(+), 13 deletions(-)
diff --git a/TODO.org b/TODO.org index 9bfbc4d..16b00c1 100644 --- a/TODO.org +++ b/TODO.org @@ -9,9 +9,8 @@ - [0/2] Package failures :: Offer to modify init, or try another source. - [ ] Non-existent packages. - [ ] Packages failing to load. - - [1/2] Core image checks :: Revert safely. + - [1/1] Core image checks :: Revert safely. - [X] Core backup failed. - - [ ] Check for dirty core image. - [X] Rename. equwal 2019-11-03 - [ ] Add to quicklisp. diff --git a/code/install.lisp b/code/install.lisp index 2195bec..adb2e1a 100644 --- a/code/install.lisp +++ b/code/install.lisp @@ -1,6 +1,6 @@ (in-package #:clapt) -(defparameter *installed* ";;; Leave this line for sbcl-librarian!") +(defparameter *installed* ";;; Leave this line for clapt!") (defparameter *logstream* t) (defparameter *userstream* t) @@ -12,7 +12,7 @@ "User configured Packages for " (string-downcase (symbol-name manager)) ". `clapt:add' is a convenience wrapper for it."))) -#+5am (packages-doc :quicklisp) +;; (packages-doc :quicklisp) (defun install (&key (sbclrc *sbclrc-path*) (core *core-path*) @@ -23,6 +23,12 @@ (backup-core core (merge-pathnames #P".core.bak" sbclrc)) (update core)) +(defun installedp (sbclrc-path) + "Determine if sbcl-librarian is installed in the .sbclrc." + (with-open-file (sbclrc sbclrc-path + :direction :input + :if-does-not-exist nil) + (when sbclrc (until sbclrc *installed*)))) (defmacro warner (level datum &rest arguments) "Use log to manage output." @@ -37,7 +43,7 @@ (user `(format *userstream* ,datum ,@arguments)) (otherwise (error "Bad warning spec.")))) -#+5am (backup-core #p"~/org/sbcl.org" #p"~/example.delete") +;; (backup-core #p"~/org/sbcl.org" #p"~/example.delete") (defun backup-core (core backup) "Save original core image." (handler-case (copy-file core backup) @@ -82,15 +88,25 @@ installed. Provides persistence even when a new version is built." :if-exists :append :if-does-not-exist :create) (when (not (installedp sbclrc)) + (init s sbclrc) (parameterize s systema) (self-install s core)))) +(defun init (stream init) + (prin1 + `(defvar *init-file* ,(format nil "~S" init)) + stream)) + + + +(defun manager-packages-variable (manager) + (intern (concatenate 'string "*" (symbol-name manager) "-PACKAGES*") + (find-package :clapt))) (defun package-parameter (packages manager) - `(defvar ,(intern (symbol-name manager) - (find-package :keyword)) + `(defvar ,(manager-packages-variable manager) ',packages ,(packages-doc manager))) -#+5am (package-parameter '(petalisp) :quicklisp) +;; (package-parameter '(petalisp) :quicklisp) (defun self-install (sbclrc core) (declare (stream sbclrc)) @@ -110,4 +126,4 @@ installed. Provides persistence even when a new version is built." (declare (stream sbclrc)) (mapcar #'(lambda (code) (prin1 code sbclrc)) (loop for s in systema - collect (package-parameter systema s)))) + collect (package-parameter nil s)))) diff --git a/code/save.lisp b/code/save.lisp index 628a9f4..38b29c5 100644 --- a/code/save.lisp +++ b/code/save.lisp @@ -1,5 +1,9 @@ (in-package #:clapt) +(defvar *quicklisp-packages* nil) +(defvar *asdf-packages* nil) +(defvar *init-file* nil) + (defun update (&optional (core *core-path*)) (load-configs) (save core)) @@ -11,16 +15,26 @@ (asdf/pathname:ensure-absolute-pathname core))) +(defun add (manager &rest packages) + (with-open-file (s *init-file*) + (prin1 + `(progn + ,@(loop for p in packages + collect `(pushnew ,p + (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 #'ql:quickload + #'asdf:load-system) (list (verify-ql *quicklisp-packages*) (verify-asdf *asdf-packages*)))) -(defun verify-ql (packages) (macpar #'symbol-name 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 diff --git a/code/util.lisp b/code/util.lisp index 7b11c77..f745d5b 100644 --- a/code/util.lisp +++ b/code/util.lisp @@ -30,8 +30,6 @@ 0)))) ;; (copy-file #p"/home/jose/org/sbcl.org" #p"/home/jose/example.delete") - - (defun until (stream match) (let ((line (read-line stream nil nil))) (when line