-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: set-cl-library.cl
-;;;; Purpose: Sets CL-LIBRARY logical host name if it does not exist
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: May 2002
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-;; Set logical pathname CL-LIBRARY to be directory above *load-truename*
-;; This mirrors the expectation of Common Lisp Controller's pathnames
-
-(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))))
- (: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))
- (let ((*print-circle* nil))
- (error "cl-library:~A; directory ~S does not equal *load-truename*'s directory ~S"
- base-dir (cdr dir)
- (cdr (pathname-directory logical-dir))))))))