set-cl-library.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          set-cl-library.cl
   6 ;;;; Purpose:       Sets CL-LIBRARY logical host name if it does not exist
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  May 2002
   9 ;;;;
  10 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; *************************************************************************
  16
  17 ;; Set logical pathname CL-LIBRARY to be directory above *load-truename*
  18 ;; This mirrors the expectation of Common Lisp Controller's pathnames
  19
  20 (handler-case
  21     (logical-pathname-translations "CL-LIBRARY")
  22   (error ()
  23     (let* ((dir (pathname-directory *load-truename*))
  24            (parent-dir (subseq dir 0 (1- (length dir)))))
  25       (load (make-pathname :name "set-logical" :type "cl"
  26                            :defaults *load-truename*))
  27       (set-logical-host-for-pathname
  28        "CL-LIBRARY"
  29        (make-pathname :host (pathname-host *load-truename*)
  30                       :device (pathname-device *load-truename*)
  31                       :directory parent-dir)))))