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

Last change on this file since 14907 was 14907, checked in by Mark Evenson, 6 years ago

'abcl-aio.jar' all-in-one jar target creates dist/abcl-aio.jar (Alan Ruttenberg)

Corresponds to <https://github.com/armedbear/abcl/pull/7>.

Combines usual abcl.jar contents + contribs + lisp and java source.
Fixes find-system-jar accepts abcl-aio as well, so you can use this
single jar in your lib vs. abcl.jar + abcl-contrib.jar + sources
somewhere.

Combined with recent Slime enhancements in
<https://github.com/slime/slime/commit/30566b174be3186fde1ac224d4fffd3def0f4d9e>
ff., this will allow edit definition to find source for abcl-defined
functions and java primitives without extra configuration.

File size: 4.4 KB
Line 
1(in-package :system)
2
3(require :asdf)
4
5(defconstant +get-classloader+
6  (java:jmethod "java.lang.Class" "getClassLoader"))
7
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  (or (named-jar-p "abcl" p)
14      (named-jar-p "abcl-aio" p)))
15
16(defun contrib-jar-p (p)
17  (or 
18   (named-jar-p "abcl-contrib" p)
19   (named-jar-p "abcl-aio" p)))
20
21(defun named-jar-p (name p)
22  (and (pathnamep p)
23       (equal (pathname-type p) "jar")
24       (or
25        (java:jstatic "matches"
26                      "java.util.regex.Pattern"
27                      (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?")
28                      (pathname-name p))
29        (java:jstatic "matches"
30                      "java.util.regex.Pattern"
31                      (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?")
32                      (pathname-name p)))
33       p))
34
35(defun find-system ()
36  "Find the location of the system.
37
38Used to determine relative pathname to find 'abcl-contrib.jar'."
39  (or
40   (ignore-errors
41     (find-system-jar))
42   (ignore-errors
43     (some
44      (lambda (u)
45        (probe-file (make-pathname
46                     :defaults (java:jcall "toString" u)
47                     :name "abcl")))
48      (java:jcall "getURLs" (boot-classloader))))
49   (ignore-errors
50     #p"http://abcl.org/releases/current/abcl.jar")))
51
52(defun find-jar (predicate)
53  (dolist (loader (java:dump-classpath))
54    (let ((jar (some predicate loader)))
55      (when jar
56        (return jar)))))
57
58(defun find-system-jar ()
59  "Return the pathname of the system jar, one of `abcl.jar` or
60`abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`."
61  (find-jar #'system-jar-p))
62
63(defun find-contrib-jar ()
64  "Return the pathname of the contrib jar, one of `abcl-contrib.jar` or
65`abcl-contrib-m.n.p.jar` or `abcl-contrib-m.n.p[.~-]something.jar`."
66  (find-jar #'contrib-jar-p))
67
68(defvar *abcl-contrib* nil
69  "Pathname of the ABCL contrib.
70Initialized via SYSTEM:FIND-CONTRIB.")
71
72(defparameter *verbose* t)
73
74(defun add-contrib (abcl-contrib-jar &optional relative)
75  "Introspects ABCL-CONTRIB-JAR for asdf systems to add to ASDF:*CENTRAL-REGISTRY*"
76  (when abcl-contrib-jar
77    (dolist (asdf-file
78             (directory (make-pathname :device (list abcl-contrib-jar)
79                                       :directory (if relative `(:absolute ,relative :wild) '(:absolute :wild))
80                                       :name :wild
81                                       :type "asd")))
82      (let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
83        (unless (find asdf-directory asdf:*central-registry* :test #'equal)
84          (push asdf-directory asdf:*central-registry*)
85          (format *verbose* "~&Added ~A to ASDF.~&" asdf-directory))))))
86
87(defun find-and-add-contrib (&key (verbose nil))
88  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
89Returns the pathname of the contrib if it can be found."
90  (if *abcl-contrib*
91      (format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%"
92              *abcl-contrib*)
93      (progn
94  (setf *abcl-contrib* (find-contrib))
95  (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%"
96    *abcl-contrib*)))
97  (add-contrib *abcl-contrib*
98         (and (equalp *abcl-contrib* (find-system-jar))
99        "contrib"))
100  )
101
102(defun find-contrib ()
103  "Introspect runtime classpaths to find a loadable ABCL-CONTRIB."
104  (or (ignore-errors
105       (let ((system-jar (find-system-jar)))
106   (and
107    (probe-file (make-pathname
108      :device (list system-jar)
109      :directory '(:absolute "contrib")
110      :name "README" :type "markdown" ))
111    system-jar)))
112      (ignore-errors
113       (find-contrib-jar))
114      (ignore-errors
115        (let ((system-jar (find-system-jar)))
116          (when system-jar
117            (probe-file (make-pathname
118                         :defaults system-jar
119                         :name (concatenate 'string
120                                            "abcl-contrib"
121                                            (subseq (pathname-name system-jar) 4)))))))
122      (some
123       (lambda (u)
124         (probe-file (make-pathname
125                      :defaults (java:jcall "toString" u)
126                      :name "abcl-contrib")))
127       (java:jcall "getURLs" (boot-classloader)))))
128
129(export `(find-system
130          find-contrib
131          *abcl-contrib*))
132
133(when (find-and-add-contrib :verbose t)
134  (provide :abcl-contrib))
Note: See TracBrowser for help on using the repository browser.