source: branches/1.1.x/src/org/armedbear/lisp/abcl-contrib.lisp @ 14336

Last change on this file since 14336 was 14336, checked in by Mark Evenson, 8 years ago

backport r14335 | mevenson | 2012-12-18 22:54:37 +0100 (Tue, 18 Dec 2012) | 1 line

abcl-contrib: better logic for FIND-SYSTEM-JAR to deal with post patchlevel distinction.

File size: 3.0 KB
Line 
1(in-package :system)
2
3(require :asdf)
4
5(defun system-jar-p (p)
6  (and (pathnamep p)
7       (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
20(defun find-system-jar () 
21  "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`."
22    (dolist (loader (java:dump-classpath))
23      (let ((abcl-jar (some #'system-jar-p loader)))
24        (when abcl-jar
25          (return abcl-jar)))))
26
27(defvar *abcl-jar* nil
28  "Pathname of the jar that ABCL was loaded from.
29Initialized via SYSTEM::FIND-SYSTEM-JAR.")
30
31(defvar *abcl-contrib* nil
32  "Pathname of the ABCL contrib.
33Initialized via SYSTEM:FIND-CONTRIB")
34
35(defun find-and-add-contrib (&key (verbose nil))
36  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
37Returns 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))))))))))
68
69(when (find-and-add-contrib :verbose t)
70  (provide :abcl-contrib))
71
72
73
74
75
76
77
78       
79 
Note: See TracBrowser for help on using the repository browser.