ian/dotfiles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sbcl stuff

Browse source
This commit is contained in:
Ian Keane 2020-01-20 14:13:08 -05:00
parent 1d1dbc34df
commit 5d91dbb667
335 changed files with 119806 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

106
sbcl/.quicklisp/quicklisp/client-update.lisp Normal file
View file

@ -0,0 +1,106 @@
;;;; client-update.lisp
(in-package #:quicklisp-client)
(defun fetch-client-file-info (client-file-info output-file)
(maybe-fetch-gzipped (file-url client-file-info) output-file)
(check-client-file output-file client-file-info)
(probe-file output-file))
(defun retirement-directory (base)
(let ((suffix 0))
(loop
(incf suffix)
(let* ((try (format nil "~A-~D" base suffix))
(dir (qmerge (make-pathname :directory
(list :relative "retired" try)))))
(unless (probe-directory dir)
(return dir))))))
(defun retire (directory base)
(let ((retirement-home (qmerge "retired/"))
(from (truename directory)))
(ensure-directories-exist retirement-home)
(let* ((*default-pathname-defaults* retirement-home)
(to (retirement-directory base)))
(rename-directory from to)
to)))
(defun client-update-scratch-directory (client-info)
(qmerge (make-pathname :directory
(list :relative
"tmp"
"client-update"
(version client-info)))))
(defun %install-client (new-info local-info)
(let* ((work-directory (client-update-scratch-directory new-info))
(current-quicklisp-directory (qmerge "quicklisp/"))
(new-quicklisp-directory
(merge-pathnames "quicklisp/" work-directory))
(local-temp-tar (merge-pathnames "quicklisp.tar" work-directory))
(local-setup (merge-pathnames "setup.lisp" work-directory))
(local-asdf (merge-pathnames "asdf.lisp" work-directory))
(new-client-tar-p (not (info-equal (client-tar-info new-info)
(client-tar-info local-info))))
(new-setup-p (not (info-equal (setup-info new-info)
(setup-info local-info))))
(new-asdf-p (not (info-equal (asdf-info new-info)
(asdf-info local-info)))))
(ensure-directories-exist work-directory)
;; Fetch and unpack quicklisp.tar if needed
(when new-client-tar-p
(fetch-client-file-info (client-tar-info new-info) local-temp-tar)
(unpack-tarball local-temp-tar :directory work-directory))
;; Fetch setup.lisp if needed
(when new-setup-p
(fetch-client-file-info (setup-info new-info) local-setup))
;; Fetch asdf.lisp if needed
(when new-asdf-p
(fetch-client-file-info (asdf-info new-info) local-asdf))
;; Everything fetched, so move the old stuff away and move the new
;; stuff in
(when new-client-tar-p
(retire (qmerge "quicklisp/")
(format nil "quicklisp-~A"
(version local-info)))
(rename-directory new-quicklisp-directory current-quicklisp-directory))
(when new-setup-p
(replace-file local-setup (qmerge "setup.lisp")))
(when new-asdf-p
(replace-file local-asdf (qmerge "asdf.lisp")))
;; But unconditionally move the new client-info into place
(replace-file (source-file new-info) (qmerge "client-info.sexp"))
new-info))
(defun update-client (&key (prompt t))
(let* ((local-info (local-client-info))
(newest-info (newest-client-info local-info)))
(cond ((null newest-info)
(format t "No client update available.~%"))
((client-version-lessp local-info newest-info)
(format t "Updating client from version ~A to version ~A.~%"
(version local-info)
(version newest-info))
(when (or (not prompt)
(press-enter-to-continue))
(%install-client newest-info local-info)
(format t "~&New Quicklisp client installed. ~
It will take effect on restart.~%")))
(t
(format t "The most up-to-date client, version ~A, ~
is already installed.~%"
(version local-info)))))
t)
(defun install-client (&key url version)
(unless (or url version)
(error "One of ~S or ~S is required" :url :version))
(when (and url version)
(error "Only one of ~S or ~S is allowed" :url :version))
(when version
(setf url (client-info-url-from-version version)))
(let ((local-info (local-client-info))
(new-info (fetch-client-info url)))
(%install-client new-info local-info)))