ASDF-Install patch - lets ASDF-Install work with Allegro "modern" Lisp

Back to unCLog.

Index: defpackage.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf-install/defpackage.lisp,v
retrieving revision 1.3
diff -u -w -r1.3 defpackage.lisp
--- defpackage.lisp	1 Jun 2005 20:31:54 -0000	1.3
+++ defpackage.lisp	17 Mar 2006 20:09:18 -0000
@@ -1,7 +1,7 @@
(cl:in-package :cl-user)
(defpackage :asdf-install
-  (:use "CL")
+  (:use #:common-lisp)
   (:export
    ;; Customizable variables.
@@ -28,9 +28,10 @@
    #:sysdef-source-dir-search
    #:uninstall
    #:install
+  
    ;; proxy authentication
    #:*proxy-user*
    #:*proxy-passwd*))
(defpackage :asdf-install-customize
-  (:use "CL" "ASDF-INSTALL"))
+  (:use #:common-lisp #:asdf-install))
Index: installer.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf-install/installer.lisp,v
retrieving revision 1.13
diff -u -w -r1.13 installer.lisp
--- installer.lisp	21 Dec 2005 12:42:21 -0000	1.13
+++ installer.lisp	17 Mar 2006 20:09:18 -0000
@@ -353,11 +353,11 @@
	     (unless (member response '(301 302))	      
	       (return-from got (list response headers stream)))
	     (close stream)
-	     (setf url (cdr (assoc :location headers))))))
+	     (setf url (cdr (assoc :LOCATION headers))))))
       (with-open-stream (stream stream)
	(when (>= response 400)
	  (error 'download-error :url url :response response))
-	(let ((length (parse-integer (or (cdr (assoc :content-length headers)) "")
+	(let ((length (parse-integer (or (cdr (assoc :CONTENT-LENGTH headers)) "")
				     :junk-allowed t)))
	  (installer-msg t "Downloading ~A bytes from ~A to ~A ..."
			 (or length "some unknown number of")
@@ -412,23 +412,23 @@
                                                        (find x '(#\Space #\Tab)))
                                                      l)
	       (declare (ignore _))
-               (pushnew (cons (intern tag :keyword)
+               (pushnew (cons (intern (string-upcase tag) :keyword)
			      data) tags)))
       (ignore-errors
         (close gpg-stream)))
     (unless tags
       (error 'shell-error))
     ;; test for obvious key/sig problems
-    (let ((errsig (assoc :errsig tags)))
+    (let ((errsig (assoc :ERRSIG tags)))
       (and errsig (error 'key-not-found :key-id (second errsig))))
-    (let ((badsig (assoc :badsig tags)))
+    (let ((badsig (assoc :BADSIG tags)))
       (and badsig (error 'key-not-found :key-id (second badsig))))
-    (let* ((good (assoc :goodsig tags))
+    (let* ((good (assoc :GOODSIG tags))
	   (id (second good))
	   (name (format nil "~{~A~^ ~}" (nthcdr 2 good))))
       ;; good signature, but perhaps not trusted
-      (unless (or (assoc :trust_ultimate tags)
-		  (assoc :trust_fully tags))
+      (unless (or (assoc :TRUST_ULTIMATE tags)
+		  (assoc :TRUST_FULLY tags))
	(cerror "Install the package anyway"
		'key-not-trusted
		:key-user-name name
@@ -467,7 +467,7 @@
                        (setf (char data i) (code-char byte)))))))
           (if (= response 200)
             (let ((data (make-string (parse-integer
-                                      (cdr (assoc :content-length headers))
+                                      (cdr (assoc :CONTENT-LENGTH headers))
                                       :junk-allowed t))))
               (read-signature data stream)
               (verify-gpg-signature/string data file-name))
Index: split-sequence.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf-install/split-sequence.lisp,v
retrieving revision 1.1
diff -u -w -r1.1 split-sequence.lisp
--- split-sequence.lisp	24 Apr 2004 18:19:05 -0000	1.1
+++ split-sequence.lisp	17 Mar 2006 20:09:19 -0000
@@ -50,14 +50,14 @@
;;; * (split-sequence #\; ";oo;bar;ba;" :start 1 :end 9)
;;; -> ("oo" "bar" "b"), 9
-(defpackage "SPLIT-SEQUENCE"
-  (:use "CL")
-  (:nicknames "PARTITION")
-  (:export "SPLIT-SEQUENCE" "SPLIT-SEQUENCE-IF" "SPLIT-SEQUENCE-IF-NOT"
-	   "PARTITION" "PARTITION-IF" "PARTITION-IF-NOT")
-  (:documentation "The SPLIT-SEQUENCE package provides functionality for Common Lisp sequences analagous to Perl's split operator."))
+(defpackage #:split-sequence
+  (:use #:common-lisp)
+  (:nicknames #:partition)
+  (:export #:split-sequence #:split-sequence-if #:split-sequence-if-not
+	   #:partition #:partition-if #:partition-if-not)
+  (:documentation "the split-sequence package provides functionality for common lisp sequences analagous to perl's split operator."))
-(in-package "SPLIT-SEQUENCE")
+(in-package #:split-sequence)
(defun split-sequence (delimiter seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (test nil test-supplied) (test-not nil test-not-supplied) (key nil key-supplied))
   "Return a list of subsequences in seq delimited by delimiter.