[armedbear-cvs] r13308 - trunk/abcl/contrib/asdf-jar

[mevenson at common-lisp.net]

Author: mevenson
Date: Mon May 30 08:56:46 2011
New Revision: 13308

Log:
Implementation of a utility to package ASDF systems in jars.

The recursive dependencies are just recorded, not packaged.

Added:
   trunk/abcl/contrib/asdf-jar/
   trunk/abcl/contrib/asdf-jar/asdf-jar.asd
   trunk/abcl/contrib/asdf-jar/asdf-jar.lisp
   trunk/abcl/contrib/asdf-jar/test.lisp

Added: trunk/abcl/contrib/asdf-jar/asdf-jar.asd
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/abcl/contrib/asdf-jar/asdf-jar.asd	Mon May 30 08:56:46 2011	(r13308)
@@ -0,0 +1,9 @@
+;;;; -*- Mode: LISP -*-
+(in-package :Asdf)
+
+(defsystem :asdf-jar
+  :author "Mark Evenson"
+  :version "0.1.0"
+  :components 
+  ((:module base :pathname "" :components
+	    ((:file "asdf-jar")))))
\ No newline at end of file

Added: trunk/abcl/contrib/asdf-jar/asdf-jar.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/abcl/contrib/asdf-jar/asdf-jar.lisp	Mon May 30 08:56:46 2011	(r13308)
@@ -0,0 +1,35 @@
+(defpackage :asdf-jar
+  (:use :cl)
+  (:export #:package))
+
+(in-package :asdf-jar)
+
+(defvar *systems*)
+(defmethod asdf:perform :before ((op asdf:compile-op) (c asdf:system))
+       (push c *systems*))
+
+(defun package (system-name &key (recursive t) (verbose t))
+  (declare (ignore recursive))
+  (asdf:disable-output-translations)
+  (let* ((system (asdf:find-system system-name))
+	 (name (slot-value system 'asdf::name)))
+    (when verbose 
+      (format verbose "Packaging ASDF definition of~A~%" system))
+    (setf *systems* nil)
+    (asdf:compile-system system :force t)
+    (let* ((dir (asdf:component-pathname system))
+	   (wild-contents (merge-pathnames "**/*" dir))
+	   (contents (directory wild-contents))
+	   (output (format nil "/var/tmp/~A.jar" name))
+	   (topdir (truename (merge-pathnames "../" dir))))
+      (when verbose
+	(format verbose "Packaging contents in ~A.~%" output))
+      (system:zip output contents topdir)))
+  (asdf:initialize-output-translations))
+
+
+    
+	
+
+  
+  

Added: trunk/abcl/contrib/asdf-jar/test.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/abcl/contrib/asdf-jar/test.lisp	Mon May 30 08:56:46 2011	(r13308)
@@ -0,0 +1,14 @@
+(defun init-test ()
+  (require :quicklisp)
+  (ql:quickload :cl-ppcre))
+  
+(defun package-test ()
+  (package :cl-ppcre))
+
+(defun load-test ()
+  (push "jar:file:/var/tmp/cl-ppcre.jar!/cl-ppcre-2.0.3/" 
+	asdf:*central-registry*)
+  (asdf:disable-output-translations)
+  (setf asdf::*verbose-out* t)
+  (asdf:load-system :cl-ppcre))
+