[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv12655

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Speed up symbol completion.

* swank.lisp (all-completions): Don't call unparse-symbol
while matching.  That gets very slow in CCL's CCL package.
Just use symbol-name and compare with char-equal.
(prefix-match-p): Use char-equal.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/27 15:24:31	1.1844
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/27 20:19:26	1.1845
@@ -3,6 +3,15 @@
 	* slime.el (slime-remove-old-overlays): delete notes at the very beginning
 	of the buffer too. Thanks to Nick Levine.
 
+2009-08-22  Helmut Eller  <heller at common-lisp.net>
+
+	Speed up symbol completion.
+
+	* swank.lisp (all-completions): Don't call unparse-symbol
+	while matching.  That gets very slow in CCL's CCL package.
+	Just use symbol-name and compare with char-equal.
+	(prefix-match-p): Use char-equal.
+
 2009-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-transcript-start-hook)
--- /project/slime/cvsroot/slime/swank.lisp	2009/08/16 20:00:09	1.658
+++ /project/slime/cvsroot/slime/swank.lisp	2009/08/27 20:19:26	1.659
@@ -2947,19 +2947,19 @@
 
 ;;;; Simple completion
 
-(defslimefun simple-completions (string package)
-  "Return a list of completions for the string STRING."
-  (let ((strings (all-completions string package #'prefix-match-p)))
+(defslimefun simple-completions (prefix package)
+  "Return a list of completions for the string PREFIX."
+  (let ((strings (all-completions prefix package)))
     (list strings (longest-common-prefix strings))))
 
-(defun all-completions (string package test)
-  (multiple-value-bind (name pname intern) (tokenize-symbol string)
+(defun all-completions (prefix package)
+  (multiple-value-bind (name pname intern) (tokenize-symbol prefix)
     (let* ((extern (and pname (not intern)))
-	   (pack (cond ((equal pname "") keyword-package)
-		       ((not pname) (guess-buffer-package package))
-		       (t (guess-package pname))))
-	   (test (lambda (sym) (funcall test name (unparse-symbol sym))))
-	   (syms (and pack (matching-symbols pack extern test))))
+	   (pkg (cond ((equal pname "") keyword-package)
+                      ((not pname) (guess-buffer-package package))
+                      (t (guess-package pname))))
+	   (test (lambda (sym) (prefix-match-p name (symbol-name sym))))
+	   (syms (and pkg (matching-symbols pkg extern test))))
       (format-completion-set (mapcar #'unparse-symbol syms) intern pname))))
 
 (defun matching-symbols (package external test)
@@ -2982,7 +2982,8 @@
 
 (defun prefix-match-p (prefix string)
   "Return true if PREFIX is a prefix of STRING."
-  (not (mismatch prefix string :end2 (min (length string) (length prefix)))))
+  (not (mismatch prefix string :end2 (min (length string) (length prefix))
+                 :test #'char-equal)))
 
 (defun longest-common-prefix (strings)
   "Return the longest string that is a common prefix of STRINGS."