[movitz-cvs] CVS movitz - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

28 Apr 2006

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv15447
Modified Files:
    image.lisp 
Log Message:
Implement package-nicknames.

--- /project/movitz/cvsroot/movitz/image.lisp	2006/04/10 11:48:20	1.105
+++ /project/movitz/cvsroot/movitz/image.lisp	2006/04/28 21:19:06	1.106
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.105 2006/04/10 11:48:20 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.106 2006/04/28 21:19:06 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -1117,7 +1117,7 @@
      (pushnew :constant-variable (movitz-symbol-flags symbol))
      (setf (movitz-symbol-value symbol)
        (movitz-read (translate-program (symbol-value (translate-program name :muerte.cl :cl))
-					 :cl :muerte.cl))))
+					    :cl :muerte.cl))))
    symbol)))
(defun make-packages-hash (&optional (*image* *image*))
@@ -1143,16 +1143,20 @@
    	 lisp-package context)
           (setf (gethash lisp-package lisp-to-movitz-package)
    	 (or (gethash package-name packages-hash nil)
-		     (let ((p (funcall 'muerte::make-package-object
-				       :name package-name
-				       :shadowing-symbols-list (package-shadowing-symbols lisp-package)
-				       :external-symbols (make-hash-table :test #'equal)
-				       :internal-symbols (make-hash-table :test #'equal)
-				       :use-list (mapcar #'(lambda (up) 
-							     (ensure-package (movitz-package-name (package-name up))
-									     up context))
-							 (package-use-list lisp-package)))))
+		     (let* ((nicks (mapcar #'movitz-package-name (package-nicknames lisp-package)))
+			    (p (funcall 'muerte::make-package-object
+					:name package-name
+					:shadowing-symbols-list (package-shadowing-symbols lisp-package)
+					:external-symbols (make-hash-table :test #'equal)
+					:internal-symbols (make-hash-table :test #'equal)
+					:nicknames nicks
+					:use-list (mapcar #'(lambda (up) 
+							      (ensure-package (movitz-package-name (package-name up))
+									      up context))
+							  (package-use-list lisp-package)))))
    	       (setf (gethash package-name packages-hash) p)
+		       (dolist (nick nicks)
+			 (setf (gethash nick packages-hash) p))
    	       p)))))
       (let ((movitz-cl-package (ensure-package (symbol-name :common-lisp)
    				       (find-package :muerte.common-lisp))))

    