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"
