[slime-devel] some fixes to the fuzzy completion

[Attila Lendvai]

please find this attached:

2006-10-29  Attila Lendvai  <attila.lendvai at gmail.com>

    * slime.el (sldb-sexp-highlight-mode): New custom.

    * swank.el (fuzzy-completion-set): Fix on clisp.
    (convert-fuzzy-completion-result): Fix symbol fbound
    and other annotations broken recently.

-- 
- 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/20061029/7ff7457d/attachment.html>
-------------- next part --------------
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.677
diff -u -r1.677 slime.el
--- slime.el	26 Oct 2006 13:38:07 -0000	1.677
+++ slime.el	28 Oct 2006 22:25:38 -0000
@@ -384,7 +384,15 @@
 	  (const :tag "Don't show" nil))
   :group 'slime-debugger)
 
+(defcustom sldb-sexp-highlight-mode :auto
+  "Defines how sexps are highlighted in sldb. Auto means Entire when paren-mode is 'sexp-surround." 
+  :type '(choice
+          (const :tag "Auto" :value :auto)
+          (const :tag "Entire" :value :entire)
+          (const :tag "Sides" :value :sides))
+  :group 'slime-debugger)
+
 (defmacro def-sldb-faces (&rest faces)
   "Define the set of SLDB faces.
 Each face specifiation is (NAME DESCRIPTION &optional PROPERTIES).

@@ -8377,8 +8389,13 @@
   (sldb-delete-overlays)
   (let ((start (or start (point)))
 	(end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
-    (push (make-overlay start (1+ start)) sldb-overlays)
-    (push (make-overlay (1- end) end) sldb-overlays)
+    (cond ((or (eq sldb-sexp-highlight-mode :entire)
+               (and (eq sldb-sexp-highlight-mode :auto)
+                    (eq paren-mode 'sexp-surround)))
+           (push (make-overlay start end) sldb-overlays))
+          (t
+            (push (make-overlay start (1+ start)) sldb-overlays)
+            (push (make-overlay (1- end) end) sldb-overlays)))
     (dolist (overlay sldb-overlays)
       (overlay-put overlay 'face 'secondary-selection))))
 
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.411
diff -u -r1.411 swank.lisp
--- swank.lisp	26 Oct 2006 12:47:15 -0000	1.411
+++ swank.lisp	28 Oct 2006 22:25:41 -0000
@@ -3403,7 +3403,7 @@
                           symbol-or-name))
              symbol-or-name)
          internal-p package-name)
-      (list name score 
+      (list name score
             (mapcar
              #'(lambda (chunk)
                  ;; fix up chunk positions to account for possible
@@ -3442,24 +3442,25 @@
   (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)
-             (loop for idx :upfrom 0
-                   while (< idx (length vector))
-                   for el = (aref vector idx)
-                   do (setf (aref vector idx) (convert-fuzzy-completion-result
-                                                el nil internal-p package-name)))))
+    (flet ((convert (vector &optional converter)
+             (when vector
+               (loop for idx :upfrom 0
+                     while (< idx (length vector))
+                     for el = (aref vector idx)
+                     do (setf (aref vector idx) (convert-fuzzy-completion-result
+                                                 el converter internal-p package-name))))))
       (let* ((symbols (and package
                            (fuzzy-find-matching-symbols name
                                                         package
                                                         (and (not internal-p)
                                                              package-name)
                                                         :time-limit-in-msec time-limit-in-msec
-                                                        :return-converted-p t)))
+                                                        :return-converted-p nil)))
              (packs (and (not package-name)
                          (fuzzy-find-matching-packages name)))
              (results))
-        (convert symbols)
+        (convert symbols (completion-output-symbol-converter string))
         (convert packs)
         (setf results (sort (concatenate 'vector symbols packs) #'> :key #'second))
         (when (and limit