The attached patch makes Slime's fuzzy completion semantically
complete. For example on SBCL, "sb:with C-c M-i" will now display
all with-style macros of all sb-* packages!
Here is an extract of the resulting *Fuzzy Completions* buffer (the
output in the real buffer is even cooler, as the relevant matchings
of substrings of "sb:with" are highlighted):
Completion: Flags: Score:
--------------------------------------------- ------- --------
sb-c:with-source-location -f--m-- 62.97
sb-ext:with-timeout -f--m-- 62.16
sb-sys:without-gcing -f--m-- 62.05
sb-alien:with-alien -f--m-- 61.90
sb-sys:with-fd-handler -f--m-- 61.88
sb-sys:with-interrupts -f--m-- 61.88
sb-int:with-unique-names -f--m-- 61.76
sb-thread:with-mutex -f--m-- 61.72
sb-sys:without-interrupts -f--m-- 61.71
sb-int:with-sane-io-syntax -f--m-- 61.67
sb-sys:with-pinned-objects -f--m-- 61.67
sb-ext:without-package-locks -f--m-- 61.60
sb-ext:with-unlocked-packages -f--m-- 61.57
sb-int:with-rebound-io-syntax -f--m-- 61.57
sb-int:with-float-traps-masked -f--m-- 61.55
sb-sys:with-enabled-interrupts ------- 61.55
sb-unix:with-restarted-syscall -f--m-- 61.24
sb-assem:without-scheduling -f--m-- 61.14
sb-kernel:with-array-data -f--m-- 61.13
sb-kernel:%with-array-data -f----- 61.06
sb-thread:with-new-session -f--m-- 61.06
sb-thread:with-recursive-lock -f--m-- 60.92
sb-kernel:%with-array-data-macro -f--m-- 60.82
sb-kernel:with-circularity-detection -f--m-- 60.73
sb-kernel:with-single-package-locked-error -f--m-- 60.64
swank-backend:with-struct -f--m-- 59.43
sb-c:lambda-with-lexenv ------- 56.67
...
The patch depends on my two previous patches. Appliable via -p0.
Tested on SBCL and CLISP.
-T.
--- ../slime-hacked-1/ChangeLog 2007-03-03 15:26:51.000000000 +0100
+++ ChangeLog 2007-03-03 16:18:18.000000000 +0100
@@ -1,3 +1,48 @@
+2007-03-03 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Making fuzzy completion semantically right from a
+ user perspective. As an example on SBCL, "sb:with- C-c M-i" will
+ display all exported "with"-style macros in all sb-* packages from
+ now on. :)
+
+ (parse-completion-arguments): Replacing with a semantically-sound
+ implementation Previous implementation was a bit, because the
+ previous one was a bit confused. Clarifying docstring. Adding
+ commentary table of various constellations of returned values
+ for thorough explanation.
+
+ (carefully-find-package): Removed. Obsolete by above change.
+
+ (defstruct fuzzy-matching): Introduced to make internally-used
+ datastructure explicit. Distinguishing ``completion chunks''
+ between those pertaining to the symbol itself and those to the
+ package identifier.
+
+ (convert-fuzzy-completion-result): Renamed to
+ FUZZY-CONVERT-MATCHING-FOR-EMACS.
+
+ (fuzzy-convert-matching-for-emacs): Accomodating for the new
+ datastructure. Only the chunks pertaining to the symbol itself are
+ fixed up positionally, the package-chunks are untouched.
+ Necessary for letting package identifiers be highlighted within
+ *Fuzzy Completions* in cases like "sb:with- C-c M-i."
+
+ (fuzzy-completion-set): Taking out most code to become new
+ function FUZZY-CREATE-COMPLETION-SET.
+
+ (fuzzy-create-completion-set): Doing all the hard work. Crux of
+ this changeset. so to speak. Largly rewritten to accomodate all
+ different cases of PARSE-COMPLETION-ARGUMENT.
+
+ (fuzzy-find-matching-symbols, fuzzy-find-matching-packages):
+ Accomodating to new datatstructure FUZZY-MATCHING. Adapting
+ docstring accordingly.
+
+ * swank-backend.lisp: Export WITH-STRUCT.
+
+ * swank.lisp (eval-for-emacs, fuzzy-completions):
+ Various trivia like fixing spelling and indentation.
+
2007-03-01 Tobias C. Rittweiler <tcr(a)freebits.de>
* slime.el (slime-fuzzy-highlight-current-completion): Fix
@@ -5,7 +50,7 @@
completion in the *Fuzzy Completion* buffer be highlighted
one char too far.
-2007-02-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+07-02-26 Tobias C. Rittweiler <tcr(a)freebits.de>
* swank.lisp: Cleanup of parts of the fuzzy completion code.
Additionally a couple of enhancements. As follows:
--- ../slime-hacked-1/swank.lisp 2007-03-03 15:05:27.000000000 +0100
+++ swank.lisp 2007-03-03 15:45:08.000000000 +0100
@@ -2472,7 +2472,7 @@
*package*))
(defun eval-for-emacs (form buffer-package id)
- "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM.
+ "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
Return the result to the continuation ID.
Errors are trapped and invoke our debugger."
(call-with-debugger-hook
@@ -3279,25 +3279,43 @@
collect (package-name package)
append (package-nicknames package))))))
+;; PARSE-COMPLETION-ARGUMENTS return table:
+;;
+;; user behaviour | NAME | PACKAGE-NAME | PACKAGE
+;; ----------------+--------+--------------+-----------------------------------
+;; asdf [tab] | "asdf" | NIL | #<PACKAGE "DEFAULT-PACKAGE-NAME">
+;; | | | or *BUFFER-PACKAGE*
+;; asdf: [tab] | "" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; asdf:foo [tab] | "foo" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; as:fo [tab] | "fo" | "as" | NIL
+;; | | |
+;; : [tab] | "" | "" | #<PACKAGE "KEYWORD">
+;; | | |
+;; :foo [tab] | "foo" | "" | #<PACKAGE "KEYWORD">
+;;
(defun parse-completion-arguments (string default-package-name)
"Parse STRING as a symbol designator.
Return these values:
SYMBOL-NAME
PACKAGE-NAME, or nil if the designator does not include an explicit package.
- PACKAGE, the package to complete in
+ PACKAGE, generally the package to complete in. (However, if PACKAGE-NAME is
+ NIL, return the respective package of DEFAULT-PACKAGE-NAME instead;
+ if PACKAGE is non-NIL but a package cannot be found under that name,
+ return NIL.)
INTERNAL-P, if the symbol is qualified with `::'."
(multiple-value-bind (name package-name internal-p)
(tokenize-symbol string)
- (let ((package (carefully-find-package package-name default-package-name)))
- (values name package-name package internal-p))))
+ (if package-name
+ (let ((package (guess-package (if (equal package-name "")
+ "KEYWORD"
+ package-name))))
+ (values name package-name package internal-p))
+ (let ((package (guess-package default-package-name)))
+ (values name package-name (or package *buffer-package*) internal-p))
+ )))
-(defun carefully-find-package (name default-package-name)
- "Find the package with name NAME, or DEFAULT-PACKAGE-NAME, or the
-*buffer-package*. NAME and DEFAULT-PACKAGE-NAME can be nil."
- (let ((string (cond ((equal name "") "KEYWORD")
- (t (or name default-package-name)))))
- (or (and string (guess-package string))
- *buffer-package*)))
;;;;; Format completion results
;;;
@@ -3465,9 +3483,13 @@
The result is a list of completion objects, where a completion
object is:
+
(COMPLETED-STRING SCORE (&rest CHUNKS) FLAGS)
+
where a CHUNK is a description of a matched substring:
+
(OFFSET SUBSTRING)
+
and FLAGS is a list of keywords describing properties of the
symbol (see CLASSIFY-SYMBOL).
@@ -3492,31 +3514,49 @@
;; 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)
+ (coerce (fuzzy-completion-set string default-package-name :limit limit
+ :time-limit-in-msec time-limit-in-msec)
'list))
-(defun convert-fuzzy-completion-result (fuzzy-matching converter
- internal-p package-name)
+;;; A Fuzzy Matching -- Not to be confused with a fuzzy completion
+;;; object that will be sent back to Emacs, as described above.
+
+(defstruct (fuzzy-matching (:conc-name fuzzy-matching.)
+ (:predicate fuzzy-matching-p)
+ (:constructor %make-fuzzy-matching))
+ symbol ; The symbol that has been found to match.
+ score ; the higher the better symbol is a match.
+ package-chunks ; Chunks pertaining to the package identifier of the symbol.
+ symbol-chunks) ; Chunks pertaining to the symbol's name.
+
+(defun make-fuzzy-matching (symbol score package-chunks symbol-chunks)
+ (%make-fuzzy-matching :symbol symbol :score score
+ :package-chunks package-chunks
+ :symbol-chunks symbol-chunks))
+
+
+(defun fuzzy-convert-matching-for-emacs (fuzzy-matching converter
+ internal-p package-name)
"Converts a result from the fuzzy completion core into
something that emacs is expecting. Converts symbols to strings,
fixes case issues, and adds information describing if the symbol
is :bound, :fbound, a :class, a :macro, a :generic-function,
a :special-operator, or a :package."
- (destructuring-bind (symbol score chunks) fuzzy-matching
+ (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks) fuzzy-matching
(multiple-value-bind (name added-length)
(format-completion-result
(funcall (or converter #'identity) (symbol-name symbol))
internal-p package-name)
(list name
score
- (mapcar #'(lambda (chunk)
- ;; fix up chunk positions to account for possible
- ;; added package identifier
- (list (+ added-length (first chunk))
- (second chunk)))
- chunks)
+ (append package-chunks
+ (mapcar #'(lambda (chunk)
+ ;; fix up chunk positions to account for possible
+ ;; added package identifier.
+ (let ((offset (first chunk)) (string (second chunk)))
+ (list (+ added-length offset) string)))
+ symbol-chunks))
(classify-symbol symbol)))))
(defun classify-symbol (symbol)
@@ -3538,50 +3578,107 @@
(push :generic-function result))
result))
+
(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
"Prepares list of completion objects, 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 (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)
- (flet ((convert (vector &optional converter)
- (when vector
- (map-into vector
- #'(lambda (fuzzy-matching)
- (convert-fuzzy-completion-result fuzzy-matching converter
- internal-p package-name))
- vector))))
- (let* ((symbols (and package
- (fuzzy-find-matching-symbols name package
- :time-limit-in-msec time-limit-in-msec
- :external-only (and (not internal-p)
- package-name))))
- (packages (and (not package-name)
- (fuzzy-find-matching-packages name)))
- (results))
- (convert symbols (completion-output-symbol-converter string))
- (convert packages #'(lambda (package-name)
- (let ((converter (completion-output-package-converter string)))
- ;; Present packages with a trailing colon for maximum convenience!
- (concatenate 'string (funcall converter package-name) ":"))))
- ;; Sort alphabetically before sorting by score. (Especially useful when
- ;; STRING is empty, and SYMBOLS is a list of all possible completions.)
- (setf results (sort (concatenate 'vector symbols packages) #'string-lessp :key #'first))
- (setf results (stable-sort results #'> :key #'second))
+ (check-type (values limit time-limit-in-msec)
+ (or null (integer 0 #.(1- most-positive-fixnum))))
+ (let* ((completion-set (fuzzy-create-completion-set string default-package-name
+ time-limit-in-msec)))
(when (and limit
(> limit 0)
- (< limit (length results)))
- (if (array-has-fill-pointer-p results)
- (setf (fill-pointer results) limit)
- (setf results (make-array limit :displaced-to results))))
- results))))
+ (< limit (length completion-set)))
+ (if (array-has-fill-pointer-p completion-set)
+ (setf (fill-pointer completion-set) limit)
+ (setf completion-set (make-array limit :displaced-to completion-set))))
+ completion-set))
+
+
+(defun fuzzy-create-completion-set (string default-package-name time-limit-in-msec)
+ "Does all the hard work for FUZZY-COMPLETION-SET."
+ (multiple-value-bind (parsed-name parsed-package-name package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (flet ((convert (matchings package-name &optional converter)
+ ;; Converts MATCHINGS to completion objects for Emacs.
+ ;; PACKAGE-NAME is the package identifier that's used as prefix
+ ;; during formatting. If NIL, the identifier is omitted.
+ (map-into matchings
+ #'(lambda (m)
+ (fuzzy-convert-matching-for-emacs m converter
+ internal-p
+ package-name))
+ matchings))
+ (fix-up (matchings parent-package-matching)
+ ;; The components of each matching in MATCHINGS have been computed
+ ;; relative to PARENT-PACKAGE-MATCHING. Make them absolute.
+ (let* ((p parent-package-matching)
+ (p.score (fuzzy-matching.score p))
+ (p.chunks (fuzzy-matching.package-chunks p)))
+ (map-into matchings
+ #'(lambda (m)
+ (let ((m.score (fuzzy-matching.score m)))
+ (setf (fuzzy-matching.package-chunks m) p.chunks)
+ (setf (fuzzy-matching.score m)
+ (if (string= parsed-name "")
+ ;; (make packages be sorted before their symbol
+ ;; matchings while preserving over all orderness
+ ;; among different symbols in different packages)
+ (/ p.score 100)
+ (+ p.score m.score)))
+ m))
+ matchings)))
+ (find-matchings (designator package)
+ (fuzzy-find-matching-symbols designator package
+ :time-limit-in-msec time-limit-in-msec
+ :external-only (not internal-p))))
+ (let ((symbol-normalizer (completion-output-symbol-converter string))
+ (package-normalizer #'(lambda (package-name)
+ (let ((converter (completion-output-package-converter string)))
+ ;; Present packages with a trailing colon for maximum convenience!
+ (concatenate 'string (funcall converter package-name) ":"))))
+ (symbols) (packages) (results))
+ (cond ((not parsed-package-name) ; STRING = "asd"
+ ;; We don't know if user is searching for a package or a symbol
+ ;; within his current package. So we try to find either.
+ (setf symbols (find-matchings parsed-name package)
+ symbols (convert symbols nil symbol-normalizer)
+ packages (fuzzy-find-matching-packages parsed-name)
+ packages (convert packages nil package-normalizer)))
+ ((string= parsed-package-name "") ; STRING = ":" or ":foo"
+ (setf symbols (find-matchings parsed-name package)
+ symbols (convert symbols "" symbol-normalizer)))
+ (t ; STRING= "asdf:" or "asdf:foo"
+ ;; Find fuzzy matchings of the denoted package identifier part.
+ ;; After that find matchings for the denoted symbol identifier
+ ;; relative to all those packages found.
+ (loop
+ with found-packages = (fuzzy-find-matching-packages parsed-package-name)
+ for package-matching across found-packages
+ do
+ (let* ((pkgsym (fuzzy-matching.symbol package-matching))
+ (package-name (symbol-name pkgsym))
+ (package-name (funcall symbol-normalizer package-name))
+ (matchings (find-matchings parsed-name (find-package pkgsym))))
+ (setf matchings (fix-up matchings package-matching))
+ (setf matchings (convert matchings package-name symbol-normalizer))
+ (setf symbols (concatenate 'vector symbols matchings)))
+ finally ; CONVERT is destructive. So we have to do this at last.
+ (when (string= parsed-name "")
+ (setf packages (convert found-packages nil package-normalizer))))))
+ ;; Sort alphabetically before sorting by score. (Especially useful when
+ ;; PARSED-NAME is empty, and all possible completions are to be returned.)
+ (setf results (concatenate 'vector symbols packages))
+ (setf results (sort results #'string-lessp :key #'first))
+ (setf results (stable-sort results #'> :key #'second))
+ results))))
+
(defun fuzzy-find-matching-symbols (string package &key external-only time-limit-in-msec)
- "Returns a vector of fuzzy matchings (that is a list of the symbol in
-PACKAGE that's matching STRING, its score, and a list of its completion
-chunks), using the fuzzy completion algorithm. If EXTERNAL-ONLY is true,
-only external symbols are considered."
+ "Returns a vector of fuzzy matchings for matching symbols in PACKAGE,
+using the fuzzy completion algorithm. If EXTERNAL-ONLY is true, only
+external symbols are considered."
(let ((completions (make-array 256 :adjustable t :fill-pointer 0))
(converter (completion-output-symbol-converter string))
(time-limit (if time-limit-in-msec
@@ -3593,7 +3690,7 @@
(declare (type function converter))
(flet ((time-exhausted-p ()
(and (not (zerop time-limit))
- (zerop (mod count 256)) ; ease up on calling get-universal-time like crazy
+ (zerop (mod count 256)) ; ease up on calling get-universal-time like crazy
(incf count)
(>= (- (get-universal-time) utime-at-start) time-limit)))
(perform-fuzzy-match (string symbol-name)
@@ -3604,17 +3701,19 @@
(do-symbols* (symbol package)
(when (time-exhausted-p) (return-from loop))
(when (or (not external-only) (symbol-external-p symbol package))
- (if (string= "" string)
- (vector-push-extend (list symbol 0.0 (list (list 0 ""))) completions)
+ (if (string= "" string)
+ (vector-push-extend (make-fuzzy-matching symbol 0.0 '() '())
+ completions) ; create vanilla matching.
(multiple-value-bind (match-result score)
(perform-fuzzy-match string (symbol-name symbol))
(when match-result
- (vector-push-extend (list symbol score match-result) completions)))))))))))
+ (vector-push-extend (make-fuzzy-matching symbol score '() match-result)
+ completions)))))))))))
+
(defun fuzzy-find-matching-packages (name)
- "Returns a vector of relevant fuzzy matchings (that is a list
-consisting of a symbol representing the package that matches NAME,
-its score, and its completions chunks.)"
+ "Returns a vector of fuzzy matchings for each package that
+is similiar to NAME."
(let ((converter (completion-output-package-converter name))
(completions (make-array 32 :adjustable t :fill-pointer 0)))
(declare ;;(optimize (speed 3))
@@ -3627,14 +3726,12 @@
for (result score) = (multiple-value-list ; too invasive.
(compute-highest-scoring-completion
name converted-name))
- ;; We return a symbol that represents the package, a) to make
- ;; the type of the returned value consistent with the one of
- ;; FUZZY-FIND-MATCHING-SYMBOLS, and b) to be able to call
- ;; CLASSIFY-SYMBOL upon it later on.
- when result do
- (vector-push-extend (list package-symbol score result) completions))
+ when result do (vector-push-extend
+ (make-fuzzy-matching package-symbol score result '())
+ completions))
completions))
+
(defslimefun fuzzy-completion-selected (original-string completion)
"This function is called by Slime when a fuzzy completion is
selected by the user. It is for future expansion to make
@@ -3648,6 +3745,7 @@
(declare (ignore original-string completion))
nil)
+
;;;;; Fuzzy completion core
(defparameter *fuzzy-recursion-soft-limit* 30
@@ -3759,6 +3857,7 @@
(push rev-chunks *all-chunks*)
rev-chunks))))
+
;;;;; Fuzzy completion scoring
(defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<"
--- ../slime-hacked-1/swank-backend.lisp 2007-02-25 19:19:55.000000000 +0100
+++ swank-backend.lisp 2007-02-28 20:43:08.000000000 +0100
@@ -39,6 +39,7 @@
#:label-value-line
#:label-value-line*
#:type-for-emacs
+ #:with-struct
))
(defpackage :swank-mop
