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