Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.980
diff -u -r1.980 ChangeLog
--- ChangeLog	21 Oct 2006 09:30:20 -0000	1.980
+++ ChangeLog	21 Oct 2006 09:48:55 -0000
@@ -41,7 +41,7 @@
 	slime-fuzzy-completions-map and
 	slime-target-buffer-fuzzy-completions-map for details.
 
-	* slime.el (slime-space-information-p): New variable.
+	* slime.el (slime-fuzzy-completion-in-place): New variable.
 	(slime-target-buffer-fuzzy-completions-mode): New keymap for
 	in-place fuzzy completions.
 	(slime-fuzzy-target-buffer-completions-mode): New minor mode for
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.673
diff -u -r1.673 slime.el
--- slime.el	20 Oct 2006 11:07:57 -0000	1.673
+++ slime.el	21 Oct 2006 09:49:02 -0000
@@ -273,6 +273,17 @@
   :group 'slime-mode
   :type 'boolean)
 
+(defcustom slime-fuzzy-completion-limit 300
+  "Only return and present this many symbols from swank."
+  :group 'slime-mode
+  :type 'integer)
+
+(defcustom slime-fuzzy-completion-time-limit-in-msec 1500
+  "Limit the time spent (given in msec) in swank while gathering comletitions.
+(NOTE: currently it's rounded up the nearest second)"
+  :group 'slime-mode
+  :type 'integer)
+
 (defcustom slime-space-information-p t
   "Have the SPC key offer arglist information."
   :type 'boolean
@@ -522,23 +533,29 @@
 ;;;; NOTE: this mode has to be able to override key mappings in slime-mode
 (defvar slime-target-buffer-fuzzy-completions-map
   (let* ((map (make-sparse-keymap)))
+    (flet ((remap (keys to)
+             (dolist (key keys)
+               (when (symbolp key)
+                 (setf key (where-is-internal key global-map t t)))
+               (when key
+                 (define-key map key to)
+                 (return-from remap)))))
+      
+      (dolist (key (list (kbd "<ret>") (kbd "<space>") "(" ")" "[" "]"))
+        (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer))
 
-    (define-key map (kbd "C-g") 'slime-fuzzy-abort)
-    (define-key map (kbd "<ESC>") 'slime-fuzzy-abort)
-
-    ;; the completion key
-    (define-key map "\t" 'slime-fuzzy-select-or-update-completions)
-
-    (dolist (key (list (kbd "<RET>") " " "(" ")" "[" "]"))
-      (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer))
-
-    (define-key map (kbd "<up>") 'slime-fuzzy-prev)
-    (define-key map (kbd "<down>") 'slime-fuzzy-next)
-    (define-key map (where-is-internal 'isearch-forward global-map t t)
-      (lambda ()
-        (interactive)
-        (select-window (get-buffer-window (slime-get-fuzzy-buffer)))
-        (call-interactively 'isearch-forward)))
+      (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+      (remap (list 'slime-fuzzy-indent-and-complete-symbol
+                   'slime-indent-and-complete-symbol
+                   (kbd "<tab>"))
+             'slime-fuzzy-select-or-update-completions)
+      (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+      (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
+      (remap (list 'isearch-forward (kbd "C-s"))
+             (lambda ()
+               (interactive)
+               (select-window (get-buffer-window (slime-get-fuzzy-buffer)))
+               (call-interactively 'isearch-forward))))
     map
     )
   "Keymap for slime-target-buffer-fuzzy-completions-mode. This will override the key
@@ -1013,15 +1030,11 @@
     (add-hook 'pre-command-hook 'slime-pre-command-hook)))
 
 (defun slime-setup-command-hooks ()
-  "Setup a buffer-local `pre-command-h'ook' to call `slime-pre-command-hook'."
-  (make-local-hook 'pre-command-hook)
-  (make-local-hook 'post-command-hook)
-  ;; alanr: need local t
-  (add-hook 'pre-command-hook 'slime-pre-command-hook nil t) 
-  (add-hook 'post-command-hook 'slime-post-command-hook nil t)
+  "Setup a buffer-local `pre-command-hook' to call `slime-pre-command-hook'."
+  (add-local-hook 'pre-command-hook 'slime-pre-command-hook) 
+  (add-local-hook 'post-command-hook 'slime-post-command-hook)
   (when slime-repl-enable-presentations
-    (make-local-variable 'after-change-functions)
-    (add-hook 'after-change-functions 'slime-after-change-function nil t)))
+    (add-local-hook 'after-change-functions 'slime-after-change-function)))
 
 
 ;;;; Framework'ey bits
@@ -1302,12 +1315,15 @@
 
 ;; Interface
 (defun slime-temp-buffer-quit ()
-  "Kill the current buffer and restore the old window configuration.
-See `slime-temp-buffer-dismiss'."
+  "Kill the current (temp) buffer without asking. To restore the
+window configuration without killing the buffer see
+`slime-dismiss-temp-buffer'."
   (interactive)
-  (let ((buf (current-buffer)))
-    (slime-dismiss-temp-buffer)
-    (kill-buffer buf)))
+  (let* ((buffer (current-buffer))
+         (window (get-buffer-window buffer)))
+    (kill-buffer buffer)
+    (when window
+      (delete-window window))))
 
 ;; Interface
 (defun slime-dismiss-temp-buffer ()
@@ -3130,8 +3146,7 @@
   (set (make-local-variable 'scroll-conservatively) 20)
   (set (make-local-variable 'scroll-margin) 0)
   (slime-repl-safe-load-history)
-  (make-local-hook 'kill-buffer-hook)
-  (add-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history nil t)
+  (add-local-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history)
   (add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)
   (slime-setup-command-hooks)
   (when slime-use-autodoc-mode 
@@ -6151,32 +6166,39 @@
 
 (defvar slime-fuzzy-completions-map  
   (let* ((map (make-sparse-keymap)))
+    (flet ((remap (keys to)
+             (dolist (key keys)
+               (when (symbolp key)
+                 (setf key (where-is-internal key global-map t t)))
+               (when key
+                 (define-key map key to)
+                 (return-from remap)))))
+      (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+      (define-key map "q" 'slime-fuzzy-abort)
     
-    (define-key map "q" 'slime-fuzzy-abort)
-    (define-key map (kbd "C-g") 'slime-fuzzy-abort)
-    (define-key map "\r" 'slime-fuzzy-select)
-    
-    (define-key map "n" 'slime-fuzzy-next)
-    (define-key map "\M-n" 'slime-fuzzy-next)
-    (define-key map (kbd "<down>") 'slime-fuzzy-next)
+      (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+      (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
     
-    (define-key map "p" 'slime-fuzzy-prev)
-    (define-key map "\M-p" 'slime-fuzzy-prev)
-    (define-key map (kbd "<up>") 'slime-fuzzy-prev)
+      (define-key map "n" 'slime-fuzzy-next)
+      (define-key map "\M-n" 'slime-fuzzy-next)
     
+      (define-key map "p" 'slime-fuzzy-prev)
+      (define-key map "\M-p" 'slime-fuzzy-prev)
     
-    (define-key map "\d" 'scroll-down)
+      (define-key map "\d" 'scroll-down)
 
-    ;; the completion key
-    (define-key map "\t" 'slime-fuzzy-select)
+      (remap (list 'slime-fuzzy-indent-and-complete-symbol
+                   'slime-indent-and-complete-symbol
+                   (kbd "<tab>"))
+             'slime-fuzzy-select)
 
-    (dolist (key (list (kbd "<RET>") " "))
-      (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer))
-
-    (define-key map [mouse-2] 'slime-fuzzy-select/mouse)
+      (define-key map [mouse-2] 'slime-fuzzy-select/mouse))
+    
+      (define-key map [return] 'slime-fuzzy-select)
+      (define-key map [space] 'slime-fuzzy-select)
     
     map)
-  "Keymap for slime-fuzzy-completions-mode.")
+  "Keymap for slime-fuzzy-completions-mode when in the completion buffer.")
 
 (defun slime-fuzzy-completions (prefix &optional default-package)
   "Get the list of sorted completion objects from completing
@@ -6187,7 +6209,9 @@
     (slime-eval `(swank:fuzzy-completions ,prefix 
                                           ,(or default-package
                                                (slime-find-buffer-package)
-                                               (slime-current-package))))))
+                                               (slime-current-package))
+                  :limit ,slime-fuzzy-completion-limit
+                  :time-limit-in-msec ,slime-fuzzy-completion-time-limit-in-msec))))
 
 (defun slime-fuzzy-selected (prefix completion)
   "Tell the connected Lisp that the user selected completion
@@ -6324,7 +6348,7 @@
     (slime-fuzzy-fill-completions-buffer completions)
     (when new-completion-buffer
       (pop-to-buffer (slime-get-fuzzy-buffer))
-      (add-hook 'kill-buffer-hook 'slime-fuzzy-abort nil t)
+      (add-local-hook 'kill-buffer-hook 'slime-fuzzy-abort)
       (when slime-fuzzy-completion-in-place
         ;; switch back to the original buffer
         (switch-to-buffer-other-window slime-fuzzy-target-buffer)))))
@@ -6398,6 +6422,8 @@
   (with-current-buffer (slime-get-fuzzy-buffer)
     (slime-fuzzy-dehighlight-current-completion)
     (let ((point (next-single-char-property-change (point) 'completion)))
+      (when (= point (point-max))
+        (setf point (previous-single-char-property-change (point-max) 'completion nil slime-fuzzy-first)))
       (set-window-point (get-buffer-window (current-buffer)) point)
       (goto-char point))
     (slime-fuzzy-highlight-current-completion)))
@@ -7887,8 +7913,7 @@
     (slime-autodoc-mode 1))
   ;; Make original slime-connection "sticky" for SLDB commands in this buffer
   (setq slime-buffer-connection (slime-connection))
-  (make-local-variable 'kill-buffer-hook)
-  (add-hook 'kill-buffer-hook 'sldb-delete-overlays nil t))
+  (add-local-hook 'kill-buffer-hook 'sldb-delete-overlays))
 
 (defun sldb-help-summary ()
   "Show summary of important sldb commands"
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.168
diff -u -r1.168 swank-sbcl.lisp
--- swank-sbcl.lisp	19 Oct 2006 12:30:51 -0000	1.168
+++ swank-sbcl.lisp	21 Oct 2006 09:49:03 -0000
@@ -1178,11 +1178,8 @@
 
 ;;; Weak datastructures
 
-
-;; SBCL doesn't actually implement weak hash-tables, the WEAK-P
-;; keyword is just a decoy. Leave this here, but commented out,
-;; so that no-one tries adding it back.
-#+(or)
 (defimplementation make-weak-key-hash-table (&rest args)
-  (apply #'make-hash-table :weak-p t args))
+  (apply #'make-hash-table :weakness :key args))
 
+(defimplementation make-weak-value-hash-table (&rest args)
+  (apply #'make-hash-table :weakness :value args))
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.410
diff -u -r1.410 swank.lisp
--- swank.lisp	20 Oct 2006 17:07:55 -0000	1.410
+++ swank.lisp	21 Oct 2006 09:49:06 -0000
@@ -3320,7 +3320,7 @@
            
 ;;;; Fuzzy completion
 
-(defslimefun fuzzy-completions (string default-package-name &optional limit)
+(defslimefun fuzzy-completions (string default-package-name &key limit time-limit-in-msec)
   "Return an (optionally limited to LIMIT best results) list of
 fuzzy completions for a symbol designator STRING.  The list will
 be sorted by score, most likely match first.
@@ -3346,7 +3346,13 @@
   FOO      - Symbols accessible in the buffer package.
   PKG:FOO  - Symbols external in package PKG.
   PKG::FOO - Symbols accessible in package PKG."
-  (fuzzy-completion-set string default-package-name limit))
+  ;; We may send this as elisp [] arrays to spare a coerce here,
+  ;; but then the network serialization were slower by handling arrays.
+  ;; Instead we limit the number of completions that is transferred
+  ;; (the limit is set from emacs).
+  (coerce (fuzzy-completion-set string default-package-name
+                                :limit limit :time-limit-in-msec time-limit-in-msec)
+          'list))
 
 (defun convert-fuzzy-completion-result (result converter
                                         internal-p package-name)
@@ -3395,66 +3401,90 @@
                                      )))
                   collect flag)))))
 
-(defun fuzzy-completion-set (string default-package-name &optional limit)
+(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
   "Prepares list of completion obajects, sorted by SCORE, of fuzzy
 completions of STRING in DEFAULT-PACKAGE-NAME.  If LIMIT is set,
 only the top LIMIT results will be returned."
+  (declare (optimize (speed 3))
+           (type (or null (integer 0 #.(1- most-positive-fixnum))) limit time-limit-in-msec))
   (multiple-value-bind (name package-name package internal-p)
       (parse-completion-arguments string default-package-name)
     (let* ((symbols (and package
                          (fuzzy-find-matching-symbols name
                                                       package
                                                       (and (not internal-p)
-                                                           package-name))))
+                                                           package-name)
+                                                      :time-limit-in-msec time-limit-in-msec)))
            (packs (and (not package-name)
                        (fuzzy-find-matching-packages name)))
            (converter (output-case-converter name))
-           (results
-            (sort (mapcar #'(lambda (result)
-                              (convert-fuzzy-completion-result
-                               result converter internal-p package-name))
-                          (nconc symbols packs))
-                  #'> :key #'second)))
-      (when (and limit 
-                 (> limit 0) 
+           (results (concatenate 'vector symbols packs)))
+      (loop for idx :upfrom 0
+            while (< idx (length results))
+            for el = (aref results idx)
+            do (setf (aref results idx) (convert-fuzzy-completion-result
+                                         el converter internal-p package-name)))
+      (setf results (sort results #'> :key #'second))
+      (when (and limit
+                 (> limit 0)
                  (< limit (length results)))
-        (setf (cdr (nthcdr (1- limit) results)) nil))
+        (if (array-has-fill-pointer-p results)
+            (setf (fill-pointer results) limit)
+            (setf results (make-array limit :displaced-to results))))
       results)))
 
-(defun fuzzy-find-matching-symbols (string package external)
+(defun fuzzy-find-matching-symbols (string package external &key time-limit-in-msec)
   "Return a list of symbols in PACKAGE matching STRING using the
 fuzzy completion algorithm.  If EXTERNAL is true, only external
 symbols are returned."
-  (let ((completions '())
+  (let ((completions (make-array 256 :adjustable t :fill-pointer 0))
+        (time-limit (if time-limit-in-msec
+                        (ceiling (/ time-limit-in-msec 1000))
+                        0))
+        (utime-at-start (get-universal-time))
+        (count 0)
         (converter (output-case-converter string)))
+    (declare (type (integer 0 #.(1- most-positive-fixnum)) count time-limit)
+             (type function converter))
     (flet ((symbol-match (symbol)
              (and (or (not external)
                       (symbol-external-p symbol package))
                   (compute-highest-scoring-completion 
                    string (funcall converter (symbol-name symbol))))))
-      (do-symbols (symbol package)
-        (if (string= "" string)
-            (when (or (and external (symbol-external-p symbol package))
-                      (not external))
-              (push (list symbol 0.0 (list (list 0 ""))) completions))
-            (multiple-value-bind (result score) (symbol-match symbol)
-              (when result
-                (push (list symbol score result) completions))))))
-    (remove-duplicates completions :key #'first)))
+      (block loop
+        (do-symbols (symbol package)
+          (incf count)
+          (when (and (not (zerop time-limit))
+                     (mod count 256) ; ease up on calling get-universal-time like crazy
+                     (< time-limit-in-msec (- (get-universal-time) utime-at-start)))
+            (return-from loop))
+          (if (string= "" string)
+              (when (or (and external (symbol-external-p symbol package))
+                        (not external))
+                (vector-push-extend (list symbol 0.0 (list (list 0 ""))) completions))
+              (multiple-value-bind (result score) (symbol-match symbol)
+                (when result
+                  (vector-push-extend (list symbol score result) completions)))))))
+    (remove-duplicates completions :key #'first :test #'eq)))
 
 (defun fuzzy-find-matching-packages (name)
   "Return a list of package names matching NAME using the fuzzy
 completion algorithm."
-  (let ((converter (output-case-converter name)))
+  (let ((converter (output-case-converter name))
+        (completions (make-array 32 :adjustable t :fill-pointer 0)))
+    (declare (optimize (speed 3))
+             (type function converter))  
     (loop for package in (list-all-packages)
           for package-name = (concatenate 'string 
                                           (funcall converter
                                                    (package-name package)) 
                                           ":")
           for (result score) = (multiple-value-list
-                                (compute-highest-scoring-completion
-                                 name package-name))
-          if result collect (list package-name score result))))
+                                   (compute-highest-scoring-completion
+                                    name package-name))
+          when result do
+          (vector-push-extend (list package-name score result) completions))
+    completions))
 
 (defslimefun fuzzy-completion-selected (original-string completion)
   "This function is called by Slime when a fuzzy completion is