Commit 65621197 authored by Christophe Rhodes's avatar Christophe Rhodes
Browse files

Slightly better SBCL_HOME treatement for SBCL.

parent 3bc52526
Loading
Loading
Loading
Loading
+17 −14
Original line number Original line Diff line number Diff line
;;; This is asdf: Another System Definition Facility.  $Revision: 1.101 $
;;; This is asdf: Another System Definition Facility.  $Revision: 1.102 $
;;;
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>.  But note first that the canonical
;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -112,7 +112,7 @@


(in-package #:asdf)
(in-package #:asdf)


(defvar *asdf-revision* (let* ((v "$Revision: 1.101 $")
(defvar *asdf-revision* (let* ((v "$Revision: 1.102 $")
			       (colon (or (position #\: v) -1))
			       (colon (or (position #\: v) -1))
			       (dot (position #\. v)))
			       (dot (position #\. v)))
			  (and v colon dot 
			  (and v colon dot 
@@ -1190,8 +1190,10 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
	  t))))
	  t))))


  (defun contrib-sysdef-search (system)
  (defun contrib-sysdef-search (system)
    (let ((home (sb-ext:posix-getenv "SBCL_HOME")))
      (when home
        (let* ((name (coerce-name system))
        (let* ((name (coerce-name system))
           (home (truename (sb-ext:posix-getenv "SBCL_HOME")))
               (home (truename home))
               (contrib (merge-pathnames
               (contrib (merge-pathnames
                         (make-pathname :directory `(:relative ,name)
                         (make-pathname :directory `(:relative ,name)
                                        :name name
                                        :name name
@@ -1199,11 +1201,12 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
                                        :case :local
                                        :case :local
                                        :version :newest)
                                        :version :newest)
                         home)))
                         home)))
      (probe-file contrib)))
          (probe-file contrib)))))
  
  
  (pushnew
  (pushnew
   '(merge-pathnames "site-systems/"
   '(let ((home (sb-ext:posix-getenv "SBCL_HOME")))
     (truename (sb-ext:posix-getenv "SBCL_HOME")))
      (when home
        (merge-pathnames "site-systems/" (truename home))))
   *central-registry*)
   *central-registry*)
  
  
  (pushnew
  (pushnew