[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp ChangeLog ChangeLog.10 wid-edit.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] emacs/lisp ChangeLog ChangeLog.10 wid-edit.el |
Date: |
Wed, 02 Dec 2009 04:11:13 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Stefan Monnier <monnier> 09/12/02 04:11:12
Modified files:
lisp : ChangeLog ChangeLog.10 wid-edit.el
Log message:
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.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16797&r2=1.16798
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog.10?cvsroot=emacs&r1=1.36&r2=1.37
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/wid-edit.el?cvsroot=emacs&r1=1.202&r2=1.203
Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16797
retrieving revision 1.16798
diff -u -b -r1.16797 -r1.16798
--- ChangeLog 2 Dec 2009 03:05:14 -0000 1.16797
+++ ChangeLog 2 Dec 2009 04:11:08 -0000 1.16798
@@ -1,3 +1,12 @@
+2009-12-02 Stefan Monnier <address@hidden>
+
+ 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 <address@hidden>
* mail/rmail.el (rmail-pop-to-buffer): New function. (Bug#2282)
Index: ChangeLog.10
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog.10,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- ChangeLog.10 5 Jan 2009 03:18:23 -0000 1.36
+++ ChangeLog.10 2 Dec 2009 04:11:12 -0000 1.37
@@ -1273,7 +1273,7 @@
* emacs-lisp/debug.el (debug): Fix call to message.
-2003-06-16 Michael Mauger <address@hidden> (tiny change)
+2003-06-16 Michael Mauger <address@hidden>
* emulation/cua-base.el (cua-mode): Use explicit arg to turn off
minor modes.
Index: wid-edit.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/wid-edit.el,v
retrieving revision 1.202
retrieving revision 1.203
diff -u -b -r1.202 -r1.203
--- wid-edit.el 11 Sep 2009 00:59:04 -0000 1.202
+++ wid-edit.el 2 Dec 2009 04:11:12 -0000 1.203
@@ -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)
+ (when field
(widget-apply field :complete))
- (error "Not in an editable field"))))
+ (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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] emacs/lisp ChangeLog ChangeLog.10 wid-edit.el,
Stefan Monnier <=