some preliminary patches

Matthew Danish <[email protected]>
Newsgroups gmane.lisp.cclan.general
Message-ID <[email protected]>
I have attached some patches which contain my recent modifications to
asdf and cclan.lisp.  They aren't really well cleaned up, or finished for
that matter, but I (ok, dan) thought it would be a good idea to discuss
the changes before committing them.

asdf: 
* exported some symbols

cclan: 
* uses properties now to determine .deb file contents
:mk-defsystem-source-file indicates the .system file to be used by c-l-c
:licence-file indicates this file to be installed as the licence
:installable indicates that this file is to be installed according to its
 place in the system's hierarchy.  Currently only files marked by one of
 these above 3 get installed.  The old method was to install only cl-
 source-files, but that wouldn't do for other sorts of things.  Perhaps
 there should be a :not-installable property instead?
:postinst-commands are commands to be inserted in the postinst file.
 Bit of a hack, but I needed it for something.  Must be a way of making
 this better?

* fixed up write-debian-dirs to create dirs for sub-modules, but it doesn't
  recursively descend at the moment since I was too tired to implement that
  yet and didn't need it yet


The CL-TCLink package was my recent testbed for this stuff, so you should
be able to make a Debian package out of the .asd file for it, using these
modifications.

-- 
; Matthew Danish <[email protected]>
; OpenPGP public key: C24B6010 on keyring.debian.org
; Signed or encrypted mail welcome.
; "There is no dark side of the moon really; matter of fact, it's all dark."
asdf_cclan-patches.diff (text/plain, 5.6 KB)
diff -u -r1.27 asdf.lisp
--- asdf.lisp	20 May 2002 14:16:26 -0000	1.27
+++ asdf.lisp	4 Jun 2002 08:59:53 -0000
@@ -29,6 +29,13 @@
 	   #:component-name
 	   #:component-version
 	   #:component-parent
+	   #:component-property
+	   
+	   #:system-maintainer
+	   #:long-description
+	   #:system-description
+	   #:system-author
+	   #:system-licence
 	   
 	   #:component-depends-on
 	   
@@ -705,6 +712,9 @@
 		   (ret
 		    (or (find-component parent name)
 			(make-instance (class-for-type parent type)))))
+
+;;	      (change-class ret (class-for-type parent type)) ;; proposed change
+
 	      (apply #'reinitialize-instance
 		     ret
 		     :name (coerce-name name)
diff -u -r1.5 cclan.lisp
--- cclan.lisp	30 Apr 2002 17:22:51 -0000	1.5
+++ cclan.lisp	4 Jun 2002 08:59:53 -0000
@@ -81,9 +81,13 @@
   (class-name (class-of x)))
 
 (defun write-debian-rules (stream system)
-  (let ((changelog-file-name (enough-namestring
-			      (component-pathname (find 'changelog-source-file (all-components system) :key #'class-name-of :test #'string=))
-			      (component-pathname system))))
+  (let* ((changelog-component (find-component-with-property (all-components system)
+							    :changelog-file))
+	 (changelog-file-name (if changelog-component
+				  (enough-namestring
+				   (component-pathname changelog-component)
+				   (component-pathname system))
+				  "")))
     (format stream "#!/usr/bin/make -f
 # debian/rules generated by cCLan tools
 
@@ -138,9 +142,10 @@
 .PHONY: build clean binary-indep binary-arch binary install configure
 " (component-name system) changelog-file-name)))
 
-#+infix
+
 (defun write-debian-control (stream system)
-  (format stream "Source: ~A
+  (let ((sys (find-system system)))
+    (format stream "Source: ~A
 Section: devel
 Priority: optional
 Maintainer: ~A
@@ -153,10 +158,19 @@
 Description: ~A
  ~{~<~% ~1:;~A ~>~}
 "
+	    (component-name system)
+	    (system-maintainer sys)
+	    (component-name system)
+	    nil
+	    (system-description sys)
+	    (long-description sys))))
 	  ;; FIXME: Clearly this argument list is not
 	  ;; sustainable. Also the split should be split-sequence,
 	  ;; clearly.
-	  (component-name system) (infix-system::debian-maintainer system) (component-name system) (infix-system::debian-dependencies system) (infix-system::short-description system) (asdf::split (infix-system::long-description system))))
+#|
+	  (component-name system) (infix-system::debian-maintainer system) (component-name system) (infix-system::debian-dependencies system) (infix-system::short-description system) (asdf::split (infix-system::long-description system))
+|#
+
 
 (defun write-debian-prerm (stream system)
   (format stream "#! /bin/sh
@@ -207,6 +221,10 @@
 
 (defun write-debian-postinst (stream system)
   (format stream "#! /bin/sh
+# :postinst-commands property
+
+~A
+
 # postinst script for ~A.
 set -e
 case \"$1\" in
@@ -227,7 +245,10 @@
 
 #DEBHELPER#
 exit 0
-" (component-name system)))
+"
+	  (let ((pc (component-property system :postinst-commands)))
+	    (if pc pc ""))
+	  (component-name system)))
 
 (defun print-debian-date (stream arg colonp atsignp &rest params)
   (declare (ignore colonp atsignp params))
@@ -245,21 +266,34 @@
 	    ;; FIXME: I'm sure this is wrong
 	    (+ (* (truncate tz) 100) (mod (* tz 60) 60)))))
 		     
-#+infix
+
 (defun write-debian-changelog (stream system)
   (format stream "~A (~A-1) cclan; urgency=low
 
   * Package generated by cCLan scripts
 
  -- ~A  ~/cclan:print-debian-date/
-" (component-name system) (component-version system) (infix-system::debian-maintainer system) (get-universal-time)))
+" (component-name system) (component-version system) (system-maintainer (find-system system)) (get-universal-time)))
 
 (defun write-debian-dirs (stream system)
   (format stream "~
 /usr/share/doc/~A
 /usr/share/common-lisp/systems
 /usr/share/common-lisp/repositories/~:*~A
-" (component-name system)))
+" (component-name system))
+  (loop for x in (find-all-dirs system)
+	do (format stream "~&/usr/share/common-lisp/repositories/~A/~A~%"
+		   (component-name system) x)))
+
+;; FIXME! only does one level
+(defun find-all-dirs (system)
+  (loop for x in (rest (all-components system))
+	if (typep x 'asdf::module)
+	collect (component-name x)))
+
+(defun find-component-with-property (components prop)
+  (find-if (lambda (x) (component-property x prop))
+	   components))
 
 (defun write-deb-install-makefile (stream system)
   (let ((components (all-components system))
@@ -267,9 +301,10 @@
     (format stream "install:
 	install -m 644 ~A $(DESTDIR)/usr/share/common-lisp/systems/
 ~{	install -m 644 ~A $(DESTDIR)/usr/share/common-lisp/repositories/~A~%~}"
-	    (enough-namestring (component-pathname (find 'mk-defsystem-source-file components :key #'class-name-of :test #'string=)))
+	    (enough-namestring (component-pathname (find-component-with-property components
+										 :mk-defsystem-source-file)))
 	    (loop for x in components
-		  when (typep x 'cl-source-file)
+		  when (component-property x :installable)
 		    collect (enough-namestring (component-pathname x))
 		    and collect (format nil "~A/~A" (component-name system) (enough-namestring (component-pathname x)))))))
 
@@ -318,7 +353,7 @@
 		       (directory-namestring debian-directory))
     (run-shell-command "cd ~A && ln -s ~A copyright"
 		       (directory-namestring debian-directory)
-		       (namestring (component-pathname (find 'licence-source-file components :key #'class-name-of :test #'string=))))
+		       (namestring (component-pathname (find-component-with-property components :licence-file))))
     (run-shell-command "cd ~A && dpkg-buildpackage -us -uc -rfakeroot -b"
 		       (directory-namestring path))
     ))
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.