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