Mercurial > emacs
annotate lisp/complete.el @ 16478:fb944e4dc708
Use new face.
| author | Simon Marshall <simon@gnu.org> |
|---|---|
| date | Mon, 28 Oct 1996 10:08:07 +0000 |
| parents | 1595df9ed1e8 |
| children | e2858bcbed43 |
| rev | line source |
|---|---|
| 15261 | 1 ;;; complete.el --- partial completion mechanism plus other goodies |
| 3725 | 2 |
| 3 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Dave Gillespie <daveg@synaptics.com> | |
|
11487
577cd5d36667
Add Keywords: comment header for finder.el.
Roland McGrath <roland@gnu.org>
parents:
10164
diff
changeset
|
6 ;; Keywords: abbrev |
| 3725 | 7 ;; Version: 2.02 |
| 8 ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. | |
| 9 | |
| 10 ;; This file is part of GNU Emacs. | |
| 11 | |
|
6736
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
13 ;; it under the terms of the GNU General Public License as published by |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option) |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
15 ;; any later version. |
| 3725 | 16 |
|
6736
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
20 ;; GNU General Public License for more details. |
| 3725 | 21 |
|
6736
3e1323443b1a
Fix copying conditions for current GPL version.
Richard M. Stallman <rms@gnu.org>
parents:
3725
diff
changeset
|
22 ;; You should have received a copy of the GNU General Public License |
| 14169 | 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. | |
| 3725 | 26 |
| 7942 | 27 ;;; Commentary: |
| 3725 | 28 |
| 29 ;; Extended completion for the Emacs minibuffer. | |
| 30 ;; | |
| 31 ;; The basic idea is that the command name or other completable text is | |
| 32 ;; divided into words and each word is completed separately, so that | |
| 33 ;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous | |
| 34 ;; each word is completed as much as possible and then the cursor is | |
| 35 ;; left at the first position where typing another letter will resolve | |
| 36 ;; the ambiguity. | |
| 37 ;; | |
| 38 ;; Word separators for this purpose are hyphen, space, and period. | |
| 39 ;; These would most likely occur in command names, Info menu items, | |
| 40 ;; and file names, respectively. But all word separators are treated | |
| 41 ;; alike at all times. | |
| 42 ;; | |
| 43 ;; This completion package replaces the old-style completer's key | |
| 44 ;; bindings for TAB, SPC, RET, and `?'. The old completer is still | |
| 45 ;; available on the Meta versions of those keys. If you set | |
| 46 ;; PC-meta-flag to nil, the old completion keys will be left alone | |
| 47 ;; and the partial completer will use the Meta versions of the keys. | |
| 48 | |
| 49 | |
| 50 ;; Usage: Load this file. Now, during completable minibuffer entry, | |
| 51 ;; | |
| 52 ;; TAB means to do a partial completion; | |
| 53 ;; SPC means to do a partial complete-word; | |
| 54 ;; RET means to do a partial complete-and-exit; | |
| 55 ;; ? means to do a partial completion-help. | |
| 56 ;; | |
| 57 ;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform | |
| 58 ;; original Emacs completions, and M-TAB etc. do partial completion. | |
| 59 ;; To do this, put the command, | |
| 60 ;; | |
| 61 ;; (setq PC-meta-flag nil) | |
| 62 ;; | |
| 63 ;; in your .emacs file. To load partial completion automatically, put | |
| 64 ;; | |
| 65 ;; (load "complete") | |
| 66 ;; | |
| 67 ;; in your .emacs file, too. Things will be faster if you byte-compile | |
| 68 ;; this file when you install it. | |
| 69 ;; | |
| 70 ;; As an extra feature, in cases where RET would not normally | |
| 71 ;; complete (such as `C-x b'), the M-RET key will always do a partial | |
| 72 ;; complete-and-exit. Thus `C-x b f.c RET' will select or create a | |
| 73 ;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing | |
| 74 ;; buffer whose name matches that pattern (perhaps "filing.c"). | |
| 75 ;; (PC-meta-flag does not affect this behavior; M-RET used to be | |
| 76 ;; undefined in this situation.) | |
| 77 ;; | |
| 78 ;; The regular M-TAB (lisp-complete-symbol) command also supports | |
| 79 ;; partial completion in this package. | |
| 80 | |
| 81 ;; This package also contains a wildcard feature for C-x C-f (find-file). | |
| 82 ;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly | |
| 83 ;; as if you had typed C-x C-f separately for each file. Completion | |
| 84 ;; is supported in connection with wildcards. Currently only the `*' | |
| 85 ;; wildcard character works. | |
| 86 | |
| 87 ;; File name completion does not do partial completion of directories | |
| 88 ;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo", | |
| 89 ;; but you can put *'s in the path to accomplish this: "/u*/b*/f". | |
| 90 ;; Stars are required for performance reasons. | |
| 91 | |
| 92 ;; In addition, this package includes a feature for accessing include | |
| 93 ;; files. For example, `C-x C-f <sys/time.h> RET' reads the file | |
| 94 ;; /usr/include/sys/time.h. The variable PC-include-file-path is a | |
| 95 ;; list of directories in which to search for include files. Completion | |
| 96 ;; is supported in include file names. | |
| 97 | |
| 98 | |
| 7942 | 99 ;;; Code: |
| 3725 | 100 |
| 101 (defvar PC-meta-flag t | |
| 102 "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion. | |
| 103 If t, TAB does Partial Completion and M-TAB does normal completion.") | |
| 104 | |
| 105 | |
| 106 (defvar PC-word-delimiters "-_. " | |
| 107 "*A string of characters which are to be treated as word delimiters | |
| 108 by the Partial Completion system. | |
| 109 | |
| 110 Some arcane rules: If `]' is in this string it must come first. | |
| 111 If `^' is in this string it must NOT come first. If `-' is in this | |
| 112 string, it must come first or right after `]'. In other words, if | |
| 113 S is this string, then `[S]' must be a legal Emacs regular expression | |
| 7639 | 114 \(not containing character ranges like `a-z').") |
| 3725 | 115 |
| 116 | |
| 117 (defvar PC-first-char 'x | |
| 118 "*If t, first character of a string to be completed is always taken literally. | |
| 119 If nil, word delimiters are handled even if they appear as first character. | |
| 120 This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil). | |
| 121 If neither nil nor t, first char is literal only for filename completion.") | |
| 122 | |
| 123 | |
| 124 (defvar PC-include-file-path '("/usr/include") | |
| 125 "*List of directories in which to look for include files. | |
| 126 If this is nil, uses the colon-separated path in $INCPATH instead.") | |
| 127 | |
| 128 | |
| 129 (defvar PC-disable-wildcards nil | |
| 130 "Set this to non-nil to disable wildcard support in \\[find-file].") | |
| 131 | |
| 132 (defvar PC-disable-includes nil | |
| 133 "Set this to non-nil to disable include-file support in \\[find-file].") | |
| 134 | |
| 135 | |
| 136 (defvar PC-default-bindings t | |
| 137 "Set this to nil to suppress the default partial completion key bindings.") | |
| 138 | |
| 139 (if PC-default-bindings (progn | |
| 140 (define-key minibuffer-local-completion-map "\t" 'PC-complete) | |
| 141 (define-key minibuffer-local-completion-map " " 'PC-complete-word) | |
| 142 (define-key minibuffer-local-completion-map "?" 'PC-completion-help) | |
| 143 | |
| 144 (define-key minibuffer-local-completion-map "\e\t" 'PC-complete) | |
| 145 (define-key minibuffer-local-completion-map "\e " 'PC-complete-word) | |
| 146 (define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit) | |
| 147 (define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit) | |
| 148 (define-key minibuffer-local-completion-map "\e?" 'PC-completion-help) | |
| 149 | |
| 150 (define-key minibuffer-local-must-match-map "\t" 'PC-complete) | |
| 151 (define-key minibuffer-local-must-match-map " " 'PC-complete-word) | |
| 152 (define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit) | |
| 153 (define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit) | |
| 154 (define-key minibuffer-local-must-match-map "?" 'PC-completion-help) | |
| 155 | |
| 156 (define-key minibuffer-local-must-match-map "\e\t" 'PC-complete) | |
| 157 (define-key minibuffer-local-must-match-map "\e " 'PC-complete-word) | |
| 158 (define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit) | |
| 159 (define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit) | |
| 160 (define-key minibuffer-local-must-match-map "\e?" 'PC-completion-help) | |
| 161 | |
| 162 (define-key global-map "\e\t" 'PC-lisp-complete-symbol) | |
| 163 )) | |
| 164 | |
| 165 | |
| 166 (defun PC-complete () | |
| 167 "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. | |
| 168 For example, \"M-x b--di\" would match `byte-recompile-directory', or any | |
| 169 name which consists of three or more words, the first beginning with \"b\" | |
| 170 and the third beginning with \"di\". | |
| 171 | |
| 172 The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and | |
| 173 `beginning-of-defun', so this would produce a list of completions | |
| 174 just like when normal Emacs completions are ambiguous. | |
| 175 | |
| 176 Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", | |
| 177 \".\", and SPC." | |
| 178 (interactive) | |
| 179 (if (PC-was-meta-key) | |
| 180 (minibuffer-complete) | |
|
15802
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
181 ;; If the previous command was not this one, |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
182 ;; never scroll, always retry completion. |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
183 (or (eq last-command this-command) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
184 (setq minibuffer-scroll-window nil)) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
185 (let ((window minibuffer-scroll-window)) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
186 ;; If there's a fresh completion window with a live buffer, |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
187 ;; and this command is repeated, scroll that window. |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
188 (if (and window (window-buffer window) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
189 (buffer-name (window-buffer window))) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
190 (save-excursion |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
191 (set-buffer (window-buffer window)) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
192 (if (pos-visible-in-window-p (point-max) window) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
193 (set-window-start window (point-min) nil) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
194 (scroll-other-window))) |
|
1595df9ed1e8
(PC-complete): When command is repeated,
Richard M. Stallman <rms@gnu.org>
parents:
15261
diff
changeset
|
195 (PC-do-completion nil))))) |
| 3725 | 196 |
| 197 | |
| 198 (defun PC-complete-word () | |
| 199 "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
| 200 See `PC-complete' for details. | |
| 201 This can be bound to other keys, like `-' and `.', if you wish." | |
| 202 (interactive) | |
| 203 (if (eq (PC-was-meta-key) PC-meta-flag) | |
| 204 (if (eq last-command-char ? ) | |
| 205 (minibuffer-complete-word) | |
| 206 (self-insert-command 1)) | |
| 207 (self-insert-command 1) | |
| 208 (if (eobp) | |
| 209 (PC-do-completion 'word)))) | |
| 210 | |
| 211 | |
| 212 (defun PC-complete-space () | |
| 213 "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
| 214 See `PC-complete' for details. | |
| 215 This is suitable for binding to other keys which should act just like SPC." | |
| 216 (interactive) | |
| 217 (if (eq (PC-was-meta-key) PC-meta-flag) | |
| 218 (minibuffer-complete-word) | |
| 219 (insert " ") | |
| 220 (if (eobp) | |
| 221 (PC-do-completion 'word)))) | |
| 222 | |
| 223 | |
| 224 (defun PC-complete-and-exit () | |
| 225 "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
| 226 See `PC-complete' for details." | |
| 227 (interactive) | |
| 228 (if (eq (PC-was-meta-key) PC-meta-flag) | |
| 229 (minibuffer-complete-and-exit) | |
| 230 (PC-do-complete-and-exit))) | |
| 231 | |
| 232 (defun PC-force-complete-and-exit () | |
| 233 "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
| 234 See `PC-complete' for details." | |
| 235 (interactive) | |
| 236 (let ((minibuffer-completion-confirm nil)) | |
| 237 (PC-do-complete-and-exit))) | |
| 238 | |
| 239 (defun PC-do-complete-and-exit () | |
| 240 (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on... | |
| 241 (exit-minibuffer) | |
| 242 (let ((flag (PC-do-completion 'exit))) | |
| 243 (and flag | |
| 244 (if (or (eq flag 'complete) | |
| 245 (not minibuffer-completion-confirm)) | |
| 246 (exit-minibuffer) | |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
247 (PC-temp-minibuffer-message " [Confirm]")))))) |
| 3725 | 248 |
| 249 | |
| 250 (defun PC-completion-help () | |
| 251 "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. | |
| 252 See `PC-complete' for details." | |
| 253 (interactive) | |
| 254 (if (eq (PC-was-meta-key) PC-meta-flag) | |
| 255 (minibuffer-completion-help) | |
| 256 (PC-do-completion 'help))) | |
| 257 | |
| 258 (defun PC-was-meta-key () | |
| 259 (or (/= (length (this-command-keys)) 1) | |
| 260 (let ((key (aref (this-command-keys) 0))) | |
| 261 (if (integerp key) | |
| 262 (>= key 128) | |
| 263 (not (null (memq 'meta (event-modifiers key)))))))) | |
| 264 | |
| 265 | |
| 266 (defvar PC-ignored-extensions 'empty-cache) | |
| 267 (defvar PC-delims 'empty-cache) | |
| 268 (defvar PC-ignored-regexp nil) | |
| 269 (defvar PC-word-failed-flag nil) | |
| 270 (defvar PC-delim-regex nil) | |
| 271 (defvar PC-ndelims-regex nil) | |
| 272 (defvar PC-delims-list nil) | |
| 273 | |
|
14765
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
274 (defvar PC-completion-as-file-name-predicate |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
275 (function |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
276 (lambda () |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
277 (memq minibuffer-completion-table |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
278 '(read-file-name-internal read-directory-name-internal)))) |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
279 "A function testing whether a minibuffer completion now will work filename-style. |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
280 The function takes no arguments, and typically looks at the value |
|
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
281 of `minibuffer-completion-table' and the minibuffer contents.") |
|
14759
f93ed65c0584
(PC-do-completion-filename-completers): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
282 |
| 3725 | 283 (defun PC-do-completion (&optional mode beg end) |
| 284 (or beg (setq beg (point-min))) | |
| 285 (or end (setq end (point-max))) | |
| 286 (let* ((table minibuffer-completion-table) | |
| 287 (pred minibuffer-completion-predicate) | |
|
14765
844686eabff0
(PC-completion-as-file-name-predicate):
Richard M. Stallman <rms@gnu.org>
parents:
14759
diff
changeset
|
288 (filename (funcall PC-completion-as-file-name-predicate)) |
| 3725 | 289 (dirname nil) |
|
8478
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
290 dirlength |
| 3725 | 291 (str (buffer-substring beg end)) |
| 292 (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) | |
| 293 (ambig nil) | |
| 294 basestr | |
| 295 regex | |
| 296 p offset | |
| 297 (poss nil) | |
| 298 helpposs | |
| 299 (case-fold-search completion-ignore-case)) | |
| 300 | |
| 301 ;; Check if buffer contents can already be considered complete | |
| 302 (if (and (eq mode 'exit) | |
| 303 (PC-is-complete-p str table pred)) | |
| 304 'complete | |
| 305 | |
|
8478
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
306 ;; Record how many characters at the beginning are not included |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
307 ;; in completion. |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
308 (setq dirlength |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
309 (if filename |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
310 (length (file-name-directory str)) |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
311 0)) |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
312 |
| 3725 | 313 ;; Do substitutions in directory names |
| 314 (and filename | |
| 315 (not (equal str (setq p (substitute-in-file-name str)))) | |
| 316 (progn | |
| 317 (delete-region beg end) | |
| 318 (insert p) | |
| 319 (setq str p end (+ beg (length str))))) | |
| 320 | |
| 321 ;; Prepare various delimiter strings | |
| 322 (or (equal PC-word-delimiters PC-delims) | |
| 323 (setq PC-delims PC-word-delimiters | |
| 324 PC-delim-regex (concat "[" PC-delims "]") | |
| 325 PC-ndelims-regex (concat "[^" PC-delims "]*") | |
| 326 PC-delims-list (append PC-delims nil))) | |
| 327 | |
| 328 ;; Look for wildcard expansions in directory name | |
| 329 (and filename | |
| 330 (string-match "\\*.*/" str) | |
| 331 (let ((pat str) | |
| 332 files) | |
| 333 (setq p (1+ (string-match "/[^/]*\\'" pat))) | |
| 334 (while (setq p (string-match PC-delim-regex pat p)) | |
| 335 (setq pat (concat (substring pat 0 p) | |
| 336 "*" | |
| 337 (substring pat p)) | |
| 338 p (+ p 2))) | |
| 339 (setq files (PC-expand-many-files (concat pat "*"))) | |
| 340 (if files | |
| 341 (let ((dir (file-name-directory (car files))) | |
| 342 (p files)) | |
| 343 (while (and (setq p (cdr p)) | |
| 344 (equal dir (file-name-directory (car p))))) | |
| 345 (if p | |
| 346 (setq filename nil table nil pred nil | |
| 347 ambig t) | |
| 348 (delete-region beg end) | |
| 349 (setq str (concat dir (file-name-nondirectory str))) | |
| 350 (insert str) | |
| 351 (setq end (+ beg (length str))))) | |
| 352 (setq filename nil table nil pred nil)))) | |
| 353 | |
| 354 ;; Strip directory name if appropriate | |
| 355 (if filename | |
| 356 (if incname | |
| 357 (setq basestr (substring str incname) | |
| 358 dirname (substring str 0 incname)) | |
| 359 (setq basestr (file-name-nondirectory str) | |
| 360 dirname (file-name-directory str))) | |
| 361 (setq basestr str)) | |
| 362 | |
| 363 ;; Convert search pattern to a standard regular expression | |
| 364 (setq regex (regexp-quote basestr) | |
| 365 offset (if (and (> (length regex) 0) | |
| 366 (not (eq (aref basestr 0) ?\*)) | |
| 367 (or (eq PC-first-char t) | |
| 368 (and PC-first-char filename))) 1 0) | |
| 369 p offset) | |
| 370 (while (setq p (string-match PC-delim-regex regex p)) | |
| 371 (if (eq (aref regex p) ? ) | |
| 372 (setq regex (concat (substring regex 0 p) | |
| 373 PC-ndelims-regex | |
| 374 PC-delim-regex | |
| 375 (substring regex (1+ p))) | |
| 376 p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) | |
| 377 (let ((bump (if (memq (aref regex p) | |
| 378 '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) | |
| 379 -1 0))) | |
| 380 (setq regex (concat (substring regex 0 (+ p bump)) | |
| 381 PC-ndelims-regex | |
| 382 (substring regex (+ p bump))) | |
| 383 p (+ p (length PC-ndelims-regex) 1))))) | |
| 384 (setq p 0) | |
| 385 (if filename | |
| 386 (while (setq p (string-match "\\\\\\*" regex p)) | |
| 387 (setq regex (concat (substring regex 0 p) | |
| 388 "[^/]*" | |
| 389 (substring regex (+ p 2)))))) | |
| 390 ;;(setq the-regex regex) | |
| 391 (setq regex (concat "\\`" regex)) | |
| 392 | |
| 393 ;; Find an initial list of possible completions | |
| 394 (if (not (setq p (string-match (concat PC-delim-regex | |
| 395 (if filename "\\|\\*" "")) | |
| 396 str | |
| 397 (+ (length dirname) offset)))) | |
| 398 | |
| 399 ;; Minibuffer contains no hyphens -- simple case! | |
| 400 (setq poss (all-completions str | |
| 401 table | |
| 402 pred)) | |
| 403 | |
| 404 ;; Use all-completions to do an initial cull. This is a big win, | |
| 405 ;; since all-completions is written in C! | |
| 406 (let ((compl (all-completions (substring str 0 p) | |
| 407 table | |
| 408 pred))) | |
| 409 (setq p compl) | |
| 410 (while p | |
| 411 (and (string-match regex (car p)) | |
| 412 (setq poss (cons (car p) poss))) | |
| 413 (setq p (cdr p))))) | |
| 414 | |
| 415 ;; Now we have a list of possible completions | |
| 416 (cond | |
| 417 | |
| 418 ;; No valid completions found | |
| 419 ((null poss) | |
| 420 (if (and (eq mode 'word) | |
| 421 (not PC-word-failed-flag)) | |
| 422 (let ((PC-word-failed-flag t)) | |
| 423 (delete-backward-char 1) | |
| 424 (PC-do-completion 'word)) | |
| 425 (beep) | |
| 426 (PC-temp-minibuffer-message (if ambig | |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
427 " [Ambiguous dir name]" |
| 3725 | 428 (if (eq mode 'help) |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
429 " [No completions]" |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
430 " [No match]"))) |
| 3725 | 431 nil)) |
| 432 | |
| 433 ;; More than one valid completion found | |
| 434 ((or (cdr (setq helpposs poss)) | |
| 435 (memq mode '(help word))) | |
| 436 | |
| 437 ;; Handle completion-ignored-extensions | |
| 438 (and filename | |
| 439 (not (eq mode 'help)) | |
| 440 (let ((p2 poss)) | |
| 441 | |
| 442 ;; Build a regular expression representing the extensions list | |
| 443 (or (equal completion-ignored-extensions PC-ignored-extensions) | |
| 444 (setq PC-ignored-regexp | |
| 445 (concat "\\(" | |
| 446 (mapconcat | |
| 447 'regexp-quote | |
| 448 (setq PC-ignored-extensions | |
| 449 completion-ignored-extensions) | |
| 450 "\\|") | |
| 451 "\\)\\'"))) | |
| 452 | |
| 453 ;; Check if there are any without an ignored extension | |
| 454 (setq p nil) | |
| 455 (while p2 | |
| 456 (or (string-match PC-ignored-regexp (car p2)) | |
| 457 (setq p (cons (car p2) p))) | |
| 458 (setq p2 (cdr p2))) | |
| 459 | |
| 460 ;; If there are "good" names, use them | |
| 461 (and p (setq poss p)))) | |
| 462 | |
| 463 ;; Is the actual string one of the possible completions? | |
| 464 (setq p (and (not (eq mode 'help)) poss)) | |
| 465 (while (and p | |
| 466 (not (equal (car p) basestr))) | |
| 467 (setq p (cdr p))) | |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
468 (and p (null mode) |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
469 (PC-temp-minibuffer-message " [Complete, but not unique]")) |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
470 (if (and p |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
471 (not (and (null mode) |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
472 (eq this-command last-command)))) |
|
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
473 t |
| 3725 | 474 |
| 475 ;; If ambiguous, try for a partial completion | |
| 476 (let ((improved nil) | |
| 477 prefix | |
| 478 (pt nil) | |
| 479 (skip "\\`")) | |
| 480 | |
| 481 ;; Check if next few letters are the same in all cases | |
| 482 (if (and (not (eq mode 'help)) | |
| 483 (setq prefix (try-completion "" (mapcar 'list poss)))) | |
| 484 (let ((first t) i) | |
| 485 (if (eq mode 'word) | |
| 486 (setq prefix (PC-chop-word prefix basestr))) | |
| 487 (goto-char (+ beg (length dirname))) | |
| 488 (while (and (progn | |
| 489 (setq i 0) | |
| 490 (while (< i (length prefix)) | |
| 491 (if (and (< (point) end) | |
| 492 (eq (aref prefix i) | |
| 493 (following-char))) | |
| 494 (forward-char 1) | |
| 495 (if (and (< (point) end) | |
| 496 (or (and (looking-at " ") | |
| 497 (memq (aref prefix i) | |
| 498 PC-delims-list)) | |
| 499 (eq (downcase (aref prefix i)) | |
| 500 (downcase | |
| 501 (following-char))))) | |
| 502 (progn | |
| 503 (delete-char 1) | |
| 504 (setq end (1- end))) | |
| 505 (and filename (looking-at "\\*") | |
| 506 (progn | |
| 507 (delete-char 1) | |
| 508 (setq end (1- end)))) | |
| 509 (setq improved t)) | |
|
7792
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
510 ;; Use format to discard text properties. |
|
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
511 (insert (format "%s" (substring prefix i (1+ i)))) |
| 3725 | 512 (setq end (1+ end))) |
| 513 (setq i (1+ i))) | |
| 514 (or pt (equal (point) beg) | |
| 515 (setq pt (point))) | |
| 516 (looking-at PC-delim-regex)) | |
| 517 (setq skip (concat skip | |
| 518 (regexp-quote prefix) | |
| 519 PC-ndelims-regex) | |
| 520 prefix (try-completion | |
| 521 "" | |
| 522 (mapcar | |
| 523 (function | |
| 524 (lambda (x) | |
| 525 (list | |
| 526 (and (string-match skip x) | |
| 527 (substring | |
| 528 x | |
| 529 (match-end 0)))))) | |
| 530 poss))) | |
| 531 (or (> i 0) (> (length prefix) 0)) | |
| 532 (or (not (eq mode 'word)) | |
| 533 (and first (> (length prefix) 0) | |
| 534 (setq first nil | |
| 535 prefix (substring prefix 0 1)))))) | |
| 536 (goto-char (if (eq mode 'word) end | |
| 537 (or pt beg))))) | |
| 538 | |
| 539 (if (and (eq mode 'word) | |
| 540 (not PC-word-failed-flag)) | |
| 541 | |
| 542 (if improved | |
| 543 | |
| 544 ;; We changed it... would it be complete without the space? | |
| 545 (if (PC-is-complete-p (buffer-substring 1 (1- end)) | |
| 546 table pred) | |
| 547 (delete-region (1- end) end))) | |
| 548 | |
| 549 (if improved | |
| 550 | |
| 551 ;; We changed it... enough to be complete? | |
| 552 (and (eq mode 'exit) | |
| 553 (PC-is-complete-p (buffer-string) table pred)) | |
| 554 | |
| 555 ;; If totally ambiguous, display a list of completions | |
| 556 (if (or completion-auto-help | |
| 557 (eq mode 'help)) | |
|
7844
86402e8c677b
(PC-do-completion): Likewise.
Richard M. Stallman <rms@gnu.org>
parents:
7792
diff
changeset
|
558 (with-output-to-temp-buffer "*Completions*" |
|
8478
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
559 (display-completion-list (sort helpposs 'string-lessp)) |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
560 (save-excursion |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
561 (set-buffer standard-output) |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
562 ;; Record which part of the buffer we are completing |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
563 ;; so that choosing a completion from the list |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
564 ;; knows how much old text to replace. |
|
9d3d84a3c3fa
(PC-do-completion): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
565 (setq completion-base-size dirlength))) |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
566 (PC-temp-minibuffer-message " [Next char not unique]")) |
| 3725 | 567 nil))))) |
| 568 | |
| 569 ;; Only one possible completion | |
| 570 (t | |
| 571 (if (equal basestr (car poss)) | |
| 572 (if (null mode) | |
|
10164
d16e46a4e34c
(PC-do-completion): If complete but not unique,
Richard M. Stallman <rms@gnu.org>
parents:
8478
diff
changeset
|
573 (PC-temp-minibuffer-message " [Sole completion]")) |
| 3725 | 574 (delete-region beg end) |
|
7792
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
575 (insert (format "%s" |
|
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
576 (if filename |
|
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
577 (substitute-in-file-name (concat dirname (car poss))) |
|
1335cec8a016
(PC-do-completion): Clear text props from inserted text.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
578 (car poss))))) |
| 3725 | 579 t))))) |
| 580 | |
| 581 | |
| 582 (defun PC-is-complete-p (str table pred) | |
| 583 (let ((res (if (listp table) | |
| 584 (assoc str table) | |
| 585 (if (vectorp table) | |
| 586 (or (equal str "nil") ; heh, heh, heh | |
| 587 (intern-soft str table)) | |
| 588 (funcall table str pred 'lambda))))) | |
| 589 (and res | |
| 590 (or (not pred) | |
| 591 (and (not (listp table)) (not (vectorp table))) | |
| 592 (funcall pred res)) | |
| 593 res))) | |
| 594 | |
| 595 (defun PC-chop-word (new old) | |
| 596 (let ((i -1) | |
| 597 (j -1)) | |
| 598 (while (and (setq i (string-match PC-delim-regex old (1+ i))) | |
| 599 (setq j (string-match PC-delim-regex new (1+ j))))) | |
| 600 (if (and j | |
| 601 (or (not PC-word-failed-flag) | |
| 602 (setq j (string-match PC-delim-regex new (1+ j))))) | |
| 603 (substring new 0 (1+ j)) | |
| 604 new))) | |
| 605 | |
| 606 (defvar PC-not-minibuffer nil) | |
| 607 | |
| 608 (defun PC-temp-minibuffer-message (m) | |
| 609 "A Lisp version of `temp_minibuffer_message' from minibuf.c." | |
| 610 (if PC-not-minibuffer | |
| 611 (progn | |
| 612 (message m) | |
| 613 (sit-for 2) | |
| 614 (message "")) | |
| 615 (if (fboundp 'temp-minibuffer-message) | |
| 616 (temp-minibuffer-message m) | |
| 617 (let ((savemax (point-max))) | |
| 618 (save-excursion | |
| 619 (goto-char (point-max)) | |
| 620 (insert m)) | |
| 621 (let ((inhibit-quit t)) | |
| 622 (sit-for 2) | |
| 623 (delete-region savemax (point-max)) | |
| 624 (if quit-flag | |
| 625 (setq quit-flag nil | |
| 626 unread-command-char 7))))))) | |
| 627 | |
| 628 | |
| 629 (defun PC-lisp-complete-symbol () | |
| 630 "Perform completion on Lisp symbol preceding point. | |
| 631 That symbol is compared against the symbols that exist | |
| 632 and any additional characters determined by what is there | |
| 633 are inserted. | |
| 634 If the symbol starts just after an open-parenthesis, | |
| 635 only symbols with function definitions are considered. | |
| 636 Otherwise, all symbols with function definitions, values | |
| 637 or properties are considered." | |
| 638 (interactive) | |
| 639 (let* ((end (point)) | |
| 640 (buffer-syntax (syntax-table)) | |
| 641 (beg (unwind-protect | |
| 642 (save-excursion | |
| 643 (if lisp-mode-syntax-table | |
| 644 (set-syntax-table lisp-mode-syntax-table)) | |
| 645 (backward-sexp 1) | |
| 646 (while (= (char-syntax (following-char)) ?\') | |
| 647 (forward-char 1)) | |
| 648 (point)) | |
| 649 (set-syntax-table buffer-syntax))) | |
| 650 (minibuffer-completion-table obarray) | |
| 651 (minibuffer-completion-predicate | |
| 652 (if (eq (char-after (1- beg)) ?\() | |
| 653 'fboundp | |
| 654 (function (lambda (sym) | |
| 655 (or (boundp sym) (fboundp sym) | |
| 656 (symbol-plist sym)))))) | |
| 657 (PC-not-minibuffer t)) | |
| 658 (PC-do-completion nil beg end))) | |
| 659 | |
| 660 | |
| 661 ;;; Wildcards in `C-x C-f' command. This is independent from the main | |
| 662 ;;; completion code, except for `PC-expand-many-files' which is called | |
| 663 ;;; when "*"'s are found in the path during filename completion. (The | |
| 664 ;;; above completion code always understands "*"'s, except in file paths, | |
| 665 ;;; without relying on the following code.) | |
| 666 | |
| 667 (defvar PC-many-files-list nil) | |
| 668 | |
| 669 (defun PC-try-load-many-files () | |
| 670 (if (string-match "\\*" buffer-file-name) | |
| 671 (let* ((pat buffer-file-name) | |
| 672 (files (PC-expand-many-files pat)) | |
| 673 (first (car files)) | |
| 674 (next files)) | |
| 675 (kill-buffer (current-buffer)) | |
| 676 (or files | |
| 677 (error "No matching files")) | |
| 678 (save-window-excursion | |
| 679 (while (setq next (cdr next)) | |
| 680 (let ((buf (find-file-noselect (car next)))) | |
| 681 (switch-to-buffer buf)))) | |
| 682 ;; This modifies the "buf" variable inside find-file-noselect. | |
| 683 (setq buf (get-file-buffer first)) | |
| 684 (if buf | |
| 685 nil ; should do verify-visited-file-modtime stuff. | |
| 686 (setq filename first) | |
| 687 (setq buf (create-file-buffer filename)) | |
| 688 (set-buffer buf) | |
| 689 (erase-buffer) | |
| 690 (insert-file-contents filename t)) | |
| 691 (if (cdr files) | |
| 692 (setq PC-many-files-list (mapconcat | |
| 693 (if (string-match "\\*.*/" pat) | |
| 694 'identity | |
| 695 'file-name-nondirectory) | |
| 696 (cdr files) ", ") | |
| 697 find-file-hooks (cons 'PC-after-load-many-files | |
| 698 find-file-hooks))) | |
| 699 ;; This modifies the "error" variable inside find-file-noselect. | |
| 700 (setq error nil) | |
| 701 t) | |
| 702 nil)) | |
| 703 | |
| 704 (defun PC-after-load-many-files () | |
| 705 (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks)) | |
| 706 (message "Also loaded %s." PC-many-files-list)) | |
| 707 | |
| 708 (defun PC-expand-many-files (name) | |
| 709 (save-excursion | |
| 710 (set-buffer (generate-new-buffer " *Glob Output*")) | |
| 711 (erase-buffer) | |
| 712 (shell-command (concat "echo " name) t) | |
| 713 (goto-char (point-min)) | |
| 714 (if (looking-at ".*No match") | |
| 715 nil | |
| 716 (insert "(\"") | |
| 717 (while (search-forward " " nil t) | |
| 718 (delete-backward-char 1) | |
| 719 (insert "\" \"")) | |
| 720 (goto-char (point-max)) | |
| 721 (delete-backward-char 1) | |
| 722 (insert "\")") | |
| 723 (goto-char (point-min)) | |
| 724 (let ((files (read (current-buffer)))) | |
| 725 (kill-buffer (current-buffer)) | |
| 726 files)))) | |
| 727 | |
| 728 (or PC-disable-wildcards | |
| 729 (memq 'PC-try-load-many-files find-file-not-found-hooks) | |
| 730 (setq find-file-not-found-hooks (cons 'PC-try-load-many-files | |
| 731 find-file-not-found-hooks))) | |
| 732 | |
| 733 | |
| 734 | |
| 735 ;;; Facilities for loading C header files. This is independent from the | |
| 736 ;;; main completion code. See also the variable `PC-include-file-path' | |
| 737 ;;; at top of this file. | |
| 738 | |
| 739 (defun PC-look-for-include-file () | |
| 740 (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) | |
| 741 (let ((name (substring (buffer-file-name) | |
| 742 (match-beginning 1) (match-end 1))) | |
| 743 (punc (aref (buffer-file-name) (match-beginning 0))) | |
| 744 (path nil) | |
| 745 new-buf) | |
| 746 (kill-buffer (current-buffer)) | |
| 747 (if (equal name "") | |
| 748 (save-excursion | |
| 749 (set-buffer (car (buffer-list))) | |
| 750 (save-excursion | |
| 751 (beginning-of-line) | |
| 752 (if (looking-at | |
| 753 "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") | |
| 754 (setq name (buffer-substring (match-beginning 1) | |
| 755 (match-end 1)) | |
| 756 punc (char-after (1- (match-beginning 1)))) | |
| 757 ;; Suggested by Frank Siebenlist: | |
| 758 (if (or (looking-at | |
| 759 "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") | |
| 760 (looking-at | |
| 761 "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") | |
| 762 (looking-at | |
| 763 "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) | |
| 764 (progn | |
| 765 (setq name (buffer-substring (match-beginning 1) | |
| 766 (match-end 1)) | |
| 767 punc ?\< | |
| 768 path load-path) | |
| 769 (if (string-match "\\.elc$" name) | |
| 770 (setq name (substring name 0 -1)) | |
| 771 (or (string-match "\\.el$" name) | |
| 772 (setq name (concat name ".el"))))) | |
| 773 (error "Not on an #include line")))))) | |
| 774 (or (string-match "\\.[a-zA-Z0-9]+$" name) | |
| 775 (setq name (concat name ".h"))) | |
| 776 (if (eq punc ?\<) | |
| 777 (let ((path (or path (PC-include-file-path)))) | |
| 778 (while (and path | |
| 779 (not (file-exists-p | |
| 780 (concat (file-name-as-directory (car path)) | |
| 781 name)))) | |
| 782 (setq path (cdr path))) | |
| 783 (if path | |
| 784 (setq name (concat (file-name-as-directory (car path)) name)) | |
| 785 (error "No such include file: <%s>" name))) | |
| 786 (let ((dir (save-excursion | |
| 787 (set-buffer (car (buffer-list))) | |
| 788 default-directory))) | |
| 789 (if (file-exists-p (concat dir name)) | |
| 790 (setq name (concat dir name)) | |
| 791 (error "No such include file: \"%s\"" name)))) | |
| 792 (setq new-buf (get-file-buffer name)) | |
| 793 (if new-buf | |
| 794 ;; no need to verify last-modified time for this! | |
| 795 (set-buffer new-buf) | |
| 796 (setq new-buf (create-file-buffer name)) | |
| 797 (set-buffer new-buf) | |
| 798 (erase-buffer) | |
| 799 (insert-file-contents name t)) | |
| 800 (setq filename name | |
| 801 error nil | |
| 802 buf new-buf) | |
| 803 t) | |
| 804 nil)) | |
| 805 | |
| 806 (defun PC-include-file-path () | |
| 807 (or PC-include-file-path | |
| 808 (let ((env (getenv "INCPATH")) | |
| 809 (path nil) | |
| 810 pos) | |
| 811 (or env (error "No include file path specified")) | |
| 812 (while (setq pos (string-match ":[^:]+$" env)) | |
| 813 (setq path (cons (substring env (1+ pos)) path) | |
| 814 env (substring env 0 pos))) | |
| 815 path))) | |
| 816 | |
| 817 ;;; This is adapted from lib-complete.el, by Mike Williams. | |
| 818 (defun PC-include-file-all-completions (file search-path &optional full) | |
| 819 "Return all completions for FILE in any directory on SEARCH-PATH. | |
| 820 If optional third argument FULL is non-nil, returned pathnames should be | |
| 821 absolute rather than relative to some directory on the SEARCH-PATH." | |
| 822 (setq search-path | |
| 823 (mapcar '(lambda (dir) | |
| 824 (if dir (file-name-as-directory dir) default-directory)) | |
| 825 search-path)) | |
| 826 (if (file-name-absolute-p file) | |
| 827 ;; It's an absolute file name, so don't need search-path | |
| 828 (progn | |
| 829 (setq file (expand-file-name file)) | |
| 830 (file-name-all-completions | |
| 831 (file-name-nondirectory file) (file-name-directory file))) | |
| 832 (let ((subdir (file-name-directory file)) | |
| 833 (ndfile (file-name-nondirectory file)) | |
| 834 file-lists) | |
| 835 ;; Append subdirectory part to each element of search-path | |
| 836 (if subdir | |
| 837 (setq search-path | |
| 838 (mapcar '(lambda (dir) (concat dir subdir)) | |
| 839 search-path) | |
| 840 file )) | |
| 841 ;; Make list of completions in each directory on search-path | |
| 842 (while search-path | |
| 843 (let* ((dir (car search-path)) | |
| 844 (subdir (if full dir subdir))) | |
| 845 (if (file-directory-p dir) | |
| 846 (progn | |
| 847 (setq file-lists | |
| 848 (cons | |
| 849 (mapcar '(lambda (file) (concat subdir file)) | |
| 850 (file-name-all-completions ndfile | |
| 851 (car search-path))) | |
| 852 file-lists)))) | |
| 853 (setq search-path (cdr search-path)))) | |
| 854 ;; Compress out duplicates while building complete list (slloooow!) | |
| 855 (let ((sorted (sort (apply 'nconc file-lists) | |
| 856 '(lambda (x y) (not (string-lessp x y))))) | |
| 857 compressed) | |
| 858 (while sorted | |
| 859 (if (equal (car sorted) (car compressed)) nil | |
| 860 (setq compressed (cons (car sorted) compressed))) | |
| 861 (setq sorted (cdr sorted))) | |
| 862 compressed)))) | |
| 863 | |
| 864 (defvar PC-old-read-file-name-internal nil) | |
| 865 | |
| 866 (defun PC-read-include-file-name-internal (string dir action) | |
| 867 (if (string-match "<\\([^\"<>]*\\)>?$" string) | |
| 868 (let* ((name (substring string (match-beginning 1) (match-end 1))) | |
| 869 (str2 (substring string (match-beginning 0))) | |
| 870 (completion-table | |
| 871 (mapcar (function (lambda (x) (list (format "<%s>" x)))) | |
| 872 (PC-include-file-all-completions | |
| 873 name (PC-include-file-path))))) | |
| 874 (cond | |
| 875 ((not completion-table) nil) | |
| 876 ((eq action nil) (try-completion str2 completion-table nil)) | |
| 877 ((eq action t) (all-completions str2 completion-table nil)) | |
| 878 ((eq action 'lambda) | |
| 879 (eq (try-completion str2 completion-table nil) t)))) | |
| 880 (funcall PC-old-read-file-name-internal string dir action))) | |
| 881 | |
| 882 (or PC-disable-includes | |
| 883 (memq 'PC-look-for-include-file find-file-not-found-hooks) | |
| 884 (setq find-file-not-found-hooks (cons 'PC-look-for-include-file | |
| 885 find-file-not-found-hooks))) | |
| 886 | |
| 887 (or PC-disable-includes | |
| 888 PC-old-read-file-name-internal | |
| 889 (progn | |
| 890 (setq PC-old-read-file-name-internal | |
| 891 (symbol-function 'read-file-name-internal)) | |
| 892 (fset 'read-file-name-internal 'PC-read-include-file-name-internal))) | |
| 893 | |
| 894 | |
| 895 (provide 'complete) | |
| 896 | |
| 897 ;;; End. |
