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