commit 3888a0b923c6cec1976ee42a265b355c63fbf697 Spenser Truex <web@spensertruex.com> 2019-11-02 22:03:34 -0700 Compiles and installs; better interface; backups.
README.md | 4 +--- code/install.fasl | Bin 0 -> 10648 bytes code/install.lisp | 48 +++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 46 insertions(+), 6 deletions(-)
diff --git a/README.md b/README.md index d73bbab..54cf08c 100644 --- a/README.md +++ b/README.md @@ -23,14 +23,12 @@ We need to know which packages are needed, and whether they are from quicklisp. 1. Modify `CONFIG-ASDF.lisp` and/or `CONFIG-QUICKLISP.lisp` with the desired packages. -2. Install: `(sbcl-librarian:install)`. +2. Install: `(sbcl-librarian:install)`. ## Updating packages Run `(sbcl-librarian:update)`. -## - ## License GNU GPL v3 diff --git a/code/install.fasl b/code/install.fasl new file mode 100644 index 0000000..8e9db07 Binary files /dev/null and b/code/install.fasl differ diff --git a/code/install.lisp b/code/install.lisp index b090a88..16975d6 100644 --- a/code/install.lisp +++ b/code/install.lisp @@ -2,6 +2,38 @@ (defparameter *installed* ";;; Leave this line for sbcl-librarian!") +(defun write-array (array stream) + "Write a binary array to the unsigned-byte stream." + (loop for x across array + do (write-byte x stream))) + +(defun copy-stream (from to size buffer loc) + "Copy an unsigned-byte stream to another one, somewhat efficiently." + (if (< loc size) + (let ((byte (read-byte from nil nil))) + (if byte + (copy-stream from to size + (progn (setf (aref buffer loc) byte) buffer) + (1+ loc)) + (write-array (subseq buffer 0 loc) to))) + (progn (write-array buffer to) + (copy-stream from to size buffer 0)))) + +(defun copy-file (from to &optional (buffer-size 1024)) + (with-open-file (fr from + :element-type 'unsigned-byte + :if-does-not-exist nil) + (if fr + (with-open-file (to to :direction :output + :if-exists nil ;Want it to stay ORIGINAL. + :if-does-not-exist :create + :element-type 'unsigned-byte) + (when to + (copy-stream fr to buffer-size + (make-array buffer-size :element-type 'unsigned-byte) + 0))) + (warn "~%~%The core does not exist, sbcl will have to be started with the --core ~S option to enable the sbcl-librarian libraries core.~%~%" from)))) + (defun until (stream match) (let ((line (read-line stream nil nil))) (when line @@ -14,7 +46,8 @@ :direction :input :if-does-not-exist nil) (when sbclrc (until sbclrc *installed*)))) -(defun install (&optional (sbclrc-path *sbclrc-path*) (core-path *core-path*)) + +(defun write-to-init-file (sbclrc-path core-path) (with-open-file (sbclrc sbclrc-path :direction :output :if-exists :append @@ -29,5 +62,14 @@ (prin1 '(asdf:load-system :sbcl-librarian) sbclrc) (format sbclrc "~%~A~%" "#-sblibr") (prin1 '(sbcl-librarian:update) sbclrc) - (format sbclrc "~%"))) - (update core-path)) + (format sbclrc "~%")))) + +(defun backup-core (core &optional (backup #P".core.bak")) + (let ((backup (merge-pathnames backup core))) + (copy-file core backup (* 1024 1024)))) + +(defun install (&optional (sbclrc *sbclrc-path*) (core *core-path*)) + (if (not (installedp sbclrc)) + (write-to-init-file sbclrc core)) + (backup-core core) + (update core))