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"