Mercurial > hg > xemacs-beta

comparison lisp/packages/icomplete.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;;_. icomplete.el - minibuffer completion incremental feedback 1 ;;; icomplete.el --- minibuffer completion with 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@python.org> 5 ;;; Author: Ken Manheimer <klm@nist.gov>
6 ;; Maintainer: Ken Manheimer <klm@python.org> 6 ;;; Maintainer: Ken Manheimer <klm@nist.gov>
7 ;; Version: $Id: icomplete.el,v 1.4 1997/09/17 01:51:04 steve Exp $ 7 ;;; Version: $Id: icomplete.el,v 1.1.1.1 1996/12/18 22:42:52 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 ;; This file is part of GNU Emacs. 11 ;;; Hacked for XEmacs: David Hughes 7th September 1995
12 12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;; This file is part of XEmacs.
14 ;; it under the terms of the GNU General Public License as published by 14
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
15 ;; the Free Software Foundation; either version 2, or (at your option) 17 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version. 18 ;; any later version.
17 19
18 ;; GNU Emacs is distributed in the hope that it will be useful, 20 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; GNU General Public License for more details. 23 ;; General Public License for more details.
22 24
23 ;; You should have received a copy of the GNU General Public License 25 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 26 ;; along with XEmacs; see the file COPYING. If not, write to the Free
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
26 ;; Boston, MA 02111-1307, USA. 28 ;; 02111-1307, USA.
27 29
28 ;; This file is also part of XEmacs. 30 ;;; Synched up with: FSF 19.34.
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.")
82 75
83 ;;;_* Initialization 76 ;;;_* Initialization
84 ;;;_ = icomplete-minibuffer-setup-hook 77 ;;;_ = icomplete-minibuffer-setup-hook
85 (defvar icomplete-minibuffer-setup-hook nil 78 (defvar icomplete-minibuffer-setup-hook nil
86 "*Icomplete-specific customization of minibuffer setup. 79 "*Icomplete-specific customization of minibuffer setup.
95 \(make-local-variable 'resize-minibuffer-window-max-height) 88 \(make-local-variable 'resize-minibuffer-window-max-height)
96 \(setq resize-minibuffer-window-max-height 3)))) 89 \(setq resize-minibuffer-window-max-height 3))))
97 90
98 will constrain rsz-mini to a maximum minibuffer height of 3 lines when 91 will constrain rsz-mini to a maximum minibuffer height of 3 lines when
99 icompletion is occurring.") 92 icompletion is occurring.")
100
101 (if (string-match "XEmacs\\|Lucid" emacs-version)
102 (add-hook 'icomplete-minibuffer-setup-hook 'icomplete-exhibit))
103 93
104 ;;;_ + Internal Variables 94 ;;;_ + Internal Variables
105 ;;;_ = icomplete-mode 95 ;;;_ = icomplete-mode
106 (defvar icomplete-mode t 96 (defvar icomplete-mode t
107 "Non-nil enables incremental minibuffer completion, once 97 "Non-nil enables incremental minibuffer completion, once
126 Use `icomplete-mode' function to set it up properly for incremental 116 Use `icomplete-mode' function to set it up properly for incremental
127 minibuffer completion.") 117 minibuffer completion.")
128 (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) 118 (add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
129 119
130 ;; XEmacs addition 120 ;; XEmacs addition
131 (defvar icomplete-show-key-bindings (string-match "XEmacs\\|Lucid" 121 (defvar icomplete-show-key-bindings t
132 emacs-version)
133 "When non-nil show key bindings as well as completion when matching 122 "When non-nil show key bindings as well as completion when matching
134 a command. Currently working only for XEmacs - see `icomplete-get-keys'.") 123 a command.")
135 124
125 ;; XEmacs addition
136 (defun icomplete-get-keys (func-name) 126 (defun icomplete-get-keys (func-name)
137 "Return the keys `func-name' is bound to as a string, or nil if none. 127 "Return the keys `func-name' is bound to as a string."
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."
141 (when (commandp func-name) 128 (when (commandp func-name)
142 (save-excursion 129 (let* ((sym (intern func-name))
143 ;; Depends on dynamic scope from read-from-minibuffer :-( 130 (keys (where-is-internal sym)))
144 (let* ((sym (intern func-name)) 131 (concat "<"
145 (buf (set-buffer (window-buffer owindow))) 132 (if keys
146 (keys (where-is-internal sym (current-local-map buf)))) 133 (mapconcat 'key-description
147 (if keys 134 (sort '([next] [kp_next] [(control v)])
148 (concat "<" 135 #'(lambda (x y)
149 (mapconcat 'key-description 136 (< (length x) (length y))))
150 (sort keys 137 ", ")
151 #'(lambda (x y) 138 "Unbound")
152 (< (length x) (length y)))) 139 ">"))))
153 ", ")
154 ">"))))))
155 140
156 ;;;_ > icomplete-mode (&optional prefix) 141 ;;;_ > icomplete-mode (&optional prefix)
157 ;;;###autoload 142 ;;;###autoload
158 (defun icomplete-mode (&optional prefix) 143 (defun icomplete-mode (&optional prefix)
159 "Activate incremental minibuffer completion for this emacs session, 144 "Activate incremental minibuffer completion for this emacs session,
223 (setq icomplete-eoinput 1)))) 208 (setq icomplete-eoinput 1))))
224 209
225 ;;;_ > icomplete-exhibit () 210 ;;;_ > icomplete-exhibit ()
226 (defun icomplete-exhibit () 211 (defun icomplete-exhibit ()
227 "Insert icomplete completions display. 212 "Insert icomplete completions display.
228
229 Should be run via minibuffer `post-command-hook'. See `icomplete-mode' 213 Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
230 and `minibuffer-setup-hook'." 214 and `minibuffer-setup-hook'."
231 (if (icomplete-simple-completing-p) 215 (if (icomplete-simple-completing-p)
232 (let ((contents (buffer-substring (point-min)(point-max))) 216 (let ((contents (buffer-substring (point-min)(point-max)))
233 (buffer-undo-list t)) 217 (buffer-undo-list t))
239 (if (not (boundp 'icomplete-eoinput)) 223 (if (not (boundp 'icomplete-eoinput))
240 ;; In case it got wiped out by major mode business: 224 ;; In case it got wiped out by major mode business:
241 (make-local-variable 'icomplete-eoinput)) 225 (make-local-variable 'icomplete-eoinput))
242 (setq icomplete-eoinput (point)) 226 (setq icomplete-eoinput (point))
243 ; Insert the match-status information: 227 ; Insert the match-status information:
244 (if (and (> (point-max) 1) 228 (if (> (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)))
260 (insert-string 229 (insert-string
261 (icomplete-completions contents 230 (icomplete-completions contents
262 minibuffer-completion-table 231 minibuffer-completion-table
263 minibuffer-completion-predicate 232 minibuffer-completion-predicate
264 (not 233 (not
279 \{...} - multiple prospects, separated by commas, are indicated, and 248 \{...} - multiple prospects, separated by commas, are indicated, and
280 further input is required to distinguish a single one. 249 further input is required to distinguish a single one.
281 250
282 The displays for unambiguous matches have ` [Matched]' appended 251 The displays for unambiguous matches have ` [Matched]' appended
283 \(whether complete or not), or ` \[No matches]', if no eligible 252 \(whether complete or not), or ` \[No matches]', if no eligible
284 matches exist. \(In XEmacs, keybindings for matched commands, if any, 253 matches exist."
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))
291 254
292 (let ((comps (all-completions name candidates predicate)) 255 (let ((comps (all-completions name candidates predicate))
293 ; "-determined" - only one candidate 256 ; "-determined" - only one candidate
294 (open-bracket-determined (if require-match "(" "[")) 257 (open-bracket-determined (if require-match "(" "["))
295 (close-bracket-determined (if require-match ")" "]")) 258 (close-bracket-determined (if require-match ")" "]"))
296 ;"-prospects" - more than one candidate 259 ;"-prospects" - more than one candidate
297 (open-bracket-prospects "{") 260 (open-bracket-prospects "{")
298 (close-bracket-prospects "}") 261 (close-bracket-prospects "}")
299 ) 262 )
300 (catch 'input 263 (cond ((null comps) (format " %sNo matches%s"
301 (cond ((null comps) (format " %sNo matches%s" 264 open-bracket-determined
302 open-bracket-determined 265 close-bracket-determined))
266 ((null (cdr comps)) ;one match
267 (concat (if (and (> (length (car comps))
268 (length name)))
269 (concat open-bracket-determined
270 (substring (car comps) (length name))
271 close-bracket-determined)
272 "")
273 " [Matched]"
274 ;; XEmacs
275 (if (and icomplete-show-key-bindings
276 (commandp (car comps)))
277 (icomplete-get-keys (car comps))
278 "")
279 ))
280 (t ;multiple matches
281 (let* ((most (try-completion name candidates predicate))
282 (most-len (length most))
283 most-is-exact
284 (alternatives
285 (apply
286 (function concat)
287 (cdr (apply
288 (function nconc)
289 (mapcar '(lambda (com)
290 (if (= (length com) most-len)
291 ;; Most is one exact match,
292 ;; note that and leave out
293 ;; for later indication:
294 (progn
295 (setq most-is-exact t)
296 ())
297 (list ","
298 (substring com
299 most-len))))
300 comps))))))
301 (concat (and (> most-len (length name))
302 (concat open-bracket-determined
303 (substring most (length name))
303 close-bracket-determined)) 304 close-bracket-determined))
304 ((null (cdr comps)) ;one match 305 open-bracket-prospects
305 (concat (if (and (> (length (car comps)) 306 (if most-is-exact
306 (length name))) 307 (concat "," alternatives)
307 (concat open-bracket-determined 308 alternatives)
308 (substring (car comps) (length name)) 309 close-bracket-prospects))))))
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)))))))
365 310
366 ;;;_ + Initialization 311 ;;;_ + Initialization
367 ;;; If user hasn't setq-default icomplete-mode to nil, then setup for 312 ;;; If user hasn't setq-default icomplete-mode to nil, then setup for
368 ;;; activation: 313 ;;; activation:
369 (if icomplete-mode 314 (if icomplete-mode