Add :pre-file option everywhere, add :qlmapper to *features*.

qlmapper.lisp

@@ -6,6 +6,9 @@
 
 (defvar *sbcl-program* sb-ext:*runtime-pathname*)
 
+(defun native-truename (file)
+  (native-namestring (truename file)))
+
 (defun eval-defvar-forms (environment-pairs)
   (loop for (name value) on environment-pairs by #'cddr
         for sym = (format nil "cl-user::~A" name)
@@ -21,24 +24,27 @@
 (defun flatlist (&rest args)
   (alexandria:flatten args))
 
-(defun run-sbcl (&key file environment-pairs evals)
-  (run-program (native-namestring (pathname *sbcl-program*))
+(defun run-sbcl (&key file pre-file environment-pairs evals)
+  (run-program (native-truename *sbcl-program*)
                (flatlist "--noinform"
                          "--non-interactive"
                          "--no-userinit"
                          "--no-sysinit"
-                         "--load" (native-namestring
+                         "--load" (native-truename
                                    (ql-setup:qmerge "setup.lisp"))
                          (eval-defvar-forms environment-pairs)
                          "--eval"
+                         "(push :qlmapper cl:*features*)"
+                         "--eval"
                          (format nil  "(setf cl:*default-pathname-defaults* ~
                                        #p~S)"
-                                 (native-namestring *default-pathname-defaults*))
+                                 (native-truename *default-pathname-defaults*))
+                         (when pre-file
+                           (list "--load" (native-truename pre-file)))
                          (mapcar (lambda (eval)
                                    (list "--eval" eval))
                                  evals)
-                        "--load" (native-namestring
-                                   (truename file)))
+                        "--load" (native-truename file))
                :environment (append (environment-list environment-pairs)
                                     (sb-ext:posix-environ))
                :output *standard-output*))
@@ -51,7 +57,7 @@
     (base-directory (ql-dist:release system))))
 
 (defun map-objects (file
-                    &key dist-name function (filter 'identity) evals)
+                    &key dist-name function (filter 'identity) evals pre-file)
   (unless (probe-file file)
     (error "~S does not exist" file))
   (let ((dist (ql-dist:find-dist dist-name)))
@@ -65,33 +71,41 @@
             (let ((*default-pathname-defaults*
                    (base-directory object)))
               (run-sbcl :file file
+                        :pre-file pre-file
                         :environment-pairs (list "*qlmapper-object-name*"
                                                  name)
                         :evals evals))))))))
 
-(defun map-releases (file &key (dist-name "quicklisp") (filter 'identity))
+(defun map-releases (file &key (dist-name "quicklisp") (filter 'identity)
+                     pre-file)
   "For each release in a dist (defaults to the \"quicklisp\" dist),
   start an independent SBCL process and load FILE with the variable
   CL-USER:*QLMAPPER-OBJECT-NAME* bound to the release's name."
   (map-objects file
+               :pre-file pre-file
                :dist-name dist-name
                :function #'ql-dist:provided-releases
                :filter filter))
 
-(defun map-systems (file &key (dist-name "quicklisp") (filter 'identity))
+(defun map-systems (file &key (dist-name "quicklisp") (filter 'identity)
+                    pre-file)
   "For each system in a dist (defaults to the \"quicklisp\" dist),
   start an independent SBCL process and load FILE with the variable
   CL-USER:*QLMAPPER-OBJECT-NAME* bound to the system's name."
   (map-objects file
+               :pre-file pre-file
                :dist-name dist-name
                :function #'ql-dist:provided-systems
                :filter filter))
 
-(defun map-loaded-systems (file &key (dist-name "quicklisp") (filter 'identity))
+(defun map-loaded-systems (file &key (dist-name "quicklisp") (filter 'identity)
+                           pre-file)
   "For each system in a dist (defaults to the \"quicklisp\" dist),
   start an independent SBCL process and load FILE with the variable
-  CL-USER:*QLMAPPER-OBJECT-NAME* bound to the system's name."
+  CL-USER:*QLMAPPER-OBJECT-NAME* bound to the system's name and the
+  given system loaded."
   (map-objects file
+               :pre-file pre-file
                :dist-name dist-name
                :function #'ql-dist:provided-systems
                :filter filter