diff lisp/packages/icomplete.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children b82b59fe008d
line wrap: on
line diff
--- a/lisp/packages/icomplete.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/packages/icomplete.el	Mon Aug 13 08:46:35 2007 +0200
@@ -1,69 +1,70 @@
 ;;; icomplete.el --- minibuffer completion with incremental feedback
 
-;;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
 
 ;;; Author: Ken Manheimer <klm@nist.gov>
 ;;; Maintainer: Ken Manheimer <klm@nist.gov>
-;;; Version: $Id: icomplete.el,v 1.1.1.1 1996/12/18 03:31:39 steve Exp $
+;;; Version: $Id: icomplete.el,v 1.1.1.2 1996/12/18 03:44:58 steve Exp $
 ;;; Created: Mar 1993 klm@nist.gov - first release to usenet
 ;;; Keywords: help, abbrev
 
 ;;; Hacked for XEmacs: David Hughes 7th September 1995
 
-;; This file is part of GNU Emacs.
+;; This file is part of XEmacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.29.
+;;; Synched up with: FSF 19.34.
 
 ;;; Commentary:
 
-;;; Loading this package implements a more fine-grained minibuffer
-;;; completion feedback scheme.  Prospective completions are concisely
-;;; indicated within the minibuffer itself, with each successive
-;;; keystroke.
+;; Loading this package implements a more fine-grained minibuffer
+;; completion feedback scheme.  Prospective completions are concisely
+;; indicated within the minibuffer itself, with each successive
+;; keystroke.
 
-;;; See 'icomplete-completions' docstring for a description of the
-;;; icomplete display format.
+;; See 'icomplete-completions' docstring for a description of the
+;; icomplete display format.
 
-;;; See the `icomplete-minibuffer-setup-hook' docstring for a means to
-;;; customize icomplete setup for interoperation with other
-;;; minibuffer-oriented packages.
+;; See the `icomplete-minibuffer-setup-hook' docstring for a means to
+;; customize icomplete setup for interoperation with other
+;; minibuffer-oriented packages.
 
-;;; To activate icomplete mode, simply load the package.  You can
-;;; subsequently deactivate it by invoking the function icomplete-mode
-;;; with a negative prefix-arg (C-U -1 ESC-x icomplete-mode).  Also,
-;;; you can prevent activation of the mode during package load by
-;;; first setting the variable `icomplete-mode' to nil.  Icompletion
-;;; can be enabled any time after the package is loaded by invoking
-;;; icomplete-mode without a prefix arg.
+;; To activate icomplete mode, simply load the package.  You can
+;; subsequently deactivate it by invoking the function icomplete-mode
+;; with a negative prefix-arg (C-U -1 ESC-x icomplete-mode).  Also,
+;; you can prevent activation of the mode during package load by
+;; first setting the variable `icomplete-mode' to nil.  Icompletion
+;; can be enabled any time after the package is loaded by invoking
+;; icomplete-mode without a prefix arg.
 
-;;; This version of icomplete runs on Emacs 19.18 and later.  (It
-;;; depends on the incorporation of minibuffer-setup-hook.)  The elisp
-;;; archives, ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive,
-;;; probably still has a version that works in GNU Emacs v18.
+;; This version of icomplete runs on Emacs 19.18 and later.  (It
+;; depends on the incorporation of minibuffer-setup-hook.)  The elisp
+;; archives, ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive,
+;; probably still has a version that works in GNU Emacs v18.
 
-;;; Thanks to everyone for their suggestions for refinements of this
-;;; package.  I particularly have to credit Michael Cook, who
-;;; implemented an incremental completion style in his 'iswitch'
-;;; functions that served as a model for icomplete.  Some other
-;;; contributors: Noah Freidman (restructuring as minor mode), Colin
-;;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and
-;;; others.
+;; Thanks to everyone for their suggestions for refinements of this
+;; package.  I particularly have to credit Michael Cook, who
+;; implemented an incremental completion style in his 'iswitch'
+;; functions that served as a model for icomplete.  Some other
+;; contributors: Noah Freidman (restructuring as minor mode), Colin
+;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and
+;; others.
 
-;;; klm.
+;; klm.
 
 ;;; Code:
 
@@ -71,13 +72,6 @@
 (provide 'icomplete)
 
 ;;;_* User Customization variables
-(defvar icomplete-compute-delay .3
-  "*Completions-computation stall, used only with large-number
-completions - see `icomplete-delay-completions-threshold'.")
-(defvar icomplete-delay-completions-threshold 400
-  "*Pending-completions number over which to apply icomplete-compute-delay.")
-(defvar icomplete-max-delay-chars 3
-  "*Maximum number of initial chars to apply icomplete compute delay.")
 
 ;;;_* Initialization
 ;;;_  = icomplete-minibuffer-setup-hook
@@ -123,13 +117,26 @@
 minibuffer completion.")
 (add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
 
-;;;_ > icomplete-run-pre-command-hooks
-(defun icomplete-run-pre-command-hooks ()
-  (run-hooks 'icomplete-pre-command-hook))
+;; XEmacs addition
+(defvar icomplete-show-key-bindings t
+  "When non-nil show key bindings as well as completion when matching
+a command.")
 
-;;;_ > icomplete-run-post-command-hooks
-(defun icomplete-run-post-command-hooks ()
-  (run-hooks 'icomplete-post-command-hook))
+;; XEmacs addition
+(defun icomplete-get-keys (func-name)
+  "Return the keys `func-name' is bound to as a string."
+  (when (commandp func-name)
+    (let* ((sym (intern func-name))
+	   (keys (where-is-internal sym)))
+      (concat "<"
+	      (if keys
+		  (mapconcat 'key-description
+			     (sort '([next] [kp_next] [(control v)])
+				   #'(lambda (x y)
+				       (< (length x) (length y))))
+			     ", ")
+		"Unbound")
+	      ">"))))
 
 ;;;_ > icomplete-mode (&optional prefix)
 ;;;###autoload
@@ -154,34 +161,37 @@
    the selected window is a minibuffer,
    and not in the middle of macro execution,
    and minibuffer-completion-table is not a symbol (which would
-       indicate some non-standard, non-simple completion mechansm,
+       indicate some non-standard, non-simple completion mechanism,
        like file-name and other custom-func completions)."
 
   (and (window-minibuffer-p (selected-window))
-       (not executing-macro)
+       (not executing-kbd-macro)
        (not (symbolp minibuffer-completion-table))))
+
 ;;;_ > icomplete-minibuffer-setup ()
 ;;;###autoload
 (defun icomplete-minibuffer-setup ()
-
   "Run in minibuffer on activation to establish incremental completion.
-
-Usually run by inclusion in minibuffer-setup-hook."
-
+Usually run by inclusion in `minibuffer-setup-hook'."
   (cond ((and icomplete-mode (icomplete-simple-completing-p))
 	 (make-local-hook 'pre-command-hook)
-	 (add-hook 'pre-command-hook 'icomplete-run-pre-command-hooks nil t)
+	 (add-hook 'pre-command-hook
+		   (function (lambda ()
+			       (run-hooks 'icomplete-pre-command-hook)))
+		   nil t)
 	 (make-local-hook 'post-command-hook)
-	 (add-hook 'post-command-hook 'icomplete-run-post-command-hooks nil t)
+	 (add-hook 'post-command-hook
+		   (function (lambda ()
+			       (run-hooks 'icomplete-post-command-hook)))
+		   nil t)
 	 (run-hooks 'icomplete-minibuffer-setup-hook))))
-
+
 ;;;_* Completion
 
 ;;;_ > icomplete-tidy ()
 (defun icomplete-tidy ()
   "Remove completions display \(if any) prior to new user input.
-
-Should be run in on the minibuffer pre-command-hook.  See `icomplete-mode'
+Should be run in on the minibuffer `pre-command-hook'.  See `icomplete-mode'
 and `minibuffer-setup-hook'."
   (if (icomplete-simple-completing-p)
       (if (and (boundp 'icomplete-eoinput)
@@ -196,15 +206,15 @@
 	;; Reestablish the local variable 'cause minibuffer-setup is weird:
 	(make-local-variable 'icomplete-eoinput)
 	(setq icomplete-eoinput 1))))
+
 ;;;_ > icomplete-exhibit ()
 (defun icomplete-exhibit ()
   "Insert icomplete completions display.
-
-Should be run via minibuffer post-command-hook.  See `icomplete-mode'
+Should be run via minibuffer `post-command-hook'.  See `icomplete-mode'
 and `minibuffer-setup-hook'."
   (if (icomplete-simple-completing-p)
-      (let* ((contents (buffer-substring (point-min)(point-max)))
-	     (buffer-undo-list t))
+      (let ((contents (buffer-substring (point-min)(point-max)))
+	    (buffer-undo-list t))
 	(save-excursion
 	  (goto-char (point-max))
                                         ; Register the end of input, so we
@@ -215,28 +225,14 @@
 	      (make-local-variable 'icomplete-eoinput))
 	  (setq icomplete-eoinput (point))
                                         ; Insert the match-status information:
-	  (if (and (> (point-max) 1)
-		   (or
-		    ;; Don't bother with delay after certain number of chars:
-		    (> (point-max) icomplete-max-delay-chars)
-		    ;; Don't delay if alternatives number is small enough:
-		    (if minibuffer-completion-table
-			(cond ((numberp minibuffer-completion-table)
-			       (< minibuffer-completion-table
-				  icomplete-delay-completions-threshold))
-			      ((sequencep minibuffer-completion-table)
-			       (< (length minibuffer-completion-table)
-				  icomplete-delay-completions-threshold))
-			      ))
-		    ;; Delay - give some grace time for next keystroke, before
-		    ;; embarking on computing completions:
-                    (sit-for icomplete-compute-delay)))
+	  (if (> (point-max) 1)
 	      (insert-string
 	       (icomplete-completions contents
 				      minibuffer-completion-table
 				      minibuffer-completion-predicate
 				      (not
 				       minibuffer-completion-confirm))))))))
+
 ;;;_ > icomplete-completions (name candidates predicate require-match)
 (defun icomplete-completions (name candidates predicate require-match)
   "Identify prospective candidates for minibuffer completion.
@@ -250,10 +246,10 @@
   \(...) - a single prospect is identified and matching is enforced,
   \[...] - a single prospect is identified but matching is optional, or
   \{...} - multiple prospects, separated by commas, are indicated, and
-          further input is required to distingish a single one.
+          further input is required to distinguish a single one.
 
-The displays for disambiguous matches have \" [Matched]\" appended
-\(whether complete or not), or \" \[No matches]\", if no eligible
+The displays for unambiguous matches have ` [Matched]' appended
+\(whether complete or not), or ` \[No matches]', if no eligible
 matches exist."
 
   (let ((comps (all-completions name candidates predicate))
@@ -264,64 +260,53 @@
         (open-bracket-prospects "{")
         (close-bracket-prospects "}")
         )
-    (catch 'input
-      (cond ((null comps) (format " %sNo matches%s"
-				  open-bracket-determined
+    (cond ((null comps) (format " %sNo matches%s"
+				open-bracket-determined
+				close-bracket-determined))
+	  ((null (cdr comps))           ;one match
+	   (concat (if (and (> (length (car comps))
+			       (length name)))
+		       (concat open-bracket-determined
+			       (substring (car comps) (length name))
+			       close-bracket-determined)
+		     "")
+		   " [Matched]"
+	   ;; XEmacs
+		   (if (and icomplete-show-key-bindings
+			    (commandp (car comps)))
+		       (icomplete-get-keys (car comps))
+		     "")
+		   ))
+	  (t                            ;multiple matches
+	   (let* ((most (try-completion name candidates predicate))
+		  (most-len (length most))
+		  most-is-exact
+		  (alternatives
+		   (apply
+		    (function concat)
+		    (cdr (apply
+			  (function nconc)
+			  (mapcar '(lambda (com)
+				     (if (= (length com) most-len)
+					 ;; Most is one exact match,
+					 ;; note that and leave out
+					 ;; for later indication:
+					 (progn
+					   (setq most-is-exact t)
+					   ())
+				       (list ","
+					     (substring com
+							most-len))))
+				  comps))))))
+	     (concat (and (> most-len (length name))
+			  (concat open-bracket-determined
+				  (substring most (length name))
 				  close-bracket-determined))
-	    ((null (cdr comps))		;one match
-	     (concat (if (and (> (length (car comps))
-				 (length name)))
-			 (concat open-bracket-determined
-				 (substring (car comps) (length name))
-				 close-bracket-determined)
-		       "")
-		     " [Matched]"))
-	    (t				;multiple matches
-	     (let* ((most
-		     (try-completion name candidates
-				     (and predicate
-					  ;; Wrap predicate in impatience - ie,
-					  ;; `throw' up when pending input is
-					  ;; noticed.  Adds some overhead to
-					  ;; predicate, but should be worth it.
-					  (function
-					   (lambda (item)
-                                             (if (input-pending-p)
-						 (throw 'input "")
-					       (apply predicate
-						      item nil)))))))
-		    (most-len (length most))
-		    most-is-exact
-		    (alternatives
-		     (substring
-		      (apply (function concat)
-			     (mapcar (function
-				      (lambda (com)
-                                        (if (input-pending-p)
-					    (throw 'input ""))
-					(if (= (length com) most-len)
-					    ;; Most is one exact match,
-					    ;; note that and leave out
-					    ;; for later indication:
-					    (progn
-					      (setq most-is-exact t)
-					      ())
-					  (concat ","
-						  (substring com
-							     most-len)))))
-				     comps))
-		      1)))
-	       (concat (and (> most-len (length name))
-			    (concat open-bracket-determined
-				    (substring most (length name))
-				    close-bracket-determined))
-		       open-bracket-prospects
-		       (if most-is-exact
-			   ;; Add a ',' at the front to indicate "complete but
-			   ;; not unique":
-			   (concat "," alternatives)
-			 alternatives)
-		       close-bracket-prospects)))))))
+		     open-bracket-prospects
+		     (if most-is-exact
+			 (concat "," alternatives)
+		       alternatives)
+		     close-bracket-prospects))))))
 
 ;;;_ + Initialization
 ;;; If user hasn't setq-default icomplete-mode to nil, then setup for