Changeset 13346


Ignore:
Timestamp:
06/17/11 13:10:21 (10 years ago)
Author:
Mark Evenson
Message:

Incremental progress towards getting ASDF-JAR working.

Now we just need to come up with the logic for specifying the entry
within the jar for the source and the fasls.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/contrib/asdf-jar/asdf-jar.lisp

    r13344 r13346  
    2222          (format nil "~A~A-~A.jar" name (when recursive "-all") version))
    2323         (package-jar
    24           (make-pathname :directory out :defaults package-jar-name))
     24          (make-pathname :directory (pathname-directory out) :defaults package-jar-name))
    2525         (mapping (make-hash-table :test 'equal)))
    2626    (when verbose
     
    4141          ;;; system, adding appropiate entries
    4242        (let ((sources
    43                (mapwalk (lambda (c) (typep c 'asdf::source-file))
    44                         (lambda (c) (input-files c )))))
     43               (mapwalk system
     44                        (lambda (c) (typep c 'asdf::source-file))
     45                        (lambda (c) (slot-value c 'asdf::absolute-pathname)))))
    4546          (loop :for source :in sources
    46              :do (setf (gethash (pathname-namestring source) mapping)
    47                        (make-pathname :defaults source
    48                                       :type "abcl"))))))
    49   (system:zip package-jar mapping)))
     47             :for source-entry = (relative-pathname base source)
     48             :for output = (make-pathname
     49                             :defaults (asdf:apply-output-translations source)
     50                             :type "abcl")
     51             :for output-entry = (relative-pathname base output)
     52             :do (setf (gethash (namestring source) mapping)
     53                       source-entry)
     54             :do (setf (gethash (namestring output) mapping)
     55                       output-entry)))))
     56      (system:zip package-jar mapping)))
     57
     58(defun relative-pathname (base source)
     59  (declare (ignore base source))
     60  (error "unimplemented."))
    5061
    5162;;; This more Map than Walk at this point ...
    5263(defun mapwalk (system test-if callable)
    5364  (declare (type system asdf:system))
    54   (let ((components
    55          (loop
    56             :for component :being :each :hash-value
    57               :of (slot-value system 'asdf::components-by-name)
    58             :when (funcall test-if component)
    59             :collect component)))
    60     (loop :for component :in components
    61        :collecting (apply callable component))))
     65  (loop
     66     :for component :being :each :hash-value
     67     :of (slot-value system 'asdf::components-by-name)
     68     :when
     69       (funcall test-if component)
     70     :collect
     71       (funcall callable component)))
    6272
    6373(defun relative-path (base dir file)
Note: See TracChangeset for help on using the changeset viewer.