mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
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.
This commit is contained in:
parent
96bdcdc44e
commit
bb12edf129
3 changed files with 39 additions and 79 deletions
|
|
@ -1,3 +1,12 @@
|
|||
2009-12-02 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
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 <rgm@gnu.org>
|
||||
|
||||
* mail/rmail.el (rmail-pop-to-buffer): New function. (Bug#2282)
|
||||
|
|
|
|||
|
|
@ -1273,7 +1273,7 @@
|
|||
|
||||
* emacs-lisp/debug.el (debug): Fix call to message.
|
||||
|
||||
2003-06-16 Michael Mauger <mmaug@yahoo.com> (tiny change)
|
||||
2003-06-16 Michael Mauger <mmaug@yahoo.com>
|
||||
|
||||
* emulation/cua-base.el (cua-mode): Use explicit arg to turn off
|
||||
minor modes.
|
||||
|
|
|
|||
107
lisp/wid-edit.el
107
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue