Mercurial > hg > xemacs-beta

comparison lisp/packages/icomplete.el @ 54:05472e90ae02 r19-16-pre2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents 461c7ba8286a
children 131b0175ea99
comparison
equal deleted inserted replaced
53:875393c1a535 54:05472e90ae02
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.3 1997/09/13 00:24:38 steve Exp $ 7 ;; Version: $Id: icomplete.el,v 1.4 1997/09/17 01:51:04 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
143 ;; Depends on dynamic scope from read-from-minibuffer :-(
133 (let* ((sym (intern func-name)) 144 (let* ((sym (intern func-name))
134 (buf (set-buffer (window-buffer owindow))) 145 (buf (set-buffer (window-buffer owindow)))
135 (keys (where-is-internal sym (current-local-map buf)))) 146 (keys (where-is-internal sym (current-local-map buf))))
136 (concat "<" 147 (if keys
137 (if keys 148 (concat "<"
138 (mapconcat 'key-description 149 (mapconcat 'key-description
139 (sort '([next] [kp-next] [(control v)]) 150 (sort keys
140 #'(lambda (x y) 151 #'(lambda (x y)
141 (< (length x) (length y)))) 152 (< (length x) (length y))))
142 ", ") 153 ", ")
143 "Unbound") 154 ">"))))))
144 ">")))))
145 155
146 ;;;_ > icomplete-mode (&optional prefix) 156 ;;;_ > icomplete-mode (&optional prefix)
147 ;;;###autoload 157 ;;;###autoload
148 (defun icomplete-mode (&optional prefix) 158 (defun icomplete-mode (&optional prefix)
149 "Activate incremental minibuffer completion for this emacs session, 159 "Activate incremental minibuffer completion for this emacs session,
213 (setq icomplete-eoinput 1)))) 223 (setq icomplete-eoinput 1))))
214 224
215 ;;;_ > icomplete-exhibit () 225 ;;;_ > icomplete-exhibit ()
216 (defun icomplete-exhibit () 226 (defun icomplete-exhibit ()
217 "Insert icomplete completions display. 227 "Insert icomplete completions display.
228
218 Should be run via minibuffer `post-command-hook'. See `icomplete-mode' 229 Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
219 and `minibuffer-setup-hook'." 230 and `minibuffer-setup-hook'."
220 (if (icomplete-simple-completing-p) 231 (if (icomplete-simple-completing-p)
221 (let ((contents (buffer-substring (point-min)(point-max))) 232 (let ((contents (buffer-substring (point-min)(point-max)))
222 (buffer-undo-list t)) 233 (buffer-undo-list t))
228 (if (not (boundp 'icomplete-eoinput)) 239 (if (not (boundp 'icomplete-eoinput))
229 ;; In case it got wiped out by major mode business: 240 ;; In case it got wiped out by major mode business:
230 (make-local-variable 'icomplete-eoinput)) 241 (make-local-variable 'icomplete-eoinput))
231 (setq icomplete-eoinput (point)) 242 (setq icomplete-eoinput (point))
232 ; Insert the match-status information: 243 ; Insert the match-status information:
233 (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)))
234 (insert-string 260 (insert-string
235 (icomplete-completions contents 261 (icomplete-completions contents
236 minibuffer-completion-table 262 minibuffer-completion-table
237 minibuffer-completion-predicate 263 minibuffer-completion-predicate
238 (not 264 (not
253 \{...} - multiple prospects, separated by commas, are indicated, and 279 \{...} - multiple prospects, separated by commas, are indicated, and
254 further input is required to distinguish a single one. 280 further input is required to distinguish a single one.
255 281
256 The displays for unambiguous matches have ` [Matched]' appended 282 The displays for unambiguous matches have ` [Matched]' appended
257 \(whether complete or not), or ` \[No matches]', if no eligible 283 \(whether complete or not), or ` \[No matches]', if no eligible
258 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))
259 291
260 (let ((comps (all-completions name candidates predicate)) 292 (let ((comps (all-completions name candidates predicate))
261 ; "-determined" - only one candidate 293 ; "-determined" - only one candidate
262 (open-bracket-determined (if require-match "(" "[")) 294 (open-bracket-determined (if require-match "(" "["))
263 (close-bracket-determined (if require-match ")" "]")) 295 (close-bracket-determined (if require-match ")" "]"))
264 ;"-prospects" - more than one candidate 296 ;"-prospects" - more than one candidate
265 (open-bracket-prospects "{") 297 (open-bracket-prospects "{")
266 (close-bracket-prospects "}") 298 (close-bracket-prospects "}")
267 ) 299 )
268 (cond ((null comps) (format " %sNo matches%s" 300 (catch 'input
269 open-bracket-determined 301 (cond ((null comps) (format " %sNo matches%s"
270 close-bracket-determined)) 302 open-bracket-determined
271 ((null (cdr comps)) ;one match
272 (concat (if (and (> (length (car comps))
273 (length name)))
274 (concat open-bracket-determined
275 (substring (car comps) (length name))
276 close-bracket-determined)
277 "")
278 " [Matched]"
279 ;; XEmacs
280 (if (and icomplete-show-key-bindings
281 (commandp (intern-soft (car comps))))
282 (icomplete-get-keys (car comps))
283 "")
284 ))
285 (t ;multiple matches
286 (let* ((most (try-completion name candidates predicate))
287 (most-len (length most))
288 most-is-exact
289 (alternatives
290 (apply
291 (function concat)
292 (cdr (apply
293 (function nconc)
294 (mapcar '(lambda (com)
295 (if (= (length com) most-len)
296 ;; Most is one exact match,
297 ;; note that and leave out
298 ;; for later indication:
299 (progn
300 (setq most-is-exact t)
301 ())
302 (list ","
303 (substring com
304 most-len))))
305 comps))))))
306 (concat (and (> most-len (length name))
307 (concat open-bracket-determined
308 (substring most (length name))
309 close-bracket-determined)) 303 close-bracket-determined))
310 open-bracket-prospects 304 ((null (cdr comps)) ;one match
311 (if most-is-exact 305 (concat (if (and (> (length (car comps))
312 (concat "," alternatives) 306 (length name)))
313 alternatives) 307 (concat open-bracket-determined
314 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)))))))
315 365
316 ;;;_ + Initialization 366 ;;;_ + Initialization
317 ;;; 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
318 ;;; activation: 368 ;;; activation:
319 (if icomplete-mode 369 (if icomplete-mode