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