Mercurial > hg > xemacs-beta
diff lisp/packages/icomplete.el @ 153:25f70ba0133c r20-3b3
Import from CVS: tag r20-3b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:38:25 +0200 |
parents | fe104dbd9147 |
children | 43dd3413c7c7 |
line wrap: on
line diff
--- a/lisp/packages/icomplete.el Mon Aug 13 09:37:21 2007 +0200 +++ b/lisp/packages/icomplete.el Mon Aug 13 09:38:25 2007 +0200 @@ -1,33 +1,33 @@ -;;; icomplete.el --- minibuffer completion with incremental feedback +;;;_. icomplete.el - minibuffer completion incremental feedback -;;; Copyright (C) 1992, 1993, 1994 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.2 1997/03/16 03:05:29 steve Exp $ -;;; Created: Mar 1993 klm@nist.gov - first release to usenet -;;; Keywords: help, abbrev +;; Author: Ken Manheimer <klm@python.org> +;; Maintainer: Ken Manheimer <klm@python.org> +;; Version: $Id: icomplete.el,v 1.3 1997/05/29 23:50:06 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. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by +;; 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 ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; 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. +;; 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. ;; You should have received a copy of the GNU General Public License -;; 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. +;; along with GNU Emacs; 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.34. +;; This file is also part of XEmacs. +;; Hacked for XEmacs: David Hughes 7th September 1995 +;; With some integration and refinement by Ken Manheimer, May 1997 ;;; Commentary: @@ -72,6 +72,13 @@ (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 @@ -121,28 +128,30 @@ (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) ;; XEmacs addition -(defvar icomplete-show-key-bindings t +(defvar icomplete-show-key-bindings (string-match "XEmacs\\|Lucid" + emacs-version) "When non-nil show key bindings as well as completion when matching -a command.") +a command. Currently working only for XEmacs - see `icomplete-get-keys'.") -;; XEmacs addition (defun icomplete-get-keys (func-name) - "Return the keys `func-name' is bound to as a string." + "Return the keys `func-name' is bound to as a string, or nil if none. +NOTE that this depends on `owindow' minbuf setting and `current-local-map' +taking arg, both present in XEmacs but not present in mainline GNU Emacs +19.34." (when (commandp func-name) (save-excursion ;; Depends on dynamic scope from read-from-minibuffer :-( (let* ((sym (intern func-name)) (buf (set-buffer (window-buffer owindow))) (keys (where-is-internal sym (current-local-map buf)))) - (concat "<" - (if keys + (if keys + (concat "<" (mapconcat 'key-description (sort keys #'(lambda (x y) (< (length x) (length y)))) ", ") - "Unbound") - ">"))))) + ">")))))) ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload @@ -216,6 +225,7 @@ ;;;_ > icomplete-exhibit () (defun icomplete-exhibit () "Insert icomplete completions display. + Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." (if (icomplete-simple-completing-p) @@ -231,7 +241,22 @@ (make-local-variable 'icomplete-eoinput)) (setq icomplete-eoinput (point)) ; Insert the match-status information: - (if (> (point-max) 1) + (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))) (insert-string (icomplete-completions contents minibuffer-completion-table @@ -256,7 +281,13 @@ The displays for unambiguous matches have ` [Matched]' appended \(whether complete or not), or ` \[No matches]', if no eligible -matches exist." +matches exist. \(In XEmacs, keybindings for matched commands, if any, +are exhibited within the square braces.)" + + ;; 'all-completions' doesn't like empty + ;; minibuffer-completion-table's (ie: (nil)) + (if (and (listp candidates) (null (car candidates))) + (setq candidates nil)) (let ((comps (all-completions name candidates predicate)) ; "-determined" - only one candidate @@ -266,53 +297,71 @@ (open-bracket-prospects "{") (close-bracket-prospects "}") ) - (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 (intern-soft (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)) + (catch 'input + (cond ((null comps) (format " %sNo matches%s" + open-bracket-determined close-bracket-determined)) - open-bracket-prospects - (if most-is-exact - (concat "," alternatives) - alternatives) - close-bracket-prospects)))))) + ((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" + (let ((keys (and icomplete-show-key-bindings + (commandp (intern-soft (car comps))) + (icomplete-get-keys (car comps))))) + (if keys + (concat "; " keys) + "")) + "]")) + (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))))))) ;;;_ + Initialization ;;; If user hasn't setq-default icomplete-mode to nil, then setup for