Ignore:
Timestamp:
01/25/14 12:09:48 (7 years ago)
Author:
Mark Evenson
Message:

Find abcl-contrib even if not running from abcl.jar.

The java.lang.ClassLoader? of the org.lisp.armedbear.Main class is used
to find a place to guess at where `abcl-contrib.jar' may be located.

TODO: load from http location.

TODO: find abcl-contrib-m.n.p[-extra-stuff.jar as well.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

    r14335 r14610  
    33(require :asdf)
    44
     5(defconstant +get-classloader+ (java:jmethod "java.lang.Class" "getClassLoader"))
     6(defun boot-classloader ()
     7  (let ((boot-class (java:jclass "org.armedbear.lisp.Main")))
     8  (java:jcall +get-classloader+ boot-class)))
     9
    510(defun system-jar-p (p)
     11  (named-jar-p "abcl" p))
     12
     13(defun contrib-jar-p (p)
     14  (named-jar-p "abcl-contrib" p))
     15
     16(defun named-jar-p (name p)
    617  (and (pathnamep p)
    718       (equal (pathname-type p) "jar")
    8        (let ((name (pathname-name p)))
    9          (or
    10           (java:jstatic "matches"
    11                         "java.util.regex.Pattern"
    12                         "abcl(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?"
    13                         name)
    14           (java:jstatic "matches"
    15                         "java.util.regex.Pattern"
    16                         "abcl(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?"
    17                         name)))
    18        p))
     19     (or
     20    (java:jstatic "matches"
     21            "java.util.regex.Pattern"
     22            (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?")
     23            (pathname-name p))
     24    (java:jstatic "matches"
     25            "java.util.regex.Pattern"
     26            (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?")
     27            (pathname-name p)))
     28     (make-pathname :defaults p :name name)))
     29
     30(defun find-system ()
     31  "Find the location of the system. 
     32
     33Used to determine relative pathname to find 'abcl-contrib.jar'."
     34  (or
     35   (ignore-errors
     36   (find-system-jar))
     37   (ignore-errors
     38   (some
     39    (lambda (u)
     40    (probe-file (make-pathname
     41           :defaults  (java:jcall "toString" u)
     42           :name "abcl")))
     43    (java:jcall "getURLs" (boot-classloader))))
     44   (ignore-errors
     45   #p"http://abcl.org/releases/current/abcl.jar")))
    1946
    2047(defun find-system-jar ()
     
    2552          (return abcl-jar)))))
    2653
    27 (defvar *abcl-jar* nil
    28   "Pathname of the jar that ABCL was loaded from.
    29 Initialized via SYSTEM::FIND-SYSTEM-JAR.")
    30 
    3154(defvar *abcl-contrib* nil
    3255  "Pathname of the ABCL contrib.
    3356Initialized via SYSTEM:FIND-CONTRIB")
    3457
     58(defparameter *verbose* t)
     59
     60(defun add-contrib (abcl-contrib-jar)
     61  "Introspects ABCL-CONTRIB-JAR for asdf systems to add to ASDF:*CENTRAL-REGISTRY*"
     62  (when abcl-contrib-jar
     63  (dolist (asdf-file
     64        (directory (make-pathname :device (list abcl-contrib-jar)
     65                    :directory '(:absolute :wild)
     66                    :name :wild
     67                    :type "asd")))
     68    (let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
     69    (unless (find asdf-directory asdf:*central-registry* :test #'equal)
     70      (push asdf-directory asdf:*central-registry*)
     71      (format *verbose* "~&Added ~A to ASDF.~&" asdf-directory))))))
     72
     73
    3574(defun find-and-add-contrib (&key (verbose nil))
    3675  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
    3776Returns the pathname of the contrib if it can be found."
    38   (flet ((add-contrib (abcl-contrib)
    39               (setf *abcl-contrib* abcl-contrib)
    40               (dolist (asdf-file
    41                         (directory (make-pathname :device (list *abcl-contrib*)
    42                                                   :directory '(:absolute :wild)
    43                                                   :name :wild
    44                                                   :type "asd")))
    45                 (let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
    46                   (unless (find asdf-directory asdf:*central-registry* :test #'equal)
    47                     (push asdf-directory asdf:*central-registry*)
    48                     (format verbose "~&Added ~A to ASDF.~&" asdf-directory))))
    49               *abcl-contrib*))
    50     (unless *abcl-contrib*
    51       (unless *abcl-jar*
    52         (setf *abcl-jar* (find-system-jar)))
    53       (when *abcl-jar*
    54         (let* ((abcl-contrib-name
    55                 (concatenate 'string "abcl-contrib"
    56                              (subseq (pathname-name *abcl-jar*) 4)))
    57                (abcl-contrib (make-pathname :defaults *abcl-jar*
    58                                             :name abcl-contrib-name)))
    59           (if (probe-file abcl-contrib)
    60               (add-contrib abcl-contrib)
    61               (let ((abcl-contrib  (make-pathname :defaults abcl-contrib
    62                                                   :name "abcl-contrib")))
    63                 (if (probe-file abcl-contrib)
    64                     (progn 
    65                       (warn "Falling back to using '~A' to satisfy require." abcl-contrib)
    66                       (add-contrib abcl-contrib)
    67                       (error "Failed to find abcl-contrib at '~A'." abcl-contrib))))))))))
     77  (if *abcl-contrib*
     78    (format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%"
     79        *abcl-contrib*)
     80    (progn
     81    (setf *abcl-contrib* (find-contrib))
     82    (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%"
     83        *abcl-contrib*)))
     84  (add-contrib *abcl-contrib*))
    6885
     86(defun find-contrib ()
     87  "Introspect runtime classpaths to find a loadable ABCL-CONTRIB."
     88  (or
     89   (ignore-errors (when (find-system-jar)
     90          (probe-file
     91           (make-pathname :defaults (find-system-jar)
     92                  :name "abcl-contrib"))))
     93   (some
     94  (lambda (u)
     95    (probe-file (make-pathname
     96           :defaults  (java:jcall "toString" u)
     97           :name "abcl-contrib")))
     98  (java:jcall "getURLs" (boot-classloader)))))
     99
     100(export `(find-system
     101      find-contrib
     102      *abcl-contrib*))
    69103(when (find-and-add-contrib :verbose t)
    70104  (provide :abcl-contrib))
Note: See TracChangeset for help on using the changeset viewer.