]> code.delx.au - gnu-emacs/blob - lisp/hippie-exp.el
(backup-extract-version-start): New variable.
[gnu-emacs] / lisp / hippie-exp.el
1 ;;; hippie-exp.el --- expand text trying various ways to find its expansion.
2
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
4
5 ;; Author: Anders Holst <aho@sans.kth.se>
6 ;; Last change: 6 August 1995
7 ;; Version: 1.4
8 ;; Keywords: abbrev
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Commentary:
28
29 ;; `hippie-expand' is a single function for a lot of different kinds
30 ;; of completions and expansions. Called repeatedly it tries all
31 ;; possible completions in succession.
32 ;; Which kinds of completions to try, and in which order, is
33 ;; determined by the contents of `hippie-expand-try-functions-list'.
34 ;; Much customization of `hippie-expand' can be made by changing the
35 ;; order of, removing, or inserting new functions in this list.
36 ;; Given a positive numeric argument, `hippie-expand' jumps directly
37 ;; ARG functions forward in this list. Given some other argument
38 ;; (a negative argument or just Ctrl-U) it undoes the tried
39 ;; completion.
40 ;;
41 ;; If the variable `hippie-expand-verbose' is non-nil, `hippie-expand'
42 ;; outputs in a message which try-function in the list that is used
43 ;; currently (ie. was used currently and will be tried first the next
44 ;; time).
45 ;; The variable `hippie-expand-max-buffers' determines in how many
46 ;; buffers, apart from the current, to search for expansions in. It
47 ;; is used by the try-functions named "-all-buffers".
48 ;; The variable `hippie-expand-ignore-buffers' is a list of regexps
49 ;; matching buffer names (as strings) or major modes (as atoms) of
50 ;; buffers that should not be searched by the try-functions named
51 ;; "-all-buffers".
52 ;; See also the macro `make-hippie-expand-function' below.
53 ;;
54 ;; A short description of the current try-functions in this file:
55 ;; `try-complete-file-name' : very convenient to have in any buffer,
56 ;; and not just in the minibuffer or (some) shell-mode. It goes
57 ;; through all possible completions instead of just completing as
58 ;; much as is unique.
59 ;; `try-complete-file-name-partially' : To insert in the list just
60 ;; before `try-complete-file-name' for those who want first to get
61 ;; a file name completed only as many characters as is unique.
62 ;; `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
63 ;; Otherwise it looks through all abbrev-tables, starting with
64 ;; the local followed by the global.
65 ;; `try-expand-line' : Searches the buffer for an entire line that
66 ;; begins exactly as the current line. Convenient sometimes, for
67 ;; example as a substitute for (or complement to) the history
68 ;; list in shell-like buffers. At other times, only confusing.
69 ;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches
70 ;; in all buffers (except the current). (This may be a little
71 ;; slow, don't use it unless you are really fond of `hippie-expand'.)
72 ;; `try-expand-list' : Tries to expand the text back to the nearest
73 ;; open delimiter, to a whole list from the buffer. Convenient for
74 ;; example when writing lisp or TeX.
75 ;; `try-expand-list-all-buffers' : Like `try-expand-list' but searches
76 ;; in all buffers (except the current).
77 ;; `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
78 ;; course in a way compatible with the other try-functions).
79 ;; `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
80 ;; like `dabbrev-expand' but searches all Emacs buffers (except the
81 ;; current) for matching words. (No, I don't find this one
82 ;; particularly slow.)
83 ;; `try-expand-dabbrev-visible': Searches the currently visible parts of
84 ;; all windows. Can be put before `try-expand-dabbrev-all-buffers' to
85 ;; first try the expansions you can see.
86 ;; `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable
87 ;; completion of the word. Good to have, just in case the word was not
88 ;; found elsewhere.
89 ;; `try-expand-whole-kill' : Tries to complete text with a whole entry
90 ;; from the kill ring. May be good if you don't know how far up in
91 ;; the kill-ring the required entry is, and don't want to mess with
92 ;; "Choose Next Paste".
93 ;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
94 ;; through all possibilities instead of completing what is unique.
95 ;; Might be tedious (usually a lot of possible completions) and
96 ;; since its function is much like `lisp-complete-symbol', which
97 ;; already has a key of its own, you might want to remove this.
98 ;; `try-complete-lisp-symbol-partially' : To insert in the list just
99 ;; before `try-complete-lisp-symbol' for those who first want to get
100 ;; completion of what is unique in the name.
101 ;;
102 ;; Not all of the above functions are by default in
103 ;; `hippie-expand-try-functions-list'. This variable is better set
104 ;; in ".emacs" to make `hippie-expand' behave maximally convenient
105 ;; according to personal taste. Also, instead of loading the
106 ;; variable with all kinds of try-functions above, it might be an
107 ;; idea to use `make-hippie-expand-function' to construct different
108 ;; `hippie-expand'-like functions, with different try-lists and bound
109 ;; to different keys. It is also possible to make
110 ;; `hippie-expand-try-functions-list' a buffer local variable, and
111 ;; let it depend on the mode (by setting it in the mode-hooks).
112 ;;
113 ;; To write new try-functions, consider the following:
114 ;; Each try-function takes one argument OLD which is nil the first
115 ;; time the function is called and true in succeeding calls for the
116 ;; same string to complete. The first time the function has to
117 ;; extract the string before point to complete, and substitute the
118 ;; first completion alternative for it. On following calls it has to
119 ;; substitute the next possible completion for the last tried string.
120 ;; The try-function is to return t as long as it finds new
121 ;; possible completions. When there are no more alternatives it has
122 ;; to restore the text before point to its original contents, and
123 ;; return nil (don't beep or message or anything).
124 ;; The try-function can (should) use the following functions:
125 ;; `he-init-string' : Initializes the text to substitute to the
126 ;; contents of the region BEGIN to END. Also sets the variable
127 ;; `he-search-string' to the text to expand.
128 ;; `he-substitute-string' : substitutes STR into the region
129 ;; initialized with `he-init-string'. (An optional second argument
130 ;; TRANS-CASE non-nil, means transfer of case from the abbreviation
131 ;; to the expansion is ok if that is enabled in the buffer.)
132 ;; `he-reset-string' : Resets the initialized region to its original
133 ;; contents.
134 ;; There is also a variable: `he-tried-table' which is meant to contain
135 ;; all tried expansions so far. The try-function can check this
136 ;; variable to see whether an expansion has already been tried
137 ;; (hint: `he-string-member').
138 ;;
139 ;; Known bugs
140 ;;
141 ;; It may happen that some completion suggestion occurs twice, in
142 ;; spite of the use of `he-tried-table' to prevent that. This is
143 ;; because different try-functions may try to complete different
144 ;; lengths of text, and thus put different amounts of the
145 ;; text in `he-tried-table'. Anyway this seems to occur seldom enough
146 ;; not to be too disturbing. Also it should NOT be possible for the
147 ;; opposite situation to occur, that `hippie-expand' misses some
148 ;; suggestion because it thinks it has already tried it.
149 ;;
150 ;; Acknowledgement
151 ;;
152 ;; I want to thank Mikael Djurfeldt in discussions with whom the idea
153 ;; of this function took form.
154 ;; I am also grateful to all those who have given me suggestions on
155 ;; how to improve it, and all those who helped to find and remove bugs.
156 ;;
157
158 ;;; Code:
159
160 (defgroup hippie-expand nil
161 "Expand text trying various ways to find its expansion."
162 :group 'abbrev)
163
164 (defvar he-num -1)
165
166 (defvar he-string-beg (make-marker))
167
168 (defvar he-string-end (make-marker))
169
170 (defvar he-search-string ())
171
172 (defvar he-expand-list ())
173
174 (defvar he-tried-table ())
175
176 (defvar he-search-loc (make-marker))
177
178 (defvar he-search-loc2 ())
179
180 (defvar he-search-bw ())
181
182 (defvar he-search-bufs ())
183
184 (defvar he-searched-n-bufs ())
185
186 (defvar he-search-window ())
187
188 ;;;###autoload
189 (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially
190 try-complete-file-name
191 try-expand-all-abbrevs
192 try-expand-list
193 try-expand-line
194 try-expand-dabbrev
195 try-expand-dabbrev-all-buffers
196 try-expand-dabbrev-from-kill
197 try-complete-lisp-symbol-partially
198 try-complete-lisp-symbol)
199 "The list of expansion functions tried in order by `hippie-expand'.
200 To change the behavior of `hippie-expand', remove, change the order of,
201 or insert functions in this list.")
202
203 ;;;###autoload
204 (defcustom hippie-expand-verbose t
205 "*Non-nil makes `hippie-expand' output which function it is trying."
206 :type 'boolean
207 :group 'hippie-expand)
208
209 ;;;###autoload
210 (defcustom hippie-expand-max-buffers ()
211 "*The maximum number of buffers (apart from the current) searched.
212 If nil, all buffers are searched."
213 :type '(choice (const :tag "All" nil)
214 integer)
215 :group 'hippie-expand)
216
217 ;;;###autoload
218 (defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
219 "*A list specifying which buffers not to search (if not current).
220 Can contain both regexps matching buffer names (as strings) and major modes
221 \(as atoms)"
222 :type '(repeat (choice regexp (symbol :tag "Major Mode")))
223 :group 'hippie-expand)
224
225 ;;;###autoload
226 (defun hippie-expand (arg)
227 "Try to expand text before point, using multiple methods.
228 The expansion functions in `hippie-expand-try-functions-list' are
229 tried in order, until a possible expansion is found. Repeated
230 application of `hippie-expand' inserts successively possible
231 expansions.
232 With a positive numeric argument, jumps directly to the ARG next
233 function in this list. With a negative argument or just \\[universal-argument],
234 undoes the expansion."
235 (interactive "P")
236 (if (or (not arg)
237 (and (integerp arg) (> arg 0)))
238 (let ((first (or (= he-num -1)
239 (not (equal this-command last-command)))))
240 (if first
241 (progn
242 (setq he-num -1)
243 (setq he-tried-table nil)))
244 (if arg
245 (if (not first) (he-reset-string))
246 (setq arg 0))
247 (let ((i (max (+ he-num arg) 0)))
248 (while (not (or (>= i (length hippie-expand-try-functions-list))
249 (apply (nth i hippie-expand-try-functions-list)
250 (list (= he-num i)))))
251 (setq i (1+ i)))
252 (setq he-num i))
253 (if (>= he-num (length hippie-expand-try-functions-list))
254 (progn
255 (setq he-num -1)
256 (if first
257 (message "No expansion found")
258 (message "No further expansions found"))
259 (ding))
260 (if (and hippie-expand-verbose
261 (not (window-minibuffer-p (selected-window))))
262 (message "Using %s"
263 (prin1-to-string (nth he-num
264 hippie-expand-try-functions-list))))))
265 (if (and (>= he-num 0)
266 (eq (marker-buffer he-string-beg) (current-buffer)))
267 (progn
268 (setq he-num -1)
269 (he-reset-string)
270 (if (and hippie-expand-verbose
271 (not (window-minibuffer-p (selected-window))))
272 (message "Undoing expansions"))))))
273
274 ;; Initializes the region to expand (to between BEG and END).
275 (defun he-init-string (beg end)
276 (set-marker he-string-beg beg)
277 (set-marker he-string-end end)
278 (setq he-search-string (buffer-substring beg end)))
279
280 ;; Resets the expanded region to its original contents.
281 (defun he-reset-string ()
282 (let ((newpos (point-marker)))
283 (goto-char he-string-beg)
284 (insert he-search-string)
285 (delete-region (point) he-string-end)
286 (goto-char newpos)))
287
288 ;; Substitutes an expansion STR into the correct region (the region
289 ;; initialized with `he-init-string').
290 ;; An optional argument TRANS-CASE means that it is ok to transfer case
291 ;; from the abbreviation to the expansion if that is possible, and is
292 ;; enabled in the buffer.
293 (defun he-substitute-string (str &optional trans-case)
294 (let ((trans-case (and trans-case
295 case-replace
296 case-fold-search))
297 (newpos (point-marker))
298 (subst ()))
299 (goto-char he-string-beg)
300 (setq subst (if trans-case (he-transfer-case he-search-string str) str))
301 (setq he-tried-table (cons subst he-tried-table))
302 (insert subst)
303 (delete-region (point) he-string-end)
304 (goto-char newpos)))
305
306 (defun he-capitalize-first (str)
307 (save-match-data
308 (if (string-match "\\Sw*\\(\\sw\\).*" str)
309 (let ((res (downcase str))
310 (no (match-beginning 1)))
311 (aset res no (upcase (aref str no)))
312 res)
313 str)))
314
315 (defun he-ordinary-case-p (str)
316 (or (string= str (downcase str))
317 (string= str (upcase str))
318 (string= str (capitalize str))
319 (string= str (he-capitalize-first str))))
320
321 (defun he-transfer-case (from-str to-str)
322 (cond ((string= from-str (substring to-str 0 (min (length from-str)
323 (length to-str))))
324 to-str)
325 ((not (he-ordinary-case-p to-str))
326 to-str)
327 ((string= from-str (downcase from-str))
328 (downcase to-str))
329 ((string= from-str (upcase from-str))
330 (upcase to-str))
331 ((string= from-str (he-capitalize-first from-str))
332 (he-capitalize-first to-str))
333 ((string= from-str (capitalize from-str))
334 (capitalize to-str))
335 (t
336 to-str)))
337
338
339 ;; Check if STR is a member of LST.
340 ;; Transform to the final case if optional TRANS-CASE is non-NIL.
341 (defun he-string-member (str lst &optional trans-case)
342 (if str
343 (member (if (and trans-case
344 case-replace
345 case-fold-search)
346 (he-transfer-case he-search-string str)
347 str)
348 lst)))
349
350 ;; Check if STR matches any regexp in LST.
351 ;; Ignore possible non-strings in LST.
352 (defun he-regexp-member (str lst)
353 (while (and lst
354 (or (not (stringp (car lst)))
355 (not (string-match (car lst) str))))
356 (setq lst (cdr lst)))
357 lst)
358
359 ;; For the real hippie-expand enthusiast: A macro that makes it
360 ;; possible to use many functions like hippie-expand, but with
361 ;; different try-functions-lists.
362 ;; Usage is for example:
363 ;; (fset 'my-complete-file (make-hippie-expand-function
364 ;; '(try-complete-file-name-partially
365 ;; try-complete-file-name)))
366 ;; (fset 'my-complete-line (make-hippie-expand-function
367 ;; '(try-expand-line
368 ;; try-expand-line-all-buffers)))
369 ;;
370 ;;;###autoload
371 (defmacro make-hippie-expand-function (try-list &optional verbose)
372 "Construct a function similar to `hippie-expand'.
373 Make it use the expansion functions in TRY-LIST. An optional second
374 argument VERBOSE non-nil makes the function verbose."
375 (` (function (lambda (arg)
376 (, (concat
377 "Try to expand text before point, using the following functions: \n"
378 (mapconcat 'prin1-to-string (eval try-list) ", ")))
379 (interactive "P")
380 (let ((hippie-expand-try-functions-list (, try-list))
381 (hippie-expand-verbose (, verbose)))
382 (hippie-expand arg))))))
383
384
385 ;;; Here follows the try-functions and their requisites:
386
387
388 (defun try-complete-file-name (old)
389 "Try to complete text as a file name.
390 The argument OLD has to be nil the first call of this function, and t
391 for subsequent calls (for further possible completions of the same
392 string). It returns t if a new completion is found, nil otherwise."
393 (if (not old)
394 (progn
395 (he-init-string (he-file-name-beg) (point))
396 (let ((name-part (he-file-name-nondirectory he-search-string))
397 (dir-part (expand-file-name (or (he-file-name-directory
398 he-search-string) ""))))
399 (if (not (he-string-member name-part he-tried-table))
400 (setq he-tried-table (cons name-part he-tried-table)))
401 (if (and (not (equal he-search-string ""))
402 (he-file-directory-p dir-part))
403 (setq he-expand-list (sort (file-name-all-completions
404 name-part
405 dir-part)
406 'string-lessp))
407 (setq he-expand-list ())))))
408
409 (while (and he-expand-list
410 (he-string-member (car he-expand-list) he-tried-table))
411 (setq he-expand-list (cdr he-expand-list)))
412 (if (null he-expand-list)
413 (progn
414 (if old (he-reset-string))
415 ())
416 (let ((filename (he-concat-directory-file-name
417 (he-file-name-directory he-search-string)
418 (car he-expand-list))))
419 (he-substitute-string filename)
420 (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
421 (setq he-expand-list (cdr he-expand-list))
422 t)))
423
424 (defun try-complete-file-name-partially (old)
425 "Try to complete text as a file name, as many characters as unique.
426 The argument OLD has to be nil the first call of this function. It
427 returns t if a unique, possibly partial, completion is found, nil
428 otherwise."
429 (let ((expansion ()))
430 (if (not old)
431 (progn
432 (he-init-string (he-file-name-beg) (point))
433 (let ((name-part (he-file-name-nondirectory he-search-string))
434 (dir-part (expand-file-name (or (he-file-name-directory
435 he-search-string) ""))))
436 (if (and (not (equal he-search-string ""))
437 (he-file-directory-p dir-part))
438 (setq expansion (file-name-completion name-part
439 dir-part)))
440 (if (or (eq expansion t)
441 (string= expansion name-part)
442 (he-string-member expansion he-tried-table))
443 (setq expansion ())))))
444
445 (if (not expansion)
446 (progn
447 (if old (he-reset-string))
448 ())
449 (let ((filename (he-concat-directory-file-name
450 (he-file-name-directory he-search-string)
451 expansion)))
452 (he-substitute-string filename)
453 (setq he-tried-table (cons expansion (cdr he-tried-table)))
454 t))))
455
456 (defvar he-file-name-chars
457 (cond ((memq system-type '(vax-vms axp-vms))
458 "-a-zA-Z0-9_/.,~^#$+=:\\[\\]")
459 ((memq system-type '(ms-dos windows-nt))
460 "-a-zA-Z0-9_/.,~^#$+=:\\\\")
461 (t ;; More strange file formats ?
462 "-a-zA-Z0-9_/.,~^#$+="))
463 "Characters that are considered part of the file name to expand.")
464
465 (defun he-file-name-beg ()
466 (save-excursion
467 (skip-chars-backward he-file-name-chars)
468 (point)))
469
470 ;; Thanks go to Richard Levitte <levitte@e.kth.se> who helped to make these
471 ;; work under VMS, and to David Hughes <ukchugd@ukpmr.cs.philips.nl> who
472 ;; helped to make it work on PC.
473 (defun he-file-name-nondirectory (file)
474 "Fix to make `file-name-nondirectory' work for hippie-expand under VMS."
475 (if (memq system-type '(axp-vms vax-vms))
476 (let ((n (file-name-nondirectory file)))
477 (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
478 (concat "[." (substring n (match-beginning 2) (match-end 2)))
479 n))
480 (file-name-nondirectory file)))
481
482 (defun he-file-name-directory (file)
483 "Fix to make `file-name-directory' work for hippie-expand under VMS."
484 (if (memq system-type '(axp-vms vax-vms))
485 (let ((n (file-name-nondirectory file))
486 (d (file-name-directory file)))
487 (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
488 (concat d (substring n (match-beginning 1) (match-end 1)) "]")
489 d))
490 (file-name-directory file)))
491
492 (defun he-file-directory-p (file)
493 "Fix to make `file-directory-p' work for hippie-expand under VMS."
494 (if (memq system-type '(vax-vms axp-vms))
495 (or (file-directory-p file)
496 (file-directory-p (concat file "[000000]")))
497 (file-directory-p file)))
498
499 (defun he-concat-directory-file-name (dir-part name-part)
500 "Try to slam together two parts of a file specification, system dependently."
501 (cond ((null dir-part) name-part)
502 ((memq system-type '(axp-vms vax-vms))
503 (if (and (string= (substring dir-part -1) "]")
504 (string= (substring name-part 0 2) "[."))
505 (concat (substring dir-part 0 -1) (substring name-part 1))
506 (concat dir-part name-part)))
507 ((memq system-type '(ms-dos w32))
508 (if (and (string-match "\\\\" dir-part)
509 (not (string-match "/" dir-part))
510 (= (aref name-part (1- (length name-part))) ?/))
511 (aset name-part (1- (length name-part)) ?\\))
512 (concat dir-part name-part))
513 (t
514 (concat dir-part name-part))))
515
516 (defun try-complete-lisp-symbol (old)
517 "Try to complete word as an Emacs Lisp symbol.
518 The argument OLD has to be nil the first call of this function, and t
519 for subsequent calls (for further possible completions of the same
520 string). It returns t if a new completion is found, nil otherwise."
521 (if (not old)
522 (progn
523 (he-init-string (he-lisp-symbol-beg) (point))
524 (if (not (he-string-member he-search-string he-tried-table))
525 (setq he-tried-table (cons he-search-string he-tried-table)))
526 (setq he-expand-list
527 (and (not (equal he-search-string ""))
528 (sort (all-completions he-search-string obarray
529 (function (lambda (sym)
530 (or (boundp sym)
531 (fboundp sym)
532 (symbol-plist sym)))))
533 'string-lessp)))))
534 (while (and he-expand-list
535 (he-string-member (car he-expand-list) he-tried-table))
536 (setq he-expand-list (cdr he-expand-list)))
537 (if (null he-expand-list)
538 (progn
539 (if old (he-reset-string))
540 ())
541 (progn
542 (he-substitute-string (car he-expand-list))
543 (setq he-expand-list (cdr he-expand-list))
544 t)))
545
546 (defun try-complete-lisp-symbol-partially (old)
547 "Try to complete as an Emacs Lisp symbol, as many characters as unique.
548 The argument OLD has to be nil the first call of this function. It
549 returns t if a unique, possibly partial, completion is found, nil
550 otherwise."
551 (let ((expansion ()))
552 (if (not old)
553 (progn
554 (he-init-string (he-lisp-symbol-beg) (point))
555 (if (not (string= he-search-string ""))
556 (setq expansion
557 (try-completion he-search-string obarray
558 (function (lambda (sym)
559 (or (boundp sym)
560 (fboundp sym)
561 (symbol-plist sym)))))))
562 (if (or (eq expansion t)
563 (string= expansion he-search-string)
564 (he-string-member expansion he-tried-table))
565 (setq expansion ()))))
566
567 (if (not expansion)
568 (progn
569 (if old (he-reset-string))
570 ())
571 (progn
572 (he-substitute-string expansion)
573 t))))
574
575 (defun he-lisp-symbol-beg ()
576 (let ((skips "-a-zA-Z0-9_."))
577 (save-excursion
578 (skip-chars-backward skips)
579 (point))))
580
581 (defun try-expand-line (old)
582 "Try to complete the current line to an entire line in the buffer.
583 The argument OLD has to be nil the first call of this function, and t
584 for subsequent calls (for further possible completions of the same
585 string). It returns t if a new completion is found, nil otherwise."
586 (let ((expansion ())
587 (strip-prompt (and (get-buffer-process (current-buffer))
588 comint-prompt-regexp)))
589 (if (not old)
590 (progn
591 (he-init-string (he-line-beg strip-prompt) (point))
592 (set-marker he-search-loc he-string-beg)
593 (setq he-search-bw t)))
594
595 (if (not (equal he-search-string ""))
596 (save-excursion
597 ;; Try looking backward unless inhibited.
598 (if he-search-bw
599 (progn
600 (goto-char he-search-loc)
601 (setq expansion (he-line-search he-search-string
602 strip-prompt t))
603 (set-marker he-search-loc (point))
604 (if (not expansion)
605 (progn
606 (set-marker he-search-loc he-string-end)
607 (setq he-search-bw ())))))
608
609 (if (not expansion) ; Then look forward.
610 (progn
611 (goto-char he-search-loc)
612 (setq expansion (he-line-search he-search-string
613 strip-prompt nil))
614 (set-marker he-search-loc (point))))))
615
616 (if (not expansion)
617 (progn
618 (if old (he-reset-string))
619 ())
620 (progn
621 (he-substitute-string expansion t)
622 t))))
623
624 (defun try-expand-line-all-buffers (old)
625 "Try to complete the current line, searching all other buffers.
626 The argument OLD has to be nil the first call of this function, and t
627 for subsequent calls (for further possible completions of the same
628 string). It returns t if a new completion is found, nil otherwise."
629 (let ((expansion ())
630 (strip-prompt (and (get-buffer-process (current-buffer))
631 comint-prompt-regexp))
632 (buf (current-buffer))
633 (orig-case-fold-search case-fold-search))
634 (if (not old)
635 (progn
636 (he-init-string (he-line-beg strip-prompt) (point))
637 (setq he-search-bufs (buffer-list))
638 (setq he-searched-n-bufs 0)
639 (set-marker he-search-loc 1 (car he-search-bufs))))
640
641 (if (not (equal he-search-string ""))
642 (while (and he-search-bufs
643 (not expansion)
644 (or (not hippie-expand-max-buffers)
645 (< he-searched-n-bufs hippie-expand-max-buffers)))
646 (set-buffer (car he-search-bufs))
647 (if (and (not (eq (current-buffer) buf))
648 (not (memq major-mode hippie-expand-ignore-buffers))
649 (not (he-regexp-member (buffer-name)
650 hippie-expand-ignore-buffers)))
651 (save-excursion
652 (goto-char he-search-loc)
653 (setq strip-prompt (and (get-buffer-process (current-buffer))
654 comint-prompt-regexp))
655 (setq expansion (let ((case-fold-search orig-case-fold-search))
656 (he-line-search he-search-string
657 strip-prompt nil)))
658 (set-marker he-search-loc (point))
659 (if (not expansion)
660 (progn
661 (setq he-search-bufs (cdr he-search-bufs))
662 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
663 (set-marker he-search-loc 1 (car he-search-bufs)))))
664 (setq he-search-bufs (cdr he-search-bufs))
665 (set-marker he-search-loc 1 (car he-search-bufs)))))
666
667 (set-buffer buf)
668 (if (not expansion)
669 (progn
670 (if old (he-reset-string))
671 ())
672 (progn
673 (he-substitute-string expansion t)
674 t))))
675
676 (defun he-line-search (str strip-prompt reverse)
677 (let ((result ()))
678 (while (and (not result)
679 (if reverse
680 (re-search-backward
681 (he-line-search-regexp str strip-prompt)
682 nil t)
683 (re-search-forward
684 (he-line-search-regexp str strip-prompt)
685 nil t)))
686 (setq result (buffer-substring (match-beginning 2) (match-end 2)))
687 (if (he-string-member result he-tried-table t)
688 (setq result nil))) ; if already in table, ignore
689 result))
690
691 (defun he-line-beg (strip-prompt)
692 (save-excursion
693 (if (re-search-backward (he-line-search-regexp "" strip-prompt)
694 (save-excursion (beginning-of-line)
695 (point)) t)
696 (match-beginning 2)
697 (point))))
698
699 (defun he-line-search-regexp (pat strip-prompt)
700 (if strip-prompt
701 (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
702 (regexp-quote pat)
703 "[^\n]*[^ \t\n]\\)")
704 (concat "^\\(\\s-*\\)\\("
705 (regexp-quote pat)
706 "[^\n]*[^ \t\n]\\)")))
707
708 (defun try-expand-list (old)
709 "Try to complete the current beginning of a list.
710 The argument OLD has to be nil the first call of this function, and t
711 for subsequent calls (for further possible completions of the same
712 string). It returns t if a new completion is found, nil otherwise."
713 (let ((expansion ()))
714 (if (not old)
715 (progn
716 (he-init-string (he-list-beg) (point))
717 (set-marker he-search-loc he-string-beg)
718 (setq he-search-bw t)))
719
720 (if (not (equal he-search-string ""))
721 (save-excursion
722 ;; Try looking backward unless inhibited.
723 (if he-search-bw
724 (progn
725 (goto-char he-search-loc)
726 (setq expansion (he-list-search he-search-string t))
727 (set-marker he-search-loc (point))
728 (if (not expansion)
729 (progn
730 (set-marker he-search-loc he-string-end)
731 (setq he-search-bw ())))))
732
733 (if (not expansion) ; Then look forward.
734 (progn
735 (goto-char he-search-loc)
736 (setq expansion (he-list-search he-search-string nil))
737 (set-marker he-search-loc (point))))))
738
739 (if (not expansion)
740 (progn
741 (if old (he-reset-string))
742 ())
743 (progn
744 (he-substitute-string expansion t)
745 t))))
746
747 (defun try-expand-list-all-buffers (old)
748 "Try to complete the current list, searching all other buffers.
749 The argument OLD has to be nil the first call of this function, and t
750 for subsequent calls (for further possible completions of the same
751 string). It returns t if a new completion is found, nil otherwise."
752 (let ((expansion ())
753 (buf (current-buffer))
754 (orig-case-fold-search case-fold-search))
755 (if (not old)
756 (progn
757 (he-init-string (he-list-beg) (point))
758 (setq he-search-bufs (buffer-list))
759 (setq he-searched-n-bufs 0)
760 (set-marker he-search-loc 1 (car he-search-bufs))))
761
762 (if (not (equal he-search-string ""))
763 (while (and he-search-bufs
764 (not expansion)
765 (or (not hippie-expand-max-buffers)
766 (< he-searched-n-bufs hippie-expand-max-buffers)))
767 (set-buffer (car he-search-bufs))
768 (if (and (not (eq (current-buffer) buf))
769 (not (memq major-mode hippie-expand-ignore-buffers))
770 (not (he-regexp-member (buffer-name)
771 hippie-expand-ignore-buffers)))
772 (save-excursion
773 (goto-char he-search-loc)
774 (setq expansion (let ((case-fold-search orig-case-fold-search))
775 (he-list-search he-search-string nil)))
776 (set-marker he-search-loc (point))
777 (if (not expansion)
778 (progn
779 (setq he-search-bufs (cdr he-search-bufs))
780 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
781 (set-marker he-search-loc 1 (car he-search-bufs)))))
782 (setq he-search-bufs (cdr he-search-bufs))
783 (set-marker he-search-loc 1 (car he-search-bufs)))))
784
785 (set-buffer buf)
786 (if (not expansion)
787 (progn
788 (if old (he-reset-string))
789 ())
790 (progn
791 (he-substitute-string expansion t)
792 t))))
793
794 (defun he-list-search (str reverse)
795 (let ((result ())
796 beg pos err)
797 (while (and (not result)
798 (if reverse
799 (search-backward str nil t)
800 (search-forward str nil t)))
801 (setq pos (point))
802 (setq beg (match-beginning 0))
803 (goto-char beg)
804 (setq err ())
805 (condition-case ()
806 (forward-list 1)
807 (error (setq err t)))
808 (if (and reverse
809 (> (point) he-string-beg))
810 (setq err t))
811 (if (not err)
812 (progn
813 (setq result (buffer-substring beg (point)))
814 (if (he-string-member result he-tried-table t)
815 (setq result nil)))) ; if already in table, ignore
816 (goto-char pos))
817 result))
818
819 (defun he-list-beg ()
820 (save-excursion
821 (condition-case ()
822 (backward-up-list 1)
823 (error ()))
824 (point)))
825
826 (defun try-expand-all-abbrevs (old)
827 "Try to expand word before point according to all abbrev tables.
828 The argument OLD has to be nil the first call of this function, and t
829 for subsequent calls (for further possible expansions of the same
830 string). It returns t if a new expansion is found, nil otherwise."
831 (if (not old)
832 (progn
833 (he-init-string (he-dabbrev-beg) (point))
834 (setq he-expand-list
835 (and (not (equal he-search-string ""))
836 (mapcar (function (lambda (sym)
837 (if (and (boundp sym) (vectorp (eval sym)))
838 (abbrev-expansion (downcase he-search-string)
839 (eval sym)))))
840 (append '(local-abbrev-table
841 global-abbrev-table)
842 abbrev-table-name-list))))))
843 (while (and he-expand-list
844 (or (not (car he-expand-list))
845 (he-string-member (car he-expand-list) he-tried-table t)))
846 (setq he-expand-list (cdr he-expand-list)))
847 (if (null he-expand-list)
848 (progn
849 (if old (he-reset-string))
850 ())
851 (progn
852 (he-substitute-string (car he-expand-list) t)
853 (setq he-expand-list (cdr he-expand-list))
854 t)))
855
856 (defun try-expand-dabbrev (old)
857 "Try to expand word \"dynamically\", searching the current buffer.
858 The argument OLD has to be nil the first call of this function, and t
859 for subsequent calls (for further possible expansions of the same
860 string). It returns t if a new expansion is found, nil otherwise."
861 (let ((expansion ()))
862 (if (not old)
863 (progn
864 (he-init-string (he-dabbrev-beg) (point))
865 (set-marker he-search-loc he-string-beg)
866 (setq he-search-bw t)))
867
868 (if (not (equal he-search-string ""))
869 (save-excursion
870 ;; Try looking backward unless inhibited.
871 (if he-search-bw
872 (progn
873 (goto-char he-search-loc)
874 (setq expansion (he-dabbrev-search he-search-string t))
875 (set-marker he-search-loc (point))
876 (if (not expansion)
877 (progn
878 (set-marker he-search-loc he-string-end)
879 (setq he-search-bw ())))))
880
881 (if (not expansion) ; Then look forward.
882 (progn
883 (goto-char he-search-loc)
884 (setq expansion (he-dabbrev-search he-search-string nil))
885 (set-marker he-search-loc (point))))))
886
887 (if (not expansion)
888 (progn
889 (if old (he-reset-string))
890 ())
891 (progn
892 (he-substitute-string expansion t)
893 t))))
894
895 (defun try-expand-dabbrev-all-buffers (old)
896 "Tries to expand word \"dynamically\", searching all other buffers.
897 The argument OLD has to be nil the first call of this function, and t
898 for subsequent calls (for further possible expansions of the same
899 string). It returns t if a new expansion is found, nil otherwise."
900 (let ((expansion ())
901 (buf (current-buffer))
902 (orig-case-fold-search case-fold-search))
903 (if (not old)
904 (progn
905 (he-init-string (he-dabbrev-beg) (point))
906 (setq he-search-bufs (buffer-list))
907 (setq he-searched-n-bufs 0)
908 (set-marker he-search-loc 1 (car he-search-bufs))))
909
910 (if (not (equal he-search-string ""))
911 (while (and he-search-bufs
912 (not expansion)
913 (or (not hippie-expand-max-buffers)
914 (< he-searched-n-bufs hippie-expand-max-buffers)))
915 (set-buffer (car he-search-bufs))
916 (if (and (not (eq (current-buffer) buf))
917 (not (memq major-mode hippie-expand-ignore-buffers))
918 (not (he-regexp-member (buffer-name)
919 hippie-expand-ignore-buffers)))
920 (save-excursion
921 (goto-char he-search-loc)
922 (setq expansion (let ((case-fold-search orig-case-fold-search))
923 (he-dabbrev-search he-search-string nil)))
924 (set-marker he-search-loc (point))
925 (if (not expansion)
926 (progn
927 (setq he-search-bufs (cdr he-search-bufs))
928 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
929 (set-marker he-search-loc 1 (car he-search-bufs)))))
930 (setq he-search-bufs (cdr he-search-bufs))
931 (set-marker he-search-loc 1 (car he-search-bufs)))))
932
933 (set-buffer buf)
934 (if (not expansion)
935 (progn
936 (if old (he-reset-string))
937 ())
938 (progn
939 (he-substitute-string expansion t)
940 t))))
941
942 ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
943 ;; suggested this one.
944 (defun try-expand-dabbrev-visible (old)
945 "Try to expand word \"dynamically\", searching visible window parts.
946 The argument OLD has to be nil the first call of this function, and t
947 for subsequent calls (for further possible expansions of the same
948 string). It returns t if a new expansion is found, nil otherwise."
949 (let ((expansion ())
950 (buf (current-buffer))
951 (flag (if (frame-visible-p (window-frame (selected-window)))
952 'visible t)))
953 (if (not old)
954 (progn
955 (he-init-string (he-dabbrev-beg) (point))
956 (setq he-search-window (selected-window))
957 (set-marker he-search-loc
958 (window-start he-search-window)
959 (window-buffer he-search-window))))
960
961 (while (and (not (equal he-search-string ""))
962 (marker-position he-search-loc)
963 (not expansion))
964 (save-excursion
965 (set-buffer (marker-buffer he-search-loc))
966 (goto-char he-search-loc)
967 (setq expansion (he-dabbrev-search he-search-string ()
968 (window-end he-search-window)))
969 (if (and expansion
970 (eq (marker-buffer he-string-beg) (current-buffer))
971 (eq (marker-position he-string-beg) (match-beginning 0)))
972 (setq expansion (he-dabbrev-search he-search-string ()
973 (window-end he-search-window))))
974 (set-marker he-search-loc (point) (current-buffer)))
975 (if (not expansion)
976 (progn
977 (setq he-search-window (next-window he-search-window nil flag))
978 (if (eq he-search-window (selected-window))
979 (set-marker he-search-loc nil)
980 (set-marker he-search-loc (window-start he-search-window)
981 (window-buffer he-search-window))))))
982
983 (set-buffer buf)
984 (if (not expansion)
985 (progn
986 (if old (he-reset-string))
987 ())
988 (progn
989 (he-substitute-string expansion t)
990 t))))
991
992 (defun he-dabbrev-search (pattern &optional reverse limit)
993 (let ((result ())
994 (regpat (if (eq (char-syntax (aref pattern 0)) ?_)
995 (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
996 (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))))
997 (while (and (not result)
998 (if reverse
999 (re-search-backward regpat limit t)
1000 (re-search-forward regpat limit t)))
1001 (setq result (buffer-substring (match-beginning 0) (match-end 0)))
1002 (if (or (and (> (match-beginning 0) (point-min))
1003 (memq (char-syntax (char-after (1- (match-beginning 0))))
1004 '(?_ ?w)))
1005 (he-string-member result he-tried-table t))
1006 (setq result nil))) ; ignore if bad prefix or already in table
1007 result))
1008
1009 (defvar he-dabbrev-skip-space ()
1010 "Non-NIL means tolerate trailing spaces in the abbreviation to expand.")
1011
1012 (defun he-dabbrev-beg ()
1013 (let ((op (point)))
1014 (save-excursion
1015 (if he-dabbrev-skip-space
1016 (skip-syntax-backward ". "))
1017 (if (= (skip-syntax-backward "w_") 0)
1018 op
1019 (point)))))
1020
1021 (defun try-expand-dabbrev-from-kill (old)
1022 "Try to expand word \"dynamically\", searching the kill ring.
1023 The argument OLD has to be nil the first call of this function, and t
1024 for subsequent calls (for further possible completions of the same
1025 string). It returns t if a new completion is found, nil otherwise."
1026 (let ((expansion ()))
1027 (if (not old)
1028 (progn
1029 (he-init-string (he-dabbrev-beg) (point))
1030 (setq he-expand-list
1031 (if (not (equal he-search-string ""))
1032 kill-ring))
1033 (setq he-search-loc2 0)))
1034 (if (not (equal he-search-string ""))
1035 (setq expansion (he-dabbrev-kill-search he-search-string)))
1036 (if (not expansion)
1037 (progn
1038 (if old (he-reset-string))
1039 ())
1040 (progn
1041 (he-substitute-string expansion t)
1042 t))))
1043
1044 (defun he-dabbrev-kill-search (pattern)
1045 (let ((result ())
1046 (regpat (if (eq (char-syntax (aref pattern 0)) ?_)
1047 (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
1048 (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")))
1049 (killstr (car he-expand-list)))
1050 (while (and (not result)
1051 he-expand-list)
1052 (while (and (not result)
1053 (string-match regpat killstr he-search-loc2))
1054 (setq result (substring killstr (match-beginning 0) (match-end 0)))
1055 (setq he-search-loc2 (1+ (match-beginning 0)))
1056 (if (or (and (> (match-beginning 0) 0)
1057 (memq (char-syntax (aref killstr (1- (match-beginning 0))))
1058 '(?_ ?w)))
1059 (he-string-member result he-tried-table t))
1060 (setq result nil))) ; ignore if bad prefix or already in table
1061 (if (and (not result)
1062 he-expand-list)
1063 (progn
1064 (setq he-expand-list (cdr he-expand-list))
1065 (setq killstr (car he-expand-list))
1066 (setq he-search-loc2 0))))
1067 result))
1068
1069 (defun try-expand-whole-kill (old)
1070 "Try to complete text with something from the kill ring.
1071 The argument OLD has to be nil the first call of this function, and t
1072 for subsequent calls (for further possible completions of the same
1073 string). It returns t if a new completion is found, nil otherwise."
1074 (let ((expansion ()))
1075 (if (not old)
1076 (progn
1077 (he-init-string (he-kill-beg) (point))
1078 (if (not (he-string-member he-search-string he-tried-table))
1079 (setq he-tried-table (cons he-search-string he-tried-table)))
1080 (setq he-expand-list
1081 (if (not (equal he-search-string ""))
1082 kill-ring))
1083 (setq he-search-loc2 ())))
1084 (if (not (equal he-search-string ""))
1085 (setq expansion (he-whole-kill-search he-search-string)))
1086 (if (not expansion)
1087 (progn
1088 (if old (he-reset-string))
1089 ())
1090 (progn
1091 (he-substitute-string expansion)
1092 t))))
1093
1094 (defun he-whole-kill-search (str)
1095 (let ((case-fold-search ())
1096 (result ())
1097 (str (regexp-quote str))
1098 (killstr (car he-expand-list))
1099 (pos -1))
1100 (while (and (not result)
1101 he-expand-list)
1102 (if (not he-search-loc2)
1103 (while (setq pos (string-match str killstr (1+ pos)))
1104 (setq he-search-loc2 (cons pos he-search-loc2))))
1105 (while (and (not result)
1106 he-search-loc2)
1107 (setq pos (car he-search-loc2))
1108 (setq he-search-loc2 (cdr he-search-loc2))
1109 (save-excursion
1110 (goto-char he-string-beg)
1111 (if (and (>= (- (point) pos) (point-min)) ; avoid some string GC
1112 (eq (char-after (- (point) pos)) (aref killstr 0))
1113 (search-backward (substring killstr 0 pos)
1114 (- (point) pos) t))
1115 (setq result (substring killstr pos))))
1116 (if (and result
1117 (he-string-member result he-tried-table))
1118 (setq result nil))) ; ignore if already in table
1119 (if (and (not result)
1120 he-expand-list)
1121 (progn
1122 (setq he-expand-list (cdr he-expand-list))
1123 (setq killstr (car he-expand-list))
1124 (setq pos -1))))
1125 result))
1126
1127 (defun he-kill-beg ()
1128 (let ((op (point)))
1129 (save-excursion
1130 (skip-syntax-backward "^w_")
1131 (if (= (skip-syntax-backward "w_") 0)
1132 op
1133 (point)))))
1134
1135
1136 (provide 'hippie-exp)
1137
1138 ;;; hippie-exp.el ends here