| 1 | (in-package :cl-user) |
|---|
| 2 | |
|---|
| 3 | (defpackage quicklisp-abcl |
|---|
| 4 | (:nicknames :quicklisp-abcl) |
|---|
| 5 | (:use :cl |
|---|
| 6 | :asdf) |
|---|
| 7 | (:export |
|---|
| 8 | #:quicklisp/boot/fasls |
|---|
| 9 | #:ensure-installation |
|---|
| 10 | #:*quicklisp-parent-dir*)) |
|---|
| 11 | |
|---|
| 12 | (in-package :quicklisp-abcl) |
|---|
| 13 | |
|---|
| 14 | ;;;; |
|---|
| 15 | ;;;; 1. (ABCL) Download setup.lisp if necessary from the network, |
|---|
| 16 | ;;;; running the Quicklisp setup routine |
|---|
| 17 | ;;;; |
|---|
| 18 | ;;;; 2. Ensure that we cache the and use the fasl for |
|---|
| 19 | ;;;; (merge-pathnames "setup.lisp" *quicklisp-parent-dir* |
|---|
| 20 | ;;;; |
|---|
| 21 | |
|---|
| 22 | (defvar *quicklisp-parent-dir* (user-homedir-pathname) |
|---|
| 23 | "Pathname reference to the parent directory of the local Quicklisp installation") |
|---|
| 24 | |
|---|
| 25 | (defun quicklisp/boot/fasls (&key (remove nil)) |
|---|
| 26 | "Enumerate all Quicklisp fasls, including the one we shim for the loader" |
|---|
| 27 | ;;; TODO: ensure that this works for other implementations |
|---|
| 28 | (let* ((setup-base |
|---|
| 29 | (merge-pathnames "quicklisp/setup" *quicklisp-parent-dir*)) |
|---|
| 30 | (setup-source |
|---|
| 31 | (make-pathname :defaults setup-base :type "lisp")) |
|---|
| 32 | (setup-fasl |
|---|
| 33 | (make-pathname :defaults setup-base :type "abcl")) |
|---|
| 34 | (asdf-output-root |
|---|
| 35 | (when (ignore-errors (asdf:find-system :quicklisp)) |
|---|
| 36 | (asdf:apply-output-translations |
|---|
| 37 | (asdf:system-source-directory (asdf:find-system :quicklisp)))))) |
|---|
| 38 | (let ((all-fasls (append (list setup-fasl) |
|---|
| 39 | (when asdf-output-root |
|---|
| 40 | (directory |
|---|
| 41 | (merge-pathnames "**/*" asdf-output-root)))))) |
|---|
| 42 | (when remove |
|---|
| 43 | (format *load-verbose* "~&;;quicklisp-abcl: deleting ~{~a ~}~%" all-fasls) |
|---|
| 44 | (mapcar #'delete-file all-fasls)) |
|---|
| 45 | (values all-fasls |
|---|
| 46 | setup-base setup-source setup-fasl)))) |
|---|
| 47 | |
|---|
| 48 | ;;; After we have loaded this system, ensure Quicklisp is loaded |
|---|
| 49 | (defun ensure-installation () |
|---|
| 50 | (when (find :quicklisp *features*) |
|---|
| 51 | (return-from ensure-installation)) |
|---|
| 52 | (multiple-value-bind (fasls |
|---|
| 53 | setup-base setup-source setup-fasl) |
|---|
| 54 | (quicklisp/boot/fasls) |
|---|
| 55 | (if (probe-file setup-source) |
|---|
| 56 | ;; First try loading the Quicklisp setup as a compiled fasl if it exists |
|---|
| 57 | (if (probe-file setup-fasl) |
|---|
| 58 | (handler-case |
|---|
| 59 | (load setup-fasl) |
|---|
| 60 | ;; The fasl may be invalid (i.e. between abcl versions); if so, load source, and recompile |
|---|
| 61 | (error (e) |
|---|
| 62 | (format *load-verbose* "~&Failed to load Quicklisp setup fasl ~%~t~a~%because:~%~t~a~%" setup-fasl e) |
|---|
| 63 | (when setup-source |
|---|
| 64 | (format *load-verbose* "Removing Quicklisp setup fasl and recompiling...") |
|---|
| 65 | (quicklisp/boot/fasls :remove t) |
|---|
| 66 | (load setup-source) |
|---|
| 67 | (compile-file setup-source :output-file setup-fasl)))) |
|---|
| 68 | ;; compilation only succeeds after Quicklisp has been fully loaded |
|---|
| 69 | (when (probe-file setup-source) |
|---|
| 70 | (load setup-source) |
|---|
| 71 | (compile-file setup-source :output-file setup-fasl))) |
|---|
| 72 | ;;; Otherwise download Quicklisp and run its installation sequence |
|---|
| 73 | (progn |
|---|
| 74 | (handler-case |
|---|
| 75 | (load "https://beta.quicklisp.org/quicklisp.lisp") |
|---|
| 76 | (error (e) |
|---|
| 77 | (warn "Using insecure transport for remote installation of Quicklisp:~&~A~&." e) |
|---|
| 78 | (load "http://beta.quicklisp.org/quicklisp.lisp"))) |
|---|
| 79 | (uiop:symbol-call :quicklisp-quickstart '#:install |
|---|
| 80 | :path (merge-pathnames "quicklisp/" |
|---|
| 81 | *quicklisp-parent-dir*)))))) |
|---|
| 82 | |
|---|
| 83 | |
|---|
