set-logical.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          set-logical.cl
   6 ;;;; Purpose:       Sets a logical host for src/binaries based on a pathname.
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; $Id: set-logical.cl,v 1.1 2002/03/11 18:00:57 kevin Exp $
  13 ;;;;
  14 ;;;; This file is part of UFFI.
  15 ;;;;
  16 ;;;; UFFI is free software; you can redistribute it and/or modify
  17 ;;;; it under the terms of the GNU General Public License (version 2) as
  18 ;;;; published by the Free Software Foundation.
  19 ;;;;
  20 ;;;; UFFI is distributed in the hope that it will be useful,
  21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;;; GNU General Public License for more details.
  24 ;;;;
  25 ;;;; You should have received a copy of the GNU General Public License
  26 ;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
  27 ;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  28 ;;;; *************************************************************************
  29
  30
  31 ;;; Setup logical pathname translaton with separate binary directories
  32 ;;; for each implementation
  33
  34 ;; push allegro case sensitivity on *features*
  35 #+allegro
  36 (eval-when (:compile-toplevel :load-toplevel :execute)
  37   (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
  38           (eq excl:*current-case-mode* :case-sensitive-upper))
  39       (pushnew :case-sensitive cl:*features*)
  40     (pushnew :case-insensitive cl:*features*)))
  41
  42 (defconstant +set-logical-compiler-name+
  43     #+(and allegro ics case-sensitive) "acl-modern"
  44     #+(and allegro (not ics) case-sensitive) "acl-modern8"
  45     #+(and allegro ics (not case-sensitive)) "acl-ansi"
  46     #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
  47     #+lispworks "lispworks"
  48     #+clisp "clisp"
  49     #+cmu "cmucl"
  50     #+sbcl "sbcl"
  51     #+corman "corman"
  52     #+mcl "mcl"
  53     #-(or allegro lispworks clisp cmu sbcl corman mcl) "unknown")
  54
  55 (defun set-logical-host-for-pathname (host base-pathname)
  56   (setf (logical-pathname-translations host)
  57     `(("ROOT;" ,(make-pathname
  58                 :host (pathname-host base-pathname)
  59                 :device (pathname-device base-pathname)
  60                 :directory (pathname-directory base-pathname)))
  61       ("**;bin;*.*.*" ,(merge-pathnames
  62                         (make-pathname
  63                          :name :wild
  64                          :type :wild
  65                          :directory
  66                          (append '(:relative :wild-inferiors
  67                                    ".bin" #.+set-logical-compiler-name+)))
  68                         base-pathname))
  69       ("**;*.*.*" ,(merge-pathnames
  70                     (make-pathname
  71                      :name :wild
  72                      :type :wild
  73                      :directory '(:relative :wild-inferiors))
  74                     base-pathname))))
  75   )