Mercurial > hg > xemacs-beta

comparison lisp/packages/icomplete.el @ 153:25f70ba0133c r20-3b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b3
author cvs
date Mon, 13 Aug 2007 09:38:25 +0200
parents fe104dbd9147
children 43dd3413c7c7
comparison
equal deleted inserted replaced
152:4c132ee2d62b 153:25f70ba0133c
1 ;;; icomplete.el --- minibuffer completion with incremental feedback 1 ;;;_. icomplete.el - minibuffer completion incremental feedback
2 2
3 ;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
4 4
5 ;;; Author: Ken Manheimer <klm@nist.gov> 5 ;; Author: Ken Manheimer <klm@python.org>
6 ;;; Maintainer: Ken Manheimer <klm@nist.gov> 6 ;; Maintainer: Ken Manheimer <klm@python.org>
7 ;;; Version: $Id: icomplete.el,v 1.2 1997/03/16 03:05:29 steve Exp $ 7 ;; Version: $Id: icomplete.el,v 1.3 1997/05/29 23:50:06 steve Exp $
8 ;;; Created: Mar 1993 klm@nist.gov - first release to usenet 8 ;; Created: Mar 1993 klm@nist.gov - first release to usenet
9 ;;; Keywords: help, abbrev 9 ;; Keywords: help, abbrev
10 10
11 ;;; Hacked for XEmacs: David Hughes 7th September 1995 11 ;; This file is part of GNU Emacs.
12 12
13 ;; This file is part of XEmacs. 13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 14 ;; it under the terms of the GNU General Public License as published by
15 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option) 15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version. 16 ;; any later version.
19 17
20 ;; XEmacs is distributed in the hope that it will be useful, but 18 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; General Public License for more details. 21 ;; GNU General Public License for more details.
24 22
25 ;; You should have received a copy of the GNU General Public License 23 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING. If not, write to the Free 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; 02111-1307, USA. 26 ;; Boston, MA 02111-1307, USA.
29 27
30 ;;; Synched up with: FSF 19.34. 28 ;; This file is also part of XEmacs.
29 ;; Hacked for XEmacs: David Hughes 7th September 1995
30 ;; With some integration and refinement by Ken Manheimer, May 1997
31 31
32 ;;; Commentary: 32 ;;; Commentary:
33 33
34 ;; Loading this package implements a more fine-grained minibuffer 34 ;; Loading this package implements a more fine-grained minibuffer
35 ;; completion feedback scheme. Prospective completions are concisely 35 ;; completion feedback scheme. Prospective completions are concisely
70 70
71 ;;;_* Provide 71 ;;;_* Provide
72 (provide 'icomplete) 72 (provide 'icomplete)
73 73
74 ;;;_* User Customization variables 74 ;;;_* User Customization variables
75 (defvar icomplete-compute-delay .3
76 "*Completions-computation stall, used only with large-number
77 completions - see `icomplete-delay-completions-threshold'.")
78 (defvar icomplete-delay-completions-threshold 400
79 "*Pending-completions number over which to apply icomplete-compute-delay.")
80 (defvar icomplete-max-delay-chars 3
81 "*Maximum number of initial chars to apply icomplete compute delay.")
75 82
76 ;;;_* Initialization 83 ;;;_* Initialization
77 ;;;_ = icomplete-minibuffer-setup-hook 84 ;;;_ = icomplete-minibuffer-setup-hook
78 (defvar icomplete-minibuffer-setup-hook nil 85 (defvar icomplete-minibuffer-setup-hook nil
79 "*Icomplete-specific customization of minibuffer setup. 86 "*Icomplete-specific customization of minibuffer setup.
119 Use `icomplete-mode' function to set it up properly for incremental 126 Use `icomplete-mode' function to set it up properly for incremental
120 minibuffer completion.") 127 minibuffer completion.")
121 (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) 128 (add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
122 129
123 ;; XEmacs addition 130 ;; XEmacs addition
124 (defvar icomplete-show-key-bindings t 131 (defvar icomplete-show-key-bindings (string-match "XEmacs\\|Lucid"
132 emacs-version)
125 "When non-nil show key bindings as well as completion when matching 133 "When non-nil show key bindings as well as completion when matching
126 a command.") 134 a command. Currently working only for XEmacs - see `icomplete-get-keys'.")
127 135
128 ;; XEmacs addition
129 (defun icomplete-get-keys (func-name) 136 (defun icomplete-get-keys (func-name)
130 "Return the keys `func-name' is bound to as a string." 137 "Return the keys `func-name' is bound to as a string, or nil if none.
138 NOTE that this depends on `owindow' minbuf setting and `current-local-map'
139 taking arg, both present in XEmacs but not present in mainline GNU Emacs
140 19.34."
131 (when (commandp func-name) 141 (when (commandp func-name)
132 (save-excursion 142 (save-excursion
133 ;; Depends on dynamic scope from read-from-minibuffer :-( 143 ;; Depends on dynamic scope from read-from-minibuffer :-(
134 (let* ((sym (intern func-name)) 144 (let* ((sym (intern func-name))
135 (buf (set-buffer (window-buffer owindow))) 145 (buf (set-buffer (window-buffer owindow)))
136 (keys (where-is-internal sym (current-local-map buf)))) 146 (keys (where-is-internal sym (current-local-map buf))))
137 (concat "<" 147 (if keys
138 (if keys 148 (concat "<"
139 (mapconcat 'key-description 149 (mapconcat 'key-description
140 (sort keys 150 (sort keys
141 #'(lambda (x y) 151 #'(lambda (x y)
142 (< (length x) (length y)))) 152 (< (length x) (length y))))
143 ", ") 153 ", ")
144 "Unbound") 154 ">"))))))
145 ">")))))
146 155
147 ;;;_ > icomplete-mode (&optional prefix) 156 ;;;_ > icomplete-mode (&optional prefix)
148 ;;;###autoload 157 ;;;###autoload
149 (defun icomplete-mode (&optional prefix) 158 (defun icomplete-mode (&optional prefix)
150 "Activate incremental minibuffer completion for this emacs session, 159 "Activate incremental minibuffer completion for this emacs session,
214 (setq icomplete-eoinput 1)))) 223 (setq icomplete-eoinput 1))))
215 224
216 ;;;_ > icomplete-exhibit () 225 ;;;_ > icomplete-exhibit ()
217 (defun icomplete-exhibit () 226 (defun icomplete-exhibit ()
218 "Insert icomplete completions display. 227 "Insert icomplete completions display.
228
219 Should be run via minibuffer `post-command-hook'. See `icomplete-mode' 229 Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
220 and `minibuffer-setup-hook'." 230 and `minibuffer-setup-hook'."
221 (if (icomplete-simple-completing-p) 231 (if (icomplete-simple-completing-p)
222 (let ((contents (buffer-substring (point-min)(point-max))) 232 (let ((contents (buffer-substring (point-min)(point-max)))
223 (buffer-undo-list t)) 233 (buffer-undo-list t))
229 (if (not (boundp 'icomplete-eoinput)) 239 (if (not (boundp 'icomplete-eoinput))
230 ;; In case it got wiped out by major mode business: 240 ;; In case it got wiped out by major mode business:
231 (make-local-variable 'icomplete-eoinput)) 241 (make-local-variable 'icomplete-eoinput))
232 (setq icomplete-eoinput (point)) 242 (setq icomplete-eoinput (point))
233 ; Insert the match-status information: 243 ; Insert the match-status information:
234 (if (> (point-max) 1) 244 (if (and (> (point-max) 1)
245 (or
246 ;; Don't bother with delay after certain number of chars:
247 (> (point-max) icomplete-max-delay-chars)
248 ;; Don't delay if alternatives number is small enough:
249 (if minibuffer-completion-table
250 (cond ((numberp minibuffer-completion-table)
251 (< minibuffer-completion-table
252 icomplete-delay-completions-threshold))
253 ((sequencep minibuffer-completion-table)
254 (< (length minibuffer-completion-table)
255 icomplete-delay-completions-threshold))
256 ))
257 ;; Delay - give some grace time for next keystroke, before
258 ;; embarking on computing completions:
259 (sit-for icomplete-compute-delay)))
235 (insert-string 260 (insert-string
236 (icomplete-completions contents 261 (icomplete-completions contents
237 minibuffer-completion-table 262 minibuffer-completion-table
238 minibuffer-completion-predicate 263 minibuffer-completion-predicate
239 (not 264 (not
254 \{...} - multiple prospects, separated by commas, are indicated, and 279 \{...} - multiple prospects, separated by commas, are indicated, and
255 further input is required to distinguish a single one. 280 further input is required to distinguish a single one.
256 281
257 The displays for unambiguous matches have ` [Matched]' appended 282 The displays for unambiguous matches have ` [Matched]' appended
258 \(whether complete or not), or ` \[No matches]', if no eligible 283 \(whether complete or not), or ` \[No matches]', if no eligible
259 matches exist." 284 matches exist. \(In XEmacs, keybindings for matched commands, if any,
285 are exhibited within the square braces.)"
286
287 ;; 'all-completions' doesn't like empty
288 ;; minibuffer-completion-table's (ie: (nil))
289 (if (and (listp candidates) (null (car candidates)))
290 (setq candidates nil))
260 291
261 (let ((comps (all-completions name candidates predicate)) 292 (let ((comps (all-completions name candidates predicate))
262 ; "-determined" - only one candidate 293 ; "-determined" - only one candidate
263 (open-bracket-determined (if require-match "(" "[")) 294 (open-bracket-determined (if require-match "(" "["))
264 (close-bracket-determined (if require-match ")" "]")) 295 (close-bracket-determined (if require-match ")" "]"))
265 ;"-prospects" - more than one candidate 296 ;"-prospects" - more than one candidate
266 (open-bracket-prospects "{") 297 (open-bracket-prospects "{")
267 (close-bracket-prospects "}") 298 (close-bracket-prospects "}")
268 ) 299 )
269 (cond ((null comps) (format " %sNo matches%s" 300 (catch 'input
270 open-bracket-determined 301 (cond ((null comps) (format " %sNo matches%s"
271 close-bracket-determined)) 302 open-bracket-determined
272 ((null (cdr comps)) ;one match
273 (concat (if (and (> (length (car comps))
274 (length name)))
275 (concat open-bracket-determined
276 (substring (car comps) (length name))
277 close-bracket-determined)
278 "")
279 " [Matched]"
280 ;; XEmacs
281 (if (and icomplete-show-key-bindings
282 (commandp (intern-soft (car comps))))
283 (icomplete-get-keys (car comps))
284 "")
285 ))
286 (t ;multiple matches
287 (let* ((most (try-completion name candidates predicate))
288 (most-len (length most))
289 most-is-exact
290 (alternatives
291 (apply
292 (function concat)
293 (cdr (apply
294 (function nconc)
295 (mapcar '(lambda (com)
296 (if (= (length com) most-len)
297 ;; Most is one exact match,
298 ;; note that and leave out
299 ;; for later indication:
300 (progn
301 (setq most-is-exact t)
302 ())
303 (list ","
304 (substring com
305 most-len))))
306 comps))))))
307 (concat (and (> most-len (length name))
308 (concat open-bracket-determined
309 (substring most (length name))
310 close-bracket-determined)) 303 close-bracket-determined))
311 open-bracket-prospects 304 ((null (cdr comps)) ;one match
312 (if most-is-exact 305 (concat (if (and (> (length (car comps))
313 (concat "," alternatives) 306 (length name)))
314 alternatives) 307 (concat open-bracket-determined
315 close-bracket-prospects)))))) 308 (substring (car comps) (length name))
309 close-bracket-determined)
310 "")
311 " [Matched"
312 (let ((keys (and icomplete-show-key-bindings
313 (commandp (intern-soft (car comps)))
314 (icomplete-get-keys (car comps)))))
315 (if keys
316 (concat "; " keys)
317 ""))
318 "]"))
319 (t ;multiple matches
320 (let* ((most
321 (try-completion name candidates
322 (and predicate
323 ;; Wrap predicate in impatience - ie,
324 ;; `throw' up when pending input is
325 ;; noticed. Adds some overhead to
326 ;; predicate, but should be worth it.
327 (function
328 (lambda (item)
329 (if (input-pending-p)
330 (throw 'input "")
331 (apply predicate
332 item nil)))))))
333 (most-len (length most))
334 most-is-exact
335 (alternatives
336 (substring
337 (apply (function concat)
338 (mapcar (function
339 (lambda (com)
340 (if (input-pending-p)
341 (throw 'input ""))
342 (if (= (length com) most-len)
343 ;; Most is one exact match,
344 ;; note that and leave out
345 ;; for later indication:
346 (progn
347 (setq most-is-exact t)
348 ())
349 (concat ","
350 (substring com
351 most-len)))))
352 comps))
353 1)))
354 (concat (and (> most-len (length name))
355 (concat open-bracket-determined
356 (substring most (length name))
357 close-bracket-determined))
358 open-bracket-prospects
359 (if most-is-exact
360 ;; Add a ',' at the front to indicate "complete but
361 ;; not unique":
362 (concat "," alternatives)
363 alternatives)
364 close-bracket-prospects)))))))
316 365
317 ;;;_ + Initialization 366 ;;;_ + Initialization
318 ;;; If user hasn't setq-default icomplete-mode to nil, then setup for 367 ;;; If user hasn't setq-default icomplete-mode to nil, then setup for
319 ;;; activation: 368 ;;; activation:
320 (if icomplete-mode 369 (if icomplete-mode