Mercurial > hg > xemacs-beta

changeset 5666:daf5accfe973

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use #'test-completion, minibuf.el, instead of implementing same. lisp/ChangeLog addition: 2012-05-14 Aidan Kehoe <kehoea@parhasard.net> 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@parhasard.net> * minibuf.c (Ftest_completion): Correct some documentation here.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 14 May 2012 08:46:05 +0100
parents 8593e614573a
children b4715fcbe001
files lisp/ChangeLog lisp/behavior.el lisp/cus-edit.el lisp/faces.el lisp/minibuf.el src/ChangeLog src/minibuf.c
diffstat 7 files changed, 61 insertions(+), 104 deletions(-) [+]
line wrap: on
line diff
--- 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@parhasard.net>
+
+	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@parhasard.net>
 
 	* subr.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)))
 
--- 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)
--- 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)
--- 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)))
 
--- 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@parhasard.net>
+
+	* minibuf.c (Ftest_completion):
+	Correct some documentation here.
+
 2012-05-07  Jeff Sparkes  <jsparkes@gmail.com>
 
 	* search.c (skip_chars): Add cast to Ibyte *.
--- 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