[slime-cvs] CVS slime

[eweitz]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv26741

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Offer systems already know to ASDF for completion


--- /project/slime/cvsroot/slime/ChangeLog	2007/01/11 23:37:11	1.1045
+++ /project/slime/cvsroot/slime/ChangeLog	2007/01/12 00:06:56	1.1046
@@ -1,3 +1,16 @@
+2007-01-12  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-find-asd): Remove file extension.
+
+	(slime-read-system-name): Use SWANK:LIST-ASDF-SYSTEMS.
+
+	* swank.lisp (list-all-systems-in-central-registry): Use only
+	pathname name.
+
+	(list-all-systems-known-to-asdf): New function.
+
+	(list-asdf-systems): New function.
+
 2007-01-12  Marco Baringer  <mb at bese.it>
 
 	* slime.el (slime-keys): Remove binding of M-*, restore binding of
--- /project/slime/cvsroot/slime/slime.el	2007/01/11 23:37:05	1.743
+++ /project/slime/cvsroot/slime/slime.el	2007/01/12 00:06:56	1.744
@@ -4723,9 +4723,11 @@
 directory or in the directory belonging to the current buffer and
 returns it if it's in `system-names'."
   (let* ((asdf-systems-in-directory
-           (directory-files (file-name-directory (or default-directory
-                                                     (buffer-file-name)))
-                            nil "\.asd$")))
+           (mapcar #'file-name-sans-extension
+                   (directory-files
+                    (file-name-directory (or default-directory
+                                             (buffer-file-name)))
+                    nil "\.asd$"))))
     (loop for system in asdf-systems-in-directory
           for candidate = (file-name-sans-extension system)
           when (find candidate system-names :test #'string-equal)
@@ -4746,9 +4748,7 @@
   "Read a system name from the minibuffer, prompting with PROMPT."
   (setq prompt (or prompt "System: "))
   (let* ((completion-ignore-case nil)
-         (system-names (mapcar #'file-name-sans-extension
-                               (slime-eval 
-                                `(swank:list-all-systems-in-central-registry))))
+         (system-names (slime-eval `(swank:list-asdf-systems)))
          (alist (slime-bogus-completion-alist system-names)))
     (completing-read prompt alist nil nil
                      (or initial-value (slime-find-asd system-names) "")
--- /project/slime/cvsroot/slime/swank.lisp	2007/01/11 16:30:48	1.454
+++ /project/slime/cvsroot/slime/swank.lisp	2007/01/12 00:06:56	1.455
@@ -3079,18 +3079,33 @@
 
 (defslimefun list-all-systems-in-central-registry ()
   "Returns a list of all systems in ASDF's central registry."
-  (delete-duplicates
-    (loop for dir in (asdf-central-registry)
-          for defaults = (eval dir)
-          when defaults
-            nconc (mapcar #'file-namestring
-                            (directory
-                              (make-pathname :defaults defaults
-                                             :version :newest
-                                             :type "asd"
-                                             :name :wild
-                                             :case :local))))
-    :test #'string=))
+  (mapcar #'pathname-name
+          (delete-duplicates
+           (loop for dir in (asdf-central-registry)
+                 for defaults = (eval dir)
+                 when defaults
+                   nconc (mapcar #'file-namestring
+                                   (directory
+                                     (make-pathname :defaults defaults
+                                          :version :newest
+                                          :type "asd"
+                                          :name :wild
+                                          :case :local))))
+           :test #'string=)))
+
+(defslimefun list-all-systems-known-to-asdf ()
+  "Returns a list of all systems ASDF knows already."
+  ;; ugh, yeah, it's unexported - but do we really expect this to
+  ;; change anytime soon?
+  (loop for name being the hash-keys of asdf::*defined-systems*
+        collect name))
+
+(defslimefun list-asdf-systems ()
+  "Returns the systems in ASDF's central registry and those which ASDF
+already knows."
+  (nunion (list-all-systems-known-to-asdf)
+          (list-all-systems-in-central-registry)
+          :test #'string=))
   
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."