changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > demo / tools/prepare-image.lisp

revision 39: 1ef551e24009
parent 31: 77da08c7f445
     1.1--- a/tools/prepare-image.lisp	Fri Dec 29 00:45:44 2023 -0500
     1.2+++ b/tools/prepare-image.lisp	Thu Apr 11 18:58:35 2024 -0400
     1.3@@ -1,59 +1,20 @@
     1.4 (in-package :cl-user)
     1.5 
     1.6-;; For SBCL, if you don't have SBCL_HOME set, then we won't be able to require this later.
     1.7-#+sbcl
     1.8-(require 'sb-introspect)
     1.9-#-sbcl
    1.10-(require "asdf")
    1.11-
    1.12-#+sbcl
    1.13-(require "sb-sprof")
    1.14-
    1.15-(defvar *cwd* (uiop:getcwd))
    1.16-
    1.17-(defun update-output-translations (root)
    1.18-  (asdf:initialize-output-translations
    1.19-   `(:output-translations
    1.20-     :inherit-configuration
    1.21-     (,(namestring root)
    1.22-      ,(format nil "~abuild/asdf-cache/~a/" root
    1.23-               (uiop:implementation-identifier))))))
    1.24-
    1.25-(update-output-translations *cwd*)
    1.26-
    1.27-#+sbcl
    1.28-(progn
    1.29-  (require :sb-rotate-byte)
    1.30-  (require :sb-cltl2)
    1.31-  (asdf:register-preloaded-system :sb-rotate-byte)
    1.32-  (asdf:register-preloaded-system :sb-cltl2))
    1.33+(require :sb-introspect)
    1.34+(require :asdf)
    1.35+(require :sb-sprof)
    1.36+(require :sb-rotate-byte)
    1.37+(require :sb-cltl2)
    1.38+(asdf:register-preloaded-system :sb-rotate-byte)
    1.39+(asdf:register-preloaded-system :sb-cltl2)
    1.40+(asdf:register-preloaded-system :std)
    1.41+(asdf:register-preloaded-system :log)
    1.42 
    1.43 (ql:update-all-dists :prompt nil)
    1.44 
    1.45-;; is the package name already loaded as a feature? uhh look it up
    1.46 (pushnew :demo *features*)
    1.47 
    1.48-(defun update-project-directories (cwd)
    1.49-  (flet ((push-src-dir (name)
    1.50-           (let ((dir (pathname (format nil "~a~a/" cwd name))))
    1.51-             (when (probe-file dir)
    1.52-               (push dir ql:*local-project-directories*)))))
    1.53-    #-demo
    1.54-    (push-src-dir ".")
    1.55-    (push-src-dir "vendor")))
    1.56-
    1.57-(update-project-directories *cwd*)
    1.58+(ql:quickload :prelude)
    1.59+(ql:register-local-projects)
    1.60+(log:info! "*local-project-directories:" ql:*local-project-directories*)
    1.61 
    1.62-(defun maybe-configure-proxy ()
    1.63-  (let ((proxy (uiop:getenv "HTTP_PROXY")))
    1.64-    (when (and proxy (> (length proxy) 0))
    1.65-      (setf ql:*proxy-url* proxy))))
    1.66-
    1.67-(maybe-configure-proxy)
    1.68-
    1.69-(ql:quickload "log4cl")
    1.70-(ql:quickload "prove-asdf")
    1.71-
    1.72-(log:info "*local-project-directories: ~S" ql:*local-project-directories*)
    1.73-
    1.74-(ql:register-local-projects)