Mercurial > demo / tools/prepare-image.lisp
changeset 30: |
aa37feddcfb2 |
parent: |
2015d7277629
|
child: |
77da08c7f445 |
author: |
ellis <ellis@rwest.io> |
date: |
Thu, 15 Jun 2023 22:01:40 -0400 |
permissions: |
-rw-r--r-- |
description: |
tweaks |
3 ;; For SBCL, if you don't have SBCL_HOME set, then we won't be able to require this later. 5 (require 'sb-introspect) 7 (when (probe-file "tools/asdf.lisp") 8 (format t "Compiling asdf..~%") 9 (let ((output (compile-file "tools/asdf.lisp" :verbose nil :print nil))) 19 (push (pathname (format nil "~a/local-projects/poiu/" (namestring (uiop:getcwd)))) 20 asdf:*central-registry*) 22 (defvar *asdf-root-guesser* nil) 24 (defparameter *cwd* (merge-pathnames 25 *default-pathname-defaults* 28 (defun update-output-translations (root) 29 "This function is called dynamically from deliver-utils/common.lisp!" 30 (asdf:initialize-output-translations 31 `(:output-translations 32 :inherit-configuration 34 ,(format nil "~abuild/asdf-cache/~a/" root 35 (uiop:implementation-identifier)))))) 37 (update-output-translations *cwd*) 41 (require :sb-rotate-byte) 43 (asdf:register-preloaded-system :sb-rotate-byte) 44 (asdf:register-preloaded-system :sb-cltl2)) 46 (defun %read-version (file) 47 (let ((key "version: ")) 48 (loop for line in (uiop:read-file-lines file) 49 if (string= key line :end2 (length key)) 50 return (subseq line (length key))))) 52 (defun init-quicklisp () 53 (let ((version (%read-version "quicklisp/dists/quicklisp/distinfo.txt"))) 54 (let ((quicklisp-loc (ensure-directories-exist 56 (format nil "build/quicklisp/~a/" version) 61 (flet ((safe-copy-file (path &optional (dest path)) 62 (let ((src (merge-pathnames 65 (dest (merge-pathnames 68 (format t "Copying: ~a to ~a~%" src dest) 70 (when (equal src dest) 71 (error "Trying to overwrite the same file")) 72 (unless (uiop:file-exists-p dest) 75 (ensure-directories-exist 80 "quicklisp/quicklisp/*.lisp" 84 "quicklisp/quicklisp/*.asd" 86 do (safe-copy-file name 87 (format nil "quicklisp/~a.~a" 89 (pathname-type name)))) 90 (loop for name in (directory 94 do (safe-copy-file name 96 (pathname-name name)))) 97 (safe-copy-file "setup.lisp") 98 (safe-copy-file "quicklisp/version.txt") 99 (safe-copy-file "dists/quicklisp/distinfo.txt") 100 (safe-copy-file "dists/quicklisp/enabled.txt") 101 (safe-copy-file "dists/quicklisp/preference.txt")) 102 (load (merge-pathnames 109 (ql:update-all-dists :prompt nil) 111 ;; is the package name already loaded as a feature? uhh look it up 112 (pushnew :demo *features*) 114 (defun update-project-directories (cwd) 115 (flet ((push-src-dir (name) 116 (let ((dir (pathname (format nil "~a~a/" cwd name)))) 117 (when (probe-file dir) 118 (push dir ql:*local-project-directories*))))) 120 (push-src-dir "local-projects") 122 (push-src-dir "third-party") 123 (push-src-dir "lisp"))) 126 (defun update-root (cwd) 127 (update-output-translations cwd) 128 (update-project-directories cwd)) 130 (update-project-directories *cwd*) 132 (defun maybe-asdf-prepare () 133 (when *asdf-root-guesser* 134 (update-root (funcall *asdf-root-guesser*)))) 136 (compile 'maybe-asdf-prepare) 138 (defun unprepare-asdf (root-guesser) 139 "This function is called dynamically from deliver-utils/common.lisp!" 140 (setf *asdf-root-guesser* root-guesser)) 142 (defun maybe-configure-proxy () 143 (let ((proxy (uiop:getenv "HTTP_PROXY"))) 144 (when (and proxy (> (length proxy) 0)) 145 (setf ql:*proxy-url* proxy)))) 147 (maybe-configure-proxy) 150 (ql:quickload "log4cl") 151 (ql:quickload "prove-asdf") 153 (log:info "*local-project-directories: ~S" ql:*local-project-directories*) 155 ;; (ql:quickload :cl-ppcre) 156 ;; make sure we have build asd 158 (push (pathname (format nil "~a/build-utils/" *cwd*)) 159 asdf:*central-registry*) 160 (ql:register-local-projects)