source: trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp @ 14193

Last change on this file since 14193 was 13432, checked in by Mark Evenson, 9 years ago

Fix the ABCL-ASDF:*ADDED-TO-CLASSPATH* to actually record additions.

The use of this variable is perhaps slightly obsolescent with the use
of JAVA:DUMP-CLASSPATH, but provides a convenient shortcut to
quickly find out what has been added by JAVA:ADD-TO-CLASSPATH.

File size: 4.0 KB
Line 
1(in-package :abcl-asdf)
2
3(defvar *added-to-classpath* nil)
4
5(defvar *inhibit-add-to-classpath* nil)
6
7(defun add-directory-jars-to-class-path (directory recursive-p)
8  (loop :for jar :in (if recursive-p 
9                         (all-jars-below directory) 
10                         (directory (merge-pathnames "*.jar" directory)))
11     :do (java:add-to-classpath jar)))
12
13(defun all-jars-below (directory) 
14  (loop :with q = (system:list-directory directory) 
15     :while q :for top = (pop q)
16     :if (null (pathname-name top)) 
17       :do (setq q (append q (all-jars-below top))) 
18     :if (equal (pathname-type top) "jar") 
19       :collect top))
20
21(defun need-to-add-directory-jar? (directory recursive-p)
22  (loop :for jar :in (if recursive-p 
23                         (all-jars-below directory)
24                         (directory (merge-pathnames "*.jar" directory)))
25     :doing (if (not (member (namestring (truename jar)) 
26                             *added-to-classpath* :test 'equal))
27                (return-from need-to-add-directory-jar? t)))
28  nil)
29
30(defmethod java:add-to-classpath :around ((uri-or-uris t) &optional classloader)
31  (declare (ignore classloader))
32  (call-next-method)
33  (if (listp uri-or-uris)
34      (dolist (uri uri-or-uris)
35        (pushnew uri *added-to-classpath*))
36      (pushnew uri-or-uris *added-to-classpath*)))
37
38(in-package :asdf)
39
40(defclass jar-directory (static-file) ())
41
42(defmethod perform ((operation compile-op) (c jar-directory))
43  (unless abcl-asdf:*inhibit-add-to-classpath*
44    (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
45
46(defmethod perform ((operation load-op) (c jar-directory))
47  (unless abcl-asdf:*inhibit-add-to-classpath*
48    (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
49
50(defmethod operation-done-p ((operation load-op) (c jar-directory))
51  (or abcl-asdf:*inhibit-add-to-classpath*
52      (not (abcl-asdf:need-to-add-directory-jar? (component-pathname c) t))))
53
54(defmethod operation-done-p ((operation compile-op) (c jar-directory))
55  t)
56
57(defclass jar-file (static-file) ())
58
59(defmethod source-file-type ((c jar-file) (s module)) "jar")
60
61(defmethod perform ((operation compile-op) (c jar-file))
62  (java:add-to-classpath (component-pathname c)))
63
64(defmethod perform ((operation load-op) (c jar-file))
65  (or abcl-asdf:*inhibit-add-to-classpath*
66      (java:add-to-classpath (component-pathname c))))
67
68;;; The original JSS specified jar pathnames as having a NAME ending
69;;; in ".jar" without a TYPE.  If we encounter such a definition, we
70;;; clean it up.
71(defmethod perform :before ((operation load-op) (c jar-file))
72  (when (#"endsWith" (slot-value c 'name) ".jar")
73    (with-slots (name absolute-pathname) c
74      (let* ((new-name 
75              (subseq name 0 (- (length name) 4)))
76             (new-absolute-pathname 
77              (make-pathname :defaults absolute-pathname :name new-name)))
78        (setf name new-name
79              absolute-pathname new-absolute-pathname)))))
80
81(defmethod operation-done-p :before ((operation load-op) (c jar-file))
82  (when (#"endsWith" (slot-value c 'name) ".jar")
83    (with-slots (name absolute-pathname) c
84      (let* ((new-name 
85              (subseq name 0 (- (length name) 4)))
86             (new-absolute-pathname 
87              (make-pathname :defaults absolute-pathname :name new-name)))
88        (setf name new-name
89              absolute-pathname new-absolute-pathname)))))
90
91(defmethod operation-done-p ((operation load-op) (c jar-file))
92  (or abcl-asdf:*inhibit-add-to-classpath*
93      (member (namestring (truename (component-pathname c)))
94              abcl-asdf:*added-to-classpath* :test 'equal)))
95
96(defmethod operation-done-p ((operation compile-op) (c jar-file))
97  t)
98
99(defclass class-file-directory (static-file) ())
100
101(defmethod perform ((operation compile-op) (c class-file-directory))
102  (java:add-to-classpath (component-pathname c)))
103
104(defmethod perform ((operation load-op) (c class-file-directory))
105  (java:add-to-classpath (component-pathname c)))
106
107
108
109
110
Note: See TracBrowser for help on using the repository browser.