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))
