[slime-devel] fuzzy update with fixes
Attila Lendvai
attila.lendvai at gmail.com
Sat Oct 21 09:56:48 UTC 2006
please find the updated patch attached. (the vector serialization part was
crappy and pointless so i've dropped it)
there are some other fixes in it, too, like the completion buffer randomly
closing when editing the target buffer.
2006-10-21 Attila Lendvai <attila.lendvai at gmail.com>
* slime.el (slime-setup-command-hooks): Use make-local-hook.
(slime-repl-mode): Ditto.
(slime-fuzzy-choices-buffer): Ditto.
(sldb-mode): Ditto.
(slime-fuzzy-completion-limit): New variable.
(slime-fuzzy-completion-time-limit-in-msec): New variable.
(slime-fuzzy-next): Fix when at the end of the buffer.
(slime-temp-buffer-quit): Always close the opened window,
updated docstring.
Also made the fuzzy maps smarter, they now try to look up
keys with 'where-is-internal and map the functions on them.
* swank-sbcl.lisp
(make-weak-value-hash-table): New for sbcl.
(make-weak-key-hash-table): New for sbcl.
* swank.lisp (fuzzy-completions and friends): Added :limit
and :time-limit-in-msec keyword params. Used vectors instead
of lists that nearly doubled its speed (at least on sbcl).
Also added some declare optimize and type annotations.
--
- attila
"- The truth is that I've been too considerate, and so became
unintentionally cruel...
- I understand.
- No, you don't understand! We don't speak the same language!"
(Ingmar Bergman - Smultronstället)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-devel/attachments/20061021/c39a120b/attachment.html>
-------------- 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