[slime-devel] fuzzy update with fixes
Attila Lendvai
attila.lendvai at gmail.com
Sat Oct 21 05:56:48 EDT 2006
Skipped content of type multipart/alternative-------------- next part --------------
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
More information about the slime-devel
mailing list