Removed auto-mode-alist hacking for html-mode to files.el.
[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>
510cbc92
RS
4;; Last change: 6 August 1995
5;; Version: 1.4
d1d1ddbd 6;; Keywords: abbrev
3b1e4dd1 7
510cbc92 8;; Copyright (C) 1992 Free Software Foundation, Inc.
652304c9
RS
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.
d1d1ddbd 39;;
652304c9
RS
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).
8c6677ed
JB
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".
d1d1ddbd
RS
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".
652304c9
RS
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.
652304c9
RS
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
8c6677ed 67;; list in shell-like buffers. At other times, only confusing.
652304c9
RS
68;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches
69;; in all buffers (except the current). (This may be a little
8c6677ed
JB
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).
652304c9
RS
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.)
510cbc92
RS
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".
652304c9
RS
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
8c6677ed
JB
99;; completion of what is unique in the name.
100;;
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).
652304c9
RS
111;;
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
510cbc92 136;; (hint: `he-string-member').
652304c9 137;;
8c6677ed 138;; Known bugs
652304c9
RS
139;;
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
510cbc92
RS
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
652304c9
RS
146;; opposite situation to occur, that `hippie-expand' misses some
147;; suggestion because it thinks it has already tried it.
148;;
8c6677ed 149;; Acknowledgement
652304c9
RS
150;;
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
510cbc92 154;; how to improve it, and all those who helped to find and remove bugs.
652304c9
RS
155;;
156
76550a57 157;;; Code:
652304c9
RS
158
159(defvar he-num -1)
160
8c6677ed 161(defvar he-string-beg (make-marker))
652304c9 162
8c6677ed 163(defvar he-string-end (make-marker))
652304c9
RS
164
165(defvar he-search-string ())
166
167(defvar he-expand-list ())
168
169(defvar he-tried-table ())
170
8c6677ed 171(defvar he-search-loc (make-marker))
652304c9 172
510cbc92
RS
173(defvar he-search-loc2 ())
174
652304c9
RS
175(defvar he-search-bw ())
176
177(defvar he-search-bufs ())
178
8c6677ed
JB
179(defvar he-searched-n-bufs ())
180
510cbc92
RS
181(defvar he-search-window ())
182
8c6677ed 183;;;###autoload
510cbc92
RS
184(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially
185 try-complete-file-name
652304c9 186 try-expand-all-abbrevs
510cbc92 187 try-expand-list
652304c9
RS
188 try-expand-line
189 try-expand-dabbrev
190 try-expand-dabbrev-all-buffers
510cbc92
RS
191 try-expand-dabbrev-from-kill
192 try-complete-lisp-symbol-partially
652304c9
RS
193 try-complete-lisp-symbol)
194 "The list of expansion functions tried in order by `hippie-expand'.
195To change the behavior of `hippie-expand', remove, change the order of,
196or insert functions in this list.")
197
8c6677ed 198;;;###autoload
652304c9
RS
199(defvar hippie-expand-verbose t
200 "*Non-nil makes `hippie-expand' output which function it is trying.")
201
8c6677ed
JB
202;;;###autoload
203(defvar hippie-expand-max-buffers ()
204 "*The maximum number of buffers (apart from the current) searched.
205If nil, all buffers are searched.")
206
d1d1ddbd
RS
207;;;###autoload
208(defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
209 "*A list specifying which buffers not to search (if not current).
210Can contain both regexps matching buffer names (as strings) and major modes
a4e104bf 211\(as atoms)")
d1d1ddbd 212
8c6677ed 213;;;###autoload
652304c9
RS
214(defun hippie-expand (arg)
215 "Try to expand text before point, using multiple methods.
216The expansion functions in `hippie-expand-try-functions-list' are
217tried in order, until a possible expansion is found. Repeated
218application of `hippie-expand' inserts successively possible
219expansions.
220With a positive numeric argument, jumps directly to the ARG next
221function in this list. With a negative argument or just \\[universal-argument],
222undoes 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))
8c6677ed 248 (if (and hippie-expand-verbose
510cbc92 249 (not (window-minibuffer-p (selected-window))))
652304c9
RS
250 (message (concat "Using "
251 (prin1-to-string (nth he-num
252 hippie-expand-try-functions-list)))))))
510cbc92
RS
253 (if (and (>= he-num 0)
254 (eq (marker-buffer he-string-beg) (current-buffer)))
652304c9
RS
255 (progn
256 (setq he-num -1)
257 (he-reset-string)
8c6677ed 258 (if (and hippie-expand-verbose
510cbc92 259 (not (window-minibuffer-p (selected-window))))
652304c9 260 (message "Undoing expansions"))))))
8c6677ed 261
652304c9
RS
262;; Initializes the region to expand (to between BEG and END).
263(defun he-init-string (beg end)
8c6677ed
JB
264 (set-marker he-string-beg beg)
265 (set-marker he-string-end end)
652304c9
RS
266 (setq he-search-string (buffer-substring beg end)))
267
268;; Resets the expanded region to its original contents.
269(defun he-reset-string ()
8c6677ed 270 (let ((newpos (point-marker)))
8c6677ed
JB
271 (goto-char he-string-beg)
272 (insert he-search-string)
510cbc92
RS
273 (delete-region (point) he-string-end)
274 (goto-char newpos)))
652304c9
RS
275
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
510cbc92
RS
284 case-fold-search))
285 (newpos (point-marker))
286 (subst ()))
652304c9 287 (goto-char he-string-beg)
510cbc92
RS
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)))
293
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)))
652304c9
RS
302
303(defun he-ordinary-case-p (str)
304 (or (string= str (downcase str))
305 (string= str (upcase str))
510cbc92
RS
306 (string= str (capitalize str))
307 (string= str (he-capitalize-first str))))
308
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))
8d392c8e 314 to-str)
510cbc92
RS
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))
323 (t
324 to-str)))
325
652304c9
RS
326
327;; Check if STR is a member of LST.
510cbc92
RS
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)))
652304c9 337
d1d1ddbd
RS
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)))
510cbc92 343 (not (string-match (car lst) str))))
d1d1ddbd
RS
344 (setq lst (cdr lst)))
345 lst)
346
652304c9
RS
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)))
357;;
8c6677ed 358;;;###autoload
652304c9
RS
359(defmacro make-hippie-expand-function (try-list &optional verbose)
360 "Construct a function similar to `hippie-expand'.
361Make it use the expansion functions in TRY-LIST. An optional second
362argument VERBOSE non-nil makes the function verbose."
8c6677ed 363 (` (function (lambda (arg)
652304c9 364 (, (concat
510cbc92 365 "Try to expand text before point, using the following functions: \n"
652304c9
RS
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)))
8c6677ed 370 (hippie-expand arg))))))
652304c9
RS
371
372
373;;; Here follows the try-functions and their requisites:
374
510cbc92 375
652304c9
RS
376(defun try-complete-file-name (old)
377 "Try to complete text as a file name.
378The argument OLD has to be nil the first call of this function, and t
379for subsequent calls (for further possible completions of the same
380string). 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))
510cbc92
RS
384 (let ((name-part (he-file-name-nondirectory he-search-string))
385 (dir-part (expand-file-name (or (he-file-name-directory
652304c9
RS
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 ""))
510cbc92 390 (he-file-directory-p dir-part))
652304c9
RS
391 (setq he-expand-list (sort (file-name-all-completions
392 name-part
393 dir-part)
394 'string-lessp))
395 (setq he-expand-list ())))))
396
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
510cbc92 402 (if old (he-reset-string))
652304c9 403 ())
510cbc92
RS
404 (let ((filename (he-concat-directory-file-name
405 (he-file-name-directory he-search-string)
406 (car he-expand-list))))
652304c9 407 (he-substitute-string filename)
510cbc92 408 (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
652304c9
RS
409 (setq he-expand-list (cdr he-expand-list))
410 t)))
411
412(defun try-complete-file-name-partially (old)
413 "Try to complete text as a file name, as many characters as unique.
414The argument OLD has to be nil the first call of this function. It
415returns t if a unique, possibly partial, completion is found, nil
416otherwise."
417 (let ((expansion ()))
418 (if (not old)
419 (progn
420 (he-init-string (he-file-name-beg) (point))
510cbc92
RS
421 (let ((name-part (he-file-name-nondirectory he-search-string))
422 (dir-part (expand-file-name (or (he-file-name-directory
652304c9
RS
423 he-search-string) ""))))
424 (if (and (not (equal he-search-string ""))
510cbc92 425 (he-file-directory-p dir-part))
652304c9
RS
426 (setq expansion (file-name-completion name-part
427 dir-part)))
428 (if (or (eq expansion t)
510cbc92
RS
429 (string= expansion name-part)
430 (he-string-member expansion he-tried-table))
652304c9
RS
431 (setq expansion ())))))
432
433 (if (not expansion)
434 (progn
510cbc92 435 (if old (he-reset-string))
652304c9 436 ())
510cbc92
RS
437 (let ((filename (he-concat-directory-file-name
438 (he-file-name-directory he-search-string)
439 expansion)))
652304c9 440 (he-substitute-string filename)
510cbc92 441 (setq he-tried-table (cons expansion (cdr he-tried-table)))
652304c9
RS
442 t))))
443
510cbc92
RS
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.")
452
652304c9 453(defun he-file-name-beg ()
510cbc92
RS
454 (save-excursion
455 (skip-chars-backward he-file-name-chars)
456 (point)))
652304c9 457
510cbc92
RS
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)))
467 n))
468 (file-name-nondirectory file)))
469
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)) "]")
477 d))
478 (file-name-directory file)))
479
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)))
486
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))
500 (t
501 (concat dir-part name-part))))
502
652304c9
RS
503(defun try-complete-lisp-symbol (old)
504 "Try to complete word as an Emacs Lisp symbol.
505The argument OLD has to be nil the first call of this function, and t
506for subsequent calls (for further possible completions of the same
507string). 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
510cbc92 526 (if old (he-reset-string))
652304c9
RS
527 ())
528 (progn
529 (he-substitute-string (car he-expand-list))
652304c9
RS
530 (setq he-expand-list (cdr he-expand-list))
531 t)))
532
533(defun try-complete-lisp-symbol-partially (old)
534 "Try to complete as an Emacs Lisp symbol, as many characters as unique.
535The argument OLD has to be nil the first call of this function. It
536returns t if a unique, possibly partial, completion is found, nil
537otherwise."
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)
510cbc92
RS
550 (string= expansion he-search-string)
551 (he-string-member expansion he-tried-table))
652304c9
RS
552 (setq expansion ()))))
553
554 (if (not expansion)
555 (progn
510cbc92 556 (if old (he-reset-string))
652304c9
RS
557 ())
558 (progn
559 (he-substitute-string expansion)
652304c9
RS
560 t))))
561
562(defun he-lisp-symbol-beg ()
563 (let ((skips "-a-zA-Z0-9_."))
564 (save-excursion
565 (skip-chars-backward skips)
566 (point))))
567
568(defun try-expand-line (old)
569 "Try to complete the current line to an entire line in the buffer.
570The argument OLD has to be nil the first call of this function, and t
571for subsequent calls (for further possible completions of the same
572string). It returns t if a new completion is found, nil otherwise."
573 (let ((expansion ())
574 (strip-prompt (and (get-buffer-process (current-buffer))
8c6677ed 575 comint-prompt-regexp)))
652304c9
RS
576 (if (not old)
577 (progn
578 (he-init-string (he-line-beg strip-prompt) (point))
8c6677ed 579 (set-marker he-search-loc he-string-beg)
652304c9
RS
580 (setq he-search-bw t)))
581
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))
8c6677ed 590 (set-marker he-search-loc (point))
652304c9
RS
591 (if (not expansion)
592 (progn
8c6677ed 593 (set-marker he-search-loc he-string-end)
652304c9
RS
594 (setq he-search-bw ())))))
595
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))
8c6677ed 601 (set-marker he-search-loc (point))))))
652304c9
RS
602
603 (if (not expansion)
604 (progn
510cbc92 605 (if old (he-reset-string))
652304c9
RS
606 ())
607 (progn
608 (he-substitute-string expansion t)
652304c9
RS
609 t))))
610
611(defun try-expand-line-all-buffers (old)
612 "Try to complete the current line, searching all other buffers.
613The argument OLD has to be nil the first call of this function, and t
614for subsequent calls (for further possible completions of the same
615string). It returns t if a new completion is found, nil otherwise."
616 (let ((expansion ())
617 (strip-prompt (and (get-buffer-process (current-buffer))
8c6677ed 618 comint-prompt-regexp))
510cbc92
RS
619 (buf (current-buffer))
620 (orig-case-fold-search case-fold-search))
652304c9
RS
621 (if (not old)
622 (progn
623 (he-init-string (he-line-beg strip-prompt) (point))
8c6677ed 624 (setq he-search-bufs (buffer-list))
510cbc92 625 (setq he-searched-n-bufs 0)
8c6677ed 626 (set-marker he-search-loc 1 (car he-search-bufs))))
652304c9
RS
627
628 (if (not (equal he-search-string ""))
8c6677ed 629 (while (and he-search-bufs
510cbc92
RS
630 (not expansion)
631 (or (not hippie-expand-max-buffers)
632 (< he-searched-n-bufs hippie-expand-max-buffers)))
652304c9
RS
633 (set-buffer (car he-search-bufs))
634 (if (and (not (eq (current-buffer) buf))
d1d1ddbd 635 (not (memq major-mode hippie-expand-ignore-buffers))
510cbc92
RS
636 (not (he-regexp-member (buffer-name)
637 hippie-expand-ignore-buffers)))
652304c9
RS
638 (save-excursion
639 (goto-char he-search-loc)
510cbc92
RS
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)))
8c6677ed 645 (set-marker he-search-loc (point))
510cbc92
RS
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)))))
652304c9
RS
653
654 (set-buffer buf)
655 (if (not expansion)
656 (progn
510cbc92 657 (if old (he-reset-string))
652304c9
RS
658 ())
659 (progn
660 (he-substitute-string expansion t)
661 t))))
662
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)))
510cbc92
RS
674 (if (he-string-member result he-tried-table t)
675 (setq result nil))) ; if already in table, ignore
652304c9
RS
676 result))
677
678(defun he-line-beg (strip-prompt)
679 (save-excursion
652304c9
RS
680 (if (re-search-backward (he-line-search-regexp "" strip-prompt)
681 (save-excursion (beginning-of-line)
682 (point)) t)
683 (match-beginning 2)
652304c9
RS
684 (point))))
685
686(defun he-line-search-regexp (pat strip-prompt)
687 (if strip-prompt
8c6677ed 688 (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
652304c9
RS
689 (regexp-quote pat)
690 "[^\n]*[^ \t\n]\\)")
691 (concat "^\\(\\s-*\\)\\("
692 (regexp-quote pat)
693 "[^\n]*[^ \t\n]\\)")))
694
8c6677ed
JB
695(defun try-expand-list (old)
696 "Try to complete the current beginning of a list.
697The argument OLD has to be nil the first call of this function, and t
698for subsequent calls (for further possible completions of the same
699string). 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)))
706
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 ())))))
719
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))))))
725
726 (if (not expansion)
727 (progn
728 (if old (he-reset-string))
729 ())
730 (progn
731 (he-substitute-string expansion t)
8c6677ed
JB
732 t))))
733
734(defun try-expand-list-all-buffers (old)
735 "Try to complete the current list, searching all other buffers.
736The argument OLD has to be nil the first call of this function, and t
737for subsequent calls (for further possible completions of the same
738string). It returns t if a new completion is found, nil otherwise."
739 (let ((expansion ())
510cbc92
RS
740 (buf (current-buffer))
741 (orig-case-fold-search case-fold-search))
8c6677ed
JB
742 (if (not old)
743 (progn
744 (he-init-string (he-list-beg) (point))
745 (setq he-search-bufs (buffer-list))
510cbc92 746 (setq he-searched-n-bufs 0)
8c6677ed
JB
747 (set-marker he-search-loc 1 (car he-search-bufs))))
748
749 (if (not (equal he-search-string ""))
750 (while (and he-search-bufs
510cbc92
RS
751 (not expansion)
752 (or (not hippie-expand-max-buffers)
753 (< he-searched-n-bufs hippie-expand-max-buffers)))
8c6677ed
JB
754 (set-buffer (car he-search-bufs))
755 (if (and (not (eq (current-buffer) buf))
d1d1ddbd 756 (not (memq major-mode hippie-expand-ignore-buffers))
510cbc92
RS
757 (not (he-regexp-member (buffer-name)
758 hippie-expand-ignore-buffers)))
8c6677ed
JB
759 (save-excursion
760 (goto-char he-search-loc)
510cbc92
RS
761 (setq expansion (let ((case-fold-search orig-case-fold-search))
762 (he-list-search he-search-string nil)))
8c6677ed 763 (set-marker he-search-loc (point))
510cbc92
RS
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)))))
8c6677ed
JB
771
772 (set-buffer buf)
773 (if (not expansion)
774 (progn
510cbc92 775 (if old (he-reset-string))
8c6677ed
JB
776 ())
777 (progn
778 (he-substitute-string expansion t)
779 t))))
780
781(defun he-list-search (str reverse)
782 (let ((result ())
510cbc92 783 beg pos err)
8c6677ed
JB
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 ()
510cbc92
RS
793 (forward-list 1)
794 (error (setq err t)))
d1d1ddbd 795 (if (and reverse
510cbc92
RS
796 (> (point) he-string-beg))
797 (setq err t))
8c6677ed 798 (if (not err)
510cbc92
RS
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
8c6677ed
JB
803 (goto-char pos))
804 result))
805
806(defun he-list-beg ()
807 (save-excursion
808 (condition-case ()
510cbc92 809 (backward-up-list 1)
8c6677ed
JB
810 (error ()))
811 (point)))
812
652304c9
RS
813(defun try-expand-all-abbrevs (old)
814 "Try to expand word before point according to all abbrev tables.
815The argument OLD has to be nil the first call of this function, and t
816for subsequent calls (for further possible expansions of the same
817string). 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)
510cbc92
RS
824 (if (and (boundp sym) (vectorp (eval sym)))
825 (abbrev-expansion (downcase he-search-string)
826 (eval sym)))))
652304c9
RS
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))
510cbc92 832 (he-string-member (car he-expand-list) he-tried-table t)))
652304c9
RS
833 (setq he-expand-list (cdr he-expand-list)))
834 (if (null he-expand-list)
835 (progn
510cbc92 836 (if old (he-reset-string))
652304c9
RS
837 ())
838 (progn
8c6677ed 839 (he-substitute-string (car he-expand-list) t)
652304c9
RS
840 (setq he-expand-list (cdr he-expand-list))
841 t)))
842
843(defun try-expand-dabbrev (old)
844 "Try to expand word \"dynamically\", searching the current buffer.
845The argument OLD has to be nil the first call of this function, and t
846for subsequent calls (for further possible expansions of the same
847string). 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))
8c6677ed 852 (set-marker he-search-loc he-string-beg)
652304c9
RS
853 (setq he-search-bw t)))
854
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)
510cbc92 861 (setq expansion (he-dabbrev-search he-search-string t))
8c6677ed 862 (set-marker he-search-loc (point))
652304c9
RS
863 (if (not expansion)
864 (progn
8c6677ed 865 (set-marker he-search-loc he-string-end)
652304c9
RS
866 (setq he-search-bw ())))))
867
868 (if (not expansion) ; Then look forward.
869 (progn
870 (goto-char he-search-loc)
510cbc92 871 (setq expansion (he-dabbrev-search he-search-string nil))
8c6677ed 872 (set-marker he-search-loc (point))))))
652304c9
RS
873
874 (if (not expansion)
875 (progn
510cbc92 876 (if old (he-reset-string))
652304c9
RS
877 ())
878 (progn
879 (he-substitute-string expansion t)
652304c9
RS
880 t))))
881
882(defun try-expand-dabbrev-all-buffers (old)
883 "Tries to expand word \"dynamically\", searching all other buffers.
884The argument OLD has to be nil the first call of this function, and t
885for subsequent calls (for further possible expansions of the same
886string). It returns t if a new expansion is found, nil otherwise."
887 (let ((expansion ())
510cbc92
RS
888 (buf (current-buffer))
889 (orig-case-fold-search case-fold-search))
652304c9
RS
890 (if (not old)
891 (progn
892 (he-init-string (he-dabbrev-beg) (point))
8c6677ed 893 (setq he-search-bufs (buffer-list))
510cbc92 894 (setq he-searched-n-bufs 0)
8c6677ed 895 (set-marker he-search-loc 1 (car he-search-bufs))))
652304c9
RS
896
897 (if (not (equal he-search-string ""))
8c6677ed 898 (while (and he-search-bufs
510cbc92
RS
899 (not expansion)
900 (or (not hippie-expand-max-buffers)
901 (< he-searched-n-bufs hippie-expand-max-buffers)))
652304c9
RS
902 (set-buffer (car he-search-bufs))
903 (if (and (not (eq (current-buffer) buf))
d1d1ddbd 904 (not (memq major-mode hippie-expand-ignore-buffers))
510cbc92
RS
905 (not (he-regexp-member (buffer-name)
906 hippie-expand-ignore-buffers)))
652304c9
RS
907 (save-excursion
908 (goto-char he-search-loc)
510cbc92
RS
909 (setq expansion (let ((case-fold-search orig-case-fold-search))
910 (he-dabbrev-search he-search-string nil)))
8c6677ed 911 (set-marker he-search-loc (point))
510cbc92
RS
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)))))
652304c9
RS
919
920 (set-buffer buf)
921 (if (not expansion)
922 (progn
510cbc92 923 (if old (he-reset-string))
652304c9
RS
924 ())
925 (progn
926 (he-substitute-string expansion t)
927 t))))
928
510cbc92
RS
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.
933The argument OLD has to be nil the first call of this function, and t
934for subsequent calls (for further possible expansions of the same
935string). 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))))
947
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))))))
969
970 (set-buffer buf)
971 (if (not expansion)
972 (progn
973 (if old (he-reset-string))
974 ())
975 (progn
976 (he-substitute-string expansion t)
977 t))))
652304c9 978
510cbc92
RS
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_\\)+"))))
652304c9
RS
984 (while (and (not result)
985 (if reverse
510cbc92
RS
986 (re-search-backward regpat limit t)
987 (re-search-forward regpat limit t)))
652304c9 988 (setq result (buffer-substring (match-beginning 0) (match-end 0)))
510cbc92
RS
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
652304c9
RS
994 result))
995
510cbc92
RS
996(defvar he-dabbrev-skip-space ()
997 "Non-NIL means tolerate trailing spaces in the abbreviation to expand.")
998
652304c9 999(defun he-dabbrev-beg ()
510cbc92
RS
1000 (let ((op (point)))
1001 (save-excursion
1002 (if he-dabbrev-skip-space
1003 (skip-syntax-backward ". "))
1004 (if (= (skip-syntax-backward "w_") 0)
1005 op
1006 (point)))))
1007
1008(defun try-expand-dabbrev-from-kill (old)
1009 "Try to expand word \"dynamically\", searching the kill ring.
1010The argument OLD has to be nil the first call of this function, and t
1011for subsequent calls (for further possible completions of the same
1012string). 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))
1026 ())
1027 (progn
1028 (he-substitute-string expansion t)
1029 t))))
1030
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))
1055
1056(defun try-expand-whole-kill (old)
1057 "Try to complete text with something from the kill ring.
1058The argument OLD has to be nil the first call of this function, and t
1059for subsequent calls (for further possible completions of the same
1060string). 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))
1076 ())
1077 (progn
1078 (he-substitute-string expansion)
1079 t))))
1080
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))
1113
1114(defun he-kill-beg ()
1115 (let ((op (point)))
1116 (save-excursion
1117 (skip-syntax-backward "^w_")
1118 (if (= (skip-syntax-backward "w_") 0)
1119 op
1120 (point)))))
1121
8c6677ed
JB
1122
1123(provide 'hippie-exp)
652304c9 1124
8c6677ed 1125;;; hippie-exp.el ends here