From: Stefan Monnier Date: Wed, 2 Dec 2009 04:11:08 +0000 (+0000) Subject: Use completion-in-buffer. X-Git-Tag: emacs-pretest-23.1.90~120 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bb12edf129de7f0c9cb5eca4bbc58f4d04051d8d;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c9eacbfe4f..b360022c5f1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2009-12-02 Stefan Monnier + + 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 * mail/rmail.el (rmail-pop-to-buffer): New function. (Bug#2282) diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 0c91303cebf..656dbc03b2d 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -1273,7 +1273,7 @@ * emacs-lisp/debug.el (debug): Fix call to message. -2003-06-16 Michael Mauger (tiny change) +2003-06-16 Michael Mauger * emulation/cua-base.el (cua-mode): Use explicit arg to turn off minor modes. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 5a22b371db0..f96c71995a6 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1160,11 +1160,9 @@ the field." 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 @@ When not inside a field, move to the previous button or field." (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 @@ the earlier input." (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 @@ the earlier input." (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 @@ as the value." 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 @@ It reads a file name from an editable text field." (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 @@ example: (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