abcl-contrib.lisp 3.71 KB
Newer Older
1
2
3
4
(in-package :system)

(require :asdf)

5
(defconstant +get-classloader+
6
7
  (java:jmethod "java.lang.Class" "getClassLoader"))

8
(defun boot-classloader ()
9
  (let ((boot-class (java:jclass "org.armedbear.lisp.Main")))
10
    (java:jcall +get-classloader+ boot-class)))
11

12
(defun system-jar-p (p)
13
14
15
16
17
18
  (named-jar-p "abcl" p))

(defun contrib-jar-p (p)
  (named-jar-p "abcl-contrib" p))

(defun named-jar-p (name p)
19
20
  (and (pathnamep p)
       (equal (pathname-type p) "jar")
21
       (or
22
        (java:jstatic "matches"
23
                      "java.util.regex.Pattern"
24
25
26
                      (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?")
                      (pathname-name p))
        (java:jstatic "matches"
27
                      "java.util.regex.Pattern"
28
29
30
                      (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?")
                      (pathname-name p)))
       (make-pathname :defaults p :name name)))
31
32

(defun find-system ()
33
  "Find the location of the system.
34
35

Used to determine relative pathname to find 'abcl-contrib.jar'."
36
37
  (or
   (ignore-errors
38
     (find-system-jar))
39
   (ignore-errors
40
41
42
43
     (some
      (lambda (u)
        (probe-file (make-pathname
                     :defaults (java:jcall "toString" u)
44
45
                     :name "abcl")))
      (java:jcall "getURLs" (boot-classloader))))
46
   (ignore-errors
47
     #p"http://abcl.org/releases/current/abcl.jar")))
48

49
(defun find-system-jar ()
50
  "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`."
51
    (dolist (loader (java:dump-classpath))
52
      (let ((abcl-jar (some #'system-jar-p loader)))
53
        (when abcl-jar
54
          (return abcl-jar)))))
55
56
57

(defvar *abcl-contrib* nil
  "Pathname of the ABCL contrib.
58
Initialized via SYSTEM:FIND-CONTRIB.")
59

60
61
62
63
64
(defparameter *verbose* t)

(defun add-contrib (abcl-contrib-jar)
  "Introspects ABCL-CONTRIB-JAR for asdf systems to add to ASDF:*CENTRAL-REGISTRY*"
  (when abcl-contrib-jar
65
66
67
68
69
70
71
72
73
    (dolist (asdf-file
              (directory (make-pathname :device (list abcl-contrib-jar)
                                        :directory '(:absolute :wild)
                                        :name :wild
                                        :type "asd")))
      (let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
        (unless (find asdf-directory asdf:*central-registry* :test #'equal)
          (push asdf-directory asdf:*central-registry*)
          (format *verbose* "~&Added ~A to ASDF.~&" asdf-directory))))))
74
75


76
(defun find-and-add-contrib (&key (verbose nil))
77
78
  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
Returns the pathname of the contrib if it can be found."
79
  (if *abcl-contrib*
80
81
      (format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%"
              *abcl-contrib*)
82
      (progn
83
84
85
        (setf *abcl-contrib* (find-contrib))
        (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%"
                *abcl-contrib*)))
86
87
88
89
  (add-contrib *abcl-contrib*))

(defun find-contrib ()
  "Introspect runtime classpaths to find a loadable ABCL-CONTRIB."
90
91
92
93
94
95
96
97
98
99
100
101
102
  (or (ignore-errors
                (when (find-system-jar)
                  (probe-file
                   (make-pathname :defaults (find-system-jar)
                                                  :name "abcl-contrib"))))
          (some
           (lambda (u)
                 (probe-file (make-pathname
                                          :defaults (java:jcall "toString" u)
                                          :name "abcl-contrib")))
           (java:jcall "getURLs" (boot-classloader)))))

(export `(find-system
103
104
          find-contrib
          *abcl-contrib*))
105

106
(when (find-and-add-contrib :verbose t)
107
  (provide :abcl-contrib))