changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > demo / tools/prepare-image.lisp

changeset 31: 77da08c7f445
parent: aa37feddcfb2
child: 1ef551e24009
author: ellis <ellis@rwest.io>
date: Sun, 18 Jun 2023 22:25:28 -0400
permissions: -rw-r--r--
description: bugfixes, tweaks to run.lisp 
     1 (in-package :cl-user)
     2 
     3 ;; For SBCL, if you don't have SBCL_HOME set, then we won't be able to require this later.
     4 #+sbcl
     5 (require 'sb-introspect)
     6 #-sbcl
     7 (require "asdf")
     8 
     9 #+sbcl
    10 (require "sb-sprof")
    11 
    12 (defvar *cwd* (uiop:getcwd))
    13 
    14 (defun update-output-translations (root)
    15   (asdf:initialize-output-translations
    16    `(:output-translations
    17      :inherit-configuration
    18      (,(namestring root)
    19       ,(format nil "~abuild/asdf-cache/~a/" root
    20                (uiop:implementation-identifier))))))
    21 
    22 (update-output-translations *cwd*)
    23 
    24 #+sbcl
    25 (progn
    26   (require :sb-rotate-byte)
    27   (require :sb-cltl2)
    28   (asdf:register-preloaded-system :sb-rotate-byte)
    29   (asdf:register-preloaded-system :sb-cltl2))
    30 
    31 (ql:update-all-dists :prompt nil)
    32 
    33 ;; is the package name already loaded as a feature? uhh look it up
    34 (pushnew :demo *features*)
    35 
    36 (defun update-project-directories (cwd)
    37   (flet ((push-src-dir (name)
    38            (let ((dir (pathname (format nil "~a~a/" cwd name))))
    39              (when (probe-file dir)
    40                (push dir ql:*local-project-directories*)))))
    41     #-demo
    42     (push-src-dir ".")
    43     (push-src-dir "vendor")))
    44 
    45 (update-project-directories *cwd*)
    46 
    47 (defun maybe-configure-proxy ()
    48   (let ((proxy (uiop:getenv "HTTP_PROXY")))
    49     (when (and proxy (> (length proxy) 0))
    50       (setf ql:*proxy-url* proxy))))
    51 
    52 (maybe-configure-proxy)
    53 
    54 (ql:quickload "log4cl")
    55 (ql:quickload "prove-asdf")
    56 
    57 (log:info "*local-project-directories: ~S" ql:*local-project-directories*)
    58 
    59 (ql:register-local-projects)