source: trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp @ 13730

Last change on this file since 13730 was 13730, checked in by Mark Evenson, 11 years ago

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 size: 2.2 KB
Line 
1(in-package :system)
2
3(require :asdf)
4
5;;; TODO possibly allow customization in system.lisp?
6(defun find-system-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))))))
20
21(defvar *abcl-jar* nil
22  "Pathname of the jar that ABCL was loaded from.
23Initialized via SYSTEM::FIND-SYSTEM-JAR.")
24
25(defvar *abcl-contrib* nil
26  "Pathname of the ABCL contrib.
27Initialized via SYSTEM:FIND-CONTRIB")
28
29(defun find-contrib (&key (verbose nil))
30"Attempt to find the ABCL contrib jar and add its contents to ASDF."
31  (unless *abcl-contrib*
32    (unless *abcl-jar*
33      (setf *abcl-jar* (find-system-jar)))
34    (when *abcl-jar*
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))))))
54
55
56(when (find-contrib :verbose t)
57  (provide :abcl-contrib))
58
59
60
61
62
63
64
65       
66 
Note: See TracBrowser for help on using the repository browser.