;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: clsql.system,v 1.9 2002/05/13 00:45:10 kevin Exp $
+;;;; $Id: clsql.system,v 1.10 2002/05/13 00:57:42 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :cl-user)
-(handler-case
- (logical-pathname-translations "CL-LIBRARY")
- (error ()
- (load (make-pathname :name "set-cl-library" :type "cl"
- :defaults *load-truename*))))
+(load (make-pathname :name "set-cl-library" :type "cl"
+ :defaults *load-truename*))
;;; System definitions
(handler-case
(logical-pathname-translations "CL-LIBRARY")
(error ()
- (let* ((dir (pathname-directory *load-truename*))
- (parent-dir (subseq dir 0 (1- (length dir)))))
- (load (make-pathname :name "set-logical" :type "cl"
- :defaults *load-truename*))
- (set-logical-host-for-pathname
- "CL-LIBRARY"
- (make-pathname :host (pathname-host *load-truename*)
- :device (pathname-device *load-truename*)
- :directory parent-dir)))))
+ (let* ((dir (pathname-directory *load-truename*))
+ (parent-dir (subseq dir 0 (1- (length dir)))))
+ (load (make-pathname :name "set-logical" :type "cl"
+ :defaults *load-truename*))
+ (set-logical-host-for-pathname
+ "CL-LIBRARY"
+ (make-pathname :host (pathname-host *load-truename*)
+ :device (pathname-device *load-truename*)
+ :directory parent-dir))))
+ (:no-error (translation)
+ ;; Make sure that CL-LIBRARY points to this installation
+ (let* ((dir (pathname-directory *load-truename*))
+ (base-dir (car (last dir)))
+ (logical-dir (translate-logical-pathname
+ (concatenate 'string
+ "CL-LIBRARY:" base-dir ";"))))
+ (unless (equalp dir (pathname-directory logical-dir))
+ (error
+ (format nil "~S does not equal ~S"
+ dir (pathname-directory logical-dir)))))))
+
+
+ ))