Hi, the attached patch cleans up parts of the relevant code for fuzzy completion in swank.lisp. There are two user visible changes: i) The flags in the *Fuzzy Completions* buffer (indicating if the respective symbol is boundp, fboundp, represeting a class, macro &c) are now extended by the "p" flag indicating the there exists a package accessible via that symbol. ii) the symbols in the *Fuzzy Completions* are now sorted alphabetically before sorted by their score. From my ChangeLog entry: Affects especially the list of all possible completions when the user hits fuzzy-completion on an empty string within Emacs; also makes the potential limitness of the listed completions clearer to the end user of SLIME. Stay tuned, -T. Index: ChangeLog =================================================================== RCS file: /project/slime/cvsroot/slime/ChangeLog,v retrieving revision 1.1076 diff -u -r1.1076 ChangeLog --- ChangeLog 26 Feb 2007 09:56:06 -0000 1.1076 +++ ChangeLog 26 Feb 2007 19:58:56 -0000 @@ -1,3 +1,53 @@ +2007-02-26 Tobias C. Rittweiler <tcr@freebits.de> + + * swank.lisp: Cleanup of parts of the fuzzy completion code. + Additionally a couple of enhancements. As follows: + + (fuzzy-completions, fuzzy-completion-selected): Minor + stylistic and clarifying modifications of the docstrings. + + (fuzzy-find-matching-symbols): Huge code reorganization. + Organizing relevant code into local function TIME-EXHAUSTED-P, + renaming local function SYMBOL-MATCH to PERFORM-FUZZY-MATCH, + making previously required argument EXTERNAL to new &key + argument :EXTERNAL-ONLY, clarifying docstring. + + (fuzzy-find-matching-packages): Making its return value + conformant to that of FUZZY-FIND-MATCHING-SYMBOLS, i.e. + instead of returning, among others, a package's name as + string, it now returns a symbol representing the package. + Accomodates the docstring accordingly. + + (fuzzy-completion-set): Minor typographical fix in docstring. + Changing local function CONVERT to use MAP-INTO instead of + doing it essentially manually. Accomodating to changes of + FUZZY-FIND-MATCHING-SYMBOLS, resp. -PACKAGES. + + (fuzzy-completion-set): Additional new feature: + The returned completions are sorted alphabetically by the + matched completion string before sorted by its score. + Affects especially the list of all possible completions when + the user hits fuzzy-completion on an empty string within Emacs; + also makes the potential limitness of the listed completions + clearer to the end user of SLIME. + + (classify-symbol): New function. Returns a list with keywords + that classifies a given symbol. (E.g. :BOUNDP, :MACRO &c) + Supersedes parts of CONVERT-FUZZY-COMPLETION-RESULT, + implementing them in a more straightforward and proper way; + removes prior KLUDGE in that part of the original function. + + (convert-fuzzy-completion-result): The above changes made + it possible to simplify this function drastically. Now uses + the newly introduced function CLASSIFY-SYMBOL. + + * slime.el: Minor stylistic changes. Additionally: + (slime-fuzzy-insert-completion-choice): + (slime-fuzzy-fill-completions-buffer) : Adding use of the + :PACKAGE classification flag returned by SWANK:FUZZY-COMPLETIONS. + This flag is called "p". + + 2007-02-26 Nikodemus Siivola <nikodemus@random-state.net> * swank.lisp (inspect-for-emacs): Add support for inspecting Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.766 diff -u -r1.766 slime.el --- slime.el 25 Feb 2007 15:59:34 -0000 1.766 +++ slime.el 26 Feb 2007 19:58:57 -0000 @@ -6412,7 +6412,7 @@ (slime-fuzzy-done)) (goto-char end) (cond ((= (length completion-set) 1) - (insert-and-inherit (caar completion-set)) + (insert-and-inherit (caar completion-set)) ; insert completed string (delete-region beg end) (goto-char (+ beg (length (caar completion-set)))) (slime-minibuffer-respecting-message "Sole completion") @@ -6430,7 +6430,7 @@ "Click <mouse-2> on a completion to select it. In this buffer, type n and p to navigate between completions. Type RET to select the completion near point. Type q to abort. -Flags: boundp fboundp generic-function class macro special-operator +Flags: boundp fboundp generic-function class macro special-operator package \n" "The explanation that gets inserted at the beginning of the *Fuzzy Completions* buffer.") @@ -6440,11 +6440,11 @@ completion choice into the current buffer, and mark it with the proper text properties." (let ((start (point)) - (symbol (first completion)) + (symbol-name (first completion)) (score (second completion)) (chunks (third completion)) (flags (fourth completion))) - (insert symbol) + (insert symbol-name) (let ((end (point))) (dolist (chunk chunks) (put-text-property (+ start (first chunk)) @@ -6454,13 +6454,14 @@ (put-text-property start (point) 'mouse-face 'highlight) (dotimes (i (- max-length (- end start))) (insert " ")) - (insert (format " %s%s%s%s%s%s %8.2f" + (insert (format " %s%s%s%s%s%s%s %8.2f" (if (member :boundp flags) "b" "-") (if (member :fboundp flags) "f" "-") (if (member :generic-function flags) "g" "-") (if (member :class flags) "c" "-") (if (member :macro flags) "m" "-") (if (member :special-operator flags) "s" "-") + (if (member :package flags) "p" "-") score)) (insert "\n") (put-text-property start (point) 'completion completion)))) @@ -6522,9 +6523,12 @@ (setf max-length (max max-length (length (first completion))))) (insert "Completion:") (dotimes (i (- max-length 10)) (insert " ")) - (insert "Flags: Score:\n") + ;; Flags: Score: + ;; ... ------- -------- + ;; bfgcmsp + (insert "Flags: Score:\n") (dotimes (i max-length) (insert "-")) - (insert " ------ --------\n") + (insert " ------- --------\n") (setq slime-fuzzy-first (point)) (dolist (completion completions) (slime-fuzzy-insert-completion-choice completion max-length)) Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.460 diff -u -r1.460 swank.lisp --- swank.lisp 26 Feb 2007 09:56:06 -0000 1.460 +++ swank.lisp 26 Feb 2007 19:58:57 -0000 @@ -3455,6 +3455,9 @@ ;;;; Fuzzy completion +;;; For nomenclature of the fuzzy completion section, please read +;;; through the following docstring. + (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 @@ -3463,13 +3466,17 @@ 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 string of characters: - (OFFSET STRING) -and FLAGS is a list of keywords describing properties of the symbol. -For example, the top result for completing \"mvb\" in a package -that uses COMMON-LISP would be something like: - (\"multiple-value-bind\" 42.391666 ((0 \"mul\") (9 \"v\") (15 \"b\")) +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). + +E.g., completing \"mvb\" in a package that uses COMMON-LISP would +return something like: + + ((\"multiple-value-bind\" 26.588236 ((0 \"m\") (9 \"v\") (15 \"b\")) (:FBOUNDP :MACRO)) + ...) If STRING is package qualified the result list will also be qualified. If string is non-qualified the result strings are @@ -3489,57 +3496,50 @@ :limit limit :time-limit-in-msec time-limit-in-msec) 'list)) -(defun convert-fuzzy-completion-result (result converter + +(defun convert-fuzzy-completion-result (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-or-name score chunks) result + (destructuring-bind (symbol score chunks) fuzzy-matching (multiple-value-bind (name added-length) (format-completion-result - (if converter - (funcall converter - (if (symbolp symbol-or-name) - (symbol-name symbol-or-name) - symbol-or-name)) - symbol-or-name) - 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) - (loop for flag in '(:boundp :fboundp :generic-function - :class :macro :special-operator - :package) - if (if (symbolp symbol-or-name) - (case flag - (:boundp (boundp symbol-or-name)) - (:fboundp (fboundp symbol-or-name)) - (:class (find-class symbol-or-name nil)) - (:macro (macro-function symbol-or-name)) - (:special-operator - (special-operator-p symbol-or-name)) - (:generic-function - (typep (ignore-errors (fdefinition symbol-or-name)) - 'generic-function))) - (case flag - (:package (stringp symbol-or-name) - ;; KLUDGE: depends on internal - ;; knowledge that packages are - ;; brought up from the bowels of - ;; the completion algorithm as - ;; strings! - ))) - collect flag))))) + (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) + (classify-symbol symbol))))) + +(defun classify-symbol (symbol) + "Returns a list of classifiers that classify SYMBOL according +to its underneath objects (e.g. :BOUNDP if SYMBOL constitutes a +special variable.) The list may contain the following classification +keywords: :BOUNDP, :FBOUNDP, :GENERIC-FUNCTION, :CLASS, :MACRO, +:SPECIAL-OPERATOR, and/or :PACKAGE" + (check-type symbol symbol) + (let (result) + (when (boundp symbol) (push :boundp result)) + (when (fboundp symbol) (push :fboundp result)) + (when (find-class symbol nil) (push :class result)) + (when (macro-function symbol) (push :macro result)) + (when (special-operator-p symbol) (push :special-operator result)) + (when (find-package symbol) (push :package result)) + (when (typep (ignore-errors (fdefinition symbol)) + 'generic-function) + (push :generic-function result)) + result)) (defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec) - "Prepares list of completion obajects, sorted by SCORE, of fuzzy + "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)) @@ -3547,23 +3547,28 @@ (parse-completion-arguments string default-package-name) (flet ((convert (vector &optional converter) (when vector - (loop for idx below (length vector) - for el = (aref vector idx) - do (setf (aref vector idx) (convert-fuzzy-completion-result - el converter internal-p package-name)))))) + (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 - (and (not internal-p) - package-name) + (fuzzy-find-matching-symbols name package :time-limit-in-msec time-limit-in-msec - :return-converted-p nil))) - (packs (and (not package-name) + :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 packs) - (setf results (sort (concatenate 'vector symbols packs) #'> :key #'second)) + (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)) (when (and limit (> limit 0) (< limit (length results))) @@ -3572,59 +3577,62 @@ (setf results (make-array limit :displaced-to results)))) results)))) -(defun fuzzy-find-matching-symbols (string package external &key time-limit-in-msec return-converted-p) - "Return a list of symbols in PACKAGE matching STRING using the -fuzzy completion algorithm. If EXTERNAL is true, only external -symbols are returned." +(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." (let ((completions (make-array 256 :adjustable t :fill-pointer 0)) + (converter (completion-output-symbol-converter string)) (time-limit (if time-limit-in-msec (ceiling (/ time-limit-in-msec 1000)) 0)) (utime-at-start (get-universal-time)) - (count 0) - (converter (completion-output-symbol-converter string))) - (declare (type (integer 0 #.(1- most-positive-fixnum)) count time-limit) - (type function converter)) - (flet ((symbol-match (symbol converted) - (and (or (not external) - (symbol-external-p symbol package)) - (compute-highest-scoring-completion - string converted)))) - (block loop - (do-symbols* (symbol package) - (incf count) - (when (and (not (zerop time-limit)) - (zerop (mod count 256)) ; ease up on calling get-universal-time like crazy - (>= (- (get-universal-time) utime-at-start) time-limit)) - (return-from loop)) - (let* ((converted (funcall converter (symbol-name symbol))) - (result (if return-converted-p converted symbol))) - (if (string= "" string) - (when (or (and external (symbol-external-p symbol package)) - (not external)) - (vector-push-extend (list result 0.0 (list (list 0 ""))) completions)) - (multiple-value-bind (match-result score) (symbol-match symbol converted) - (when match-result - (vector-push-extend (list result score match-result) completions))))))) - completions))) + (count 0)) + (declare (type (integer 0 #.(1- most-positive-fixnum)) count time-limit)) + (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 + (incf count) + (>= (- (get-universal-time) utime-at-start) time-limit))) + (perform-fuzzy-match (string symbol-name) + (let ((converted-symbol-name (funcall converter symbol-name))) + (compute-highest-scoring-completion string converted-symbol-name)))) + (prog1 completions + (block loop + (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) + (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))))))))))) (defun fuzzy-find-matching-packages (name) - "Return a list of package names matching NAME using the fuzzy -completion algorithm." + "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.)" (let ((converter (completion-output-package-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 + for package-name = (package-name package) + for converted-name = (funcall converter package-name) + for package-symbol = (or (find-symbol package-name) + (make-symbol package-name)) ; INTERN'd be + for (result score) = (multiple-value-list ; too invasive. (compute-highest-scoring-completion - name package-name)) + 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-name score result) completions)) + (vector-push-extend (list package-symbol score result) completions)) completions)) (defslimefun fuzzy-completion-selected (original-string completion) @@ -3657,7 +3665,7 @@ "Finds the highest scoring way to complete the abbreviation SHORT onto the string FULL, using CHAR= as a equality function for letters. Returns two values: The first being the completion -chunks of the high scorer, and the second being the score." +chunks of the highest scorer, and the second being the score." (let* ((scored-results (mapcar #'(lambda (result) (cons (score-completion result short full) result))