DataMuseum.dk

top - metrics - download

    Length: 4598 (0x11f6)
    Types: TextFile
    Names: »compl-read.el«

└─⟦a05ed705a⟧ Bits:30007078 DKUUG GNU 2/12/89
    └─⟦dbcd4071d⟧ »./gnu-ada-1.05.tar.Z« 
        └─⟦999713de5⟧ 
            └─⟦this⟧ »compl-read.el« 

TextFile

;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; compl-read.el --- Bug workaround for completing-read
;; Author          : Lynn Slater
;; Created On      : Tue Jun  7 10:11:49 1988
;; Last Modified By: Lynn Slater
;; Last Modified On: Fri Oct  7 07:48:45 1988
;; Update Count    : 9
;; Status          : Released
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; In emacs 18.49 (machine independent).
;; 
;; Completing-read has a serious bug in that it does not always 
;; return a member of the alist even if the Require-match arguement is true. 
;; To recreate, evaluate the following form
;;   (let ((completion-ignore-case t)
;; 	(alist '(("CAT". 1) ("dog" . 2) ("lion" . 3))))
;;     (assoc (completing-read "Type 'cat': " alist nil t) alist))
;; 
;; If you type 'c<cr>' you get '("CAT" . 1) which is correct.
;; If you type 'cat<cr>', you get nil, which is grossely wrong.
;; 
;; The problem is that if the input is an exact match (except for case) to a
;; key of the alist, the input string is returned instead of the case
;; corrected alist key.
;; 
;; There seems to be no elegant fix to this. There is no assoc function that
;; is case insensitive. The best fix would be in C but the closest lisp
;; equivilent follows. Place this in your search path under the file name
;; completing-read.
;; 
;;  From: Lynn R. Slater [lrs@esl]
;;  Organization: ESL/TRW 495 Java Dr. Sunnyvale, CA 94088-3510
;;  Phone.......: Office (408) 294-2888 x 4482; Home (415) 796-4149 
;; -- Cut Here --

;; Copyright (C) 1988 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(provide 'compl-read)
(if (not (fboundp 'completing-read-original-buggy-version))
    (progn
      (fset 'completing-read-original-buggy-version
	    (symbol-function 'completing-read))))

(defun completing-read (prompt table
			       &optional predicate require-match Initial-input)
  "FIXED VERSION! Read a string in the minibuffer, with completion.\n\
Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.\n\
PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
TABLE is an alist whose elements' cars are strings, or an obarray (see try-completion).\n\
PREDICATE limits completion to a subset of TABLE; see try-completion for details.\n\
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
 the input is (or completes to) an element of TABLE.\n\
 If it is also not t, Return does not exit if it does non-null completion.\n\
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
Case is ignored if ambient value of  completion-ignore-case  is non-nil."

  (if (and require-match completion-ignore-case)
      ;; do the old completing-read and manually search the table afterwards.
      ;; Use a search key made from the old results but wrap it in "^$" so that
      ;; only exact matches are returned.
      (let ((key (concat
		   "^"
		   (regexp-quote
		     (completing-read-original-buggy-version
		       prompt table predicate require-match Initial-input))
		   "$"))
	    ;; we need string-match to obey the same case rules as the old
	    ;; completing-read did.
	    (case-fold-search  completion-ignore-case)
	    (result nil))

	;; manually search the table
	(while (and (null result) table)
	  (if (and (or (not predicate) (funcall predicate (car table)))
		   (string-match key (car (car table))))
	      (setq result (car table))
	    (setq table (cdr table))))
	(car result))
    ;; completing read is case sensitive and there is no bug as the user's
    ;; input string must match the input;  do not bother manually searching
    ;; the table.
    (completing-read-original-buggy-version
      prompt table predicate require-match Initial-input)
    ))