X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Ftarget-package.lisp;h=ab640e9c4b7a5ad35092ec13ab724575801bc368;hb=f9c9b95e86c05a63192533e2d57050ae48a62472;hp=23e9150aa34de947f2094f40cbe62385a9bdeda9;hpb=0ea76b6b3c9e5c5608ca4c03f429834222717301;p=sbcl.git

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 23e9150..ab640e9 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -130,12 +130,29 @@
 (!cold-init-forms
   (setf *!deferred-use-packages* nil))
 
-;;; FIXME: I rewrote this. Test it and the stuff that calls it.
+(define-condition bootstrap-package-not-found (condition)
+  ((name :initarg :name :reader bootstrap-package-name)))
+(defun debootstrap-package (&optional condition)
+  (invoke-restart 
+   (find-restart-or-control-error 'debootstrap-package condition)))
+  
 (defun find-package (package-designator)
   (flet ((find-package-from-string (string)
 	   (declare (type string string))
-	   (values (gethash string *package-names*))))
-    (declare (inline find-package-from-string))
+	   (let ((packageoid (gethash string *package-names*)))
+	     (when (and (null packageoid)
+			(not *in-package-init*) ; KLUDGE
+			(let ((mismatch (mismatch "SB!" string)))
+			  (and mismatch (= mismatch 3))))
+	       (restart-case
+		   (signal 'bootstrap-package-not-found :name string)
+		 (debootstrap-package ()
+		   (return-from find-package
+		     (if (string= string "SB!XC")
+			 (find-package "COMMON-LISP")
+			 (find-package 
+			  (substitute #\- #\! string :count 1)))))))
+	     packageoid)))
     (typecase package-designator
       (package package-designator)
       (symbol (find-package-from-string (symbol-name package-designator)))
@@ -540,9 +557,9 @@
 	   (let ((sym (read *query-io*)))
 	     (cond
 	      ((not (symbolp sym))
-	       (format *query-io* "~S is not a symbol."))
+	       (format *query-io* "~S is not a symbol." sym))
 	      ((not (member sym cset))
-	       (format *query-io* "~S is not one of the conflicting symbols."))
+	       (format *query-io* "~S is not one of the conflicting symbols." sym))
 	      (t
 	       (shadowing-import sym package)
 	       (return-from unintern t)))))))
@@ -818,7 +835,8 @@
 	  (when cset
 	    (cerror
 	     "Unintern the conflicting symbols in the ~2*~A package."
-	     "Use'ing package ~A results in name conflicts for these symbols:~%~S"
+	     "Using package ~A results in name conflicts for these symbols:~%~
+              ~S"
 	     (package-%name pkg) cset (package-%name package))
 	    (dolist (s cset) (moby-unintern s package))))
 
@@ -877,7 +895,8 @@
 	(do-symbols (symbol package)
 	  (when (and (eq (symbol-package symbol) package)
 		     (or (not external-only)
-			 (eq (find-symbol (symbol-name symbol) package)
+			 (eq (nth-value 1 (find-symbol (symbol-name symbol)
+						       package))
 			     :external))
 		     (search string (symbol-name symbol) :test #'char-equal))
 	    (push symbol result)))
@@ -938,7 +957,9 @@
 	(add-symbol external symbol))
 
       ;; Put shadowing symbols in the shadowing symbols list.
-      (setf (package-%shadowing-symbols pkg) (sixth spec))))
+      (setf (package-%shadowing-symbols pkg) (sixth spec))
+      ;; Set the package documentation
+      (setf (package-doc-string pkg) (seventh spec))))
 
   ;; FIXME: These assignments are also done at toplevel in
   ;; boot-extensions.lisp. They should probably only be done once.