APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1336981565 -3600 # Node ID daf5accfe9736ac481b1bdd6063d060f8b4a633d # Parent 8593e614573a4a167af4d3e73201dfa46c7e30a8 Use #'test-completion, minibuf.el, instead of implementing same. lisp/ChangeLog addition: 2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; Update minibuf.el to use #'test-completion, use the generality of recent completion changes to avoid some unnecessary consing when reading. * behavior.el (read-behavior): * cus-edit.el (custom-face-prompt): * cus-edit.el (widget-face-action): * faces.el (read-face-name): * minibuf.el: * minibuf.el (minibuffer-completion-table): * minibuf.el (exact-minibuffer-completion-p): Removed. #'test-completion is equivalent to this, but more general. * minibuf.el (minibuffer-do-completion-1): Use #'test-completion. * minibuf.el (completing-read): Update the documentation of the arguments used for completion. * minibuf.el (minibuffer-complete-and-exit): Use #'test-completion. * minibuf.el (exit-minibuffer): Use #'test-completion. * minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion. * minibuf.el (read-color): No need to construct a completion table separate from the colour list. src/ChangeLog addition: 2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; * minibuf.c (Ftest_completion): Correct some documentation here. diff -r 8593e614573a -r daf5accfe973 lisp/ChangeLog --- a/lisp/ChangeLog Sat May 12 18:12:13 2012 +0100 +++ b/lisp/ChangeLog Mon May 14 08:46:05 2012 +0100 ＠＠ -1,3 +1,26 ＠＠ +2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Update minibuf.el to use #'test-completion, use the generality of + recent completion changes to avoid some unnecessary consing when + reading. + * behavior.el (read-behavior): + * cus-edit.el (custom-face-prompt): + * cus-edit.el (widget-face-action): + * faces.el (read-face-name): + * minibuf.el: + * minibuf.el (minibuffer-completion-table): + * minibuf.el (exact-minibuffer-completion-p): + Removed. #'test-completion is equivalent to this, but more + general. + * minibuf.el (minibuffer-do-completion-1): Use #'test-completion. + * minibuf.el (completing-read): Update the documentation of the + arguments used for completion. + * minibuf.el (minibuffer-complete-and-exit): Use #'test-completion. + * minibuf.el (exit-minibuffer): Use #'test-completion. + * minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion. + * minibuf.el (read-color): No need to construct a completion table + separate from the colour list. + 2012-05-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * subr.el: diff -r 8593e614573a -r daf5accfe973 lisp/behavior.el --- a/lisp/behavior.el Sat May 12 18:12:13 2012 +0100 +++ b/lisp/behavior.el Mon May 14 08:46:05 2012 +0100 ＠＠ -345,16 +345,10 ＠＠ for history command, and as the value to return if the user enters the empty string." (let ((result - (completing-read - prompt - (let (list) - (maphash #'(lambda (key value) - (push (cons (symbol-name key) value) list)) - behavior-hash-table) - list) - nil must-match initial-contents (or history 'behavior-history) - default-value))) - (if (and result (stringp result)) + (completing-read prompt behavior-hash-table nil must-match + initial-contents (or history 'behavior-history) + default-value))) + (if (stringp result) (intern result) result))) diff -r 8593e614573a -r daf5accfe973 lisp/cus-edit.el --- a/lisp/cus-edit.el Sat May 12 18:12:13 2012 +0100 +++ b/lisp/cus-edit.el Mon May 14 08:46:05 2012 +0100 ＠＠ -878,10 +878,7 ＠＠ ;; Make a choice only amongst the faces under point: (let ((choice (completing-read "Customize face: (default all faces at point) " - (mapcar (lambda (face) - (list (symbol-name face) face)) - faces) - nil t))) + faces nil t))) (if (eql (length choice) 0) (list faces) (list (intern choice))))))))) ＠＠ -2972,12 +2969,8 ＠＠ (defun widget-face-action (widget &optional event) "Prompt for a face." - (let ((answer (completing-read "Face: " - (mapcar (lambda (face) - (list (symbol-name face))) - (face-list)) - nil nil nil - 'face-history))) + (let ((answer (completing-read "Face: " (face-list) nil nil nil + 'face-history))) (unless (eql (length answer) 0) (widget-value-set widget (intern answer)) (widget-apply widget :notify widget event) diff -r 8593e614573a -r daf5accfe973 lisp/faces.el --- a/lisp/faces.el Sat May 12 18:12:13 2012 +0100 +++ b/lisp/faces.el Mon May 14 08:46:05 2012 +0100 ＠＠ -54,14 +54,10 ＠＠ Such a collection of attributes is called a \"face\"." :group 'emacs) - (defun read-face-name (prompt) (let (face) (while (eql (length face) 0) ; nil or "" - (setq face (completing-read prompt - (mapcar (lambda (x) (list (symbol-name x))) - (face-list)) - nil t))) + (setq face (completing-read prompt (face-list) nil t))) (intern face))) (defun face-interactive (what &optional bool) diff -r 8593e614573a -r daf5accfe973 lisp/minibuf.el --- a/lisp/minibuf.el Sat May 12 18:12:13 2012 +0100 +++ b/lisp/minibuf.el Mon May 14 08:46:05 2012 +0100 ＠＠ -58,18 +58,11 ＠＠ :group 'minibuffer) (defvar minibuffer-completion-table nil - "Alist or obarray used for completion in the minibuffer. -This becomes the ALIST argument to `try-completion' and `all-completions'. + "List, hash table, function or obarray used for minibuffer completion. -The value may alternatively be a function, which is given three arguments: - STRING, the current buffer contents; - PREDICATE, the predicate for filtering possible matches; - CODE, which says what kind of things to do. -CODE can be nil, t or `lambda'. -nil means to return the best completion of STRING, nil if there is none, - or t if it is already a unique completion. -t means to return a list of all possible completions of STRING. -`lambda' means to return t if STRING is a valid completion as it stands.") +This becomes the COLLECTION argument to `try-completion', `all-completions' +and `test-completion'; see the documentation of those functions for how +values are interpreted.") (defvar minibuffer-completion-predicate nil "Within call to `completing-read', this holds the PREDICATE argument.") ＠＠ -621,56 +614,6 ＠＠ (setq unread-command-event (character-to-event (quit-char)) quit-flag nil))))) - -;; Determines whether buffer-string is an exact completion -(defun exact-minibuffer-completion-p (buffer-string) - (cond ((not minibuffer-completion-table) - ;; Empty alist - nil) - ((vectorp minibuffer-completion-table) - (let ((tem (intern-soft buffer-string - minibuffer-completion-table))) - (if (or tem - (and (string-equal buffer-string "nil") - ;; intern-soft loses for 'nil - (catch 'found - (mapatoms #'(lambda (s) - (if (string-equal - (symbol-name s) - buffer-string) - (throw 'found t))) - minibuffer-completion-table) - nil))) - (if minibuffer-completion-predicate - (funcall minibuffer-completion-predicate - tem) - t) - nil))) - ((and (consp minibuffer-completion-table) - ;;#### Emacs-Lisp truly sucks! - ;; lambda, autoload, etc - (not (symbolp (car minibuffer-completion-table)))) - (if (not completion-ignore-case) - (assoc buffer-string minibuffer-completion-table) - (let ((s (upcase buffer-string)) - (tail minibuffer-completion-table) - tem) - (while tail - (setq tem (car (car tail))) - (if (or (equal tem buffer-string) - (equal tem s) - (if tem (equal (upcase tem) s))) - (setq s 'win - tail nil) ;exit - (setq tail (cdr tail)))) - (eq s 'win)))) - (t - (funcall minibuffer-completion-table - buffer-string - minibuffer-completion-predicate - 'lambda))) - ) - ;; 0 'none no possible completion ;; 1 'unique was already an exact and unique completion ;; 3 'exact was already an exact (but nonunique) completion ＠＠ -693,7 +636,8 ＠＠ (erase-buffer) (insert completion) (setq buffer-string completion))) - (if (exact-minibuffer-completion-p buffer-string) + (if (test-completion buffer-string minibuffer-completion-table + minibuffer-completion-predicate) ;; An exact completion was possible (if completedp ;; Since no callers need to know the difference, don't bother ＠＠ -752,20 +696,18 ＠＠  ;;;; completing-read -(defun completing-read (prompt table - &optional predicate require-match - initial-contents history default) +(defun completing-read (prompt collection &optional predicate require-match + initial-contents history default) "Read a string in the minibuffer, with completion. PROMPT is a string to prompt with; normally it ends in a colon and a space. -TABLE is an alist whose elements' cars are strings, or an obarray. -TABLE can also be a function which does the completion itself. -PREDICATE limits completion to a subset of TABLE. -See `try-completion' and `all-completions' for more details - on completion, TABLE, and PREDICATE. +COLLECTION is a set of objects that are the possible completions. +PREDICATE limits completion to a subset of COLLECTION. +See `try-completion' and `all-completions' for details of COLLECTION, + PREDICATE, and completion in general. If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of TABLE or is null. + the input is (or completes to) an element of COLLECTION or is null. If it is also not t, Return does not exit if it does non-null completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input ＠＠ -785,7 +727,7 ＠＠ Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." - (let ((minibuffer-completion-table table) + (let ((minibuffer-completion-table collection) (minibuffer-completion-predicate predicate) (minibuffer-completion-confirm (if (eq require-match 't) nil t)) (last-exact-completion nil) ＠＠ -862,7 +804,8 ＠＠ (let ((buffer-string (buffer-string))) ;; Short-cut -- don't call minibuffer-do-completion if we already ;; have an (possibly nonunique) exact completion. - (if (exact-minibuffer-completion-p buffer-string) + (if (test-completion buffer-string minibuffer-completion-table + minibuffer-completion-predicate) (throw 'exit nil)) (let ((status (minibuffer-do-completion buffer-string))) (if (or (eq status 'unique) ＠＠ -893,7 +836,8 ＠＠ (if (not minibuffer-confirm-incomplete) (throw 'exit nil)) (let ((buffer-string (buffer-string))) - (if (exact-minibuffer-completion-p buffer-string) + (if (test-completion buffer-string minibuffer-completion-table + minibuffer-completion-predicate) (throw 'exit nil)) (let ((completion (if (not minibuffer-completion-table) t ＠＠ -1092,6 +1036,9 ＠＠ ;; prefix for other completions. This means that we ;; can't just do the obvious thing, (eq t ;; (try-completion ...)). + ;; + ;; Could be reasonable to use #'test-completion + ;; instead. Aidan Kehoe, Mo 14 Mai 2012 08:17:10 IST (let (comp) (if (and filename-kludge-p ;; #### evil evil evil evil ＠＠ -2186,7 +2133,7 ＠＠ to build a completion table. On TTY devices, this uses `tty-color-list'. On mswindows devices, this uses `mswindows-color-list'." - (let ((table (read-color-completion-table))) + (let ((table (color-list))) (completing-read prompt table nil (and table must-match) initial-contents))) diff -r 8593e614573a -r daf5accfe973 src/ChangeLog --- a/src/ChangeLog Sat May 12 18:12:13 2012 +0100 +++ b/src/ChangeLog Mon May 14 08:46:05 2012 +0100 ＠＠ -1,3 +1,8 ＠＠ +2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * minibuf.c (Ftest_completion): + Correct some documentation here. + 2012-05-07 Jeff Sparkes <jsparkes(a)gmail.com&gt; * search.c (skip_chars): Add cast to Ibyte *. diff -r 8593e614573a -r daf5accfe973 src/minibuf.c --- a/src/minibuf.c Sat May 12 18:12:13 2012 +0100 +++ b/src/minibuf.c Mon May 14 08:46:05 2012 +0100 ＠＠ -688,13 +688,12 ＠＠ } DEFUN ("test-completion", Ftest_completion, 2, 3, 0, /* -Return non-nil if STRING is a valid completion in COLLECTION. +Return non-nil if STRING is an exact completion in COLLECTION. COLLECTION must be a list, a hash table, an obarray, or a function. Each string (or symbol) in COLLECTION is tested to see if it (or its -name) begins with STRING. The value is a list of all the strings from -COLLECTION that match. +name) begins with STRING, until a valid, exact completion is found. If COLLECTION is a list, the elements of the list that are not cons cells and the cars of the elements of the list that are cons cells ＠＠ -755,7 +754,7 ＠＠ lookup, 0) ? Qnil : Qt; /* It would be reasonable to do something similar for the hash - tables, except, both symbol and string keys are vaild + tables, except, both symbol and string keys are valid completions there. So a negative #'gethash for the string (with #'equal as the hash table tests) still means you have to do the linear search, for any symbols with that string -- ‘Liston operated so fast that he once accidentally amputated an assistant’s fingers along with a patient’s leg, […] The patient and the assistant both died of sepsis, and a spectator reportedly died of shock, resulting in the only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches