[cl-menusystem-cvs] CVS update: cl-menusystem/system-menu.lisp

[Brian Rice]

Update of /project/cl-menusystem/cvsroot/cl-menusystem
In directory common-lisp.net:/tmp/cvs-serv9939

Modified Files:
	system-menu.lisp 
Log Message:
Several bug-fixes.

Date: Fri Oct  3 00:28:09 2003
Author: brice

Index: cl-menusystem/system-menu.lisp
diff -u cl-menusystem/system-menu.lisp:1.1 cl-menusystem/system-menu.lisp:1.2
--- cl-menusystem/system-menu.lisp:1.1	Thu Oct  2 23:17:10 2003
+++ cl-menusystem/system-menu.lisp	Fri Oct  3 00:28:08 2003
@@ -49,9 +49,10 @@
 
 (defun sysdef-central-registry-list ()
   "Mirrors asdf's sysdef-central-registry-search."
-  (loop for path in asdf:*central-registry*
-    with pathname = (if (pathnamep path) path (pathname path))
-    with dir = (ignore-errors (sysdef-list-from-dir pathname))
+  (loop for path-expr in asdf:*central-registry*
+    for path = (eval path-expr)
+    for pathname = (if (pathnamep path) path (pathname path))
+    for dir = (ignore-errors (sysdef-list-from-dir pathname))
     when (consp dir)
     nconc dir))
 
@@ -64,24 +65,25 @@
 (defun local-systems-refresh ()
   "Scans the appropriate areas for locally-installed system definitions."
   (loop for sysdef in (sysdef-central-registry-list)
-    do (pushnew sysdef *local-systems*))
-  (sort *local-systems* #'string<=)
+    do (pushnew sysdef *local-systems* :key #'truename :test #'equal))
+  (sort *local-systems* #'string<= :key #'namestring)
   *local-systems*)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (local-systems-refresh))
 
 (defmethod display-object ((sys asdf:system) output-device)
-  (mapcar
-   (lambda (pair)
-     (simple-format-message output-device "~A: ~A~&" (car pair) (cdr pair)))
-   '(("Name"       . (component-name sys))
-     ("Version"    . (component-version sys))
-     ("Description" . (system-description sys))
-     ("Author"     . (system-author sys))
-     ("Maintainer" . (system-maintainer sys))
-     ("License"    . (system-licence sys))
-     ("Status"     . nil)))) ;TODO: get package installation status
+  (handler-bind ((unbound-slot (lambda (x) nil)))
+    (mapcar
+     (lambda (pair)
+       (simple-format-message output-device "~A: ~A~&" (car pair) (cdr pair)))
+     `(("Name"       . ,(asdf:component-name sys))
+       ("Version"    . ,(asdf:component-version sys))
+       ("Description" . ,(asdf:system-description sys))
+       ("Author"     . ,(asdf:system-author sys))
+       ("Maintainer" . ,(asdf:system-maintainer sys))
+       ("License"    . ,(asdf::system-licence sys))
+       ("Status"     . nil))))) ;TODO: get package installation status
 
 (defmenu *system-menu* "System Menu" nil
   (make-menu-action
@@ -109,7 +111,7 @@
      (do-menu
       (make-menu
        (format nil "Operating on system ~A" sys-pathname)
-       "Select an action to perform on this system."
+       "Select an action to perform."
        (make-menu-action
 	"Show Extended Information" nil (rst)
 	(display-object (asdf:find-system (pathname-name sys-pathname))
@@ -121,7 +123,7 @@
        (make-menu-action "Load Source" nil (rst)
 			 (asdf:oos 'asdf:load-source-op sys-pathname))
        (make-menu-action "Back to the main menu" nil (rst)
-			 (invoke-restart main-rst)))
+			 (invoke-restart rst)))
       *menu-output* *menu-input*)))
   (make-menu-action
    "Edit the ASDF central registry"