xref: /386bsd/usr/local/lib/emacs/19.25/lisp/hippie-exp.el (revision a2142627)
1;;; hippie-exp.el --- expand text trying various ways to find its expansion.
2
3;; Author: Anders Holst <aho@sans.kth.se>
4;; Last change: 2 September 1993
5;; Version: 1.3
6;; Keywords: abbrev
7
8;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
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
24;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25
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.
39;;
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-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
83;;      through all possibilities instead of completing what is unique.
84;;      Might be tedious (usually a lot of possible completions) and
85;;      since its function is much like `lisp-complete-symbol', which
86;;      already has a key of its own, you might want to remove this.
87;;    `try-complete-lisp-symbol-partially' : To insert in the list just
88;;      before `try-complete-lisp-symbol' for those who first want to get
89;;      completion of what is unique in the name.
90;;
91;;  Not all of the above functions are by default in
92;;  `hippie-expand-try-functions-list'.  This variable is better set
93;;  in ".emacs" to make `hippie-expand' behave maximally convenient
94;;  according to personal taste.  Also, instead of loading the
95;;  variable with all kinds of try-functions above, it might be an
96;;  idea to use `make-hippie-expand-function' to construct different
97;;  `hippie-expand'-like functions, with different try-lists and bound
98;;  to different keys. It is also possible to make
99;;  `hippie-expand-try-functions-list' a buffer local variable, and
100;;  let it depend on the mode (by setting it in the mode-hooks).
101;;
102;;  To write new try-functions, consider the following:
103;;  Each try-function takes one argument OLD which is nil the first
104;;  time the function is called and true in succeeding calls for the
105;;  same string to complete.  The first time the function has to
106;;  extract the string before point to complete, and substitute the
107;;  first completion alternative for it.  On following calls it has to
108;;  substitute the next possible completion for the last tried string.
109;;  The try-function is to return t as long as it finds new
110;;  possible completions.  When there are no more alternatives it has
111;;  to restore the text before point to its original contents, and
112;;  return nil (don't beep or message or anything).
113;;  The try-function can (should) use the following functions:
114;;    `he-init-string' : Initializes the text to substitute to the
115;;      contents of the region BEGIN to END.  Also sets the variable
116;;      `he-search-string' to the text to expand.
117;;    `he-substitute-string' : substitutes STR into the region
118;;      initialized with `he-init-string'.  (An optional second argument
119;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
120;;      to the expansion is ok if that is enabled in the buffer.)
121;;    `he-reset-string' : Resets the initialized region to its original
122;;      contents.
123;;  There is also a variable: `he-tried-table' which is meant to contain
124;;  all tried expansions so far.  The try-function can check this
125;;  variable to see whether an expansion has already been tried
126;;  (hint: `he-string-member'), and add its own tried expansions to it.
127;;
128;;  Known bugs
129;;
130;;  It may happen that some completion suggestion occurs twice, in
131;;  spite of the use of `he-tried-table' to prevent that.  This is
132;;  because different try-functions may try to complete different
133;;  lengths of text, and thus put different amounts of the
134;;  text in `he-try-table'.  Anyway this seems to occur seldom enough not
135;;  to be too disturbing.  Also it should NOT be possible for the
136;;  opposite situation to occur, that `hippie-expand' misses some
137;;  suggestion because it thinks it has already tried it.
138;;
139;;  Acknowledgement
140;;
141;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
142;;  of this function took form.
143;;  I am also grateful to all those who have given me suggestions on
144;;  how to improve it.
145;;
146
147;;; Code:
148
149(defvar he-num -1)
150
151(defvar he-string-beg (make-marker))
152
153(defvar he-string-end (make-marker))
154
155(defvar he-search-string ())
156
157(defvar he-expand-list ())
158
159(defvar he-tried-table ())
160
161(defvar he-search-loc (make-marker))
162
163(defvar he-search-bw ())
164
165(defvar he-search-bufs ())
166
167(defvar he-searched-n-bufs ())
168
169;;;###autoload
170(defvar hippie-expand-try-functions-list '(try-complete-file-name
171					   try-expand-all-abbrevs
172                                           try-expand-list
173					   try-expand-line
174					   try-expand-dabbrev
175					   try-expand-dabbrev-all-buffers
176					   try-complete-lisp-symbol)
177  "The list of expansion functions tried in order by `hippie-expand'.
178To change the behavior of `hippie-expand', remove, change the order of,
179or insert functions in this list.")
180
181;;;###autoload
182(defvar hippie-expand-verbose t
183  "*Non-nil makes `hippie-expand' output which function it is trying.")
184
185;;;###autoload
186(defvar hippie-expand-max-buffers ()
187  "*The maximum number of buffers (apart from the current) searched.
188If nil, all buffers are searched.")
189
190;;;###autoload
191(defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
192  "*A list specifying which buffers not to search (if not current).
193Can contain both regexps matching buffer names (as strings) and major modes
194\(as atoms)")
195
196;;;###autoload
197(defun hippie-expand (arg)
198  "Try to expand text before point, using multiple methods.
199The expansion functions in `hippie-expand-try-functions-list' are
200tried in order, until a possible expansion is found.  Repeated
201application of `hippie-expand' inserts successively possible
202expansions.
203With a positive numeric argument, jumps directly to the ARG next
204function in this list.  With a negative argument or just \\[universal-argument],
205undoes the expansion."
206  (interactive "P")
207  (if (or (not arg)
208	  (and (integerp arg) (> arg 0)))
209      (let ((first (or (= he-num -1)
210		       (not (equal this-command last-command)))))
211	(if first
212	    (progn
213	      (setq he-num -1)
214	      (setq he-tried-table nil)))
215	(if arg
216	    (if (not first) (he-reset-string))
217	    (setq arg 0))
218	(let ((i (max (+ he-num arg) 0)))
219	  (while (not (or (>= i (length hippie-expand-try-functions-list))
220			  (apply (nth i hippie-expand-try-functions-list)
221				 (list (= he-num i)))))
222	    (setq i (1+ i)))
223	  (setq he-num i))
224	(if (>= he-num (length hippie-expand-try-functions-list))
225	    (progn
226	      (setq he-num -1)
227	      (if first
228		  (message "No expansion found")
229		  (message "No further expansions found"))
230	      (ding))
231	    (if (and hippie-expand-verbose
232                     (not (window-minibuffer-p (selected-window))))
233		(message (concat "Using "
234				 (prin1-to-string (nth he-num
235				   hippie-expand-try-functions-list)))))))
236      (if (>= he-num 0)
237	  (progn
238	    (setq he-num -1)
239	    (he-reset-string)
240	    (if (and hippie-expand-verbose
241                     (not (window-minibuffer-p (selected-window))))
242		(message "Undoing expansions"))))))
243
244;; Initializes the region to expand (to between BEG and END).
245(defun he-init-string (beg end)
246  (set-marker he-string-beg beg)
247  (set-marker he-string-end end)
248  (setq he-search-string (buffer-substring beg end)))
249
250;; Resets the expanded region to its original contents.
251(defun he-reset-string ()
252  (let ((newpos (point-marker)))
253    (delete-region he-string-beg he-string-end)
254    (goto-char he-string-beg)
255    (insert he-search-string)
256    (set-marker he-string-end (point))
257    (if (= newpos he-string-beg)
258	(goto-char he-string-end)
259	(goto-char newpos))))
260
261;; Substitutes an expansion STR into the correct region (the region
262;; initialized with `he-init-string').
263;; An optional argument TRANS-CASE means that it is ok to transfer case
264;; from the abbreviation to the expansion if that is possible, and is
265;; enabled in the buffer.
266(defun he-substitute-string (str &optional trans-case)
267  (let ((trans-case (and trans-case
268			 case-replace
269			 case-fold-search
270			 (he-transfer-case-ok str he-search-string)))
271	(newpos (point-marker)))
272    (he-reset-string)
273    (goto-char he-string-beg)
274    (search-forward he-search-string)
275    (replace-match (if trans-case (downcase str) str)
276		   (not trans-case)
277		   'literal)
278    (set-marker he-string-end (point))
279    (if (= newpos he-string-beg)
280	(goto-char he-string-end)
281	(goto-char newpos))))
282
283(defun he-ordinary-case-p (str)
284  (or (string= str (downcase str))
285      (string= str (upcase str))
286      (string= str (capitalize str))))
287
288(defun he-transfer-case-ok (to-str from-str)
289  (and (not (string= from-str (substring to-str 0 (min (length from-str)
290                                                       (length to-str)))))
291         ;; otherwise transfer is not needed (and this also solves
292	 ;; some obscure situations)
293       (he-ordinary-case-p to-str)
294         ;; otherwise case may be significant
295       (he-ordinary-case-p from-str)
296         ;; otherwise replace-match wont know what to do
297  ))
298
299;; Check if STR is a member of LST.
300;; Ignore case if `case-replace' and `case-fold-search' are both t.
301(defun he-string-member (str lst)
302  (while (and lst
303	      (not
304	       (if (and case-fold-search case-replace)
305		   (string= (downcase (car lst)) (downcase str))
306		   (string= (car lst) str))))
307    (setq lst (cdr lst)))
308  lst)
309
310;; Check if STR matches any regexp in LST.
311;; Ignore possible non-strings in LST.
312(defun he-regexp-member (str lst)
313  (while (and lst
314	      (or (not (stringp (car lst)))
315                  (not (string-match (car lst) str))))
316    (setq lst (cdr lst)))
317  lst)
318
319;;  For the real hippie-expand enthusiast: A macro that makes it
320;;  possible to use many functions like hippie-expand, but with
321;;  different try-functions-lists.
322;;  Usage is for example:
323;;    (fset 'my-complete-file (make-hippie-expand-function
324;;                             '(try-complete-file-name-partially
325;;                               try-complete-file-name)))
326;;    (fset 'my-complete-line (make-hippie-expand-function
327;;                             '(try-expand-line
328;;                               try-expand-line-all-buffers)))
329;;
330;;;###autoload
331(defmacro make-hippie-expand-function (try-list &optional verbose)
332  "Construct a function similar to `hippie-expand'.
333Make it use the expansion functions in TRY-LIST.  An optional second
334argument VERBOSE non-nil makes the function verbose."
335  (` (function (lambda (arg)
336       (, (concat
337           "Try to expand text before point, using the following functions: \n"
338	   (mapconcat 'prin1-to-string (eval try-list) ", ")))
339       (interactive "P")
340       (let ((hippie-expand-try-functions-list (, try-list))
341	     (hippie-expand-verbose (, verbose)))
342	 (hippie-expand arg))))))
343
344
345;;;  Here follows the try-functions and their requisites:
346
347(defun try-complete-file-name (old)
348  "Try to complete text as a file name.
349The argument OLD has to be nil the first call of this function, and t
350for subsequent calls (for further possible completions of the same
351string).  It returns t if a new completion is found, nil otherwise."
352  (if (not old)
353      (progn
354	(he-init-string (he-file-name-beg) (point))
355	(let ((name-part (file-name-nondirectory he-search-string))
356	      (dir-part (expand-file-name (or (file-name-directory
357					       he-search-string) ""))))
358	  (if (not (he-string-member name-part he-tried-table))
359	      (setq he-tried-table (cons name-part he-tried-table)))
360	  (if (and (not (equal he-search-string ""))
361		   (file-directory-p dir-part))
362	      (setq he-expand-list (sort (file-name-all-completions
363					  name-part
364					  dir-part)
365					 'string-lessp))
366	      (setq he-expand-list ())))))
367
368  (while (and he-expand-list
369	      (he-string-member (car he-expand-list) he-tried-table))
370    (setq he-expand-list (cdr he-expand-list)))
371  (if (null he-expand-list)
372      (progn
373        (if old (he-reset-string))
374	())
375      (let ((filename (concat (file-name-directory he-search-string)
376			      (car he-expand-list))))
377	(he-substitute-string filename)
378	(setq he-tried-table (cons (car he-expand-list) he-tried-table))
379	(setq he-expand-list (cdr he-expand-list))
380	t)))
381
382(defun try-complete-file-name-partially (old)
383  "Try to complete text as a file name, as many characters as unique.
384The argument OLD has to be nil the first call of this function.  It
385returns t if a unique, possibly partial, completion is found, nil
386otherwise."
387  (let ((expansion ()))
388    (if (not old)
389	(progn
390	  (he-init-string (he-file-name-beg) (point))
391	  (let ((name-part (file-name-nondirectory he-search-string))
392		(dir-part (expand-file-name (or (file-name-directory
393						 he-search-string) ""))))
394	    (if (and (not (equal he-search-string ""))
395		     (file-directory-p dir-part))
396		(setq expansion (file-name-completion name-part
397						      dir-part)))
398	    (if (or (eq expansion t)
399		    (string= expansion name-part))
400		(setq expansion ())))))
401
402    (if (not expansion)
403	(progn
404          (if old (he-reset-string))
405	  ())
406	(let ((filename (concat (file-name-directory he-search-string)
407				expansion)))
408	  (he-substitute-string filename)
409	  (setq he-tried-table (cons expansion he-tried-table))
410	  t))))
411
412(defun he-file-name-beg ()
413  (let ((skips "-a-zA-Z0-9_./~^#$"))
414    (save-excursion
415      (skip-chars-backward skips)
416      (point))))
417
418(defun try-complete-lisp-symbol (old)
419  "Try to complete word as an Emacs Lisp symbol.
420The argument OLD has to be nil the first call of this function, and t
421for subsequent calls (for further possible completions of the same
422string).  It returns t if a new completion is found, nil otherwise."
423  (if (not old)
424      (progn
425	(he-init-string (he-lisp-symbol-beg) (point))
426	(if (not (he-string-member he-search-string he-tried-table))
427	    (setq he-tried-table (cons he-search-string he-tried-table)))
428	(setq he-expand-list
429	      (and (not (equal he-search-string ""))
430		   (sort (all-completions he-search-string obarray
431					  (function (lambda (sym)
432					    (or (boundp sym)
433						(fboundp sym)
434						(symbol-plist sym)))))
435			 'string-lessp)))))
436  (while (and he-expand-list
437	      (he-string-member (car he-expand-list) he-tried-table))
438    (setq he-expand-list (cdr he-expand-list)))
439  (if (null he-expand-list)
440      (progn
441        (if old (he-reset-string))
442	())
443      (progn
444	(he-substitute-string (car he-expand-list))
445	(setq he-tried-table (cons (car he-expand-list) he-tried-table))
446	(setq he-expand-list (cdr he-expand-list))
447	t)))
448
449(defun try-complete-lisp-symbol-partially (old)
450  "Try to complete as an Emacs Lisp symbol, as many characters as unique.
451The argument OLD has to be nil the first call of this function.  It
452returns t if a unique, possibly partial, completion is found, nil
453otherwise."
454  (let ((expansion ()))
455    (if (not old)
456	(progn
457	  (he-init-string (he-lisp-symbol-beg) (point))
458	  (if (not (string= he-search-string ""))
459	      (setq expansion
460		    (try-completion he-search-string obarray
461				    (function (lambda (sym)
462				      (or (boundp sym)
463					  (fboundp sym)
464					  (symbol-plist sym)))))))
465	  (if (or (eq expansion t)
466		  (string= expansion he-search-string))
467	      (setq expansion ()))))
468
469  (if (not expansion)
470      (progn
471        (if old (he-reset-string))
472	())
473      (progn
474	(he-substitute-string expansion)
475	(setq he-tried-table (cons expansion he-tried-table))
476	t))))
477
478(defun he-lisp-symbol-beg ()
479  (let ((skips "-a-zA-Z0-9_."))
480    (save-excursion
481      (skip-chars-backward skips)
482      (point))))
483
484(defun try-expand-line (old)
485  "Try to complete the current line to an entire line in the buffer.
486The argument OLD has to be nil the first call of this function, and t
487for subsequent calls (for further possible completions of the same
488string).  It returns t if a new completion is found, nil otherwise."
489  (let ((expansion ())
490	(strip-prompt (and (get-buffer-process (current-buffer))
491			   comint-prompt-regexp)))
492    (if (not old)
493	(progn
494	  (he-init-string (he-line-beg strip-prompt) (point))
495	  (set-marker he-search-loc he-string-beg)
496	  (setq he-search-bw t)))
497
498    (if (not (equal he-search-string ""))
499	(save-excursion
500	  ;; Try looking backward unless inhibited.
501	  (if he-search-bw
502	      (progn
503		(goto-char he-search-loc)
504		(setq expansion (he-line-search he-search-string
505						strip-prompt t))
506		(set-marker he-search-loc (point))
507		(if (not expansion)
508		    (progn
509		      (set-marker he-search-loc he-string-end)
510		      (setq he-search-bw ())))))
511
512	  (if (not expansion) ; Then look forward.
513	      (progn
514		(goto-char he-search-loc)
515		(setq expansion (he-line-search he-search-string
516						strip-prompt nil))
517		(set-marker he-search-loc (point))))))
518
519    (if (not expansion)
520	(progn
521          (if old (he-reset-string))
522	  ())
523	(progn
524	  (he-substitute-string expansion t)
525	  (setq he-tried-table (cons expansion he-tried-table))
526	  t))))
527
528(defun try-expand-line-all-buffers (old)
529  "Try to complete the current line, searching all other buffers.
530The argument OLD has to be nil the first call of this function, and t
531for subsequent calls (for further possible completions of the same
532string).  It returns t if a new completion is found, nil otherwise."
533  (let ((expansion ())
534	(strip-prompt (and (get-buffer-process (current-buffer))
535			   comint-prompt-regexp))
536	(buf (current-buffer)))
537    (if (not old)
538	(progn
539	  (he-init-string (he-line-beg strip-prompt) (point))
540	  (setq he-search-bufs (buffer-list))
541          (setq he-searched-n-bufs 0)
542	  (set-marker he-search-loc 1 (car he-search-bufs))))
543
544    (if (not (equal he-search-string ""))
545	(while (and he-search-bufs
546                    (not expansion)
547                    (or (not hippie-expand-max-buffers)
548                        (< he-searched-n-bufs hippie-expand-max-buffers)))
549	  (set-buffer (car he-search-bufs))
550	  (if (and (not (eq (current-buffer) buf))
551		   (not (memq major-mode hippie-expand-ignore-buffers))
552                   (not (he-regexp-member (buffer-name)
553                                          hippie-expand-ignore-buffers)))
554	      (save-excursion
555		(goto-char he-search-loc)
556                (setq strip-prompt (and (get-buffer-process (current-buffer))
557                                        comint-prompt-regexp))
558		(setq expansion (he-line-search he-search-string
559						strip-prompt nil))
560		(set-marker he-search-loc (point))
561                (if expansion
562                    (setq he-tried-table (cons expansion he-tried-table))
563                  (setq he-search-bufs (cdr he-search-bufs))
564                  (setq he-searched-n-bufs (1+ he-searched-n-bufs))
565                  (set-marker he-search-loc 1 (car he-search-bufs))))
566            (setq he-search-bufs (cdr he-search-bufs))
567            (set-marker he-search-loc 1 (car he-search-bufs)))))
568
569    (set-buffer buf)
570    (if (not expansion)
571	(progn
572          (if old (he-reset-string))
573	  ())
574	(progn
575	  (he-substitute-string expansion t)
576	  t))))
577
578(defun he-line-search (str strip-prompt reverse)
579  (let ((result ()))
580    (while (and (not result)
581		(if reverse
582		    (re-search-backward
583		     (he-line-search-regexp str strip-prompt)
584		     nil t)
585		    (re-search-forward
586		     (he-line-search-regexp str strip-prompt)
587		     nil t)))
588      (setq result (buffer-substring (match-beginning 2) (match-end 2)))
589      (if (he-string-member result he-tried-table)
590	  (setq result nil)))	            ; if already in table, ignore
591    result))
592
593(defun he-line-beg (strip-prompt)
594  (save-excursion
595    (end-of-line)
596    (if (re-search-backward (he-line-search-regexp "" strip-prompt)
597			    (save-excursion (beginning-of-line)
598					    (point)) t)
599	(match-beginning 2)
600      (beginning-of-line)
601      (point))))
602
603(defun he-line-search-regexp (pat strip-prompt)
604  (if strip-prompt
605      (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
606	      (regexp-quote pat)
607	      "[^\n]*[^ \t\n]\\)")
608      (concat "^\\(\\s-*\\)\\("
609	      (regexp-quote pat)
610	      "[^\n]*[^ \t\n]\\)")))
611
612(defun try-expand-list (old)
613  "Try to complete the current beginning of a list.
614The argument OLD has to be nil the first call of this function, and t
615for subsequent calls (for further possible completions of the same
616string).  It returns t if a new completion is found, nil otherwise."
617  (let ((expansion ()))
618    (if (not old)
619	(progn
620	  (he-init-string (he-list-beg) (point))
621	  (set-marker he-search-loc he-string-beg)
622	  (setq he-search-bw t)))
623
624    (if (not (equal he-search-string ""))
625	(save-excursion
626	  ;; Try looking backward unless inhibited.
627	  (if he-search-bw
628	      (progn
629		(goto-char he-search-loc)
630		(setq expansion (he-list-search he-search-string t))
631		(set-marker he-search-loc (point))
632		(if (not expansion)
633		    (progn
634		      (set-marker he-search-loc he-string-end)
635		      (setq he-search-bw ())))))
636
637	  (if (not expansion) ; Then look forward.
638	      (progn
639		(goto-char he-search-loc)
640		(setq expansion (he-list-search he-search-string nil))
641		(set-marker he-search-loc (point))))))
642
643    (if (not expansion)
644	(progn
645	  (if old (he-reset-string))
646	  ())
647	(progn
648	  (he-substitute-string expansion t)
649	  (setq he-tried-table (cons expansion he-tried-table))
650	  t))))
651
652(defun try-expand-list-all-buffers (old)
653  "Try to complete the current list, searching all other buffers.
654The argument OLD has to be nil the first call of this function, and t
655for subsequent calls (for further possible completions of the same
656string).  It returns t if a new completion is found, nil otherwise."
657  (let ((expansion ())
658	(buf (current-buffer)))
659    (if (not old)
660	(progn
661	  (he-init-string (he-list-beg) (point))
662	  (setq he-search-bufs (buffer-list))
663          (setq he-searched-n-bufs 0)
664	  (set-marker he-search-loc 1 (car he-search-bufs))))
665
666    (if (not (equal he-search-string ""))
667	(while (and he-search-bufs
668                    (not expansion)
669                    (or (not hippie-expand-max-buffers)
670                        (< he-searched-n-bufs hippie-expand-max-buffers)))
671	  (set-buffer (car he-search-bufs))
672	  (if (and (not (eq (current-buffer) buf))
673		   (not (memq major-mode hippie-expand-ignore-buffers))
674                   (not (he-regexp-member (buffer-name)
675                                          hippie-expand-ignore-buffers)))
676	      (save-excursion
677		(goto-char he-search-loc)
678		(setq expansion (he-list-search he-search-string nil))
679		(set-marker he-search-loc (point))
680                (if expansion
681                    (setq he-tried-table (cons expansion he-tried-table))
682                  (setq he-search-bufs (cdr he-search-bufs))
683                  (setq he-searched-n-bufs (1+ he-searched-n-bufs))
684                  (set-marker he-search-loc 1 (car he-search-bufs))))
685            (setq he-search-bufs (cdr he-search-bufs))
686            (set-marker he-search-loc 1 (car he-search-bufs)))))
687
688    (set-buffer buf)
689    (if (not expansion)
690	(progn
691          (if old (he-reset-string))
692	  ())
693	(progn
694	  (he-substitute-string expansion t)
695	  t))))
696
697(defun he-list-search (str reverse)
698  (let ((result ())
699        beg pos err)
700    (while (and (not result)
701		(if reverse
702		    (search-backward str nil t)
703		    (search-forward str nil t)))
704      (setq pos (point))
705      (setq beg (match-beginning 0))
706      (goto-char beg)
707      (setq err ())
708      (condition-case ()
709          (forward-list 1)
710        (error (setq err t)))
711      (if (and reverse
712               (> (point) he-string-beg))
713          (setq err t))
714      (if (not err)
715          (progn
716            (setq result (buffer-substring beg (point)))
717            (if (he-string-member result he-tried-table)
718                (setq result nil))))	       ; if already in table, ignore
719      (goto-char pos))
720    result))
721
722(defun he-list-beg ()
723  (save-excursion
724    (condition-case ()
725        (backward-up-list 1)
726      (error ()))
727    (point)))
728
729(defun try-expand-all-abbrevs (old)
730  "Try to expand word before point according to all abbrev tables.
731The argument OLD has to be nil the first call of this function, and t
732for subsequent calls (for further possible expansions of the same
733string).  It returns t if a new expansion is found, nil otherwise."
734  (if (not old)
735      (progn
736	(he-init-string (he-dabbrev-beg) (point))
737	(setq he-expand-list
738	      (and (not (equal he-search-string ""))
739		   (mapcar (function (lambda (sym)
740			     (abbrev-expansion (downcase he-search-string)
741					       (eval sym))))
742			   (append '(local-abbrev-table
743				     global-abbrev-table)
744				   abbrev-table-name-list))))))
745  (while (and he-expand-list
746	      (or (not (car he-expand-list))
747		  (he-string-member (car he-expand-list) he-tried-table)))
748    (setq he-expand-list (cdr he-expand-list)))
749  (if (null he-expand-list)
750      (progn
751        (if old (he-reset-string))
752	())
753      (progn
754	(he-substitute-string (car he-expand-list) t)
755	(setq he-tried-table (cons (car he-expand-list) he-tried-table))
756	(setq he-expand-list (cdr he-expand-list))
757	t)))
758
759(defun try-expand-dabbrev (old)
760  "Try to expand word \"dynamically\", searching the current buffer.
761The argument OLD has to be nil the first call of this function, and t
762for subsequent calls (for further possible expansions of the same
763string).  It returns t if a new expansion is found, nil otherwise."
764  (let ((expansion ()))
765    (if (not old)
766	(progn
767	  (he-init-string (he-dabbrev-beg) (point))
768	  (set-marker he-search-loc he-string-beg)
769	  (setq he-search-bw t)))
770
771    (if (not (equal he-search-string ""))
772	(save-excursion
773	  ;; Try looking backward unless inhibited.
774	  (if he-search-bw
775	      (progn
776		(goto-char he-search-loc)
777		(setq expansion (he-dab-search he-search-string t))
778		(set-marker he-search-loc (point))
779		(if (not expansion)
780		    (progn
781		      (set-marker he-search-loc he-string-end)
782		      (setq he-search-bw ())))))
783
784	  (if (not expansion) ; Then look forward.
785	      (progn
786		(goto-char he-search-loc)
787		(setq expansion (he-dab-search he-search-string nil))
788		(set-marker he-search-loc (point))))))
789
790    (if (not expansion)
791	(progn
792          (if old (he-reset-string))
793	  ())
794	(progn
795	  (he-substitute-string expansion t)
796	  (setq he-tried-table (cons expansion he-tried-table))
797	  t))))
798
799(defun try-expand-dabbrev-all-buffers (old)
800  "Tries to expand word \"dynamically\", searching all other buffers.
801The argument OLD has to be nil the first call of this function, and t
802for subsequent calls (for further possible expansions of the same
803string).  It returns t if a new expansion is found, nil otherwise."
804  (let ((expansion ())
805	(buf (current-buffer)))
806    (if (not old)
807	(progn
808	  (he-init-string (he-dabbrev-beg) (point))
809	  (setq he-search-bufs (buffer-list))
810          (setq he-searched-n-bufs 0)
811	  (set-marker he-search-loc 1 (car he-search-bufs))))
812
813    (if (not (equal he-search-string ""))
814	(while (and he-search-bufs
815                    (not expansion)
816                    (or (not hippie-expand-max-buffers)
817                        (< he-searched-n-bufs hippie-expand-max-buffers)))
818	  (set-buffer (car he-search-bufs))
819	  (if (and (not (eq (current-buffer) buf))
820		   (not (memq major-mode hippie-expand-ignore-buffers))
821                   (not (he-regexp-member (buffer-name)
822                                          hippie-expand-ignore-buffers)))
823	      (save-excursion
824		(goto-char he-search-loc)
825		(setq expansion (he-dab-search he-search-string nil))
826		(set-marker he-search-loc (point))
827                (if expansion
828                    (setq he-tried-table (cons expansion he-tried-table))
829                  (setq he-search-bufs (cdr he-search-bufs))
830                  (setq he-searched-n-bufs (1+ he-searched-n-bufs))
831                  (set-marker he-search-loc 1 (car he-search-bufs))))
832            (setq he-search-bufs (cdr he-search-bufs))
833            (set-marker he-search-loc 1 (car he-search-bufs)))))
834
835    (set-buffer buf)
836    (if (not expansion)
837	(progn
838          (if old (he-reset-string))
839	  ())
840	(progn
841	  (he-substitute-string expansion t)
842	  t))))
843
844(defun he-dab-search-regexp (pat)
845  (concat "\\<" (regexp-quote pat)
846	  "\\(\\sw\\|\\s_\\)+"))
847
848(defun he-dab-search (pattern reverse)
849  (let ((result ()))
850    (while (and (not result)
851		(if reverse
852		     (re-search-backward (he-dab-search-regexp pattern)
853					 nil t)
854		     (re-search-forward (he-dab-search-regexp pattern)
855					nil t)))
856      (setq result (buffer-substring (match-beginning 0) (match-end 0)))
857      (if (he-string-member result he-tried-table)
858	  (setq result nil)))	            ; if already in table, ignore
859    result))
860
861(defun he-dabbrev-beg ()
862  (min (point)
863       (save-excursion
864         (skip-syntax-backward "w_")
865         (skip-syntax-forward "_")
866         (point))))
867
868(provide 'hippie-exp)
869
870;;; hippie-exp.el ends here
871