Ignore:
Timestamp:
01/09/12 10:53:45 (9 years ago)
Author:
Mark Evenson
Message:

Fix #177: make logic for finding abcl-contrib more robust.

Issuing a (REQUIRE 'ABCL-CONTRIB) will now use the full name of the
jar archive ABCL was loaded from if it is of the form `abcl.jar' or
abcl-x.y.z.jar or `abcl-x.y.z-some-arbitrary-string.jar' to
determine the location of the jar containing the ABCL-CONTRIB
packages. The namestrings of the ASDF systems located by this
mechanism are now printed to *STANDARD-OUTPUT*.

Installations of the implementations loading from non-standard
locations may use the SYS::*ABCL-JAR* and SYS:*ABCL-CONTRIB* specials
to override this behavior.

File:
1 edited

Legend:

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

    r13672 r13730  
    33(require :asdf)
    44
    5 ;;; XXX make less sensitive to ABCL jar being called "abcl.jar"
    6 ;;;     allow being called "abcl-x.y.z.jar for semantic versioning
    7 ;;;     allow customization in system.lisp
     5;;; TODO possibly allow customization in system.lisp?
    86(defun find-system-jar ()
    9   (dolist (loader (java:dump-classpath))
    10     (let ((abcl-jar
    11      (find-if (lambda (p) (and
    12                                  (or (equal (pathname-name p) "abcl")
    13                                      (equal (pathname-name p)
    14                                             (format nil "abcl-~A"
    15                                                     (lisp-implementation-version))))
    16              (equal (pathname-type p) "jar")))
    17         (rest loader))))
    18       (when abcl-jar
    19   (return abcl-jar)))))
     7  (flet ((match-system-jar (p)
     8           "Match `abcl.jar` or `abcl-1.0.1.jar` or `abcl-1.0.1-something.jar`"
     9           (and (pathnamep p)
     10                (equal (pathname-type p) "jar")
     11                (java:jstatic "matches"
     12                              "java.util.regex.Pattern"
     13                              "abcl(-[0-9]\\.[0-9]\\.[0-9](-.+)?)?"
     14                              (pathname-name p))
     15                p)))
     16    (dolist (loader (java:dump-classpath))
     17      (let ((abcl-jar (some #'match-system-jar loader)))
     18        (when abcl-jar
     19          (return abcl-jar))))))
    2020
    2121(defvar *abcl-jar* nil
     
    2727Initialized via SYSTEM:FIND-CONTRIB")
    2828
    29 (defun find-contrib (&optional (verbose nil))
     29(defun find-contrib (&key (verbose nil))
    3030"Attempt to find the ABCL contrib jar and add its contents to ASDF."
    3131  (unless *abcl-contrib*
     
    3333      (setf *abcl-jar* (find-system-jar)))
    3434    (when *abcl-jar*
    35       (let ((abcl-contrib (make-pathname :defaults *abcl-jar*
    36            :name "abcl-contrib")))
    37   (when (probe-file abcl-contrib)
    38     (setf *abcl-contrib* abcl-contrib)
    39     (dolist (asdf-file
    40         (directory (make-pathname :device (list *abcl-contrib*)
    41                 :directory '(:absolute :wild)
    42                 :name :wild
    43                 :type "asd")))
    44       (let ((asdf-directory
    45        (make-pathname :defaults asdf-file :name nil :type nil)))
    46         (when verbose
    47     (format t "Adding ~A to ASDF.~%" asdf-directory))
    48         (push asdf-directory asdf:*central-registry*)))
    49     *abcl-contrib*)))))
     35      (let* ((abcl-contrib-name
     36              (concatenate 'string "abcl-contrib"
     37                           (subseq (pathname-name *abcl-jar*) 4)))
     38             (abcl-contrib (make-pathname :defaults *abcl-jar*
     39                                          :name abcl-contrib-name)))
     40  (if (probe-file abcl-contrib)
     41            (progn
     42              (setf *abcl-contrib* abcl-contrib)
     43              (dolist (asdf-file
     44                        (directory (make-pathname :device (list *abcl-contrib*)
     45                                                  :directory '(:absolute :wild)
     46                                                  :name :wild
     47                                                  :type "asd")))
     48                (let ((asdf-directory
     49                       (make-pathname :defaults asdf-file :name nil :type nil)))
     50                  (format verbose "Adding ~A to ASDF.~%" asdf-directory)
     51                  (push asdf-directory asdf:*central-registry*)))
     52              *abcl-contrib*)
     53        (format verbose "Failed to find abcl-contrib at '~A'." abcl-contrib))))))
    5054
    51 (when (find-contrib)
     55
     56(when (find-contrib :verbose t)
    5257  (provide :abcl-contrib))
     58
     59
     60
     61
    5362
    5463
Note: See TracChangeset for help on using the changeset viewer.