changeset 104738:16738af2eddd

(lisp-complete-symbol): Use minibuffer-complete.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 30 Aug 2009 21:45:36 +0000
parents 8224438aa3cd
children 329b26389fdb
files lisp/ChangeLog lisp/emacs-lisp/lisp.el
diffstat 2 files changed, 40 insertions(+), 79 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Aug 30 18:17:20 2009 +0000
+++ b/lisp/ChangeLog	Sun Aug 30 21:45:36 2009 +0000
@@ -1,3 +1,7 @@
+2009-08-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/lisp.el (lisp-complete-symbol): Use minibuffer-complete.
+
 2009-08-30  Juanma Barranquero  <lekktu@gmail.com>
 
 	* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
--- a/lisp/emacs-lisp/lisp.el	Sun Aug 30 18:17:20 2009 +0000
+++ b/lisp/emacs-lisp/lisp.el	Sun Aug 30 21:45:36 2009 +0000
@@ -622,85 +622,42 @@
 symbols with function definitions, values or properties are
 considered."
   (interactive)
-  (let ((window (get-buffer-window "*Completions*" 0)))
-    (if (and (eq last-command this-command)
-	     window (window-live-p window) (window-buffer window)
-	     (buffer-name (window-buffer window)))
-	;; If this command was repeated, and
-	;; there's a fresh completion window with a live buffer,
-	;; and this command is repeated, scroll that window.
-	(with-current-buffer (window-buffer window)
-	  (if (pos-visible-in-window-p (point-max) window)
-	      (set-window-start window (point-min))
-	    (save-selected-window
-	      (select-window window)
-	      (scroll-up))))
-
-      ;; Do completion.
-      (let* ((end (point))
-	     (beg (with-syntax-table emacs-lisp-mode-syntax-table
-		    (save-excursion
-		      (backward-sexp 1)
-		      (while (= (char-syntax (following-char)) ?\')
-			(forward-char 1))
-		      (point))))
-	     (pattern (buffer-substring-no-properties beg end))
-	     (predicate
-	      (or predicate
-		  (save-excursion
-		    (goto-char beg)
-		    (if (not (eq (char-before) ?\())
-			(lambda (sym)	;why not just nil ?   -sm
-			  (or (boundp sym) (fboundp sym)
-			      (symbol-plist sym)))
-		      ;; Looks like a funcall position.  Let's double check.
-		      (if (condition-case nil
-			      (progn (up-list -2) (forward-char 1)
-				     (eq (char-after) ?\())
-			    (error nil))
-			  ;; If the first element of the parent list is an open
-			  ;; parenthesis we are probably not in a funcall position.
-			  ;; Maybe a `let' varlist or something.
-			  nil
-			;; Else, we assume that a function name is expected.
-			'fboundp)))))
-	     (completion (try-completion pattern obarray predicate)))
-	(cond ((eq completion t))
-	      ((null completion)
-	       (if (window-minibuffer-p (selected-window))
-		   (minibuffer-message (format " [No completions of \"%s\"]" pattern))
-		 (message "Can't find completion for \"%s\"" pattern))
-	       (ding))
-	      ((not (string= pattern completion))
-	       (delete-region beg end)
-	       (insert completion)
-	       ;; Don't leave around a completions buffer that's out of date.
-	       (let ((win (get-buffer-window "*Completions*" 0)))
-		 (if win (with-selected-window win (bury-buffer)))))
-	      (t
-	       (let ((minibuf-is-in-use
-		      (eq (minibuffer-window) (selected-window))))
-		 (unless minibuf-is-in-use
-		   (message "Making completion list..."))
-		 (let ((list (all-completions pattern obarray predicate)))
-		   (setq list (sort list 'string<))
-		   (unless (eq predicate 'fboundp)
-		     (let (new)
-		       (dolist (compl list)
-			 (push (if (fboundp (intern compl))
-				   (list compl " <f>")
-				 compl)
-			       new))
-		       (setq list (nreverse new))))
-		   (if (> (length list) 1)
-		       (with-output-to-temp-buffer "*Completions*"
-			 (display-completion-list list pattern))
-		     ;; Don't leave around a completions buffer that's
-		     ;; out of date.
-		     (let ((win (get-buffer-window "*Completions*" 0)))
-		       (if win (with-selected-window win (bury-buffer))))))
-		 (unless minibuf-is-in-use
-		   (message "Making completion list...%s" "done")))))))))
+  (let* ((end (point))
+         (beg (with-syntax-table emacs-lisp-mode-syntax-table
+                (save-excursion
+                  (backward-sexp 1)
+                  (while (= (char-syntax (following-char)) ?\')
+                    (forward-char 1))
+                  (point))))
+         (predicate
+          (or predicate
+              (save-excursion
+                (goto-char beg)
+                (if (not (eq (char-before) ?\())
+                    (lambda (sym)	;why not just nil ?   -sm
+                      (or (boundp sym) (fboundp sym)
+                          (symbol-plist sym)))
+                  ;; Looks like a funcall position.  Let's double check.
+                  (if (condition-case nil
+                          (progn (up-list -2) (forward-char 1)
+                                 (eq (char-after) ?\())
+                        (error nil))
+                      ;; If the first element of the parent list is an open
+                      ;; parenthesis we are probably not in a funcall position.
+                      ;; Maybe a `let' varlist or something.
+                      nil
+                    ;; Else, we assume that a function name is expected.
+                    'fboundp)))))
+         (ol (make-overlay beg end nil nil t)))
+    (overlay-put ol 'field 'completion)
+    (let ((completion-annotate-function
+           (unless (eq predicate 'fboundp)
+             (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))
+          (minibuffer-completion-table obarray)
+          (minibuffer-completion-predicate predicate))
+      (unwind-protect
+          (call-interactively 'minibuffer-complete)
+        (delete-overlay ol)))))
 
 ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
 ;;; lisp.el ends here