New script for automatically loading sandboxed projects.
Wed May 20 13:49:48 PDT 2009 Maciej Pasternacki <maciej@pasternacki.net>
* New script for automatically loading sandboxed projects.
diff -rN -u old-cl-librarian/scripts/load-sandbox.lisp new-cl-librarian/scripts/load-sandbox.lisp
--- old-cl-librarian/scripts/load-sandbox.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-cl-librarian/scripts/load-sandbox.lisp 2014-08-01 08:56:40.000000000 -0700
@@ -0,0 +1,45 @@
+;;; -*- lisp -*-
+
+(defpackage #:cl-librarian.sandbox-loader
+ (:use #:common-lisp)
+ (:export #:*cl-librarian-root* #:*sandbox-root* #:*shelve-pathnames* #:*shelves*))
+(in-package #:cl-librarian.sandbox-loader)
+
+;;; load ASDF first
+(unless (find-package :asdf)
+ (require 'asdf))
+
+;;; figure out CL-Librarian's and sandbox' directories
+(defvar *cl-librarian-root*)
+(defvar *sandbox-root*)
+(defvar *shelve-pathnames*)
+
+(unless (boundp '+up+)
+ (defconstant +up+
+ (make-pathname :directory '(:relative :up))))
+
+(setf *cl-librarian-root*
+ (truename (merge-pathnames +up+
+ (make-pathname :defaults *load-truename*
+ :name nil :type nil :version nil))))
+(loop
+ for path = *cl-librarian-root* then (merge-pathnames +up+ path)
+ for shelves = (directory
+ (merge-pathnames (make-pathname :name :wild :type "shelf")
+ path))
+ until shelves
+ finally (setf *sandbox-root* path
+ *shelve-pathnames* shelves))
+
+;;; load CL-Librarian
+(pushnew *cl-librarian-root* asdf:*central-registry*)
+(asdf:operate 'asdf:load-op :cl-librarian)
+
+;;; init shelves
+(defvar *shelves*)
+(setf *shelves* (mapcar #'cl-librarian:use-shelf *shelve-pathnames*))
+
+;;; load shelves
+(pushnew *sandbox-root* asdf:*central-registry*)
+(loop for shelf in *shelves*
+ do (cl-librarian:load-shelf shelf))