[slime-cvs] CVS update: slime/slime.el

Luke Gorrie lgorrie at common-lisp.net
Tue Jun 22 17:02:50 UTC 2004


Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6058

Modified Files:
	slime.el 
Log Message:
Backed out all of my changes to fuzzy completion. I was too hasty and
didn't do good things. Now it's back in pristine state from Brian's
patch -- use `C-c M-i' to fuzzy-complete.

Date: Tue Jun 22 10:02:50 2004
Author: lgorrie

Index: slime/slime.el
diff -u slime/slime.el:1.332 slime/slime.el:1.333
--- slime/slime.el:1.332	Tue Jun 22 07:06:32 2004
+++ slime/slime.el	Tue Jun 22 10:02:50 2004
@@ -159,9 +159,7 @@
   "Function to perform symbol completion."
   :group 'slime
   :type 'function
-  :options '(slime-complete-symbol*
-             slime-simple-complete-symbol
-             slime-fuzzy-complete-symbol))
+  :options '(slime-complete-symbol* slime-simple-complete-symbol))
   
 (defcustom slime-connected-hook nil
   "List of functions to call when SLIME connects to Lisp."
@@ -444,6 +442,7 @@
     ;; Editing/navigating
     ("\M-\C-i" slime-complete-symbol :inferior t)
     ("\C-i" slime-complete-symbol :prefixed t :inferior t)
+    ("\M-i" slime-fuzzy-complete-symbol :prefixed t :inferior t)
     ("\M-." slime-edit-definition :inferior t :sldb t)
     ("\M-," slime-pop-find-definition-stack :inferior t :sldb t)
     ("\C-q" slime-close-parens-at-point :prefixed t :inferior t)
@@ -536,7 +535,6 @@
       [ "Edit Definition..."       slime-edit-definition ,C ]
       [ "Return From Definition"   slime-pop-find-definition-stack ,C ]
       [ "Complete Symbol"          slime-complete-symbol ,C ]
-      [ "Fuzzy Complete Symbol"    slime-fuzzy-complete-symbol ,C ]
       [ "Show REPL"                slime-switch-to-output-buffer ,C ]
       "--"
       ("Evaluation"
@@ -4045,59 +4043,58 @@
 
 ;;; Fuzzy completion
 
-(defvar slime-fuzzy-target-buffer nil
+(defvar slime-fuzzy-completion-target-buffer nil
   "The buffer that is the target of the completion activities.")
-(defvar slime-fuzzy-saved-window-configuration nil
+(defvar slime-fuzzy-completion-window-configuration nil
   "The saved window configuration before the fuzzy completion
 buffer popped up.")
-(defvar slime-fuzzy-start nil
-  "The beginning of the completion slot in the target buffer.
-This is a non-advancing marker.")
-(defvar slime-fuzzy-end nil
-  "The end of the completion slot in the target buffer.
-This is an advancing marker.")
-(defvar slime-fuzzy-original-text nil
+(defvar slime-fuzzy-completion-start nil
+  "The beginning of the completion slot in the target buffer.")
+(defvar slime-fuzzy-completion-end nil
+  "The end of the completion slot in the target buffer.")
+(defvar slime-fuzzy-completion-original-text nil
   "The original text that was in the completion slot in the
 target buffer.  This is what is put back if completion is
 aborted.")
-(defvar slime-fuzzy-target-mtime nil
-  "The expected `buffer-modified-tick' of the target buffer.
-This is used to detect unexpected changes by the user.")
-(defvar slime-fuzzy-first nil
+(defvar slime-fuzzy-completion-current-text nil
+  "The text that is currently in the completion slot in the
+target buffer.  If this ever doesn't match, the target buffer has
+been modified and we abort without touching it.")
+(defvar slime-fuzzy-completion-first nil
   "The position of the first completion in the completions buffer.
 The descriptive text and headers are above this.")
-(defvar slime-fuzzy-current-completion nil
+(defvar slime-fuzzy-completion-current-completion nil
   "The current completion object.  If this is the same before and
 after point moves in the completions buffer, the text is not
 replaced in the target for efficiency.")
 
-(define-derived-mode slime-fuzzy-completions-mode 
+(define-derived-mode slime-fuzzy-mode 
   fundamental-mode "Fuzzy Completions"
   "Major mode for presenting fuzzy completion results.
 
-\\<slime-fuzzy-completions-map>
-\\{slime-fuzzy-completions-map}"
-  (use-local-map slime-fuzzy-completions-map))
+\\<slime-fuzzy-map>
+\\{slime-fuzzy-map}"
+  (use-local-map slime-fuzzy-map))
 
-(defvar slime-fuzzy-completions-map  
+(defvar slime-fuzzy-map  
   (let* ((map (make-sparse-keymap)))
     
-    (define-key map "q" 'slime-fuzzy-abort)
-    (define-key map "\r" 'slime-fuzzy-select)
+    (define-key map "q" 'slime-fuzzy-completion-abort)
+    (define-key map "\r" 'slime-fuzzy-completion-select)
     
-    (define-key map "n" 'slime-fuzzy-next)
-    (define-key map "\M-n" 'slime-fuzzy-next)
+    (define-key map "n" 'slime-fuzzy-completion-next)
+    (define-key map "\M-n" 'slime-fuzzy-completion-next)
     
-    (define-key map "p" 'slime-fuzzy-prev)
-    (define-key map "\M-p" 'slime-fuzzy-prev)
+    (define-key map "p" 'slime-fuzzy-completion-prev)
+    (define-key map "\M-p" 'slime-fuzzy-completion-prev)
     
     (define-key map "\d" 'scroll-down)
     (define-key map " " 'scroll-up)
     
-    (define-key map [mouse-2] 'slime-fuzzy-click)
+    (define-key map [mouse-2] 'slime-fuzzy-completion-click)
     
     map)
-  "Keymap for slime-fuzzy-completions-mode.")
+  "Keymap for slime-fuzzy-mode.")
 
 (defun slime-fuzzy-completions (prefix &optional default-package)
   "Get the list of sorted completion objects from completing
@@ -4110,7 +4107,7 @@
                                                (slime-find-buffer-package)
                                                (slime-buffer-package))))))
 
-(defun slime-fuzzy-selected (prefix completion)
+(defun slime-fuzzy-completion-selected (prefix completion)
   "Tell the connected Lisp that the user selected completion
 `completion' as the completion for `prefix'."
   (let ((no-properties (copy-sequence prefix)))
@@ -4142,10 +4139,11 @@
             ;; Incomplete
             (t
              (slime-minibuffer-respecting-message "Complete but not unique")
-             (slime-fuzzy-choices-buffer completion-set beg end))))))
+             (slime-fuzzy-completion-choices-buffer completion-set beg end)))
+      )))
 
 
-(defun slime-get-fuzzy-buffer ()
+(defun get-slime-fuzzy-buffer ()
   (get-buffer-create "*Fuzzy Completions*"))
 
 (defvar slime-fuzzy-explanation
@@ -4178,166 +4176,200 @@
       (insert "\n")
       (put-text-property start (point) 'completion completion))))
 
-(defun slime-fuzzy-click (event)
+(defun slime-fuzzy-completion-click (event)
   "Handle a mouse-2 click on a completion choice as if point were
-on the completion choice and the slime-fuzzy-select
+on the completion choice and the slime-fuzzy-completion-select
 command was run."
   (interactive "e")
-  (with-current-buffer (window-buffer (posn-window (event-end event)))
-    (save-excursion
-      (goto-char (posn-point (event-end event)))
-      (when (get-text-property (point) 'mouse-face)
-        (slime-fuzzy-insert-from-point)
-        (slime-fuzzy-select)))))
+  (save-excursion
+    (with-current-buffer (window-buffer (posn-window (event-end event)))
+      (save-excursion
+        (goto-char (posn-point (event-end event)))
+        (when (get-text-property (point) 'mouse-face)
+          (slime-fuzzy-completion-insert-from-point)
+          (slime-fuzzy-completion-select))))))
 
-(defun slime-fuzzy-insert (text)
+(defun slime-fuzzy-completion-insert (text)
   "Inserts `text' into the target buffer in the completion slot.
 If the buffer has been modified in the meantime, abort the
 completion process.  Otherwise, update all completion variables
 so that the new text is present."
-  (with-current-buffer slime-fuzzy-target-buffer
-    (when (and slime-fuzzy-target-mtime
-               (/= slime-fuzzy-target-mtime
-                   (buffer-modified-tick slime-fuzzy-target-buffer)))
-      ;; The user has changed the buffer. Bail out.
-      (slime-fuzzy-done)
+  (with-current-buffer slime-fuzzy-completion-target-buffer
+    (when (not (string-equal slime-fuzzy-completion-current 
+                             (buffer-substring slime-fuzzy-completion-start
+                                               slime-fuzzy-completion-end)))
+      (slime-fuzzy-completion-done)
+      ;; Not an error, we may be in the post-command-hook.
       (beep)
       (message "Target buffer has been modified!"))
-    (goto-char slime-fuzzy-start)
-    (delete-region slime-fuzzy-start slime-fuzzy-end)
+    (goto-char slime-fuzzy-completion-end)
     (insert-and-inherit text)
-    (setq slime-fuzzy-target-mtime (buffer-modified-tick))))
+    (delete-region slime-fuzzy-completion-start slime-fuzzy-completion-end)
+    (setq slime-fuzzy-completion-end (+ slime-fuzzy-completion-start 
+                                        (length text)))
+    (setq slime-fuzzy-completion-current text)
+    (goto-char slime-fuzzy-completion-end)))
 
-(defun slime-fuzzy-choices-buffer (completions start end)
+(defun slime-fuzzy-completion-choices-buffer (completions start end)
   "Creates (if neccessary), populates, and pops up the *Fuzzy
 Completions* buffer with the completions from `completions' and
 the completion slot in the current buffer bounded by `start' and
 `end'.  This saves the window configuration before popping the
 buffer so that it can possibly be restored when the user is
 done."
-  (setq slime-fuzzy-target-buffer (current-buffer))
-  (setq slime-fuzzy-target-mtime nil)
-  (setq slime-fuzzy-start (move-marker (make-marker) start))
-  (setq slime-fuzzy-end (move-marker (make-marker) end))
-  (set-marker-insertion-type slime-fuzzy-end t)
-  (setq slime-fuzzy-original-text (buffer-substring start end))
-  (slime-fuzzy-save-window-configuration)
-  (with-current-buffer (slime-get-fuzzy-buffer)
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (slime-fuzzy-completions-mode)
-    (insert slime-fuzzy-explanation)
-    (let ((max-length 12))
-      (dolist (completion completions)
-        (setf max-length (max max-length (length (first completion)))))
-      (insert "Completion:")
-      (dotimes (i (- max-length 10)) (insert " "))
-      (insert "Score:\n")
-      (dotimes (i max-length) (insert "-"))
-      (insert " --------\n")
-      (setq slime-fuzzy-first (point))
-      (dolist (completion completions)
-        (slime-fuzzy-insert-completion-choice completion max-length))
-      (setq buffer-read-only t))
-    (setq slime-fuzzy-current-completion
-          (caar completions))
-    (slime-fuzzy-insert (caar completions))
-    (goto-char slime-fuzzy-first)
-    (pop-to-buffer (current-buffer))
-    (add-hook (make-local-variable 'post-command-hook)
-              'slime-fuzzy-post-command-hook)))
+  (remove-hook 'window-configuration-change-hook
+               'slime-fuzzy-completion-window-configuration-change)
+  (setq slime-fuzzy-completion-start start)
+  (setq slime-fuzzy-completion-end end)
+  (setq slime-fuzzy-completion-original-text (buffer-substring start end))
+  (setq slime-fuzzy-completion-current slime-fuzzy-completion-original-text)
+  (setq slime-fuzzy-completion-target-buffer (current-buffer))
+  (set-buffer (get-slime-fuzzy-buffer))
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (slime-fuzzy-mode)
+  (insert slime-fuzzy-explanation)
+  (let ((max-length 12))
+    (dolist (completion completions)
+      (setf max-length (max max-length (length (first completion)))))
+    (insert "Completion:")
+    (dotimes (i (- max-length 10)) (insert " "))
+    (insert "Score:\n")
+    (dotimes (i max-length) (insert "-"))
+    (insert " --------\n")
+    (setq slime-fuzzy-completion-first (point))
+    (dolist (completion completions)
+      (slime-fuzzy-insert-completion-choice completion max-length))
+    (setq buffer-read-only t))
+  (setq slime-fuzzy-completion-current-completion
+        (caar completions))
+  (slime-fuzzy-completion-insert (caar completions))
+  (goto-char slime-fuzzy-completion-first)
+  (slime-fuzzy-completion-save-window-configuration)
+  (pop-to-buffer (current-buffer))
+  (make-local-variable 'post-command-hook)
+  (add-hook 'post-command-hook
+            'slime-fuzzy-completion-post-command-hook))
 
-(defun slime-fuzzy-insert-from-point ()
+(defun slime-fuzzy-completion-insert-from-point ()
   "Inserts the completion that is under point in the completions
 buffer into the target buffer.  If the completion in question had
 already been inserted, it does nothing."
-  (with-current-buffer (slime-get-fuzzy-buffer)
+  (with-current-buffer (get-slime-fuzzy-buffer)
     (let ((current-completion (get-text-property (point) 'completion)))
       (when (and current-completion
-                 (not (eq slime-fuzzy-current-completion 
+                 (not (eq slime-fuzzy-completion-current-completion 
                           current-completion)))
-        (slime-fuzzy-insert 
+        (slime-fuzzy-completion-insert 
          (first (get-text-property (point) 'completion)))
-        (setq slime-fuzzy-current-completion
+        (setq slime-fuzzy-completion-current-completion
               current-completion)))))
 
-(defun slime-fuzzy-post-command-hook ()
+(defun slime-fuzzy-completion-post-command-hook ()
   "The post-command-hook for the *Fuzzy Completions* buffer.
 This makes sure the completion slot in the target buffer matches
 the completion that point is on in the completions buffer."
   (condition-case err
-      (when slime-fuzzy-target-buffer
-        (slime-fuzzy-insert-from-point))
+      (when slime-fuzzy-completion-target-buffer
+        (slime-fuzzy-completion-insert-from-point))
     (error
      ;; Because this is called on the post-command-hook, we mustn't let
      ;; errors propagate.
-     (message "Error in slime-fuzzy-post-command-hook: %S" err))))
+     (message "Error in slime-fuzzy-completion-post-command-hook: %S" err))))
 
-(defun slime-fuzzy-next ()
+(defun slime-fuzzy-completion-next ()
   "Moves point directly to the next completion in the completions
 buffer."
   (interactive)
   (goto-char 
    (next-single-char-property-change (point) 'completion)))
 
-(defun slime-fuzzy-prev ()
+(defun slime-fuzzy-completion-prev ()
   "Moves point directly to the previous completion in the
 completions buffer."
   (interactive)
   (goto-char (previous-single-char-property-change 
               (point) 'completion
-              nil slime-fuzzy-first)))
+              nil slime-fuzzy-completion-first)))
 
-(defun slime-fuzzy-abort ()
+(defun slime-fuzzy-completion-abort ()
   "Aborts the completion process, setting the completions slot in
 the target buffer back to its original contents."
   (interactive)
-  (when slime-fuzzy-target-buffer
-    (slime-fuzzy-insert slime-fuzzy-original-text)
-    (slime-fuzzy-done)))
+  (when slime-fuzzy-completion-target-buffer
+    (slime-fuzzy-completion-insert slime-fuzzy-completion-original-text)
+    (slime-fuzzy-completion-done)))
 
-(defun slime-fuzzy-select ()
+(defun slime-fuzzy-completion-select ()
   "Selects the current completion, making sure that it is inserted 
 into the target buffer.  This tells the connected Lisp what completion
 was selected."
   (interactive)
-  (when slime-fuzzy-target-buffer
-    (with-current-buffer (slime-get-fuzzy-buffer)
+  (when slime-fuzzy-completion-target-buffer
+    (with-current-buffer (get-slime-fuzzy-buffer)
       (let ((completion (get-text-property (point) 'completion)))
         (when completion
-          (slime-fuzzy-insert (first completion))
-          (slime-fuzzy-selected slime-fuzzy-original-text
+          (slime-fuzzy-completion-insert (first completion))
+          (slime-fuzzy-completion-selected slime-fuzzy-completion-original-text
                                            completion)
-          (slime-fuzzy-done))))))
+          (slime-fuzzy-completion-done))))))
 
-(defun slime-fuzzy-done ()
+(defun slime-fuzzy-completion-done ()
   "Cleans up after the completion process.  This removes all hooks,
 and attempts to restore the window configuration.  If this fails,
 it just burys the completions buffer and leaves the window
 configuration alone."
-  (set-buffer slime-fuzzy-target-buffer)
+  (set-buffer slime-fuzzy-completion-target-buffer)
   (remove-hook 'post-command-hook
-               'slime-fuzzy-post-command-hook)
-  (slime-fuzzy-restore-window-configuration)
-  (bury-buffer (slime-get-fuzzy-buffer))
-  (goto-char slime-fuzzy-end)
-  (setq slime-fuzzy-target-buffer nil))
+               'slime-fuzzy-completion-post-command-hook)
+  (if (slime-fuzzy-completion-maybe-restore-window-configuration)
+      (bury-buffer (get-slime-fuzzy-buffer))
+    ;; We couldn't restore the windows, so just bury the
+    ;; fuzzy completions buffer and let something else fill
+    ;; it in.
+    (pop-to-buffer (get-slime-fuzzy-buffer))
+    (bury-buffer))
+  (pop-to-buffer slime-fuzzy-completion-target-buffer)
+  (goto-char slime-fuzzy-completion-end)
+  (setq slime-fuzzy-completion-target-buffer nil))
 
-(defun slime-fuzzy-save-window-configuration ()
+(defun slime-fuzzy-completion-save-window-configuration ()
   "Saves the current window configuration, and sets up for the
 saved configuration to be nullified if the user changes the
 window configuration further.  Adding the nullification routine
 to window-configuration-change-hook is delayed so that the
 windows stabalize before we start listening on the hook."
-  (setq slime-fuzzy-saved-window-configuration
-        (current-window-configuration)))
+  (setq slime-fuzzy-completion-window-configuration 
+        (current-window-configuration))
+  (setq slime-fuzzy-completion-window-configuration-change-count 0)
+  (run-with-timer 
+   0.5 nil 'slime-fuzzy-completion-window-configuration-change-add-hook))
 
-(defun slime-fuzzy-restore-window-configuration ()
+(defun slime-fuzzy-completion-maybe-restore-window-configuration ()
   "Restores the saved window configuration if it has not been
 nullified."
-  (when slime-fuzzy-saved-window-configuration
-    (set-window-configuration slime-fuzzy-saved-window-configuration)
-    (setq slime-fuzzy-saved-window-configuration nil)))
+  (remove-hook 'window-configuration-change-hook
+               'slime-fuzzy-completion-window-configuration-change)
+  (if (not slime-fuzzy-completion-window-configuration)
+      nil
+    (set-window-configuration slime-fuzzy-completion-window-configuration)
+    (setq slime-fuzzy-completion-window-configuration nil)
+    t))
+
+(defun slime-fuzzy-completion-window-configuration-change-add-hook ()
+  "Sets up slime-fuzzy-completion-window-configuration-change on
+window-configuration-change-hook."
+  (remove-hook 'post-command-hook
+               'slime-fuzzy-completion-window-configuration-change-add-hook)
+  (add-hook 'window-configuration-change-hook
+            'slime-fuzzy-completion-window-configuration-change))
+
+(defun slime-fuzzy-completion-window-configuration-change ()
+  "Called on window-configuration-change-hook.  Since the window
+configuration was changed, we nullify our saved configuration."
+  (remove-hook 'window-configuration-change-hook
+               'slime-fuzzy-completion-window-configuration-change)
+  (setq slime-fuzzy-completion-window-configuration nil))
 
 
 ;;; Interpreting Elisp symbols as CL symbols (package qualifiers)





More information about the slime-cvs mailing list