diff options
| author | Jim Blandy | 1993-06-14 14:58:03 +0000 |
|---|---|---|
| committer | Jim Blandy | 1993-06-14 14:58:03 +0000 |
| commit | b545bfe6d495b3473e07f609502ca97402faf37b (patch) | |
| tree | 24bba3213863c0b1f2b5b53abb1fdee59fa5a2a5 /lisp/complete.el | |
| parent | 7162c5c4dc3c0f92f14d179b3592a630173b0263 (diff) | |
| download | emacs-b545bfe6d495b3473e07f609502ca97402faf37b.tar.gz emacs-b545bfe6d495b3473e07f609502ca97402faf37b.zip | |
Initial revision
Diffstat (limited to 'lisp/complete.el')
| -rw-r--r-- | lisp/complete.el | 859 |
1 files changed, 859 insertions, 0 deletions
diff --git a/lisp/complete.el b/lisp/complete.el new file mode 100644 index 00000000000..222a0cfba61 --- /dev/null +++ b/lisp/complete.el | |||
| @@ -0,0 +1,859 @@ | |||
| 1 | ;; complete.el -- partial completion mechanism plus other goodies. | ||
| 2 | |||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Dave Gillespie <daveg@synaptics.com> | ||
| 6 | ;; Version: 2.02 | ||
| 7 | ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 12 | ;; but WITHOUT ANY WARRANTY. No author or distributor | ||
| 13 | ;; accepts responsibility to anyone for the consequences of using it | ||
| 14 | ;; or for whether it serves any particular purpose or works at all, | ||
| 15 | ;; unless he says so in writing. Refer to the GNU Emacs General Public | ||
| 16 | ;; License for full details. | ||
| 17 | |||
| 18 | ;; Everyone is granted permission to copy, modify and redistribute | ||
| 19 | ;; GNU Emacs, but only under the conditions described in the | ||
| 20 | ;; GNU Emacs General Public License. A copy of this license is | ||
| 21 | ;; supposed to have been given to you along with GNU Emacs so you | ||
| 22 | ;; can know your rights and responsibilities. It should be in a | ||
| 23 | ;; file named COPYING. Among other things, the copyright notice | ||
| 24 | ;; and this notice must be preserved on all copies. | ||
| 25 | |||
| 26 | |||
| 27 | ;; Commentary: | ||
| 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 | |||
| 99 | ;; Code: | ||
| 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 | ||
| 114 | (not containing character ranges like `a-z').") | ||
| 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) | ||
| 181 | (PC-do-completion nil))) | ||
| 182 | |||
| 183 | |||
| 184 | (defun PC-complete-word () | ||
| 185 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | ||
| 186 | See `PC-complete' for details. | ||
| 187 | This can be bound to other keys, like `-' and `.', if you wish." | ||
| 188 | (interactive) | ||
| 189 | (if (eq (PC-was-meta-key) PC-meta-flag) | ||
| 190 | (if (eq last-command-char ? ) | ||
| 191 | (minibuffer-complete-word) | ||
| 192 | (self-insert-command 1)) | ||
| 193 | (self-insert-command 1) | ||
| 194 | (if (eobp) | ||
| 195 | (PC-do-completion 'word)))) | ||
| 196 | |||
| 197 | |||
| 198 | (defun PC-complete-space () | ||
| 199 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | ||
| 200 | See `PC-complete' for details. | ||
| 201 | This is suitable for binding to other keys which should act just like SPC." | ||
| 202 | (interactive) | ||
| 203 | (if (eq (PC-was-meta-key) PC-meta-flag) | ||
| 204 | (minibuffer-complete-word) | ||
| 205 | (insert " ") | ||
| 206 | (if (eobp) | ||
| 207 | (PC-do-completion 'word)))) | ||
| 208 | |||
| 209 | |||
| 210 | (defun PC-complete-and-exit () | ||
| 211 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | ||
| 212 | See `PC-complete' for details." | ||
| 213 | (interactive) | ||
| 214 | (if (eq (PC-was-meta-key) PC-meta-flag) | ||
| 215 | (minibuffer-complete-and-exit) | ||
| 216 | (PC-do-complete-and-exit))) | ||
| 217 | |||
| 218 | (defun PC-force-complete-and-exit () | ||
| 219 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | ||
| 220 | See `PC-complete' for details." | ||
| 221 | (interactive) | ||
| 222 | (let ((minibuffer-completion-confirm nil)) | ||
| 223 | (PC-do-complete-and-exit))) | ||
| 224 | |||
| 225 | (defun PC-do-complete-and-exit () | ||
| 226 | (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on... | ||
| 227 | (exit-minibuffer) | ||
| 228 | (let ((flag (PC-do-completion 'exit))) | ||
| 229 | (and flag | ||
| 230 | (if (or (eq flag 'complete) | ||
| 231 | (not minibuffer-completion-confirm)) | ||
| 232 | (exit-minibuffer) | ||
| 233 | (PC-temp-minibuffer-message " (Confirm)")))))) | ||
| 234 | |||
| 235 | |||
| 236 | (defun PC-completion-help () | ||
| 237 | "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. | ||
| 238 | See `PC-complete' for details." | ||
| 239 | (interactive) | ||
| 240 | (if (eq (PC-was-meta-key) PC-meta-flag) | ||
| 241 | (minibuffer-completion-help) | ||
| 242 | (PC-do-completion 'help))) | ||
| 243 | |||
| 244 | (defun PC-was-meta-key () | ||
| 245 | (or (/= (length (this-command-keys)) 1) | ||
| 246 | (let ((key (aref (this-command-keys) 0))) | ||
| 247 | (if (integerp key) | ||
| 248 | (>= key 128) | ||
| 249 | (not (null (memq 'meta (event-modifiers key)))))))) | ||
| 250 | |||
| 251 | |||
| 252 | (defvar PC-ignored-extensions 'empty-cache) | ||
| 253 | (defvar PC-delims 'empty-cache) | ||
| 254 | (defvar PC-ignored-regexp nil) | ||
| 255 | (defvar PC-word-failed-flag nil) | ||
| 256 | (defvar PC-delim-regex nil) | ||
| 257 | (defvar PC-ndelims-regex nil) | ||
| 258 | (defvar PC-delims-list nil) | ||
| 259 | |||
| 260 | (defun PC-do-completion (&optional mode beg end) | ||
| 261 | (or beg (setq beg (point-min))) | ||
| 262 | (or end (setq end (point-max))) | ||
| 263 | (let* ((table minibuffer-completion-table) | ||
| 264 | (pred minibuffer-completion-predicate) | ||
| 265 | (filename (memq table '(read-file-name-internal | ||
| 266 | read-directory-name-internal))) | ||
| 267 | (dirname nil) | ||
| 268 | (str (buffer-substring beg end)) | ||
| 269 | (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) | ||
| 270 | (ambig nil) | ||
| 271 | basestr | ||
| 272 | regex | ||
| 273 | p offset | ||
| 274 | (poss nil) | ||
| 275 | helpposs | ||
| 276 | (case-fold-search completion-ignore-case)) | ||
| 277 | |||
| 278 | ;; Check if buffer contents can already be considered complete | ||
| 279 | (if (and (eq mode 'exit) | ||
| 280 | (PC-is-complete-p str table pred)) | ||
| 281 | 'complete | ||
| 282 | |||
| 283 | ;; Do substitutions in directory names | ||
| 284 | (and filename | ||
| 285 | (not (equal str (setq p (substitute-in-file-name str)))) | ||
| 286 | (progn | ||
| 287 | (delete-region beg end) | ||
| 288 | (insert p) | ||
| 289 | (setq str p end (+ beg (length str))))) | ||
| 290 | |||
| 291 | ;; Prepare various delimiter strings | ||
| 292 | (or (equal PC-word-delimiters PC-delims) | ||
| 293 | (setq PC-delims PC-word-delimiters | ||
| 294 | PC-delim-regex (concat "[" PC-delims "]") | ||
| 295 | PC-ndelims-regex (concat "[^" PC-delims "]*") | ||
| 296 | PC-delims-list (append PC-delims nil))) | ||
| 297 | |||
| 298 | ;; Look for wildcard expansions in directory name | ||
| 299 | (and filename | ||
| 300 | (string-match "\\*.*/" str) | ||
| 301 | (let ((pat str) | ||
| 302 | files) | ||
| 303 | (setq p (1+ (string-match "/[^/]*\\'" pat))) | ||
| 304 | (while (setq p (string-match PC-delim-regex pat p)) | ||
| 305 | (setq pat (concat (substring pat 0 p) | ||
| 306 | "*" | ||
| 307 | (substring pat p)) | ||
| 308 | p (+ p 2))) | ||
| 309 | (setq files (PC-expand-many-files (concat pat "*"))) | ||
| 310 | (if files | ||
| 311 | (let ((dir (file-name-directory (car files))) | ||
| 312 | (p files)) | ||
| 313 | (while (and (setq p (cdr p)) | ||
| 314 | (equal dir (file-name-directory (car p))))) | ||
| 315 | (if p | ||
| 316 | (setq filename nil table nil pred nil | ||
| 317 | ambig t) | ||
| 318 | (delete-region beg end) | ||
| 319 | (setq str (concat dir (file-name-nondirectory str))) | ||
| 320 | (insert str) | ||
| 321 | (setq end (+ beg (length str))))) | ||
| 322 | (setq filename nil table nil pred nil)))) | ||
| 323 | |||
| 324 | ;; Strip directory name if appropriate | ||
| 325 | (if filename | ||
| 326 | (if incname | ||
| 327 | (setq basestr (substring str incname) | ||
| 328 | dirname (substring str 0 incname)) | ||
| 329 | (setq basestr (file-name-nondirectory str) | ||
| 330 | dirname (file-name-directory str))) | ||
| 331 | (setq basestr str)) | ||
| 332 | |||
| 333 | ;; Convert search pattern to a standard regular expression | ||
| 334 | (setq regex (regexp-quote basestr) | ||
| 335 | offset (if (and (> (length regex) 0) | ||
| 336 | (not (eq (aref basestr 0) ?\*)) | ||
| 337 | (or (eq PC-first-char t) | ||
| 338 | (and PC-first-char filename))) 1 0) | ||
| 339 | p offset) | ||
| 340 | (while (setq p (string-match PC-delim-regex regex p)) | ||
| 341 | (if (eq (aref regex p) ? ) | ||
| 342 | (setq regex (concat (substring regex 0 p) | ||
| 343 | PC-ndelims-regex | ||
| 344 | PC-delim-regex | ||
| 345 | (substring regex (1+ p))) | ||
| 346 | p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) | ||
| 347 | (let ((bump (if (memq (aref regex p) | ||
| 348 | '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) | ||
| 349 | -1 0))) | ||
| 350 | (setq regex (concat (substring regex 0 (+ p bump)) | ||
| 351 | PC-ndelims-regex | ||
| 352 | (substring regex (+ p bump))) | ||
| 353 | p (+ p (length PC-ndelims-regex) 1))))) | ||
| 354 | (setq p 0) | ||
| 355 | (if filename | ||
| 356 | (while (setq p (string-match "\\\\\\*" regex p)) | ||
| 357 | (setq regex (concat (substring regex 0 p) | ||
| 358 | "[^/]*" | ||
| 359 | (substring regex (+ p 2)))))) | ||
| 360 | ;;(setq the-regex regex) | ||
| 361 | (setq regex (concat "\\`" regex)) | ||
| 362 | |||
| 363 | ;; Find an initial list of possible completions | ||
| 364 | (if (not (setq p (string-match (concat PC-delim-regex | ||
| 365 | (if filename "\\|\\*" "")) | ||
| 366 | str | ||
| 367 | (+ (length dirname) offset)))) | ||
| 368 | |||
| 369 | ;; Minibuffer contains no hyphens -- simple case! | ||
| 370 | (setq poss (all-completions str | ||
| 371 | table | ||
| 372 | pred)) | ||
| 373 | |||
| 374 | ;; Use all-completions to do an initial cull. This is a big win, | ||
| 375 | ;; since all-completions is written in C! | ||
| 376 | (let ((compl (all-completions (substring str 0 p) | ||
| 377 | table | ||
| 378 | pred))) | ||
| 379 | (setq p compl) | ||
| 380 | (while p | ||
| 381 | (and (string-match regex (car p)) | ||
| 382 | (setq poss (cons (car p) poss))) | ||
| 383 | (setq p (cdr p))))) | ||
| 384 | |||
| 385 | ;; Now we have a list of possible completions | ||
| 386 | (cond | ||
| 387 | |||
| 388 | ;; No valid completions found | ||
| 389 | ((null poss) | ||
| 390 | (if (and (eq mode 'word) | ||
| 391 | (not PC-word-failed-flag)) | ||
| 392 | (let ((PC-word-failed-flag t)) | ||
| 393 | (delete-backward-char 1) | ||
| 394 | (PC-do-completion 'word)) | ||
| 395 | (beep) | ||
| 396 | (PC-temp-minibuffer-message (if ambig | ||
| 397 | " (Ambiguous dir name)" | ||
| 398 | (if (eq mode 'help) | ||
| 399 | " (No completions)" | ||
| 400 | " (No match)"))) | ||
| 401 | nil)) | ||
| 402 | |||
| 403 | ;; More than one valid completion found | ||
| 404 | ((or (cdr (setq helpposs poss)) | ||
| 405 | (memq mode '(help word))) | ||
| 406 | |||
| 407 | ;; Handle completion-ignored-extensions | ||
| 408 | (and filename | ||
| 409 | (not (eq mode 'help)) | ||
| 410 | (let ((p2 poss)) | ||
| 411 | |||
| 412 | ;; Build a regular expression representing the extensions list | ||
| 413 | (or (equal completion-ignored-extensions PC-ignored-extensions) | ||
| 414 | (setq PC-ignored-regexp | ||
| 415 | (concat "\\(" | ||
| 416 | (mapconcat | ||
| 417 | 'regexp-quote | ||
| 418 | (setq PC-ignored-extensions | ||
| 419 | completion-ignored-extensions) | ||
| 420 | "\\|") | ||
| 421 | "\\)\\'"))) | ||
| 422 | |||
| 423 | ;; Check if there are any without an ignored extension | ||
| 424 | (setq p nil) | ||
| 425 | (while p2 | ||
| 426 | (or (string-match PC-ignored-regexp (car p2)) | ||
| 427 | (setq p (cons (car p2) p))) | ||
| 428 | (setq p2 (cdr p2))) | ||
| 429 | |||
| 430 | ;; If there are "good" names, use them | ||
| 431 | (and p (setq poss p)))) | ||
| 432 | |||
| 433 | ;; Is the actual string one of the possible completions? | ||
| 434 | (setq p (and (not (eq mode 'help)) poss)) | ||
| 435 | (while (and p | ||
| 436 | (not (equal (car p) basestr))) | ||
| 437 | (setq p (cdr p))) | ||
| 438 | (if p | ||
| 439 | |||
| 440 | (progn | ||
| 441 | (if (null mode) | ||
| 442 | (PC-temp-minibuffer-message " (Complete, but not unique)")) | ||
| 443 | t) | ||
| 444 | |||
| 445 | ;; If ambiguous, try for a partial completion | ||
| 446 | (let ((improved nil) | ||
| 447 | prefix | ||
| 448 | (pt nil) | ||
| 449 | (skip "\\`")) | ||
| 450 | |||
| 451 | ;; Check if next few letters are the same in all cases | ||
| 452 | (if (and (not (eq mode 'help)) | ||
| 453 | (setq prefix (try-completion "" (mapcar 'list poss)))) | ||
| 454 | (let ((first t) i) | ||
| 455 | (if (eq mode 'word) | ||
| 456 | (setq prefix (PC-chop-word prefix basestr))) | ||
| 457 | (goto-char (+ beg (length dirname))) | ||
| 458 | (while (and (progn | ||
| 459 | (setq i 0) | ||
| 460 | (while (< i (length prefix)) | ||
| 461 | (if (and (< (point) end) | ||
| 462 | (eq (aref prefix i) | ||
| 463 | (following-char))) | ||
| 464 | (forward-char 1) | ||
| 465 | (if (and (< (point) end) | ||
| 466 | (or (and (looking-at " ") | ||
| 467 | (memq (aref prefix i) | ||
| 468 | PC-delims-list)) | ||
| 469 | (eq (downcase (aref prefix i)) | ||
| 470 | (downcase | ||
| 471 | (following-char))))) | ||
| 472 | (progn | ||
| 473 | (delete-char 1) | ||
| 474 | (setq end (1- end))) | ||
| 475 | (and filename (looking-at "\\*") | ||
| 476 | (progn | ||
| 477 | (delete-char 1) | ||
| 478 | (setq end (1- end)))) | ||
| 479 | (setq improved t)) | ||
| 480 | (insert (substring prefix i (1+ i))) | ||
| 481 | (setq end (1+ end))) | ||
| 482 | (setq i (1+ i))) | ||
| 483 | (or pt (equal (point) beg) | ||
| 484 | (setq pt (point))) | ||
| 485 | (looking-at PC-delim-regex)) | ||
| 486 | (setq skip (concat skip | ||
| 487 | (regexp-quote prefix) | ||
| 488 | PC-ndelims-regex) | ||
| 489 | prefix (try-completion | ||
| 490 | "" | ||
| 491 | (mapcar | ||
| 492 | (function | ||
| 493 | (lambda (x) | ||
| 494 | (list | ||
| 495 | (and (string-match skip x) | ||
| 496 | (substring | ||
| 497 | x | ||
| 498 | (match-end 0)))))) | ||
| 499 | poss))) | ||
| 500 | (or (> i 0) (> (length prefix) 0)) | ||
| 501 | (or (not (eq mode 'word)) | ||
| 502 | (and first (> (length prefix) 0) | ||
| 503 | (setq first nil | ||
| 504 | prefix (substring prefix 0 1)))))) | ||
| 505 | (goto-char (if (eq mode 'word) end | ||
| 506 | (or pt beg))))) | ||
| 507 | |||
| 508 | (if (and (eq mode 'word) | ||
| 509 | (not PC-word-failed-flag)) | ||
| 510 | |||
| 511 | (if improved | ||
| 512 | |||
| 513 | ;; We changed it... would it be complete without the space? | ||
| 514 | (if (PC-is-complete-p (buffer-substring 1 (1- end)) | ||
| 515 | table pred) | ||
| 516 | (delete-region (1- end) end))) | ||
| 517 | |||
| 518 | (if improved | ||
| 519 | |||
| 520 | ;; We changed it... enough to be complete? | ||
| 521 | (and (eq mode 'exit) | ||
| 522 | (PC-is-complete-p (buffer-string) table pred)) | ||
| 523 | |||
| 524 | ;; If totally ambiguous, display a list of completions | ||
| 525 | (if (or completion-auto-help | ||
| 526 | (eq mode 'help)) | ||
| 527 | (with-output-to-temp-buffer " *Completions*" | ||
| 528 | (display-completion-list (sort helpposs 'string-lessp))) | ||
| 529 | (PC-temp-minibuffer-message " (Next char not unique)")) | ||
| 530 | nil))))) | ||
| 531 | |||
| 532 | ;; Only one possible completion | ||
| 533 | (t | ||
| 534 | (if (equal basestr (car poss)) | ||
| 535 | (if (null mode) | ||
| 536 | (PC-temp-minibuffer-message " (Sole completion)")) | ||
| 537 | (delete-region beg end) | ||
| 538 | (insert (if filename | ||
| 539 | (substitute-in-file-name (concat dirname (car poss))) | ||
| 540 | (car poss)))) | ||
| 541 | t))))) | ||
| 542 | |||
| 543 | |||
| 544 | (defun PC-is-complete-p (str table pred) | ||
| 545 | (let ((res (if (listp table) | ||
| 546 | (assoc str table) | ||
| 547 | (if (vectorp table) | ||
| 548 | (or (equal str "nil") ; heh, heh, heh | ||
| 549 | (intern-soft str table)) | ||
| 550 | (funcall table str pred 'lambda))))) | ||
| 551 | (and res | ||
| 552 | (or (not pred) | ||
| 553 | (and (not (listp table)) (not (vectorp table))) | ||
| 554 | (funcall pred res)) | ||
| 555 | res))) | ||
| 556 | |||
| 557 | (defun PC-chop-word (new old) | ||
| 558 | (let ((i -1) | ||
| 559 | (j -1)) | ||
| 560 | (while (and (setq i (string-match PC-delim-regex old (1+ i))) | ||
| 561 | (setq j (string-match PC-delim-regex new (1+ j))))) | ||
| 562 | (if (and j | ||
| 563 | (or (not PC-word-failed-flag) | ||
| 564 | (setq j (string-match PC-delim-regex new (1+ j))))) | ||
| 565 | (substring new 0 (1+ j)) | ||
| 566 | new))) | ||
| 567 | |||
| 568 | (defvar PC-not-minibuffer nil) | ||
| 569 | |||
| 570 | (defun PC-temp-minibuffer-message (m) | ||
| 571 | "A Lisp version of `temp_minibuffer_message' from minibuf.c." | ||
| 572 | (if PC-not-minibuffer | ||
| 573 | (progn | ||
| 574 | (message m) | ||
| 575 | (sit-for 2) | ||
| 576 | (message "")) | ||
| 577 | (if (fboundp 'temp-minibuffer-message) | ||
| 578 | (temp-minibuffer-message m) | ||
| 579 | (let ((savemax (point-max))) | ||
| 580 | (save-excursion | ||
| 581 | (goto-char (point-max)) | ||
| 582 | (insert m)) | ||
| 583 | (let ((inhibit-quit t)) | ||
| 584 | (sit-for 2) | ||
| 585 | (delete-region savemax (point-max)) | ||
| 586 | (if quit-flag | ||
| 587 | (setq quit-flag nil | ||
| 588 | unread-command-char 7))))))) | ||
| 589 | |||
| 590 | |||
| 591 | (defun PC-lisp-complete-symbol () | ||
| 592 | "Perform completion on Lisp symbol preceding point. | ||
| 593 | That symbol is compared against the symbols that exist | ||
| 594 | and any additional characters determined by what is there | ||
| 595 | are inserted. | ||
| 596 | If the symbol starts just after an open-parenthesis, | ||
| 597 | only symbols with function definitions are considered. | ||
| 598 | Otherwise, all symbols with function definitions, values | ||
| 599 | or properties are considered." | ||
| 600 | (interactive) | ||
| 601 | (let* ((end (point)) | ||
| 602 | (buffer-syntax (syntax-table)) | ||
| 603 | (beg (unwind-protect | ||
| 604 | (save-excursion | ||
| 605 | (if lisp-mode-syntax-table | ||
| 606 | (set-syntax-table lisp-mode-syntax-table)) | ||
| 607 | (backward-sexp 1) | ||
| 608 | (while (= (char-syntax (following-char)) ?\') | ||
| 609 | (forward-char 1)) | ||
| 610 | (point)) | ||
| 611 | (set-syntax-table buffer-syntax))) | ||
| 612 | (minibuffer-completion-table obarray) | ||
| 613 | (minibuffer-completion-predicate | ||
| 614 | (if (eq (char-after (1- beg)) ?\() | ||
| 615 | 'fboundp | ||
| 616 | (function (lambda (sym) | ||
| 617 | (or (boundp sym) (fboundp sym) | ||
| 618 | (symbol-plist sym)))))) | ||
| 619 | (PC-not-minibuffer t)) | ||
| 620 | (PC-do-completion nil beg end))) | ||
| 621 | |||
| 622 | |||
| 623 | ;;; Wildcards in `C-x C-f' command. This is independent from the main | ||
| 624 | ;;; completion code, except for `PC-expand-many-files' which is called | ||
| 625 | ;;; when "*"'s are found in the path during filename completion. (The | ||
| 626 | ;;; above completion code always understands "*"'s, except in file paths, | ||
| 627 | ;;; without relying on the following code.) | ||
| 628 | |||
| 629 | (defvar PC-many-files-list nil) | ||
| 630 | |||
| 631 | (defun PC-try-load-many-files () | ||
| 632 | (if (string-match "\\*" buffer-file-name) | ||
| 633 | (let* ((pat buffer-file-name) | ||
| 634 | (files (PC-expand-many-files pat)) | ||
| 635 | (first (car files)) | ||
| 636 | (next files)) | ||
| 637 | (kill-buffer (current-buffer)) | ||
| 638 | (or files | ||
| 639 | (error "No matching files")) | ||
| 640 | (save-window-excursion | ||
| 641 | (while (setq next (cdr next)) | ||
| 642 | (let ((buf (find-file-noselect (car next)))) | ||
| 643 | (switch-to-buffer buf)))) | ||
| 644 | ;; This modifies the "buf" variable inside find-file-noselect. | ||
| 645 | (setq buf (get-file-buffer first)) | ||
| 646 | (if buf | ||
| 647 | nil ; should do verify-visited-file-modtime stuff. | ||
| 648 | (setq filename first) | ||
| 649 | (setq buf (create-file-buffer filename)) | ||
| 650 | (set-buffer buf) | ||
| 651 | (erase-buffer) | ||
| 652 | (insert-file-contents filename t)) | ||
| 653 | (if (cdr files) | ||
| 654 | (setq PC-many-files-list (mapconcat | ||
| 655 | (if (string-match "\\*.*/" pat) | ||
| 656 | 'identity | ||
| 657 | 'file-name-nondirectory) | ||
| 658 | (cdr files) ", ") | ||
| 659 | find-file-hooks (cons 'PC-after-load-many-files | ||
| 660 | find-file-hooks))) | ||
| 661 | ;; This modifies the "error" variable inside find-file-noselect. | ||
| 662 | (setq error nil) | ||
| 663 | t) | ||
| 664 | nil)) | ||
| 665 | |||
| 666 | (defun PC-after-load-many-files () | ||
| 667 | (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks)) | ||
| 668 | (message "Also loaded %s." PC-many-files-list)) | ||
| 669 | |||
| 670 | (defun PC-expand-many-files (name) | ||
| 671 | (save-excursion | ||
| 672 | (set-buffer (generate-new-buffer " *Glob Output*")) | ||
| 673 | (erase-buffer) | ||
| 674 | (shell-command (concat "echo " name) t) | ||
| 675 | (goto-char (point-min)) | ||
| 676 | (if (looking-at ".*No match") | ||
| 677 | nil | ||
| 678 | (insert "(\"") | ||
| 679 | (while (search-forward " " nil t) | ||
| 680 | (delete-backward-char 1) | ||
| 681 | (insert "\" \"")) | ||
| 682 | (goto-char (point-max)) | ||
| 683 | (delete-backward-char 1) | ||
| 684 | (insert "\")") | ||
| 685 | (goto-char (point-min)) | ||
| 686 | (let ((files (read (current-buffer)))) | ||
| 687 | (kill-buffer (current-buffer)) | ||
| 688 | files)))) | ||
| 689 | |||
| 690 | (or PC-disable-wildcards | ||
| 691 | (memq 'PC-try-load-many-files find-file-not-found-hooks) | ||
| 692 | (setq find-file-not-found-hooks (cons 'PC-try-load-many-files | ||
| 693 | find-file-not-found-hooks))) | ||
| 694 | |||
| 695 | |||
| 696 | |||
| 697 | ;;; Facilities for loading C header files. This is independent from the | ||
| 698 | ;;; main completion code. See also the variable `PC-include-file-path' | ||
| 699 | ;;; at top of this file. | ||
| 700 | |||
| 701 | (defun PC-look-for-include-file () | ||
| 702 | (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) | ||
| 703 | (let ((name (substring (buffer-file-name) | ||
| 704 | (match-beginning 1) (match-end 1))) | ||
| 705 | (punc (aref (buffer-file-name) (match-beginning 0))) | ||
| 706 | (path nil) | ||
| 707 | new-buf) | ||
| 708 | (kill-buffer (current-buffer)) | ||
| 709 | (if (equal name "") | ||
| 710 | (save-excursion | ||
| 711 | (set-buffer (car (buffer-list))) | ||
| 712 | (save-excursion | ||
| 713 | (beginning-of-line) | ||
| 714 | (if (looking-at | ||
| 715 | "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") | ||
| 716 | (setq name (buffer-substring (match-beginning 1) | ||
| 717 | (match-end 1)) | ||
| 718 | punc (char-after (1- (match-beginning 1)))) | ||
| 719 | ;; Suggested by Frank Siebenlist: | ||
| 720 | (if (or (looking-at | ||
| 721 | "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") | ||
| 722 | (looking-at | ||
| 723 | "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") | ||
| 724 | (looking-at | ||
| 725 | "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) | ||
| 726 | (progn | ||
| 727 | (setq name (buffer-substring (match-beginning 1) | ||
| 728 | (match-end 1)) | ||
| 729 | punc ?\< | ||
| 730 | path load-path) | ||
| 731 | (if (string-match "\\.elc$" name) | ||
| 732 | (setq name (substring name 0 -1)) | ||
| 733 | (or (string-match "\\.el$" name) | ||
| 734 | (setq name (concat name ".el"))))) | ||
| 735 | (error "Not on an #include line")))))) | ||
| 736 | (or (string-match "\\.[a-zA-Z0-9]+$" name) | ||
| 737 | (setq name (concat name ".h"))) | ||
| 738 | (if (eq punc ?\<) | ||
| 739 | (let ((path (or path (PC-include-file-path)))) | ||
| 740 | (while (and path | ||
| 741 | (not (file-exists-p | ||
| 742 | (concat (file-name-as-directory (car path)) | ||
| 743 | name)))) | ||
| 744 | (setq path (cdr path))) | ||
| 745 | (if path | ||
| 746 | (setq name (concat (file-name-as-directory (car path)) name)) | ||
| 747 | (error "No such include file: <%s>" name))) | ||
| 748 | (let ((dir (save-excursion | ||
| 749 | (set-buffer (car (buffer-list))) | ||
| 750 | default-directory))) | ||
| 751 | (if (file-exists-p (concat dir name)) | ||
| 752 | (setq name (concat dir name)) | ||
| 753 | (error "No such include file: \"%s\"" name)))) | ||
| 754 | (setq new-buf (get-file-buffer name)) | ||
| 755 | (if new-buf | ||
| 756 | ;; no need to verify last-modified time for this! | ||
| 757 | (set-buffer new-buf) | ||
| 758 | (setq new-buf (create-file-buffer name)) | ||
| 759 | (set-buffer new-buf) | ||
| 760 | (erase-buffer) | ||
| 761 | (insert-file-contents name t)) | ||
| 762 | (setq filename name | ||
| 763 | error nil | ||
| 764 | buf new-buf) | ||
| 765 | t) | ||
| 766 | nil)) | ||
| 767 | |||
| 768 | (defun PC-include-file-path () | ||
| 769 | (or PC-include-file-path | ||
| 770 | (let ((env (getenv "INCPATH")) | ||
| 771 | (path nil) | ||
| 772 | pos) | ||
| 773 | (or env (error "No include file path specified")) | ||
| 774 | (while (setq pos (string-match ":[^:]+$" env)) | ||
| 775 | (setq path (cons (substring env (1+ pos)) path) | ||
| 776 | env (substring env 0 pos))) | ||
| 777 | path))) | ||
| 778 | |||
| 779 | ;;; This is adapted from lib-complete.el, by Mike Williams. | ||
| 780 | (defun PC-include-file-all-completions (file search-path &optional full) | ||
| 781 | "Return all completions for FILE in any directory on SEARCH-PATH. | ||
| 782 | If optional third argument FULL is non-nil, returned pathnames should be | ||
| 783 | absolute rather than relative to some directory on the SEARCH-PATH." | ||
| 784 | (setq search-path | ||
| 785 | (mapcar '(lambda (dir) | ||
| 786 | (if dir (file-name-as-directory dir) default-directory)) | ||
| 787 | search-path)) | ||
| 788 | (if (file-name-absolute-p file) | ||
| 789 | ;; It's an absolute file name, so don't need search-path | ||
| 790 | (progn | ||
| 791 | (setq file (expand-file-name file)) | ||
| 792 | (file-name-all-completions | ||
| 793 | (file-name-nondirectory file) (file-name-directory file))) | ||
| 794 | (let ((subdir (file-name-directory file)) | ||
| 795 | (ndfile (file-name-nondirectory file)) | ||
| 796 | file-lists) | ||
| 797 | ;; Append subdirectory part to each element of search-path | ||
| 798 | (if subdir | ||
| 799 | (setq search-path | ||
| 800 | (mapcar '(lambda (dir) (concat dir subdir)) | ||
| 801 | search-path) | ||
| 802 | file )) | ||
| 803 | ;; Make list of completions in each directory on search-path | ||
| 804 | (while search-path | ||
| 805 | (let* ((dir (car search-path)) | ||
| 806 | (subdir (if full dir subdir))) | ||
| 807 | (if (file-directory-p dir) | ||
| 808 | (progn | ||
| 809 | (setq file-lists | ||
| 810 | (cons | ||
| 811 | (mapcar '(lambda (file) (concat subdir file)) | ||
| 812 | (file-name-all-completions ndfile | ||
| 813 | (car search-path))) | ||
| 814 | file-lists)))) | ||
| 815 | (setq search-path (cdr search-path)))) | ||
| 816 | ;; Compress out duplicates while building complete list (slloooow!) | ||
| 817 | (let ((sorted (sort (apply 'nconc file-lists) | ||
| 818 | '(lambda (x y) (not (string-lessp x y))))) | ||
| 819 | compressed) | ||
| 820 | (while sorted | ||
| 821 | (if (equal (car sorted) (car compressed)) nil | ||
| 822 | (setq compressed (cons (car sorted) compressed))) | ||
| 823 | (setq sorted (cdr sorted))) | ||
| 824 | compressed)))) | ||
| 825 | |||
| 826 | (defvar PC-old-read-file-name-internal nil) | ||
| 827 | |||
| 828 | (defun PC-read-include-file-name-internal (string dir action) | ||
| 829 | (if (string-match "<\\([^\"<>]*\\)>?$" string) | ||
| 830 | (let* ((name (substring string (match-beginning 1) (match-end 1))) | ||
| 831 | (str2 (substring string (match-beginning 0))) | ||
| 832 | (completion-table | ||
| 833 | (mapcar (function (lambda (x) (list (format "<%s>" x)))) | ||
| 834 | (PC-include-file-all-completions | ||
| 835 | name (PC-include-file-path))))) | ||
| 836 | (cond | ||
| 837 | ((not completion-table) nil) | ||
| 838 | ((eq action nil) (try-completion str2 completion-table nil)) | ||
| 839 | ((eq action t) (all-completions str2 completion-table nil)) | ||
| 840 | ((eq action 'lambda) | ||
| 841 | (eq (try-completion str2 completion-table nil) t)))) | ||
| 842 | (funcall PC-old-read-file-name-internal string dir action))) | ||
| 843 | |||
| 844 | (or PC-disable-includes | ||
| 845 | (memq 'PC-look-for-include-file find-file-not-found-hooks) | ||
| 846 | (setq find-file-not-found-hooks (cons 'PC-look-for-include-file | ||
| 847 | find-file-not-found-hooks))) | ||
| 848 | |||
| 849 | (or PC-disable-includes | ||
| 850 | PC-old-read-file-name-internal | ||
| 851 | (progn | ||
| 852 | (setq PC-old-read-file-name-internal | ||
| 853 | (symbol-function 'read-file-name-internal)) | ||
| 854 | (fset 'read-file-name-internal 'PC-read-include-file-name-internal))) | ||
| 855 | |||
| 856 | |||
| 857 | (provide 'complete) | ||
| 858 | |||
| 859 | ;;; End. | ||