Etags.el change moved. Add dired-aux change.
[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
ddb6e2e2
DL
171(eval-when-compile (require 'comint))
172
94114394
RS
173(defgroup hippie-expand nil
174 "Expand text trying various ways to find its expansion."
ddb6e2e2
DL
175 :link '(custom-manual "(autotype)Hippie Expand")
176 :link '(emacs-commentary-link "hippie-exp")
f5f727f8
DN
177 :group 'abbrev
178 :group 'convenience)
94114394 179
652304c9
RS
180(defvar he-num -1)
181
8c6677ed 182(defvar he-string-beg (make-marker))
652304c9 183
8c6677ed 184(defvar he-string-end (make-marker))
652304c9
RS
185
186(defvar he-search-string ())
187
188(defvar he-expand-list ())
189
190(defvar he-tried-table ())
191
8c6677ed 192(defvar he-search-loc (make-marker))
652304c9 193
510cbc92
RS
194(defvar he-search-loc2 ())
195
652304c9
RS
196(defvar he-search-bw ())
197
198(defvar he-search-bufs ())
199
8c6677ed
JB
200(defvar he-searched-n-bufs ())
201
510cbc92
RS
202(defvar he-search-window ())
203
8c6677ed 204;;;###autoload
ddb6e2e2
DL
205(defcustom hippie-expand-try-functions-list
206 '(try-complete-file-name-partially
207 try-complete-file-name
208 try-expand-all-abbrevs
209 try-expand-list
210 try-expand-line
211 try-expand-dabbrev
212 try-expand-dabbrev-all-buffers
213 try-expand-dabbrev-from-kill
214 try-complete-lisp-symbol-partially
215 try-complete-lisp-symbol)
652304c9
RS
216 "The list of expansion functions tried in order by `hippie-expand'.
217To change the behavior of `hippie-expand', remove, change the order of,
ddb6e2e2
DL
218or insert functions in this list."
219 :type '(repeat function)
220 :group 'hippie-expand)
652304c9 221
8c6677ed 222;;;###autoload
94114394
RS
223(defcustom hippie-expand-verbose t
224 "*Non-nil makes `hippie-expand' output which function it is trying."
225 :type 'boolean
226 :group 'hippie-expand)
652304c9 227
41b8e71c
RS
228;;;###autoload
229(defcustom hippie-expand-dabbrev-skip-space nil
230 "*Non-nil means tolerate trailing spaces in the abbreviation to expand."
231 :group 'hippie-expand
232 :type 'boolean)
233
234;;;###autoload
235(defcustom hippie-expand-dabbrev-as-symbol t
236 "*Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
237 :group 'hippie-expand
238 :type 'boolean)
239
240;;;###autoload
241(defcustom hippie-expand-no-restriction t
242 "*Non-nil means that narrowed buffers are widened during search."
243 :group 'hippie-expand
244 :type 'boolean)
245
8c6677ed 246;;;###autoload
94114394 247(defcustom hippie-expand-max-buffers ()
8c6677ed 248 "*The maximum number of buffers (apart from the current) searched.
94114394
RS
249If nil, all buffers are searched."
250 :type '(choice (const :tag "All" nil)
251 integer)
252 :group 'hippie-expand)
8c6677ed 253
d1d1ddbd 254;;;###autoload
94114394 255(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
d1d1ddbd
RS
256 "*A list specifying which buffers not to search (if not current).
257Can contain both regexps matching buffer names (as strings) and major modes
94114394
RS
258\(as atoms)"
259 :type '(repeat (choice regexp (symbol :tag "Major Mode")))
260 :group 'hippie-expand)
d1d1ddbd 261
41b8e71c
RS
262;;;###autoload
263(defcustom hippie-expand-only-buffers ()
264 "*A list specifying the only buffers to search (in addition to current).
265Can contain both regexps matching buffer names (as strings) and major modes
266\(as atoms). If non-NIL, this variable overrides the variable
267`hippie-expand-ignore-buffers'."
268 :type '(repeat (choice regexp (symbol :tag "Major Mode")))
269 :group 'hippie-expand)
270
8c6677ed 271;;;###autoload
652304c9
RS
272(defun hippie-expand (arg)
273 "Try to expand text before point, using multiple methods.
274The expansion functions in `hippie-expand-try-functions-list' are
275tried in order, until a possible expansion is found. Repeated
276application of `hippie-expand' inserts successively possible
277expansions.
278With a positive numeric argument, jumps directly to the ARG next
279function in this list. With a negative argument or just \\[universal-argument],
280undoes the expansion."
281 (interactive "P")
282 (if (or (not arg)
283 (and (integerp arg) (> arg 0)))
284 (let ((first (or (= he-num -1)
285 (not (equal this-command last-command)))))
286 (if first
287 (progn
288 (setq he-num -1)
289 (setq he-tried-table nil)))
290 (if arg
291 (if (not first) (he-reset-string))
292 (setq arg 0))
293 (let ((i (max (+ he-num arg) 0)))
294 (while (not (or (>= i (length hippie-expand-try-functions-list))
295 (apply (nth i hippie-expand-try-functions-list)
296 (list (= he-num i)))))
297 (setq i (1+ i)))
298 (setq he-num i))
299 (if (>= he-num (length hippie-expand-try-functions-list))
300 (progn
301 (setq he-num -1)
302 (if first
303 (message "No expansion found")
304 (message "No further expansions found"))
305 (ding))
8c6677ed 306 (if (and hippie-expand-verbose
510cbc92 307 (not (window-minibuffer-p (selected-window))))
32561aba 308 (message "Using %s"
41b8e71c 309 (nth he-num hippie-expand-try-functions-list)))))
510cbc92
RS
310 (if (and (>= he-num 0)
311 (eq (marker-buffer he-string-beg) (current-buffer)))
652304c9
RS
312 (progn
313 (setq he-num -1)
314 (he-reset-string)
8c6677ed 315 (if (and hippie-expand-verbose
510cbc92 316 (not (window-minibuffer-p (selected-window))))
652304c9 317 (message "Undoing expansions"))))))
8c6677ed 318
652304c9
RS
319;; Initializes the region to expand (to between BEG and END).
320(defun he-init-string (beg end)
8c6677ed
JB
321 (set-marker he-string-beg beg)
322 (set-marker he-string-end end)
41b8e71c 323 (setq he-search-string (buffer-substring-no-properties beg end)))
652304c9
RS
324
325;; Resets the expanded region to its original contents.
326(defun he-reset-string ()
8c6677ed 327 (let ((newpos (point-marker)))
8c6677ed
JB
328 (goto-char he-string-beg)
329 (insert he-search-string)
510cbc92
RS
330 (delete-region (point) he-string-end)
331 (goto-char newpos)))
652304c9
RS
332
333;; Substitutes an expansion STR into the correct region (the region
334;; initialized with `he-init-string').
335;; An optional argument TRANS-CASE means that it is ok to transfer case
336;; from the abbreviation to the expansion if that is possible, and is
337;; enabled in the buffer.
338(defun he-substitute-string (str &optional trans-case)
339 (let ((trans-case (and trans-case
340 case-replace
510cbc92
RS
341 case-fold-search))
342 (newpos (point-marker))
343 (subst ()))
652304c9 344 (goto-char he-string-beg)
510cbc92
RS
345 (setq subst (if trans-case (he-transfer-case he-search-string str) str))
346 (setq he-tried-table (cons subst he-tried-table))
347 (insert subst)
348 (delete-region (point) he-string-end)
349 (goto-char newpos)))
350
351(defun he-capitalize-first (str)
352 (save-match-data
353 (if (string-match "\\Sw*\\(\\sw\\).*" str)
354 (let ((res (downcase str))
355 (no (match-beginning 1)))
356 (aset res no (upcase (aref str no)))
357 res)
358 str)))
652304c9
RS
359
360(defun he-ordinary-case-p (str)
361 (or (string= str (downcase str))
362 (string= str (upcase str))
510cbc92
RS
363 (string= str (capitalize str))
364 (string= str (he-capitalize-first str))))
365
366(defun he-transfer-case (from-str to-str)
367 (cond ((string= from-str (substring to-str 0 (min (length from-str)
368 (length to-str))))
369 to-str)
370 ((not (he-ordinary-case-p to-str))
8d392c8e 371 to-str)
510cbc92
RS
372 ((string= from-str (downcase from-str))
373 (downcase to-str))
374 ((string= from-str (upcase from-str))
375 (upcase to-str))
376 ((string= from-str (he-capitalize-first from-str))
377 (he-capitalize-first to-str))
378 ((string= from-str (capitalize from-str))
379 (capitalize to-str))
380 (t
381 to-str)))
382
652304c9
RS
383
384;; Check if STR is a member of LST.
510cbc92
RS
385;; Transform to the final case if optional TRANS-CASE is non-NIL.
386(defun he-string-member (str lst &optional trans-case)
387 (if str
388 (member (if (and trans-case
389 case-replace
390 case-fold-search)
391 (he-transfer-case he-search-string str)
392 str)
393 lst)))
652304c9 394
41b8e71c
RS
395;; Check if current buffer matches any atom or regexp in LST.
396;; Atoms are interpreted as major modes, strings as regexps mathing the name.
397(defun he-buffer-member (lst)
398 (or (memq major-mode lst)
399 (progn
400 (while (and lst
401 (or (not (stringp (car lst)))
402 (not (string-match (car lst) (buffer-name)))))
403 (setq lst (cdr lst)))
404 lst)))
d1d1ddbd 405
652304c9
RS
406;; For the real hippie-expand enthusiast: A macro that makes it
407;; possible to use many functions like hippie-expand, but with
408;; different try-functions-lists.
409;; Usage is for example:
410;; (fset 'my-complete-file (make-hippie-expand-function
411;; '(try-complete-file-name-partially
412;; try-complete-file-name)))
413;; (fset 'my-complete-line (make-hippie-expand-function
414;; '(try-expand-line
415;; try-expand-line-all-buffers)))
416;;
8c6677ed 417;;;###autoload
652304c9
RS
418(defmacro make-hippie-expand-function (try-list &optional verbose)
419 "Construct a function similar to `hippie-expand'.
420Make it use the expansion functions in TRY-LIST. An optional second
421argument VERBOSE non-nil makes the function verbose."
d7d20e6a
GM
422 `(function (lambda (arg)
423 ,(concat
424 "Try to expand text before point, using the following functions: \n"
425 (mapconcat 'prin1-to-string (eval try-list) ", "))
426 (interactive "P")
427 (let ((hippie-expand-try-functions-list ,try-list)
428 (hippie-expand-verbose ,verbose))
429 (hippie-expand arg)))))
652304c9
RS
430
431
432;;; Here follows the try-functions and their requisites:
433
510cbc92 434
652304c9
RS
435(defun try-complete-file-name (old)
436 "Try to complete text as a file name.
437The argument OLD has to be nil the first call of this function, and t
438for subsequent calls (for further possible completions of the same
439string). It returns t if a new completion is found, nil otherwise."
440 (if (not old)
441 (progn
442 (he-init-string (he-file-name-beg) (point))
510cbc92
RS
443 (let ((name-part (he-file-name-nondirectory he-search-string))
444 (dir-part (expand-file-name (or (he-file-name-directory
652304c9
RS
445 he-search-string) ""))))
446 (if (not (he-string-member name-part he-tried-table))
447 (setq he-tried-table (cons name-part he-tried-table)))
448 (if (and (not (equal he-search-string ""))
510cbc92 449 (he-file-directory-p dir-part))
652304c9
RS
450 (setq he-expand-list (sort (file-name-all-completions
451 name-part
452 dir-part)
453 'string-lessp))
454 (setq he-expand-list ())))))
455
456 (while (and he-expand-list
457 (he-string-member (car he-expand-list) he-tried-table))
458 (setq he-expand-list (cdr he-expand-list)))
459 (if (null he-expand-list)
460 (progn
510cbc92 461 (if old (he-reset-string))
652304c9 462 ())
510cbc92
RS
463 (let ((filename (he-concat-directory-file-name
464 (he-file-name-directory he-search-string)
465 (car he-expand-list))))
652304c9 466 (he-substitute-string filename)
510cbc92 467 (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
652304c9
RS
468 (setq he-expand-list (cdr he-expand-list))
469 t)))
470
471(defun try-complete-file-name-partially (old)
472 "Try to complete text as a file name, as many characters as unique.
473The argument OLD has to be nil the first call of this function. It
474returns t if a unique, possibly partial, completion is found, nil
475otherwise."
476 (let ((expansion ()))
477 (if (not old)
478 (progn
479 (he-init-string (he-file-name-beg) (point))
510cbc92
RS
480 (let ((name-part (he-file-name-nondirectory he-search-string))
481 (dir-part (expand-file-name (or (he-file-name-directory
652304c9
RS
482 he-search-string) ""))))
483 (if (and (not (equal he-search-string ""))
510cbc92 484 (he-file-directory-p dir-part))
652304c9
RS
485 (setq expansion (file-name-completion name-part
486 dir-part)))
487 (if (or (eq expansion t)
510cbc92
RS
488 (string= expansion name-part)
489 (he-string-member expansion he-tried-table))
652304c9
RS
490 (setq expansion ())))))
491
492 (if (not expansion)
493 (progn
510cbc92 494 (if old (he-reset-string))
652304c9 495 ())
510cbc92
RS
496 (let ((filename (he-concat-directory-file-name
497 (he-file-name-directory he-search-string)
498 expansion)))
652304c9 499 (he-substitute-string filename)
510cbc92 500 (setq he-tried-table (cons expansion (cdr he-tried-table)))
652304c9
RS
501 t))))
502
510cbc92
RS
503(defvar he-file-name-chars
504 (cond ((memq system-type '(vax-vms axp-vms))
505 "-a-zA-Z0-9_/.,~^#$+=:\\[\\]")
8a5a6d3e 506 ((memq system-type '(ms-dos windows-nt))
510cbc92
RS
507 "-a-zA-Z0-9_/.,~^#$+=:\\\\")
508 (t ;; More strange file formats ?
509 "-a-zA-Z0-9_/.,~^#$+="))
510 "Characters that are considered part of the file name to expand.")
511
652304c9 512(defun he-file-name-beg ()
de073e06
KH
513 (let ((op (point)))
514 (save-excursion
515 (skip-chars-backward he-file-name-chars)
516 (if (> (skip-syntax-backward "w") 0) ;; No words with non-file chars
41b8e71c
RS
517 op
518 (point)))))
652304c9 519
510cbc92
RS
520;; Thanks go to Richard Levitte <levitte@e.kth.se> who helped to make these
521;; work under VMS, and to David Hughes <ukchugd@ukpmr.cs.philips.nl> who
522;; helped to make it work on PC.
523(defun he-file-name-nondirectory (file)
524 "Fix to make `file-name-nondirectory' work for hippie-expand under VMS."
525 (if (memq system-type '(axp-vms vax-vms))
526 (let ((n (file-name-nondirectory file)))
527 (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
528 (concat "[." (substring n (match-beginning 2) (match-end 2)))
529 n))
530 (file-name-nondirectory file)))
531
532(defun he-file-name-directory (file)
533 "Fix to make `file-name-directory' work for hippie-expand under VMS."
534 (if (memq system-type '(axp-vms vax-vms))
535 (let ((n (file-name-nondirectory file))
536 (d (file-name-directory file)))
537 (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
538 (concat d (substring n (match-beginning 1) (match-end 1)) "]")
539 d))
540 (file-name-directory file)))
541
542(defun he-file-directory-p (file)
543 "Fix to make `file-directory-p' work for hippie-expand under VMS."
544 (if (memq system-type '(vax-vms axp-vms))
545 (or (file-directory-p file)
546 (file-directory-p (concat file "[000000]")))
a0341d13 547 (file-directory-p file)))
510cbc92
RS
548
549(defun he-concat-directory-file-name (dir-part name-part)
550 "Try to slam together two parts of a file specification, system dependently."
a0341d13
RS
551 (cond ((null dir-part) name-part)
552 ((memq system-type '(axp-vms vax-vms))
510cbc92
RS
553 (if (and (string= (substring dir-part -1) "]")
554 (string= (substring name-part 0 2) "[."))
555 (concat (substring dir-part 0 -1) (substring name-part 1))
556 (concat dir-part name-part)))
b86b9918 557 ((memq system-type '(ms-dos w32))
510cbc92
RS
558 (if (and (string-match "\\\\" dir-part)
559 (not (string-match "/" dir-part))
560 (= (aref name-part (1- (length name-part))) ?/))
561 (aset name-part (1- (length name-part)) ?\\))
562 (concat dir-part name-part))
563 (t
564 (concat dir-part name-part))))
565
652304c9
RS
566(defun try-complete-lisp-symbol (old)
567 "Try to complete word as an Emacs Lisp symbol.
568The argument OLD has to be nil the first call of this function, and t
569for subsequent calls (for further possible completions of the same
570string). It returns t if a new completion is found, nil otherwise."
571 (if (not old)
572 (progn
573 (he-init-string (he-lisp-symbol-beg) (point))
574 (if (not (he-string-member he-search-string he-tried-table))
575 (setq he-tried-table (cons he-search-string he-tried-table)))
576 (setq he-expand-list
577 (and (not (equal he-search-string ""))
578 (sort (all-completions he-search-string obarray
579 (function (lambda (sym)
580 (or (boundp sym)
581 (fboundp sym)
582 (symbol-plist sym)))))
583 'string-lessp)))))
584 (while (and he-expand-list
585 (he-string-member (car he-expand-list) he-tried-table))
586 (setq he-expand-list (cdr he-expand-list)))
587 (if (null he-expand-list)
588 (progn
510cbc92 589 (if old (he-reset-string))
652304c9
RS
590 ())
591 (progn
592 (he-substitute-string (car he-expand-list))
652304c9
RS
593 (setq he-expand-list (cdr he-expand-list))
594 t)))
595
596(defun try-complete-lisp-symbol-partially (old)
597 "Try to complete as an Emacs Lisp symbol, as many characters as unique.
598The argument OLD has to be nil the first call of this function. It
599returns t if a unique, possibly partial, completion is found, nil
600otherwise."
601 (let ((expansion ()))
602 (if (not old)
603 (progn
604 (he-init-string (he-lisp-symbol-beg) (point))
605 (if (not (string= he-search-string ""))
606 (setq expansion
607 (try-completion he-search-string obarray
608 (function (lambda (sym)
609 (or (boundp sym)
610 (fboundp sym)
611 (symbol-plist sym)))))))
612 (if (or (eq expansion t)
510cbc92
RS
613 (string= expansion he-search-string)
614 (he-string-member expansion he-tried-table))
652304c9
RS
615 (setq expansion ()))))
616
617 (if (not expansion)
618 (progn
510cbc92 619 (if old (he-reset-string))
652304c9
RS
620 ())
621 (progn
622 (he-substitute-string expansion)
652304c9
RS
623 t))))
624
625(defun he-lisp-symbol-beg ()
de073e06
KH
626 (save-excursion
627 (skip-syntax-backward "w_")
628 (point)))
652304c9
RS
629
630(defun try-expand-line (old)
631 "Try to complete the current line to an entire line in the buffer.
632The argument OLD has to be nil the first call of this function, and t
633for subsequent calls (for further possible completions of the same
634string). It returns t if a new completion is found, nil otherwise."
635 (let ((expansion ())
636 (strip-prompt (and (get-buffer-process (current-buffer))
8c6677ed 637 comint-prompt-regexp)))
652304c9
RS
638 (if (not old)
639 (progn
640 (he-init-string (he-line-beg strip-prompt) (point))
8c6677ed 641 (set-marker he-search-loc he-string-beg)
652304c9
RS
642 (setq he-search-bw t)))
643
644 (if (not (equal he-search-string ""))
645 (save-excursion
41b8e71c
RS
646 (save-restriction
647 (if hippie-expand-no-restriction
648 (widen))
649 ;; Try looking backward unless inhibited.
650 (if he-search-bw
651 (progn
652 (goto-char he-search-loc)
653 (setq expansion (he-line-search he-search-string
654 strip-prompt t))
655 (set-marker he-search-loc (point))
656 (if (not expansion)
657 (progn
658 (set-marker he-search-loc he-string-end)
659 (setq he-search-bw ())))))
660
661 (if (not expansion) ; Then look forward.
662 (progn
663 (goto-char he-search-loc)
664 (setq expansion (he-line-search he-search-string
665 strip-prompt nil))
666 (set-marker he-search-loc (point)))))))
652304c9
RS
667
668 (if (not expansion)
669 (progn
510cbc92 670 (if old (he-reset-string))
652304c9
RS
671 ())
672 (progn
673 (he-substitute-string expansion t)
652304c9
RS
674 t))))
675
676(defun try-expand-line-all-buffers (old)
677 "Try to complete the current line, searching all other buffers.
678The argument OLD has to be nil the first call of this function, and t
679for subsequent calls (for further possible completions of the same
680string). It returns t if a new completion is found, nil otherwise."
681 (let ((expansion ())
682 (strip-prompt (and (get-buffer-process (current-buffer))
8c6677ed 683 comint-prompt-regexp))
510cbc92
RS
684 (buf (current-buffer))
685 (orig-case-fold-search case-fold-search))
652304c9
RS
686 (if (not old)
687 (progn
688 (he-init-string (he-line-beg strip-prompt) (point))
8c6677ed 689 (setq he-search-bufs (buffer-list))
510cbc92 690 (setq he-searched-n-bufs 0)
8c6677ed 691 (set-marker he-search-loc 1 (car he-search-bufs))))
652304c9
RS
692
693 (if (not (equal he-search-string ""))
8c6677ed 694 (while (and he-search-bufs
510cbc92
RS
695 (not expansion)
696 (or (not hippie-expand-max-buffers)
697 (< he-searched-n-bufs hippie-expand-max-buffers)))
652304c9
RS
698 (set-buffer (car he-search-bufs))
699 (if (and (not (eq (current-buffer) buf))
41b8e71c
RS
700 (if hippie-expand-only-buffers
701 (he-buffer-member hippie-expand-only-buffers)
702 (not (he-buffer-member hippie-expand-ignore-buffers))))
652304c9 703 (save-excursion
41b8e71c
RS
704 (save-restriction
705 (if hippie-expand-no-restriction
706 (widen))
707 (goto-char he-search-loc)
708 (setq strip-prompt (and (get-buffer-process (current-buffer))
709 comint-prompt-regexp))
710 (setq expansion
711 (let ((case-fold-search orig-case-fold-search))
712 (he-line-search he-search-string
713 strip-prompt nil)))
714 (set-marker he-search-loc (point))
715 (if (not expansion)
716 (progn
717 (setq he-search-bufs (cdr he-search-bufs))
718 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
719 (set-marker he-search-loc 1 (car he-search-bufs))))))
510cbc92
RS
720 (setq he-search-bufs (cdr he-search-bufs))
721 (set-marker he-search-loc 1 (car he-search-bufs)))))
652304c9
RS
722
723 (set-buffer buf)
724 (if (not expansion)
725 (progn
510cbc92 726 (if old (he-reset-string))
652304c9
RS
727 ())
728 (progn
729 (he-substitute-string expansion t)
730 t))))
731
732(defun he-line-search (str strip-prompt reverse)
733 (let ((result ()))
734 (while (and (not result)
735 (if reverse
736 (re-search-backward
737 (he-line-search-regexp str strip-prompt)
738 nil t)
739 (re-search-forward
740 (he-line-search-regexp str strip-prompt)
741 nil t)))
d7d20e6a
GM
742 (setq result (buffer-substring-no-properties (match-end 1)
743 (match-end 0)))
510cbc92
RS
744 (if (he-string-member result he-tried-table t)
745 (setq result nil))) ; if already in table, ignore
652304c9
RS
746 result))
747
748(defun he-line-beg (strip-prompt)
749 (save-excursion
652304c9
RS
750 (if (re-search-backward (he-line-search-regexp "" strip-prompt)
751 (save-excursion (beginning-of-line)
752 (point)) t)
753 (match-beginning 2)
652304c9
RS
754 (point))))
755
756(defun he-line-search-regexp (pat strip-prompt)
757 (if strip-prompt
8c6677ed 758 (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
652304c9
RS
759 (regexp-quote pat)
760 "[^\n]*[^ \t\n]\\)")
761 (concat "^\\(\\s-*\\)\\("
762 (regexp-quote pat)
763 "[^\n]*[^ \t\n]\\)")))
764
8c6677ed
JB
765(defun try-expand-list (old)
766 "Try to complete the current beginning of a list.
767The argument OLD has to be nil the first call of this function, and t
768for subsequent calls (for further possible completions of the same
769string). It returns t if a new completion is found, nil otherwise."
770 (let ((expansion ()))
771 (if (not old)
772 (progn
773 (he-init-string (he-list-beg) (point))
774 (set-marker he-search-loc he-string-beg)
775 (setq he-search-bw t)))
776
777 (if (not (equal he-search-string ""))
778 (save-excursion
41b8e71c
RS
779 (save-restriction
780 (if hippie-expand-no-restriction
781 (widen))
782 ;; Try looking backward unless inhibited.
783 (if he-search-bw
784 (progn
785 (goto-char he-search-loc)
786 (setq expansion (he-list-search he-search-string t))
787 (set-marker he-search-loc (point))
788 (if (not expansion)
789 (progn
790 (set-marker he-search-loc he-string-end)
791 (setq he-search-bw ())))))
792
793 (if (not expansion) ; Then look forward.
794 (progn
795 (goto-char he-search-loc)
796 (setq expansion (he-list-search he-search-string nil))
797 (set-marker he-search-loc (point)))))))
8c6677ed
JB
798
799 (if (not expansion)
800 (progn
801 (if old (he-reset-string))
802 ())
803 (progn
804 (he-substitute-string expansion t)
8c6677ed
JB
805 t))))
806
807(defun try-expand-list-all-buffers (old)
808 "Try to complete the current list, searching all other buffers.
809The argument OLD has to be nil the first call of this function, and t
810for subsequent calls (for further possible completions of the same
811string). It returns t if a new completion is found, nil otherwise."
812 (let ((expansion ())
510cbc92
RS
813 (buf (current-buffer))
814 (orig-case-fold-search case-fold-search))
8c6677ed
JB
815 (if (not old)
816 (progn
817 (he-init-string (he-list-beg) (point))
818 (setq he-search-bufs (buffer-list))
510cbc92 819 (setq he-searched-n-bufs 0)
8c6677ed
JB
820 (set-marker he-search-loc 1 (car he-search-bufs))))
821
822 (if (not (equal he-search-string ""))
823 (while (and he-search-bufs
510cbc92
RS
824 (not expansion)
825 (or (not hippie-expand-max-buffers)
826 (< he-searched-n-bufs hippie-expand-max-buffers)))
8c6677ed
JB
827 (set-buffer (car he-search-bufs))
828 (if (and (not (eq (current-buffer) buf))
41b8e71c
RS
829 (if hippie-expand-only-buffers
830 (he-buffer-member hippie-expand-only-buffers)
831 (not (he-buffer-member hippie-expand-ignore-buffers))))
8c6677ed 832 (save-excursion
41b8e71c
RS
833 (save-restriction
834 (if hippie-expand-no-restriction
835 (widen))
836 (goto-char he-search-loc)
837 (setq expansion
838 (let ((case-fold-search orig-case-fold-search))
839 (he-list-search he-search-string nil)))
840 (set-marker he-search-loc (point))
841 (if (not expansion)
842 (progn
843 (setq he-search-bufs (cdr he-search-bufs))
844 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
845 (set-marker he-search-loc 1 (car he-search-bufs))))))
510cbc92
RS
846 (setq he-search-bufs (cdr he-search-bufs))
847 (set-marker he-search-loc 1 (car he-search-bufs)))))
8c6677ed
JB
848
849 (set-buffer buf)
850 (if (not expansion)
851 (progn
510cbc92 852 (if old (he-reset-string))
8c6677ed
JB
853 ())
854 (progn
855 (he-substitute-string expansion t)
856 t))))
857
858(defun he-list-search (str reverse)
859 (let ((result ())
510cbc92 860 beg pos err)
8c6677ed
JB
861 (while (and (not result)
862 (if reverse
863 (search-backward str nil t)
864 (search-forward str nil t)))
865 (setq pos (point))
866 (setq beg (match-beginning 0))
867 (goto-char beg)
868 (setq err ())
869 (condition-case ()
510cbc92
RS
870 (forward-list 1)
871 (error (setq err t)))
d1d1ddbd 872 (if (and reverse
510cbc92
RS
873 (> (point) he-string-beg))
874 (setq err t))
8c6677ed 875 (if (not err)
510cbc92 876 (progn
41b8e71c 877 (setq result (buffer-substring-no-properties beg (point)))
510cbc92
RS
878 (if (he-string-member result he-tried-table t)
879 (setq result nil)))) ; if already in table, ignore
8c6677ed
JB
880 (goto-char pos))
881 result))
882
883(defun he-list-beg ()
884 (save-excursion
885 (condition-case ()
510cbc92 886 (backward-up-list 1)
8c6677ed
JB
887 (error ()))
888 (point)))
889
652304c9
RS
890(defun try-expand-all-abbrevs (old)
891 "Try to expand word before point according to all abbrev tables.
892The argument OLD has to be nil the first call of this function, and t
893for subsequent calls (for further possible expansions of the same
894string). It returns t if a new expansion is found, nil otherwise."
895 (if (not old)
896 (progn
897 (he-init-string (he-dabbrev-beg) (point))
898 (setq he-expand-list
899 (and (not (equal he-search-string ""))
900 (mapcar (function (lambda (sym)
510cbc92
RS
901 (if (and (boundp sym) (vectorp (eval sym)))
902 (abbrev-expansion (downcase he-search-string)
903 (eval sym)))))
652304c9
RS
904 (append '(local-abbrev-table
905 global-abbrev-table)
906 abbrev-table-name-list))))))
907 (while (and he-expand-list
908 (or (not (car he-expand-list))
510cbc92 909 (he-string-member (car he-expand-list) he-tried-table t)))
652304c9
RS
910 (setq he-expand-list (cdr he-expand-list)))
911 (if (null he-expand-list)
912 (progn
510cbc92 913 (if old (he-reset-string))
652304c9
RS
914 ())
915 (progn
8c6677ed 916 (he-substitute-string (car he-expand-list) t)
652304c9
RS
917 (setq he-expand-list (cdr he-expand-list))
918 t)))
919
920(defun try-expand-dabbrev (old)
921 "Try to expand word \"dynamically\", searching the current buffer.
922The argument OLD has to be nil the first call of this function, and t
923for subsequent calls (for further possible expansions of the same
924string). It returns t if a new expansion is found, nil otherwise."
925 (let ((expansion ()))
926 (if (not old)
927 (progn
928 (he-init-string (he-dabbrev-beg) (point))
8c6677ed 929 (set-marker he-search-loc he-string-beg)
652304c9
RS
930 (setq he-search-bw t)))
931
932 (if (not (equal he-search-string ""))
933 (save-excursion
41b8e71c
RS
934 (save-restriction
935 (if hippie-expand-no-restriction
936 (widen))
937 ;; Try looking backward unless inhibited.
938 (if he-search-bw
939 (progn
940 (goto-char he-search-loc)
941 (setq expansion (he-dabbrev-search he-search-string t))
942 (set-marker he-search-loc (point))
943 (if (not expansion)
944 (progn
945 (set-marker he-search-loc he-string-end)
946 (setq he-search-bw ())))))
947
948 (if (not expansion) ; Then look forward.
949 (progn
950 (goto-char he-search-loc)
951 (setq expansion (he-dabbrev-search he-search-string nil))
952 (set-marker he-search-loc (point)))))))
652304c9
RS
953
954 (if (not expansion)
955 (progn
510cbc92 956 (if old (he-reset-string))
652304c9
RS
957 ())
958 (progn
959 (he-substitute-string expansion t)
652304c9
RS
960 t))))
961
962(defun try-expand-dabbrev-all-buffers (old)
963 "Tries to expand word \"dynamically\", searching all other buffers.
964The argument OLD has to be nil the first call of this function, and t
965for subsequent calls (for further possible expansions of the same
966string). It returns t if a new expansion is found, nil otherwise."
967 (let ((expansion ())
510cbc92
RS
968 (buf (current-buffer))
969 (orig-case-fold-search case-fold-search))
652304c9
RS
970 (if (not old)
971 (progn
972 (he-init-string (he-dabbrev-beg) (point))
8c6677ed 973 (setq he-search-bufs (buffer-list))
510cbc92 974 (setq he-searched-n-bufs 0)
8c6677ed 975 (set-marker he-search-loc 1 (car he-search-bufs))))
652304c9
RS
976
977 (if (not (equal he-search-string ""))
8c6677ed 978 (while (and he-search-bufs
510cbc92
RS
979 (not expansion)
980 (or (not hippie-expand-max-buffers)
981 (< he-searched-n-bufs hippie-expand-max-buffers)))
652304c9
RS
982 (set-buffer (car he-search-bufs))
983 (if (and (not (eq (current-buffer) buf))
41b8e71c
RS
984 (if hippie-expand-only-buffers
985 (he-buffer-member hippie-expand-only-buffers)
986 (not (he-buffer-member hippie-expand-ignore-buffers))))
652304c9 987 (save-excursion
41b8e71c
RS
988 (save-restriction
989 (if hippie-expand-no-restriction
990 (widen))
991 (goto-char he-search-loc)
992 (setq expansion
993 (let ((case-fold-search orig-case-fold-search))
994 (he-dabbrev-search he-search-string nil)))
995 (set-marker he-search-loc (point))
996 (if (not expansion)
997 (progn
998 (setq he-search-bufs (cdr he-search-bufs))
999 (setq he-searched-n-bufs (1+ he-searched-n-bufs))
1000 (set-marker he-search-loc 1 (car he-search-bufs))))))
510cbc92
RS
1001 (setq he-search-bufs (cdr he-search-bufs))
1002 (set-marker he-search-loc 1 (car he-search-bufs)))))
652304c9
RS
1003
1004 (set-buffer buf)
1005 (if (not expansion)
1006 (progn
510cbc92 1007 (if old (he-reset-string))
652304c9
RS
1008 ())
1009 (progn
1010 (he-substitute-string expansion t)
1011 t))))
1012
510cbc92
RS
1013;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
1014;; suggested this one.
1015(defun try-expand-dabbrev-visible (old)
1016 "Try to expand word \"dynamically\", searching visible window parts.
1017The argument OLD has to be nil the first call of this function, and t
1018for subsequent calls (for further possible expansions of the same
1019string). It returns t if a new expansion is found, nil otherwise."
1020 (let ((expansion ())
1021 (buf (current-buffer))
1022 (flag (if (frame-visible-p (window-frame (selected-window)))
1023 'visible t)))
1024 (if (not old)
1025 (progn
1026 (he-init-string (he-dabbrev-beg) (point))
1027 (setq he-search-window (selected-window))
1028 (set-marker he-search-loc
1029 (window-start he-search-window)
1030 (window-buffer he-search-window))))
1031
1032 (while (and (not (equal he-search-string ""))
1033 (marker-position he-search-loc)
1034 (not expansion))
1035 (save-excursion
1036 (set-buffer (marker-buffer he-search-loc))
1037 (goto-char he-search-loc)
1038 (setq expansion (he-dabbrev-search he-search-string ()
1039 (window-end he-search-window)))
1040 (if (and expansion
1041 (eq (marker-buffer he-string-beg) (current-buffer))
1042 (eq (marker-position he-string-beg) (match-beginning 0)))
1043 (setq expansion (he-dabbrev-search he-search-string ()
1044 (window-end he-search-window))))
1045 (set-marker he-search-loc (point) (current-buffer)))
1046 (if (not expansion)
1047 (progn
1048 (setq he-search-window (next-window he-search-window nil flag))
1049 (if (eq he-search-window (selected-window))
1050 (set-marker he-search-loc nil)
1051 (set-marker he-search-loc (window-start he-search-window)
1052 (window-buffer he-search-window))))))
1053
1054 (set-buffer buf)
1055 (if (not expansion)
1056 (progn
1057 (if old (he-reset-string))
1058 ())
1059 (progn
1060 (he-substitute-string expansion t)
1061 t))))
652304c9 1062
510cbc92
RS
1063(defun he-dabbrev-search (pattern &optional reverse limit)
1064 (let ((result ())
41b8e71c
RS
1065 (regpat (cond ((not hippie-expand-dabbrev-as-symbol)
1066 (concat "\\<" (regexp-quote pattern) "\\sw+"))
1067 ((eq (char-syntax (aref pattern 0)) ?_)
1068 (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))
1069 (t
1070 (concat "\\<" (regexp-quote pattern)
1071 "\\(\\sw\\|\\s_\\)+")))))
652304c9
RS
1072 (while (and (not result)
1073 (if reverse
510cbc92
RS
1074 (re-search-backward regpat limit t)
1075 (re-search-forward regpat limit t)))
41b8e71c
RS
1076 (setq result (buffer-substring-no-properties (match-beginning 0)
1077 (match-end 0)))
1078 (if (or (and hippie-expand-dabbrev-as-symbol
1079 (> (match-beginning 0) (point-min))
510cbc92
RS
1080 (memq (char-syntax (char-after (1- (match-beginning 0))))
1081 '(?_ ?w)))
1082 (he-string-member result he-tried-table t))
1083 (setq result nil))) ; ignore if bad prefix or already in table
652304c9
RS
1084 result))
1085
1086(defun he-dabbrev-beg ()
510cbc92
RS
1087 (let ((op (point)))
1088 (save-excursion
41b8e71c 1089 (if hippie-expand-dabbrev-skip-space
510cbc92 1090 (skip-syntax-backward ". "))
41b8e71c
RS
1091 (if (= (skip-syntax-backward (if hippie-expand-dabbrev-as-symbol
1092 "w_" "w"))
1093 0)
510cbc92
RS
1094 op
1095 (point)))))
1096
1097(defun try-expand-dabbrev-from-kill (old)
1098 "Try to expand word \"dynamically\", searching the kill ring.
1099The argument OLD has to be nil the first call of this function, and t
1100for subsequent calls (for further possible completions of the same
1101string). It returns t if a new completion is found, nil otherwise."
1102 (let ((expansion ()))
1103 (if (not old)
1104 (progn
1105 (he-init-string (he-dabbrev-beg) (point))
1106 (setq he-expand-list
1107 (if (not (equal he-search-string ""))
1108 kill-ring))
1109 (setq he-search-loc2 0)))
1110 (if (not (equal he-search-string ""))
1111 (setq expansion (he-dabbrev-kill-search he-search-string)))
1112 (if (not expansion)
1113 (progn
1114 (if old (he-reset-string))
1115 ())
1116 (progn
1117 (he-substitute-string expansion t)
1118 t))))
1119
1120(defun he-dabbrev-kill-search (pattern)
1121 (let ((result ())
41b8e71c
RS
1122 (regpat (cond ((not hippie-expand-dabbrev-as-symbol)
1123 (concat "\\<" (regexp-quote pattern) "\\sw+"))
1124 ((eq (char-syntax (aref pattern 0)) ?_)
1125 (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))
1126 (t
1127 (concat "\\<" (regexp-quote pattern)
1128 "\\(\\sw\\|\\s_\\)+"))))
510cbc92
RS
1129 (killstr (car he-expand-list)))
1130 (while (and (not result)
1131 he-expand-list)
1132 (while (and (not result)
1133 (string-match regpat killstr he-search-loc2))
1134 (setq result (substring killstr (match-beginning 0) (match-end 0)))
41b8e71c 1135 (set-text-properties 0 (length result) () result)
510cbc92 1136 (setq he-search-loc2 (1+ (match-beginning 0)))
41b8e71c
RS
1137 (if (or (and hippie-expand-dabbrev-as-symbol
1138 (> (match-beginning 0) 0)
510cbc92
RS
1139 (memq (char-syntax (aref killstr (1- (match-beginning 0))))
1140 '(?_ ?w)))
1141 (he-string-member result he-tried-table t))
1142 (setq result nil))) ; ignore if bad prefix or already in table
1143 (if (and (not result)
1144 he-expand-list)
1145 (progn
1146 (setq he-expand-list (cdr he-expand-list))
1147 (setq killstr (car he-expand-list))
1148 (setq he-search-loc2 0))))
1149 result))
1150
1151(defun try-expand-whole-kill (old)
1152 "Try to complete text with something from the kill ring.
1153The argument OLD has to be nil the first call of this function, and t
1154for subsequent calls (for further possible completions of the same
1155string). It returns t if a new completion is found, nil otherwise."
1156 (let ((expansion ()))
1157 (if (not old)
1158 (progn
1159 (he-init-string (he-kill-beg) (point))
1160 (if (not (he-string-member he-search-string he-tried-table))
1161 (setq he-tried-table (cons he-search-string he-tried-table)))
1162 (setq he-expand-list
1163 (if (not (equal he-search-string ""))
1164 kill-ring))
1165 (setq he-search-loc2 ())))
1166 (if (not (equal he-search-string ""))
1167 (setq expansion (he-whole-kill-search he-search-string)))
1168 (if (not expansion)
1169 (progn
1170 (if old (he-reset-string))
1171 ())
1172 (progn
1173 (he-substitute-string expansion)
1174 t))))
1175
1176(defun he-whole-kill-search (str)
1177 (let ((case-fold-search ())
1178 (result ())
1179 (str (regexp-quote str))
1180 (killstr (car he-expand-list))
1181 (pos -1))
1182 (while (and (not result)
1183 he-expand-list)
1184 (if (not he-search-loc2)
1185 (while (setq pos (string-match str killstr (1+ pos)))
1186 (setq he-search-loc2 (cons pos he-search-loc2))))
1187 (while (and (not result)
1188 he-search-loc2)
1189 (setq pos (car he-search-loc2))
1190 (setq he-search-loc2 (cdr he-search-loc2))
1191 (save-excursion
1192 (goto-char he-string-beg)
1193 (if (and (>= (- (point) pos) (point-min)) ; avoid some string GC
1194 (eq (char-after (- (point) pos)) (aref killstr 0))
1195 (search-backward (substring killstr 0 pos)
1196 (- (point) pos) t))
41b8e71c
RS
1197 (progn
1198 (setq result (substring killstr pos))
1199 (set-text-properties 0 (length result) () result))))
510cbc92
RS
1200 (if (and result
1201 (he-string-member result he-tried-table))
1202 (setq result nil))) ; ignore if already in table
1203 (if (and (not result)
1204 he-expand-list)
1205 (progn
1206 (setq he-expand-list (cdr he-expand-list))
1207 (setq killstr (car he-expand-list))
1208 (setq pos -1))))
1209 result))
1210
1211(defun he-kill-beg ()
1212 (let ((op (point)))
1213 (save-excursion
1214 (skip-syntax-backward "^w_")
1215 (if (= (skip-syntax-backward "w_") 0)
1216 op
1217 (point)))))
1218
8c6677ed
JB
1219
1220(provide 'hippie-exp)
652304c9 1221
8c6677ed 1222;;; hippie-exp.el ends here