changeset 106373:52460c9b040f

Use completion-in-buffer. (widget-field-text-end): New function. (widget-field-value-get): Use it. (widget-string-complete, widget-file-complete) (widget-color-complete): Use it and completion-in-region. (widget-complete): Don't narrow the buffer.

--- a/lisp/ChangeLog	Wed Dec 02 03:11:38 2009 +0000
+++ b/lisp/ChangeLog	Wed Dec 02 04:11:08 2009 +0000
@@ -1,3 +1,12 @@
[phone]  Stefan Monnier  <[e-mail]>
+
+	Use completion-in-buffer.
+	* wid-edit.el (widget-field-text-end): New function.
+	(widget-field-value-get): Use it.
+	(widget-string-complete, widget-file-complete)
+	(widget-color-complete): Use it and completion-in-region.
+	(widget-complete): Don't narrow the buffer.
+
 2009-12-02  Glenn Morris  <[e-mail]>
 
 	* mail/rmail.el (rmail-pop-to-buffer): New function.  (Bug#2282)

--- a/lisp/ChangeLog.10	Wed Dec 02 03:11:38 2009 +0000
+++ b/lisp/ChangeLog.10	Wed Dec 02 04:11:08 2009 +0000
@@ -1273,7 +1273,7 @@
 
 	* emacs-lisp/debug.el (debug): Fix call to message.
 
-2003-06-16  Michael Mauger  <[e-mail]>  (tiny change)
[phone]  Michael Mauger  <[e-mail]>
 
 	* emulation/cua-base.el (cua-mode): Use explicit arg to turn off
 	minor modes.

--- a/lisp/wid-edit.el	Wed Dec 02 03:11:38 2009 +0000
+++ b/lisp/wid-edit.el	Wed Dec 02 04:11:08 2009 +0000
@@ -1160,11 +1160,9 @@
 When not inside a field, move to the previous button or field."
   (interactive)
   (let ((field (widget-field-find (point))))
-    (if field
-	(save-restriction
-	  (widget-narrow-to-field)
-	  (widget-apply field :complete))
-	  (error "Not in an editable field"))))
+    (when field
+      (widget-apply field :complete))
+    (error "Not in an editable field")))
 
 ;;; Setting up the buffer.
 
@@ -1257,6 +1255,19 @@
             (overlay-end overlay)))
       (cdr overlay))))
 
+(defun widget-field-text-end (widget)
+  (let ((to   (widget-field-end widget))
+	(size (widget-get widget :size)))
+    (if (or (null size) (zerop size))
+        to
+      (let ((from (widget-field-start widget)))
+        (if (and from to)
+            (with-current-buffer (widget-field-buffer widget)
+              (while (and (> to from)
+                          (eq (char-after (1- to)) ?\s))
+                (setq to (1- to)))
+              to))))))
+
 (defun widget-field-find (pos)
   "Return the field at POS.
 Unlike (get-char-property POS 'field), this works with empty fields too."
@@ -1935,7 +1946,7 @@
 (defun widget-field-value-get (widget)
   "Return current text in editing field."
   (let ((from (widget-field-start widget))
-	(to (widget-field-end widget))
+	(to (widget-field-text-end widget))
 	(buffer (widget-field-buffer widget))
 	(size (widget-get widget :size))
 	(secret (widget-get widget :secret))
@@ -1943,11 +1954,6 @@
     (if (and from to)
 	(progn
 	  (set-buffer buffer)
-	  (while (and size
-		      (not (zerop size))
-		      (> to from)
-		      (eq (char-after (1- to)) ?\s))
-	    (setq to (1- to)))
 	  (let ((result (buffer-substring-no-properties from to)))
 	    (when secret
 	      (let ((index 0))
@@ -3029,35 +3035,13 @@
 Completions are taken from the :completion-alist property of the
 widget.  If that isn't a list, it's evalled and expected to yield a list."
   (interactive)
-  (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
-						 (point)))
-	 (completion-ignore-case (widget-get widget :completion-ignore-case))
+  (let* ((completion-ignore-case (widget-get widget :completion-ignore-case))
 	 (alist (widget-get widget :completion-alist))
 	 (_ (unless (listp alist)
-	      (setq alist (eval alist))))
-	 (completion (try-completion prefix alist)))
-    (cond ((eq completion t)
-	   (when completion-ignore-case
-	     ;; Replace field with completion in case its case is different.
-	     (delete-region (widget-field-start widget)
-			    (widget-field-end widget))
-	     (insert-and-inherit (car (assoc-string prefix alist t))))
-	   (message "Only match"))
-	  ((null completion)
-	   (error "No match"))
-	  ((not (eq t (compare-strings prefix nil nil completion nil nil
-				       completion-ignore-case)))
-	   (when completion-ignore-case
-	     ;; Replace field with completion in case its case is different.
-	     (delete-region (widget-field-start widget)
-			    (widget-field-end widget))
-	     (insert-and-inherit completion)))
-	  (t
-	   (message "Making completion list...")
-	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list
-	      (all-completions prefix alist nil)))
-	   (message "Making completion list...done")))))
+	      (setq alist (eval alist)))))
+    (completion-in-region (widget-field-start widget)
+                          (max (point) (widget-field-text-end widget))
+                          alist)))
 
 (define-widget 'regexp 'string
   "A regular expression."
@@ -3096,29 +3080,9 @@
 (defun widget-file-complete ()
   "Perform completion on file name preceding point."
   (interactive)
-  (let* ((end (point))
-	 (beg (widget-field-start widget))
-	 (pattern (buffer-substring beg end))
-	 (name-part (file-name-nondirectory pattern))
-	 ;; I think defaulting to root is right
-	 ;; because these really should be absolute file names.
-	 (directory (or (file-name-directory pattern) "/"))
-	 (completion (file-name-completion name-part directory)))
-    (cond ((eq completion t))
-	  ((null completion)
-	   (message "Can't find completion for \"%s\"" pattern)
-	   (ding))
-	  ((not (string= name-part completion))
-	   (delete-region beg end)
-	   (insert (expand-file-name completion directory)))
-	  (t
-	   (message "Making completion list...")
-	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list
-	      (sort (file-name-all-completions name-part directory)
-		    'string<)
-	      name-part))
-	   (message "Making completion list...%s" "done")))))
+  (completion-in-region (widget-field-start widget)
+                        (max (point) (widget-field-text-end widget))
+                        'completion-file-name-table))
 
 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.
@@ -3738,23 +3702,10 @@
 (defun widget-color-complete (widget)
   "Complete the color in WIDGET."
   (require 'facemenu)			; for facemenu-color-alist
-  (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
-						 (point)))
-	 (list (or facemenu-color-alist
-		   (sort (defined-colors) 'string-lessp)))
-	 (completion (try-completion prefix list)))
-    (cond ((eq completion t)
-	   (message "Exact match."))
-	  ((null completion)
-	   (error "Can't find completion for \"%s\"" prefix))
-	  ((not (string-equal prefix completion))
-	   (insert-and-inherit (substring completion (length prefix))))
-	  (t
-	   (message "Making completion list...")
-	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list (all-completions prefix list nil)
-				      prefix))
-	   (message "Making completion list...done")))))
+  (completion-in-region (widget-field-start widget)
+                        (max (point) (widget-field-text-end widget))
+                        (or facemenu-color-alist
+                            (sort (defined-colors) 'string-lessp))))
 
 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil