Changeset 13732


Ignore:
Timestamp:
01/09/12 10:58:11 (10 years ago)
Author:
Mark Evenson
Message:

backport r13730: make logic for finding abcl-contrib more robust.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.0.x/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

    r13303 r13732  
    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 (equal (pathname-name p) "abcl")
    12              (equal (pathname-type p) "jar")))
    13         (rest loader))))
    14       (when abcl-jar
    15   (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))))))
    1620
    1721(defvar *abcl-jar* nil
     
    2327Initialized via SYSTEM:FIND-CONTRIB")
    2428
    25 (defun find-contrib (&optional (verbose nil))
     29(defun find-contrib (&key (verbose nil))
    2630"Attempt to find the ABCL contrib jar and add its contents to ASDF."
    2731  (unless *abcl-contrib*
     
    2933      (setf *abcl-jar* (find-system-jar)))
    3034    (when *abcl-jar*
    31       (let ((abcl-contrib (make-pathname :defaults *abcl-jar*
    32            :name "abcl-contrib")))
    33   (when (probe-file abcl-contrib)
    34     (setf *abcl-contrib* abcl-contrib)
    35     (dolist (asdf-file
    36         (directory (make-pathname :device (list *abcl-contrib*)
    37                 :directory '(:absolute :wild)
    38                 :name :wild
    39                 :type "asd")))
    40       (let ((asdf-directory
    41        (make-pathname :defaults asdf-file :name nil :type nil)))
    42         (when verbose
    43     (format t "Adding ~A to ASDF.~%" asdf-directory))
    44         (push asdf-directory asdf:*central-registry*)))
    45     *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))))))
    4654
    47 (when (find-contrib)
     55
     56(when (find-contrib :verbose t)
    4857  (provide :abcl-contrib))
     58
     59
     60
     61
    4962
    5063
Note: See TracChangeset for help on using the changeset viewer.