Mercurial > hg > xemacs-beta

comparison lisp/minibuf.el @ 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 b7ae5f44b950
children f9e4d44504a4
comparison
equal deleted inserted replaced
5665:8593e614573a 5666:daf5accfe973
56 rather than just consing the new element onto the front of the list." 56 rather than just consing the new element onto the front of the list."
57 :type 'boolean 57 :type 'boolean
58 :group 'minibuffer) 58 :group 'minibuffer)
59 59
60 (defvar minibuffer-completion-table nil 60 (defvar minibuffer-completion-table nil
61 "Alist or obarray used for completion in the minibuffer. 61 "List, hash table, function or obarray used for minibuffer completion.
62 This becomes the ALIST argument to `try-completion' and `all-completions'. 62
63 63 This becomes the COLLECTION argument to `try-completion', `all-completions'
64 The value may alternatively be a function, which is given three arguments: 64 and `test-completion'; see the documentation of those functions for how
65 STRING, the current buffer contents; 65 values are interpreted.")
66 PREDICATE, the predicate for filtering possible matches;
67 CODE, which says what kind of things to do.
68 CODE can be nil, t or `lambda'.
69 nil means to return the best completion of STRING, nil if there is none,
70 or t if it is already a unique completion.
71 t means to return a list of all possible completions of STRING.
72 `lambda' means to return t if STRING is a valid completion as it stands.")
73 66
74 (defvar minibuffer-completion-predicate nil 67 (defvar minibuffer-completion-predicate nil
75 "Within call to `completing-read', this holds the PREDICATE argument.") 68 "Within call to `completing-read', this holds the PREDICATE argument.")
76 69
77 (defvar minibuffer-completion-confirm nil 70 (defvar minibuffer-completion-confirm nil
619 ;; as a normal character, and act just like typeahead. 612 ;; as a normal character, and act just like typeahead.
620 (if (and quit-flag (not unread-command-event)) 613 (if (and quit-flag (not unread-command-event))
621 (setq unread-command-event (character-to-event (quit-char)) 614 (setq unread-command-event (character-to-event (quit-char))
622 quit-flag nil))))) 615 quit-flag nil)))))
623 616
624
625 ;; Determines whether buffer-string is an exact completion
626 (defun exact-minibuffer-completion-p (buffer-string)
627 (cond ((not minibuffer-completion-table)
628 ;; Empty alist
629 nil)
630 ((vectorp minibuffer-completion-table)
631 (let ((tem (intern-soft buffer-string
632 minibuffer-completion-table)))
633 (if (or tem
634 (and (string-equal buffer-string "nil")
635 ;; intern-soft loses for 'nil
636 (catch 'found
637 (mapatoms #'(lambda (s)
638 (if (string-equal
639 (symbol-name s)
640 buffer-string)
641 (throw 'found t)))
642 minibuffer-completion-table)
643 nil)))
644 (if minibuffer-completion-predicate
645 (funcall minibuffer-completion-predicate
646 tem)
647 t)
648 nil)))
649 ((and (consp minibuffer-completion-table)
650 ;;#### Emacs-Lisp truly sucks!
651 ;; lambda, autoload, etc
652 (not (symbolp (car minibuffer-completion-table))))
653 (if (not completion-ignore-case)
654 (assoc buffer-string minibuffer-completion-table)
655 (let ((s (upcase buffer-string))
656 (tail minibuffer-completion-table)
657 tem)
658 (while tail
659 (setq tem (car (car tail)))
660 (if (or (equal tem buffer-string)
661 (equal tem s)
662 (if tem (equal (upcase tem) s)))
663 (setq s 'win
664 tail nil) ;exit
665 (setq tail (cdr tail))))
666 (eq s 'win))))
667 (t
668 (funcall minibuffer-completion-table
669 buffer-string
670 minibuffer-completion-predicate
671 'lambda)))
672 )
673
674 ;; 0 'none no possible completion 617 ;; 0 'none no possible completion
675 ;; 1 'unique was already an exact and unique completion 618 ;; 1 'unique was already an exact and unique completion
676 ;; 3 'exact was already an exact (but nonunique) completion 619 ;; 3 'exact was already an exact (but nonunique) completion
677 ;; NOT USED 'completed-exact-unique completed to an exact and completion 620 ;; NOT USED 'completed-exact-unique completed to an exact and completion
678 ;; 4 'completed-exact completed to an exact (but nonunique) completion 621 ;; 4 'completed-exact completed to an exact (but nonunique) completion
691 (progn 634 (progn
692 ;; Some completion happened 635 ;; Some completion happened
693 (erase-buffer) 636 (erase-buffer)
694 (insert completion) 637 (insert completion)
695 (setq buffer-string completion))) 638 (setq buffer-string completion)))
696 (if (exact-minibuffer-completion-p buffer-string) 639 (if (test-completion buffer-string minibuffer-completion-table
640 minibuffer-completion-predicate)
697 ;; An exact completion was possible 641 ;; An exact completion was possible
698 (if completedp 642 (if completedp
699 ;; Since no callers need to know the difference, don't bother 643 ;; Since no callers need to know the difference, don't bother
700 ;; with this (potentially expensive) discrimination. 644 ;; with this (potentially expensive) discrimination.
701 ;; (if (eq (try-completion completion 645 ;; (if (eq (try-completion completion
750 status)) 694 status))
751 695
752 696
753 ;;;; completing-read 697 ;;;; completing-read
754 698
755 (defun completing-read (prompt table 699 (defun completing-read (prompt collection &optional predicate require-match
756 &optional predicate require-match 700 initial-contents history default)
757 initial-contents history default)
758 "Read a string in the minibuffer, with completion. 701 "Read a string in the minibuffer, with completion.
759 702
760 PROMPT is a string to prompt with; normally it ends in a colon and a space. 703 PROMPT is a string to prompt with; normally it ends in a colon and a space.
761 TABLE is an alist whose elements' cars are strings, or an obarray. 704 COLLECTION is a set of objects that are the possible completions.
762 TABLE can also be a function which does the completion itself. 705 PREDICATE limits completion to a subset of COLLECTION.
763 PREDICATE limits completion to a subset of TABLE. 706 See `try-completion' and `all-completions' for details of COLLECTION,
764 See `try-completion' and `all-completions' for more details 707 PREDICATE, and completion in general.
765 on completion, TABLE, and PREDICATE.
766 708
767 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless 709 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
768 the input is (or completes to) an element of TABLE or is null. 710 the input is (or completes to) an element of COLLECTION or is null.
769 If it is also not t, Return does not exit if it does non-null completion. 711 If it is also not t, Return does not exit if it does non-null completion.
770 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. 712 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
771 If it is (STRING . POSITION), the initial input 713 If it is (STRING . POSITION), the initial input
772 is STRING, but point is placed POSITION characters into the string. 714 is STRING, but point is placed POSITION characters into the string.
773 715
783 DEFAULT, if non-nil, will be returned when the user enters an empty 725 DEFAULT, if non-nil, will be returned when the user enters an empty
784 string. 726 string.
785 727
786 Completion ignores case if the ambient value of 728 Completion ignores case if the ambient value of
787 `completion-ignore-case' is non-nil." 729 `completion-ignore-case' is non-nil."
788 (let ((minibuffer-completion-table table) 730 (let ((minibuffer-completion-table collection)
789 (minibuffer-completion-predicate predicate) 731 (minibuffer-completion-predicate predicate)
790 (minibuffer-completion-confirm (if (eq require-match 't) nil t)) 732 (minibuffer-completion-confirm (if (eq require-match 't) nil t))
791 (last-exact-completion nil) 733 (last-exact-completion nil)
792 ret) 734 ret)
793 (setq ret (read-from-minibuffer prompt 735 (setq ret (read-from-minibuffer prompt
860 ;; Crockishly allow user to specify null string 802 ;; Crockishly allow user to specify null string
861 (throw 'exit nil)) 803 (throw 'exit nil))
862 (let ((buffer-string (buffer-string))) 804 (let ((buffer-string (buffer-string)))
863 ;; Short-cut -- don't call minibuffer-do-completion if we already 805 ;; Short-cut -- don't call minibuffer-do-completion if we already
864 ;; have an (possibly nonunique) exact completion. 806 ;; have an (possibly nonunique) exact completion.
865 (if (exact-minibuffer-completion-p buffer-string) 807 (if (test-completion buffer-string minibuffer-completion-table
808 minibuffer-completion-predicate)
866 (throw 'exit nil)) 809 (throw 'exit nil))
867 (let ((status (minibuffer-do-completion buffer-string))) 810 (let ((status (minibuffer-do-completion buffer-string)))
868 (if (or (eq status 'unique) 811 (if (or (eq status 'unique)
869 (eq status 'exact) 812 (eq status 'exact)
870 (if (or (eq status 'completed-exact) 813 (if (or (eq status 'completed-exact)
891 the character in question must be typed again)." 834 the character in question must be typed again)."
892 (interactive) 835 (interactive)
893 (if (not minibuffer-confirm-incomplete) 836 (if (not minibuffer-confirm-incomplete)
894 (throw 'exit nil)) 837 (throw 'exit nil))
895 (let ((buffer-string (buffer-string))) 838 (let ((buffer-string (buffer-string)))
896 (if (exact-minibuffer-completion-p buffer-string) 839 (if (test-completion buffer-string minibuffer-completion-table
840 minibuffer-completion-predicate)
897 (throw 'exit nil)) 841 (throw 'exit nil))
898 (let ((completion (if (not minibuffer-completion-table) 842 (let ((completion (if (not minibuffer-completion-table)
899 t 843 t
900 (try-completion buffer-string 844 (try-completion buffer-string
901 minibuffer-completion-table 845 minibuffer-completion-table
1090 ;; try-completion bogusly returns a string even when 1034 ;; try-completion bogusly returns a string even when
1091 ;; that string is complete if that string is also a 1035 ;; that string is complete if that string is also a
1092 ;; prefix for other completions. This means that we 1036 ;; prefix for other completions. This means that we
1093 ;; can't just do the obvious thing, (eq t 1037 ;; can't just do the obvious thing, (eq t
1094 ;; (try-completion ...)). 1038 ;; (try-completion ...)).
1039 ;;
1040 ;; Could be reasonable to use #'test-completion
1041 ;; instead. Aidan Kehoe, Mo 14 Mai 2012 08:17:10 IST
1095 (let (comp) 1042 (let (comp)
1096 (if (and filename-kludge-p 1043 (if (and filename-kludge-p
1097 ;; #### evil evil evil evil 1044 ;; #### evil evil evil evil
1098 (or (and (fboundp 'ange-ftp-ftp-path) 1045 (or (and (fboundp 'ange-ftp-ftp-path)
1099 (declare-fboundp 1046 (declare-fboundp
2184 "Read the name of a color from the minibuffer. 2131 "Read the name of a color from the minibuffer.
2185 On X devices, this uses `x-library-search-path' to find rgb.txt in order 2132 On X devices, this uses `x-library-search-path' to find rgb.txt in order
2186 to build a completion table. 2133 to build a completion table.
2187 On TTY devices, this uses `tty-color-list'. 2134 On TTY devices, this uses `tty-color-list'.
2188 On mswindows devices, this uses `mswindows-color-list'." 2135 On mswindows devices, this uses `mswindows-color-list'."
2189 (let ((table (read-color-completion-table))) 2136 (let ((table (color-list)))
2190 (completing-read prompt table nil (and table must-match) 2137 (completing-read prompt table nil (and table must-match)
2191 initial-contents))) 2138 initial-contents)))
2192 2139
2193 2140
2194 (defun read-coding-system (prompt &optional default-coding-system) 2141 (defun read-coding-system (prompt &optional default-coding-system)