dev/load-glu.lisp

   1 (in-package :COMMON-LISP-USER)
   2
   3 ;;; ---------------------------------------------------------------------------
   4
   5 #-EKSL-GENERIC-LOAD-UTILS
   6 (let (#+MCL (*warn-if-redefine* nil))
   7   (defun current-load-pathname ()
   8     #+lucid lcl:*source-pathname*
   9     #+allegro excl:*source-pathname*
  10     #+(or Genera Explorer) sys:fdefine-file-pathname
  11     #+MCL (if *load-truename*
  12             *load-truename*
  13             ;; This makes it work in a fred buffer...
  14             *loading-file-source-file*)
  15     #-(or lucid allegro Genera Explorer MCL)
  16     *load-truename*)
  17
  18   ;;; ---------------------------------------------------------------------------
  19
  20   (setf (logical-pathname-translations "GLU")
  21         (list (list "GLU:ROOT;**;*.*.*"
  22                     (directory-namestring
  23                      (make-pathname
  24                       :directory (append
  25                                   (pathname-directory (current-load-pathname))
  26                                   (list :wild-inferiors)))))))
  27
  28   ;;; ---------------------------------------------------------------------------
  29
  30   (defun eksl-load-if-exists (filespec &rest args &key (verbose t) &allow-other-keys)
  31     (when (and filespec (probe-file filespec))
  32       (apply #'load filespec :verbose verbose args)
  33       (values t)))
  34
  35   ;;; ---------------------------------------------------------------------------
  36
  37   (defun load-sibling (name &rest args &key (verbose t) &allow-other-keys)
  38     "Load the file named 'name' that lives in the same folder as THIS file."
  39     (apply #'eksl-load-if-exists
  40            (merge-pathnames name (current-load-pathname))
  41            :verbose verbose
  42            args))
  43
  44   ;;; ---------------------------------------------------------------------------
  45
  46   (defun canonical-glu-file ()
  47     (let ((current-directory (and (current-load-pathname)
  48                                   (pathname-directory (current-load-pathname)))))
  49       (when current-directory
  50         (make-pathname
  51          :directory (append
  52                      (butlast current-directory 2)
  53                      (list "GENERIC-LOAD-UTILITIES" "DEV"))
  54          :name "generic-load-utils"
  55          :type "lisp"))))
  56
  57   ;;; ---------------------------------------------------------------------------
  58
  59   (defun load-in-canonical-place ()
  60     (eksl-load-if-exists (canonical-glu-file)))
  61
  62
  63   ;;; ---------------------------------------------------------------------------
  64
  65   (defun load-glu ()
  66     "Attempt to load generic-load-utilities.lisp"
  67     (or
  68      ;; Try the 'canonical' one
  69      (load-in-canonical-place)
  70      ;; try right here
  71      (load-sibling "generic-load-utils")
  72      ;; give up
  73      (warn "Unable to load generic-load-utilities. Please load it by hand before attempting to load or compile an EKSL load system.")))
  74
  75
  76   ;;; ---------------------------------------------------------------------------
  77   ;;; try to load generic utilities
  78   ;;; ---------------------------------------------------------------------------
  79
  80   (load-glu))
  81
  82 ;;; ***************************************************************************
  83 ;;; *                              End of File                                *
  84 ;;; ***************************************************************************