| 1 | ;;; complete.el --- partial completion mechanism plus other goodies |
| 2 | |
| 3 | ;; Copyright (C) 1990-1993, 1999-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Dave Gillespie <daveg@synaptics.com> |
| 6 | ;; Keywords: abbrev convenience |
| 7 | ;; Obsolete-since: 24.1 |
| 8 | ;; |
| 9 | ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. |
| 10 | |
| 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 |
| 15 | ;; the Free Software Foundation, either version 3 of the License, or |
| 16 | ;; (at your option) 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 |
| 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; Extended completion for the Emacs minibuffer. |
| 29 | ;; |
| 30 | ;; The basic idea is that the command name or other completable text is |
| 31 | ;; divided into words and each word is completed separately, so that |
| 32 | ;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous |
| 33 | ;; each word is completed as much as possible and then the cursor is |
| 34 | ;; left at the first position where typing another letter will resolve |
| 35 | ;; the ambiguity. |
| 36 | ;; |
| 37 | ;; Word separators for this purpose are hyphen, space, and period. |
| 38 | ;; These would most likely occur in command names, Info menu items, |
| 39 | ;; and file names, respectively. But all word separators are treated |
| 40 | ;; alike at all times. |
| 41 | ;; |
| 42 | ;; This completion package replaces the old-style completer's key |
| 43 | ;; bindings for TAB, SPC, RET, and `?'. The old completer is still |
| 44 | ;; available on the Meta versions of those keys. If you set |
| 45 | ;; PC-meta-flag to nil, the old completion keys will be left alone |
| 46 | ;; and the partial completer will use the Meta versions of the keys. |
| 47 | |
| 48 | |
| 49 | ;; Usage: M-x partial-completion-mode. During completable minibuffer entry, |
| 50 | ;; |
| 51 | ;; TAB means to do a partial completion; |
| 52 | ;; SPC means to do a partial complete-word; |
| 53 | ;; RET means to do a partial complete-and-exit; |
| 54 | ;; ? means to do a partial completion-help. |
| 55 | ;; |
| 56 | ;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform |
| 57 | ;; original Emacs completions, and M-TAB etc. do partial completion. |
| 58 | ;; To do this, put the command, |
| 59 | ;; |
| 60 | ;; (setq PC-meta-flag nil) |
| 61 | ;; |
| 62 | ;; in your .emacs file. To load partial completion automatically, put |
| 63 | ;; |
| 64 | ;; (partial-completion-mode t) |
| 65 | ;; |
| 66 | ;; in your .emacs file, too. Things will be faster if you byte-compile |
| 67 | ;; this file when you install it. |
| 68 | ;; |
| 69 | ;; As an extra feature, in cases where RET would not normally |
| 70 | ;; complete (such as `C-x b'), the M-RET key will always do a partial |
| 71 | ;; complete-and-exit. Thus `C-x b f.c RET' will select or create a |
| 72 | ;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing |
| 73 | ;; buffer whose name matches that pattern (perhaps "filing.c"). |
| 74 | ;; (PC-meta-flag does not affect this behavior; M-RET used to be |
| 75 | ;; undefined in this situation.) |
| 76 | ;; |
| 77 | ;; The regular M-TAB (lisp-complete-symbol) command also supports |
| 78 | ;; partial completion in this package. |
| 79 | |
| 80 | ;; In addition, this package includes a feature for accessing include |
| 81 | ;; files. For example, `C-x C-f <sys/time.h> RET' reads the file |
| 82 | ;; /usr/include/sys/time.h. The variable PC-include-file-path is a |
| 83 | ;; list of directories in which to search for include files. Completion |
| 84 | ;; is supported in include file names. |
| 85 | |
| 86 | |
| 87 | ;;; Code: |
| 88 | |
| 89 | (defgroup partial-completion nil |
| 90 | "Partial Completion of items." |
| 91 | :prefix "pc-" |
| 92 | :group 'minibuffer |
| 93 | :group 'convenience) |
| 94 | |
| 95 | (defcustom PC-first-char 'find-file |
| 96 | "Control how the first character of a string is to be interpreted. |
| 97 | If nil, the first character of a string is not taken literally if it is a word |
| 98 | delimiter, so that \".e\" matches \"*.e*\". |
| 99 | If t, the first character of a string is always taken literally even if it is a |
| 100 | word delimiter, so that \".e\" matches \".e*\". |
| 101 | If non-nil and non-t, the first character is taken literally only for file name |
| 102 | completion." |
| 103 | :type '(choice (const :tag "delimiter" nil) |
| 104 | (const :tag "literal" t) |
| 105 | (other :tag "find-file" find-file)) |
| 106 | :group 'partial-completion) |
| 107 | |
| 108 | (defcustom PC-meta-flag t |
| 109 | "If non-nil, TAB means PC completion and M-TAB means normal completion. |
| 110 | Otherwise, TAB means normal completion and M-TAB means Partial Completion." |
| 111 | :type 'boolean |
| 112 | :group 'partial-completion) |
| 113 | |
| 114 | (defcustom PC-word-delimiters "-_. " |
| 115 | "A string of characters treated as word delimiters for completion. |
| 116 | Some arcane rules: |
| 117 | If `]' is in this string, it must come first. |
| 118 | If `^' is in this string, it must not come first. |
| 119 | If `-' is in this string, it must come first or right after `]'. |
| 120 | In other words, if S is this string, then `[S]' must be a valid Emacs regular |
| 121 | expression (not containing character ranges like `a-z')." |
| 122 | :type 'string |
| 123 | :group 'partial-completion) |
| 124 | |
| 125 | (defcustom PC-include-file-path '("/usr/include" "/usr/local/include") |
| 126 | "A list of directories in which to look for include files. |
| 127 | If nil, means use the colon-separated path in the variable $INCPATH instead." |
| 128 | :type '(repeat directory) |
| 129 | :group 'partial-completion) |
| 130 | |
| 131 | (defcustom PC-disable-includes nil |
| 132 | "If non-nil, include-file support in \\[find-file] is disabled." |
| 133 | :type 'boolean |
| 134 | :group 'partial-completion) |
| 135 | |
| 136 | (defvar PC-default-bindings t |
| 137 | "If non-nil, default partial completion key bindings are suppressed.") |
| 138 | |
| 139 | (defvar PC-env-vars-alist nil |
| 140 | "A list of the environment variable names and values.") |
| 141 | |
| 142 | \f |
| 143 | (defun PC-bindings (bind) |
| 144 | (let ((completion-map minibuffer-local-completion-map) |
| 145 | (must-match-map minibuffer-local-must-match-map)) |
| 146 | (cond ((not bind) |
| 147 | ;; These bindings are the default bindings. It would be better to |
| 148 | ;; restore the previous bindings. |
| 149 | (define-key read-expression-map "\e\t" 'lisp-complete-symbol) |
| 150 | |
| 151 | (define-key completion-map "\t" 'minibuffer-complete) |
| 152 | (define-key completion-map " " 'minibuffer-complete-word) |
| 153 | (define-key completion-map "?" 'minibuffer-completion-help) |
| 154 | |
| 155 | (define-key must-match-map "\r" 'minibuffer-complete-and-exit) |
| 156 | (define-key must-match-map "\n" 'minibuffer-complete-and-exit) |
| 157 | |
| 158 | (define-key global-map [remap lisp-complete-symbol] nil)) |
| 159 | (PC-default-bindings |
| 160 | (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol) |
| 161 | |
| 162 | (define-key completion-map "\t" 'PC-complete) |
| 163 | (define-key completion-map " " 'PC-complete-word) |
| 164 | (define-key completion-map "?" 'PC-completion-help) |
| 165 | |
| 166 | (define-key completion-map "\e\t" 'PC-complete) |
| 167 | (define-key completion-map "\e " 'PC-complete-word) |
| 168 | (define-key completion-map "\e\r" 'PC-force-complete-and-exit) |
| 169 | (define-key completion-map "\e\n" 'PC-force-complete-and-exit) |
| 170 | (define-key completion-map "\e?" 'PC-completion-help) |
| 171 | |
| 172 | (define-key must-match-map "\r" 'PC-complete-and-exit) |
| 173 | (define-key must-match-map "\n" 'PC-complete-and-exit) |
| 174 | |
| 175 | (define-key must-match-map "\e\r" 'PC-complete-and-exit) |
| 176 | (define-key must-match-map "\e\n" 'PC-complete-and-exit) |
| 177 | |
| 178 | (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) |
| 179 | |
| 180 | (defvar PC-do-completion-end nil |
| 181 | "Internal variable used by `PC-do-completion'.") |
| 182 | |
| 183 | (make-variable-buffer-local 'PC-do-completion-end) |
| 184 | |
| 185 | (defvar PC-goto-end nil |
| 186 | "Internal variable set in `PC-do-completion', used in |
| 187 | `choose-completion-string-functions'.") |
| 188 | |
| 189 | (make-variable-buffer-local 'PC-goto-end) |
| 190 | |
| 191 | ;;;###autoload |
| 192 | (define-minor-mode partial-completion-mode |
| 193 | "Toggle Partial Completion mode. |
| 194 | With prefix ARG, turn Partial Completion mode on if ARG is positive. |
| 195 | |
| 196 | When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is |
| 197 | nil) is enhanced so that if some string is divided into words and each word is |
| 198 | delimited by a character in `PC-word-delimiters', partial words are completed |
| 199 | as much as possible and `*' characters are treated likewise in file names. |
| 200 | |
| 201 | For example, M-x p-c-m expands to M-x partial-completion-mode since no other |
| 202 | command begins with that sequence of characters, and |
| 203 | \\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no |
| 204 | other file in that directory begins with that sequence of characters. |
| 205 | |
| 206 | Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted |
| 207 | specially in \\[find-file]. For example, |
| 208 | \\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'. |
| 209 | See also the variable `PC-include-file-path'. |
| 210 | |
| 211 | Partial Completion mode extends the meaning of `completion-auto-help' (which |
| 212 | see), so that if it is neither nil nor t, Emacs shows the `*Completions*' |
| 213 | buffer only on the second attempt to complete. That is, if TAB finds nothing |
| 214 | to complete, the first TAB just says \"Next char not unique\" and the |
| 215 | second TAB brings up the `*Completions*' buffer." |
| 216 | :global t :group 'partial-completion |
| 217 | ;; Deal with key bindings... |
| 218 | (PC-bindings partial-completion-mode) |
| 219 | ;; Deal with include file feature... |
| 220 | (cond ((not partial-completion-mode) |
| 221 | (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) |
| 222 | ((not PC-disable-includes) |
| 223 | (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) |
| 224 | ;; Adjust the completion selection in *Completion* buffers to the way |
| 225 | ;; we work. The default minibuffer completion code only completes the |
| 226 | ;; text before point and leaves the text after point alone (new in |
| 227 | ;; Emacs-22). In contrast we use the whole text and we even sometimes |
| 228 | ;; move point to a place before EOB, to indicate the first position where |
| 229 | ;; there's a difference, so when the user uses choose-completion, we have |
| 230 | ;; to trick choose-completion into replacing the whole minibuffer text |
| 231 | ;; rather than only the text before point. --Stef |
| 232 | (funcall |
| 233 | (if partial-completion-mode 'add-hook 'remove-hook) |
| 234 | 'choose-completion-string-functions |
| 235 | (lambda (choice buffer &rest ignored) |
| 236 | ;; When completing M-: (lisp- ) with point before the ), it is |
| 237 | ;; not appropriate to go to point-max (unlike the filename case). |
| 238 | (if (and (not PC-goto-end) |
| 239 | (minibufferp buffer)) |
| 240 | (goto-char (point-max)) |
| 241 | ;; Need a similar hack for the non-minibuffer-case -- gm. |
| 242 | (when PC-do-completion-end |
| 243 | (goto-char PC-do-completion-end) |
| 244 | (setq PC-do-completion-end nil))) |
| 245 | (setq PC-goto-end nil) |
| 246 | nil)) |
| 247 | ;; Build the env-completion and mapping table. |
| 248 | (when (and partial-completion-mode (null PC-env-vars-alist)) |
| 249 | (setq PC-env-vars-alist |
| 250 | (mapcar (lambda (string) |
| 251 | (let ((d (string-match "=" string))) |
| 252 | (cons (concat "$" (substring string 0 d)) |
| 253 | (and d (substring string (1+ d)))))) |
| 254 | process-environment)))) |
| 255 | |
| 256 | \f |
| 257 | (defun PC-complete () |
| 258 | "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. |
| 259 | For example, \"M-x b--di\" would match `byte-recompile-directory', or any |
| 260 | name which consists of three or more words, the first beginning with \"b\" |
| 261 | and the third beginning with \"di\". |
| 262 | |
| 263 | The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and |
| 264 | `beginning-of-defun', so this would produce a list of completions |
| 265 | just like when normal Emacs completions are ambiguous. |
| 266 | |
| 267 | Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", |
| 268 | \".\", and SPC." |
| 269 | (interactive) |
| 270 | (if (PC-was-meta-key) |
| 271 | (minibuffer-complete) |
| 272 | ;; If the previous command was not this one, |
| 273 | ;; never scroll, always retry completion. |
| 274 | (or (eq last-command this-command) |
| 275 | (setq minibuffer-scroll-window nil)) |
| 276 | (let ((window minibuffer-scroll-window)) |
| 277 | ;; If there's a fresh completion window with a live buffer, |
| 278 | ;; and this command is repeated, scroll that window. |
| 279 | (if (and window (window-buffer window) |
| 280 | (buffer-name (window-buffer window))) |
| 281 | (with-current-buffer (window-buffer window) |
| 282 | (if (pos-visible-in-window-p (point-max) window) |
| 283 | (set-window-start window (point-min) nil) |
| 284 | (scroll-other-window))) |
| 285 | (PC-do-completion nil))))) |
| 286 | |
| 287 | |
| 288 | (defun PC-complete-word () |
| 289 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. |
| 290 | See `PC-complete' for details. |
| 291 | This can be bound to other keys, like `-' and `.', if you wish." |
| 292 | (interactive) |
| 293 | (if (eq (PC-was-meta-key) PC-meta-flag) |
| 294 | (if (eq last-command-event ? ) |
| 295 | (minibuffer-complete-word) |
| 296 | (self-insert-command 1)) |
| 297 | (self-insert-command 1) |
| 298 | (if (eobp) |
| 299 | (PC-do-completion 'word)))) |
| 300 | |
| 301 | |
| 302 | (defun PC-complete-space () |
| 303 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. |
| 304 | See `PC-complete' for details. |
| 305 | This is suitable for binding to other keys which should act just like SPC." |
| 306 | (interactive) |
| 307 | (if (eq (PC-was-meta-key) PC-meta-flag) |
| 308 | (minibuffer-complete-word) |
| 309 | (insert " ") |
| 310 | (if (eobp) |
| 311 | (PC-do-completion 'word)))) |
| 312 | |
| 313 | |
| 314 | (defun PC-complete-and-exit () |
| 315 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. |
| 316 | See `PC-complete' for details." |
| 317 | (interactive) |
| 318 | (if (eq (PC-was-meta-key) PC-meta-flag) |
| 319 | (minibuffer-complete-and-exit) |
| 320 | (PC-do-complete-and-exit))) |
| 321 | |
| 322 | (defun PC-force-complete-and-exit () |
| 323 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. |
| 324 | See `PC-complete' for details." |
| 325 | (interactive) |
| 326 | (let ((minibuffer-completion-confirm nil)) |
| 327 | (PC-do-complete-and-exit))) |
| 328 | |
| 329 | (defun PC-do-complete-and-exit () |
| 330 | (cond |
| 331 | ((= (point-max) (minibuffer-prompt-end)) |
| 332 | ;; Duplicate the "bug" that Info-menu relies on... |
| 333 | (exit-minibuffer)) |
| 334 | ((eq minibuffer-completion-confirm 'confirm) |
| 335 | (if (or (eq last-command this-command) |
| 336 | (test-completion (field-string) |
| 337 | minibuffer-completion-table |
| 338 | minibuffer-completion-predicate)) |
| 339 | (exit-minibuffer) |
| 340 | (PC-temp-minibuffer-message " [Confirm]"))) |
| 341 | ((eq minibuffer-completion-confirm 'confirm-after-completion) |
| 342 | ;; Similar to the above, but only if trying to exit immediately |
| 343 | ;; after typing TAB (this catches most minibuffer typos). |
| 344 | (if (and (memq last-command minibuffer-confirm-exit-commands) |
| 345 | (not (test-completion (field-string) |
| 346 | minibuffer-completion-table |
| 347 | minibuffer-completion-predicate))) |
| 348 | (PC-temp-minibuffer-message " [Confirm]") |
| 349 | (exit-minibuffer))) |
| 350 | (t |
| 351 | (let ((flag (PC-do-completion 'exit))) |
| 352 | (and flag |
| 353 | (if (or (eq flag 'complete) |
| 354 | (not minibuffer-completion-confirm)) |
| 355 | (exit-minibuffer) |
| 356 | (PC-temp-minibuffer-message " [Confirm]"))))))) |
| 357 | |
| 358 | |
| 359 | (defun PC-completion-help () |
| 360 | "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. |
| 361 | See `PC-complete' for details." |
| 362 | (interactive) |
| 363 | (if (eq (PC-was-meta-key) PC-meta-flag) |
| 364 | (minibuffer-completion-help) |
| 365 | (PC-do-completion 'help))) |
| 366 | |
| 367 | (defun PC-was-meta-key () |
| 368 | (or (/= (length (this-command-keys)) 1) |
| 369 | (let ((key (aref (this-command-keys) 0))) |
| 370 | (if (integerp key) |
| 371 | (>= key 128) |
| 372 | (not (null (memq 'meta (event-modifiers key)))))))) |
| 373 | |
| 374 | |
| 375 | (defvar PC-ignored-extensions 'empty-cache) |
| 376 | (defvar PC-delims 'empty-cache) |
| 377 | (defvar PC-ignored-regexp nil) |
| 378 | (defvar PC-word-failed-flag nil) |
| 379 | (defvar PC-delim-regex nil) |
| 380 | (defvar PC-ndelims-regex nil) |
| 381 | (defvar PC-delims-list nil) |
| 382 | |
| 383 | (defvar PC-completion-as-file-name-predicate |
| 384 | (lambda () minibuffer-completing-file-name) |
| 385 | "A function testing whether a minibuffer completion now will work filename-style. |
| 386 | The function takes no arguments, and typically looks at the value |
| 387 | of `minibuffer-completion-table' and the minibuffer contents.") |
| 388 | |
| 389 | ;; Returns the sequence of non-delimiter characters that follow regexp in string. |
| 390 | (defun PC-chunk-after (string regexp) |
| 391 | (if (not (string-match regexp string)) |
| 392 | (let ((message "String %s didn't match regexp %s")) |
| 393 | (message message string regexp) |
| 394 | (error message string regexp))) |
| 395 | (let ((result (substring string (match-end 0)))) |
| 396 | ;; result may contain multiple chunks |
| 397 | (if (string-match PC-delim-regex result) |
| 398 | (setq result (substring result 0 (match-beginning 0)))) |
| 399 | result)) |
| 400 | |
| 401 | (defun test-completion-ignore-case (str table pred) |
| 402 | "Like `test-completion', but ignores case when possible." |
| 403 | ;; Binding completion-ignore-case to nil ensures, for compatibility with |
| 404 | ;; standard completion, that the return value is exactly one of the |
| 405 | ;; possibilities. Do this binding only if pred is nil, out of paranoia; |
| 406 | ;; perhaps it is safe even if pred is non-nil. |
| 407 | (if pred |
| 408 | (test-completion str table pred) |
| 409 | (let ((completion-ignore-case nil)) |
| 410 | (test-completion str table pred)))) |
| 411 | |
| 412 | ;; The following function is an attempt to work around two problems: |
| 413 | |
| 414 | ;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to |
| 415 | ;; return the value "". With a change from 2002-07-07 it returns t which caused |
| 416 | ;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t" |
| 417 | ;; error. `PC-try-completion' returns STRING in this case. |
| 418 | |
| 419 | ;; (2) (try-completion "" '((""))) returned t before the above-mentioned change. |
| 420 | ;; Since `PC-chop-word' operates on the return value of `try-completion' this |
| 421 | ;; case might have provoked a similar error as in (1). `PC-try-completion' |
| 422 | ;; returns "" instead. I don't know whether this is a real problem though. |
| 423 | |
| 424 | ;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you |
| 425 | ;; should try to look at the following discussions when you encounter problems: |
| 426 | ;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23), |
| 427 | ;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24), |
| 428 | ;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]" |
| 429 | ;; starting 2007-03-05). |
| 430 | (defun PC-try-completion (string alist &optional predicate) |
| 431 | "Like `try-completion' but return STRING instead of t." |
| 432 | (let ((result (try-completion string alist predicate))) |
| 433 | (if (eq result t) string result))) |
| 434 | |
| 435 | ;; TODO document MODE magic... |
| 436 | (defun PC-do-completion (&optional mode beg end goto-end) |
| 437 | "Internal function to do the work of partial completion. |
| 438 | Text to be completed lies between BEG and END. Normally when |
| 439 | replacing text in the minibuffer, this function replaces up to |
| 440 | point-max (as is appropriate for completing a file name). If |
| 441 | GOTO-END is non-nil, however, it instead replaces up to END." |
| 442 | (or beg (setq beg (minibuffer-prompt-end))) |
| 443 | (or end (setq end (point-max))) |
| 444 | (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) |
| 445 | 'PC-read-file-name-internal |
| 446 | minibuffer-completion-table)) |
| 447 | (pred minibuffer-completion-predicate) |
| 448 | (filename (funcall PC-completion-as-file-name-predicate)) |
| 449 | (dirname nil) ; non-nil only if a filename is being completed |
| 450 | ;; The following used to be "(dirlength 0)" which caused the erasure of |
| 451 | ;; the entire buffer text before `point' when inserting a completion |
| 452 | ;; into a buffer. |
| 453 | dirlength |
| 454 | (str (buffer-substring beg end)) |
| 455 | (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) |
| 456 | (ambig nil) |
| 457 | basestr origstr |
| 458 | env-on |
| 459 | regex |
| 460 | p offset |
| 461 | abbreviated |
| 462 | (poss nil) |
| 463 | helpposs |
| 464 | (case-fold-search completion-ignore-case)) |
| 465 | |
| 466 | ;; Check if buffer contents can already be considered complete |
| 467 | (if (and (eq mode 'exit) |
| 468 | (test-completion str table pred)) |
| 469 | 'complete |
| 470 | |
| 471 | ;; Do substitutions in directory names |
| 472 | (and filename |
| 473 | (setq basestr (or (file-name-directory str) "")) |
| 474 | (setq dirlength (length basestr)) |
| 475 | ;; Do substitutions in directory names |
| 476 | (setq p (substitute-in-file-name basestr)) |
| 477 | (not (string-equal basestr p)) |
| 478 | (setq str (concat p (file-name-nondirectory str))) |
| 479 | (progn |
| 480 | (delete-region beg end) |
| 481 | (insert str) |
| 482 | (setq end (+ beg (length str))))) |
| 483 | |
| 484 | ;; Prepare various delimiter strings |
| 485 | (or (equal PC-word-delimiters PC-delims) |
| 486 | (setq PC-delims PC-word-delimiters |
| 487 | PC-delim-regex (concat "[" PC-delims "]") |
| 488 | PC-ndelims-regex (concat "[^" PC-delims "]*") |
| 489 | PC-delims-list (append PC-delims nil))) |
| 490 | |
| 491 | ;; Add wildcards if necessary |
| 492 | (and filename |
| 493 | (let ((dir (file-name-directory str)) |
| 494 | (file (file-name-nondirectory str)) |
| 495 | ;; The base dir for file-completion was passed in `predicate'. |
| 496 | (default-directory (if (stringp pred) (expand-file-name pred) |
| 497 | default-directory))) |
| 498 | (while (and (stringp dir) (not (file-directory-p dir))) |
| 499 | (setq dir (directory-file-name dir)) |
| 500 | (setq file (concat (replace-regexp-in-string |
| 501 | PC-delim-regex "*\\&" |
| 502 | (file-name-nondirectory dir)) |
| 503 | "*/" file)) |
| 504 | (setq dir (file-name-directory dir))) |
| 505 | (setq origstr str str (concat dir file)))) |
| 506 | |
| 507 | ;; Look for wildcard expansions in directory name |
| 508 | (and filename |
| 509 | (string-match "\\*.*/" str) |
| 510 | (let ((pat str) |
| 511 | ;; The base dir for file-completion was passed in `predicate'. |
| 512 | (default-directory (if (stringp pred) (expand-file-name pred) |
| 513 | default-directory)) |
| 514 | files) |
| 515 | (setq p (1+ (string-match "/[^/]*\\'" pat))) |
| 516 | (while (setq p (string-match PC-delim-regex pat p)) |
| 517 | (setq pat (concat (substring pat 0 p) |
| 518 | "*" |
| 519 | (substring pat p)) |
| 520 | p (+ p 2))) |
| 521 | (setq files (file-expand-wildcards (concat pat "*"))) |
| 522 | (if files |
| 523 | (let ((dir (file-name-directory (car files))) |
| 524 | (p files)) |
| 525 | (while (and (setq p (cdr p)) |
| 526 | (equal dir (file-name-directory (car p))))) |
| 527 | (if p |
| 528 | (setq filename nil table nil |
| 529 | pred (if (stringp pred) nil pred) |
| 530 | ambig t) |
| 531 | (delete-region beg end) |
| 532 | (setq str (concat dir (file-name-nondirectory str))) |
| 533 | (insert str) |
| 534 | (setq end (+ beg (length str))))) |
| 535 | (if origstr |
| 536 | ;; If the wildcards were introduced by us, it's |
| 537 | ;; possible that PC-read-file-name-internal can |
| 538 | ;; still find matches for the original string |
| 539 | ;; even if we couldn't, so remove the added |
| 540 | ;; wildcards. |
| 541 | (setq str origstr) |
| 542 | (setq filename nil table nil |
| 543 | pred (if (stringp pred) nil pred)))))) |
| 544 | |
| 545 | ;; Strip directory name if appropriate |
| 546 | (if filename |
| 547 | (if incname |
| 548 | (setq basestr (substring str incname) |
| 549 | dirname (substring str 0 incname)) |
| 550 | (setq basestr (file-name-nondirectory str) |
| 551 | dirname (file-name-directory str)) |
| 552 | ;; Make sure str is consistent with its directory and basename |
| 553 | ;; parts. This is important on DOZe'NT systems when str only |
| 554 | ;; includes a drive letter, like in "d:". |
| 555 | (setq str (concat dirname basestr))) |
| 556 | (setq basestr str)) |
| 557 | |
| 558 | ;; Convert search pattern to a standard regular expression |
| 559 | (setq regex (regexp-quote basestr) |
| 560 | offset (if (and (> (length regex) 0) |
| 561 | (not (eq (aref basestr 0) ?\*)) |
| 562 | (or (eq PC-first-char t) |
| 563 | (and PC-first-char filename))) 1 0) |
| 564 | p offset) |
| 565 | (while (setq p (string-match PC-delim-regex regex p)) |
| 566 | (if (eq (aref regex p) ? ) |
| 567 | (setq regex (concat (substring regex 0 p) |
| 568 | PC-ndelims-regex |
| 569 | PC-delim-regex |
| 570 | (substring regex (1+ p))) |
| 571 | p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) |
| 572 | (let ((bump (if (memq (aref regex p) |
| 573 | '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) |
| 574 | -1 0))) |
| 575 | (setq regex (concat (substring regex 0 (+ p bump)) |
| 576 | PC-ndelims-regex |
| 577 | (substring regex (+ p bump))) |
| 578 | p (+ p (length PC-ndelims-regex) 1))))) |
| 579 | (setq p 0) |
| 580 | (if filename |
| 581 | (while (setq p (string-match "\\\\\\*" regex p)) |
| 582 | (setq regex (concat (substring regex 0 p) |
| 583 | "[^/]*" |
| 584 | (substring regex (+ p 2)))))) |
| 585 | ;;(setq the-regex regex) |
| 586 | (setq regex (concat "\\`" regex)) |
| 587 | |
| 588 | (and (> (length basestr) 0) |
| 589 | (= (aref basestr 0) ?$) |
| 590 | (setq env-on t |
| 591 | table PC-env-vars-alist |
| 592 | pred nil)) |
| 593 | |
| 594 | ;; Find an initial list of possible completions |
| 595 | (unless (setq p (string-match (concat PC-delim-regex |
| 596 | (if filename "\\|\\*" "")) |
| 597 | str |
| 598 | (+ (length dirname) offset))) |
| 599 | |
| 600 | ;; Minibuffer contains no hyphens -- simple case! |
| 601 | (setq poss (all-completions (if env-on basestr str) |
| 602 | table |
| 603 | pred)) |
| 604 | (unless (or poss (string-equal str "")) |
| 605 | ;; Try completion as an abbreviation, e.g. "mvb" -> |
| 606 | ;; "m-v-b" -> "multiple-value-bind", but only for |
| 607 | ;; non-empty strings. |
| 608 | (setq origstr str |
| 609 | abbreviated t) |
| 610 | (if filename |
| 611 | (cond |
| 612 | ;; "alpha" or "/alpha" -> expand whole path. |
| 613 | ((string-match "^/?\\([A-Za-z0-9]+\\)$" str) |
| 614 | (setq |
| 615 | basestr "" |
| 616 | p nil |
| 617 | poss (file-expand-wildcards |
| 618 | (concat "/" |
| 619 | (mapconcat #'list (match-string 1 str) "*/") |
| 620 | "*")) |
| 621 | beg (1- beg))) |
| 622 | ;; Alphanumeric trailer -> expand trailing file |
| 623 | ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str) |
| 624 | (setq regex (concat "\\`" |
| 625 | (mapconcat #'list |
| 626 | (match-string 2 str) |
| 627 | "[A-Za-z0-9]*[^A-Za-z0-9]")) |
| 628 | p (1+ (length (match-string 1 str)))))) |
| 629 | (setq regex (concat "\\`" (mapconcat (lambda (c) |
| 630 | (regexp-quote (string c))) |
| 631 | str "[^-]*-")) |
| 632 | p 1)))) |
| 633 | (when p |
| 634 | ;; Use all-completions to do an initial cull. This is a big win, |
| 635 | ;; since all-completions is written in C! |
| 636 | (let ((compl (all-completions (if env-on |
| 637 | (file-name-nondirectory (substring str 0 p)) |
| 638 | (substring str 0 p)) |
| 639 | table |
| 640 | pred))) |
| 641 | (setq p compl) |
| 642 | (when (and compl abbreviated) |
| 643 | (if filename |
| 644 | (progn |
| 645 | (setq p nil) |
| 646 | (dolist (x compl) |
| 647 | (when (string-match regex x) |
| 648 | (push x p))) |
| 649 | (setq basestr (try-completion "" p))) |
| 650 | (setq basestr (mapconcat 'list str "-")) |
| 651 | (delete-region beg end) |
| 652 | (setq end (+ beg (length basestr))) |
| 653 | (insert basestr)))) |
| 654 | (while p |
| 655 | (and (string-match regex (car p)) |
| 656 | (progn |
| 657 | (set-text-properties 0 (length (car p)) '() (car p)) |
| 658 | (setq poss (cons (car p) poss)))) |
| 659 | (setq p (cdr p)))) |
| 660 | |
| 661 | ;; If table had duplicates, they can be here. |
| 662 | (delete-dups poss) |
| 663 | |
| 664 | ;; Handle completion-ignored-extensions |
| 665 | (and filename |
| 666 | (not (eq mode 'help)) |
| 667 | (let ((p2 poss)) |
| 668 | |
| 669 | ;; Build a regular expression representing the extensions list |
| 670 | (or (equal completion-ignored-extensions PC-ignored-extensions) |
| 671 | (setq PC-ignored-regexp |
| 672 | (concat "\\(" |
| 673 | (mapconcat |
| 674 | 'regexp-quote |
| 675 | (setq PC-ignored-extensions |
| 676 | completion-ignored-extensions) |
| 677 | "\\|") |
| 678 | "\\)\\'"))) |
| 679 | |
| 680 | ;; Check if there are any without an ignored extension. |
| 681 | ;; Also ignore `.' and `..'. |
| 682 | (setq p nil) |
| 683 | (while p2 |
| 684 | (or (string-match PC-ignored-regexp (car p2)) |
| 685 | (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) |
| 686 | (setq p (cons (car p2) p))) |
| 687 | (setq p2 (cdr p2))) |
| 688 | |
| 689 | ;; If there are "good" names, use them |
| 690 | (and p (setq poss p)))) |
| 691 | |
| 692 | ;; Now we have a list of possible completions |
| 693 | |
| 694 | (cond |
| 695 | |
| 696 | ;; No valid completions found |
| 697 | ((null poss) |
| 698 | (if (and (eq mode 'word) |
| 699 | (not PC-word-failed-flag)) |
| 700 | (let ((PC-word-failed-flag t)) |
| 701 | (delete-char -1) |
| 702 | (PC-do-completion 'word)) |
| 703 | (when abbreviated |
| 704 | (delete-region beg end) |
| 705 | (insert origstr)) |
| 706 | (beep) |
| 707 | (PC-temp-minibuffer-message (if ambig |
| 708 | " [Ambiguous dir name]" |
| 709 | (if (eq mode 'help) |
| 710 | " [No completions]" |
| 711 | " [No match]"))) |
| 712 | nil)) |
| 713 | |
| 714 | ;; More than one valid completion found |
| 715 | ((or (cdr (setq helpposs poss)) |
| 716 | (memq mode '(help word))) |
| 717 | |
| 718 | ;; Is the actual string one of the possible completions? |
| 719 | (setq p (and (not (eq mode 'help)) poss)) |
| 720 | (while (and p |
| 721 | (not (string-equal (car p) basestr))) |
| 722 | (setq p (cdr p))) |
| 723 | (and p (null mode) |
| 724 | (PC-temp-minibuffer-message " [Complete, but not unique]")) |
| 725 | (if (and p |
| 726 | (not (and (null mode) |
| 727 | (eq this-command last-command)))) |
| 728 | t |
| 729 | |
| 730 | ;; If ambiguous, try for a partial completion |
| 731 | (let ((improved nil) |
| 732 | prefix |
| 733 | (pt nil) |
| 734 | (skip "\\`")) |
| 735 | |
| 736 | ;; Check if next few letters are the same in all cases |
| 737 | (if (and (not (eq mode 'help)) |
| 738 | (setq prefix (PC-try-completion |
| 739 | (PC-chunk-after basestr skip) poss))) |
| 740 | (let ((first t) i) |
| 741 | (if (eq mode 'word) |
| 742 | (setq prefix (PC-chop-word prefix basestr))) |
| 743 | (goto-char (+ beg (length dirname))) |
| 744 | (while (and (progn |
| 745 | (setq i 0) ; index into prefix string |
| 746 | (while (< i (length prefix)) |
| 747 | (if (and (< (point) end) |
| 748 | (or (eq (downcase (aref prefix i)) |
| 749 | (downcase (following-char))) |
| 750 | (and (looking-at " ") |
| 751 | (memq (aref prefix i) |
| 752 | PC-delims-list)))) |
| 753 | ;; replace " " by the actual delimiter |
| 754 | ;; or input char by prefix char |
| 755 | (progn |
| 756 | (delete-char 1) |
| 757 | (insert (substring prefix i (1+ i)))) |
| 758 | ;; insert a new character |
| 759 | (progn |
| 760 | (and filename (looking-at "\\*") |
| 761 | (progn |
| 762 | (delete-char 1) |
| 763 | (setq end (1- end)))) |
| 764 | (setq improved t) |
| 765 | (insert (substring prefix i (1+ i))) |
| 766 | (setq end (1+ end)))) |
| 767 | (setq i (1+ i))) |
| 768 | (or pt (setq pt (point))) |
| 769 | (looking-at PC-delim-regex)) |
| 770 | (setq skip (concat skip |
| 771 | (regexp-quote prefix) |
| 772 | PC-ndelims-regex) |
| 773 | prefix (PC-try-completion |
| 774 | (PC-chunk-after |
| 775 | ;; not basestr, because that does |
| 776 | ;; not reflect insertions |
| 777 | (buffer-substring |
| 778 | (+ beg (length dirname)) end) |
| 779 | skip) |
| 780 | (mapcar |
| 781 | (lambda (x) |
| 782 | (when (string-match skip x) |
| 783 | (substring x (match-end 0)))) |
| 784 | poss))) |
| 785 | (or (> i 0) (> (length prefix) 0)) |
| 786 | (or (not (eq mode 'word)) |
| 787 | (and first (> (length prefix) 0) |
| 788 | (setq first nil |
| 789 | prefix (substring prefix 0 1)))))) |
| 790 | (goto-char (if (eq mode 'word) end |
| 791 | (or pt beg))))) |
| 792 | |
| 793 | (if (and (eq mode 'word) |
| 794 | (not PC-word-failed-flag)) |
| 795 | |
| 796 | (if improved |
| 797 | |
| 798 | ;; We changed it... would it be complete without the space? |
| 799 | (if (test-completion (buffer-substring |
| 800 | (field-beginning) (1- end)) |
| 801 | table pred) |
| 802 | (delete-region (1- end) end))) |
| 803 | |
| 804 | (if improved |
| 805 | |
| 806 | ;; We changed it... enough to be complete? |
| 807 | (and (eq mode 'exit) |
| 808 | (test-completion-ignore-case (field-string) table pred)) |
| 809 | |
| 810 | ;; If totally ambiguous, display a list of completions |
| 811 | (if (or (eq completion-auto-help t) |
| 812 | (and completion-auto-help |
| 813 | (eq last-command this-command)) |
| 814 | (eq mode 'help)) |
| 815 | (let ((prompt-end (minibuffer-prompt-end))) |
| 816 | (with-output-to-temp-buffer "*Completions*" |
| 817 | (display-completion-list (sort helpposs 'string-lessp)) |
| 818 | (setq PC-do-completion-end end |
| 819 | PC-goto-end goto-end) |
| 820 | (with-current-buffer standard-output |
| 821 | ;; Record which part of the buffer we are completing |
| 822 | ;; so that choosing a completion from the list |
| 823 | ;; knows how much old text to replace. |
| 824 | ;; This was briefly nil in the non-dirname case. |
| 825 | ;; However, if one calls PC-lisp-complete-symbol |
| 826 | ;; on "(ne-f" with point on the hyphen, PC offers |
| 827 | ;; all completions starting with "(ne", some of |
| 828 | ;; which do not match the "-f" part (maybe it |
| 829 | ;; should not, but it does). In such cases, |
| 830 | ;; completion gets confused trying to figure out |
| 831 | ;; how much to replace, so we tell it explicitly |
| 832 | ;; (ie, the number of chars in the buffer before beg). |
| 833 | ;; |
| 834 | ;; Note that choose-completion-string-functions |
| 835 | ;; plays around with point. |
| 836 | (setq completion-base-size (if dirname |
| 837 | dirlength |
| 838 | (- beg prompt-end)))))) |
| 839 | (PC-temp-minibuffer-message " [Next char not unique]")) |
| 840 | ;; Expansion of filenames is not reversible, |
| 841 | ;; so just keep the prefix. |
| 842 | (when (and abbreviated filename) |
| 843 | (delete-region (point) end)) |
| 844 | nil))))) |
| 845 | |
| 846 | ;; Only one possible completion |
| 847 | (t |
| 848 | (if (and (equal basestr (car poss)) |
| 849 | (not (and env-on filename)) |
| 850 | (not abbreviated)) |
| 851 | (if (null mode) |
| 852 | (PC-temp-minibuffer-message " [Sole completion]")) |
| 853 | (delete-region beg end) |
| 854 | (insert (format "%s" |
| 855 | (if filename |
| 856 | (substitute-in-file-name (concat dirname (car poss))) |
| 857 | (car poss))))) |
| 858 | t))))) |
| 859 | |
| 860 | (defun PC-chop-word (new old) |
| 861 | (let ((i -1) |
| 862 | (j -1)) |
| 863 | (while (and (setq i (string-match PC-delim-regex old (1+ i))) |
| 864 | (setq j (string-match PC-delim-regex new (1+ j))))) |
| 865 | (if (and j |
| 866 | (or (not PC-word-failed-flag) |
| 867 | (setq j (string-match PC-delim-regex new (1+ j))))) |
| 868 | (substring new 0 (1+ j)) |
| 869 | new))) |
| 870 | |
| 871 | (defvar PC-not-minibuffer nil) |
| 872 | |
| 873 | (defun PC-temp-minibuffer-message (message) |
| 874 | "A Lisp version of `temp_minibuffer_message' from minibuf.c." |
| 875 | (cond (PC-not-minibuffer |
| 876 | (message "%s" message) |
| 877 | (sit-for 2) |
| 878 | (message "")) |
| 879 | ((fboundp 'temp-minibuffer-message) |
| 880 | (temp-minibuffer-message message)) |
| 881 | (t |
| 882 | (let ((point-max (point-max))) |
| 883 | (save-excursion |
| 884 | (goto-char point-max) |
| 885 | (insert message)) |
| 886 | (let ((inhibit-quit t)) |
| 887 | (sit-for 2) |
| 888 | (delete-region point-max (point-max)) |
| 889 | (when quit-flag |
| 890 | (setq quit-flag nil |
| 891 | unread-command-events '(7)))))))) |
| 892 | |
| 893 | ;; Does not need to be buffer-local (?) because only used when one |
| 894 | ;; PC-l-c-s immediately follows another. |
| 895 | (defvar PC-lisp-complete-end nil |
| 896 | "Internal variable used by `PC-lisp-complete-symbol'.") |
| 897 | |
| 898 | (defun PC-lisp-complete-symbol () |
| 899 | "Perform completion on Lisp symbol preceding point. |
| 900 | That symbol is compared against the symbols that exist |
| 901 | and any additional characters determined by what is there |
| 902 | are inserted. |
| 903 | If the symbol starts just after an open-parenthesis, |
| 904 | only symbols with function definitions are considered. |
| 905 | Otherwise, all symbols with function definitions, values |
| 906 | or properties are considered." |
| 907 | (interactive) |
| 908 | (let* ((end |
| 909 | (save-excursion |
| 910 | (with-syntax-table lisp-mode-syntax-table |
| 911 | (skip-syntax-forward "_w") |
| 912 | (point)))) |
| 913 | (beg (save-excursion |
| 914 | (with-syntax-table lisp-mode-syntax-table |
| 915 | (backward-sexp 1) |
| 916 | (while (= (char-syntax (following-char)) ?\') |
| 917 | (forward-char 1)) |
| 918 | (point)))) |
| 919 | (minibuffer-completion-table obarray) |
| 920 | (minibuffer-completion-predicate |
| 921 | (if (eq (char-after (1- beg)) ?\() |
| 922 | 'fboundp |
| 923 | (function (lambda (sym) |
| 924 | (or (boundp sym) (fboundp sym) |
| 925 | (symbol-plist sym)))))) |
| 926 | (PC-not-minibuffer t)) |
| 927 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html |
| 928 | ;; |
| 929 | ;; This deals with cases like running PC-l-c-s on "M-: (n-f". |
| 930 | ;; The first call to PC-l-c-s expands this to "(ne-f", and moves |
| 931 | ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after, |
| 932 | ;; then without the last-command check, one is offered all |
| 933 | ;; completions of "(ne", which is presumably not what one wants. |
| 934 | ;; |
| 935 | ;; This is arguably (at least, it seems to be the existing intended |
| 936 | ;; behavior) what one _does_ want if point has been explicitly |
| 937 | ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds |
| 938 | ;; completion-base-size to nil, then completion does not replace the |
| 939 | ;; correct amount of text in such cases. |
| 940 | ;; |
| 941 | ;; Neither of these problems occur when using PC for filenames in the |
| 942 | ;; minibuffer, because in that case PC-do-completion is called without |
| 943 | ;; an explicit value for END, and so uses (point-max). This is fine for |
| 944 | ;; a filename, because the end of the filename must be at the end of |
| 945 | ;; the minibuffer. The same is not true for lisp symbols. |
| 946 | ;; |
| 947 | ;; [1] An alternate fix would be to not move point to the hyphen |
| 948 | ;; in such cases, but that would make the behavior different from |
| 949 | ;; that for filenames. It seems PC moves point to the site of the |
| 950 | ;; first difference between the possible completions. |
| 951 | ;; |
| 952 | ;; Alternatively alternatively, maybe end should be computed in |
| 953 | ;; the same way as beg. That would change the behavior though. |
| 954 | (if (equal last-command 'PC-lisp-complete-symbol) |
| 955 | (PC-do-completion nil beg PC-lisp-complete-end t) |
| 956 | (if PC-lisp-complete-end |
| 957 | (move-marker PC-lisp-complete-end end) |
| 958 | (setq PC-lisp-complete-end (copy-marker end t))) |
| 959 | (PC-do-completion nil beg end t)))) |
| 960 | |
| 961 | (defun PC-complete-as-file-name () |
| 962 | "Perform completion on file names preceding point. |
| 963 | Environment vars are converted to their values." |
| 964 | (interactive) |
| 965 | (let* ((end (point)) |
| 966 | (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" |
| 967 | (point-min) t) |
| 968 | (+ (point) 2) |
| 969 | (point-min))) |
| 970 | (minibuffer-completion-table 'PC-read-file-name-internal) |
| 971 | (minibuffer-completion-predicate nil) |
| 972 | (PC-not-minibuffer t)) |
| 973 | (goto-char end) |
| 974 | (PC-do-completion nil beg end))) |
| 975 | |
| 976 | ;; Facilities for loading C header files. This is independent from the |
| 977 | ;; main completion code. See also the variable `PC-include-file-path' |
| 978 | ;; at top of this file. |
| 979 | |
| 980 | (defun PC-look-for-include-file () |
| 981 | (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) |
| 982 | (let ((name (substring (buffer-file-name) |
| 983 | (match-beginning 1) (match-end 1))) |
| 984 | (punc (aref (buffer-file-name) (match-beginning 0))) |
| 985 | (path nil) |
| 986 | new-buf) |
| 987 | (kill-buffer (current-buffer)) |
| 988 | (if (equal name "") |
| 989 | (with-current-buffer (car (buffer-list)) |
| 990 | (save-excursion |
| 991 | (beginning-of-line) |
| 992 | (if (looking-at |
| 993 | "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") |
| 994 | (setq name (buffer-substring (match-beginning 1) |
| 995 | (match-end 1)) |
| 996 | punc (char-after (1- (match-beginning 1)))) |
| 997 | ;; Suggested by Frank Siebenlist: |
| 998 | (if (or (looking-at |
| 999 | "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") |
| 1000 | (looking-at |
| 1001 | "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") |
| 1002 | (looking-at |
| 1003 | "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) |
| 1004 | (progn |
| 1005 | (setq name (buffer-substring (match-beginning 1) |
| 1006 | (match-end 1)) |
| 1007 | punc ?\< |
| 1008 | path load-path) |
| 1009 | (if (string-match "\\.elc$" name) |
| 1010 | (setq name (substring name 0 -1)) |
| 1011 | (or (string-match "\\.el$" name) |
| 1012 | (setq name (concat name ".el"))))) |
| 1013 | (error "Not on an #include line")))))) |
| 1014 | (or (string-match "\\.[[:alnum:]]+$" name) |
| 1015 | (setq name (concat name ".h"))) |
| 1016 | (if (eq punc ?\<) |
| 1017 | (let ((path (or path (PC-include-file-path)))) |
| 1018 | (while (and path |
| 1019 | (not (file-exists-p |
| 1020 | (concat (file-name-as-directory (car path)) |
| 1021 | name)))) |
| 1022 | (setq path (cdr path))) |
| 1023 | (if path |
| 1024 | (setq name (concat (file-name-as-directory (car path)) name)) |
| 1025 | (error "No such include file: <%s>" name))) |
| 1026 | (let ((dir (with-current-buffer (car (buffer-list)) |
| 1027 | default-directory))) |
| 1028 | (if (file-exists-p (concat dir name)) |
| 1029 | (setq name (concat dir name)) |
| 1030 | (error "No such include file: `%s'" name)))) |
| 1031 | (setq new-buf (get-file-buffer name)) |
| 1032 | (if new-buf |
| 1033 | ;; no need to verify last-modified time for this! |
| 1034 | (set-buffer new-buf) |
| 1035 | (set-buffer (create-file-buffer name)) |
| 1036 | (erase-buffer) |
| 1037 | (insert-file-contents name t)) |
| 1038 | ;; Returning non-nil with the new buffer current |
| 1039 | ;; is sufficient to tell find-file to use it. |
| 1040 | t) |
| 1041 | nil)) |
| 1042 | |
| 1043 | (defun PC-include-file-path () |
| 1044 | (or PC-include-file-path |
| 1045 | (let ((env (getenv "INCPATH")) |
| 1046 | (path nil) |
| 1047 | pos) |
| 1048 | (or env (error "No include file path specified")) |
| 1049 | (while (setq pos (string-match ":[^:]+$" env)) |
| 1050 | (setq path (cons (substring env (1+ pos)) path) |
| 1051 | env (substring env 0 pos))) |
| 1052 | path))) |
| 1053 | |
| 1054 | ;; This is adapted from lib-complete.el, by Mike Williams. |
| 1055 | (defun PC-include-file-all-completions (file search-path &optional full) |
| 1056 | "Return all completions for FILE in any directory on SEARCH-PATH. |
| 1057 | If optional third argument FULL is non-nil, returned pathnames should be |
| 1058 | absolute rather than relative to some directory on the SEARCH-PATH." |
| 1059 | (setq search-path |
| 1060 | (mapcar (lambda (dir) |
| 1061 | (if dir (file-name-as-directory dir) default-directory)) |
| 1062 | search-path)) |
| 1063 | (if (file-name-absolute-p file) |
| 1064 | ;; It's an absolute file name, so don't need search-path |
| 1065 | (progn |
| 1066 | (setq file (expand-file-name file)) |
| 1067 | (file-name-all-completions |
| 1068 | (file-name-nondirectory file) (file-name-directory file))) |
| 1069 | (let ((subdir (file-name-directory file)) |
| 1070 | (ndfile (file-name-nondirectory file)) |
| 1071 | file-lists) |
| 1072 | ;; Append subdirectory part to each element of search-path |
| 1073 | (if subdir |
| 1074 | (setq search-path |
| 1075 | (mapcar (lambda (dir) (concat dir subdir)) |
| 1076 | search-path) |
| 1077 | file )) |
| 1078 | ;; Make list of completions in each directory on search-path |
| 1079 | (while search-path |
| 1080 | (let* ((dir (car search-path)) |
| 1081 | (subdir (if full dir subdir))) |
| 1082 | (if (file-directory-p dir) |
| 1083 | (progn |
| 1084 | (setq file-lists |
| 1085 | (cons |
| 1086 | (mapcar (lambda (file) (concat subdir file)) |
| 1087 | (file-name-all-completions ndfile |
| 1088 | (car search-path))) |
| 1089 | file-lists)))) |
| 1090 | (setq search-path (cdr search-path)))) |
| 1091 | ;; Compress out duplicates while building complete list (slloooow!) |
| 1092 | (let ((sorted (sort (apply 'nconc file-lists) |
| 1093 | (lambda (x y) (not (string-lessp x y))))) |
| 1094 | compressed) |
| 1095 | (while sorted |
| 1096 | (if (equal (car sorted) (car compressed)) nil |
| 1097 | (setq compressed (cons (car sorted) compressed))) |
| 1098 | (setq sorted (cdr sorted))) |
| 1099 | compressed)))) |
| 1100 | |
| 1101 | (defun PC-read-file-name-internal (string pred action) |
| 1102 | "Extend `read-file-name-internal' to handle include files. |
| 1103 | This is only used by " |
| 1104 | (if (string-match "<\\([^\"<>]*\\)>?\\'" string) |
| 1105 | (let* ((name (match-string 1 string)) |
| 1106 | (str2 (substring string (match-beginning 0))) |
| 1107 | (completion-table |
| 1108 | (mapcar (lambda (x) |
| 1109 | (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) |
| 1110 | (PC-include-file-all-completions |
| 1111 | name (PC-include-file-path))))) |
| 1112 | (cond |
| 1113 | ((not completion-table) nil) |
| 1114 | ((eq action 'lambda) (test-completion str2 completion-table nil)) |
| 1115 | ((eq action nil) (PC-try-completion str2 completion-table nil)) |
| 1116 | ((eq action t) (all-completions str2 completion-table nil)))) |
| 1117 | (read-file-name-internal string pred action))) |
| 1118 | \f |
| 1119 | |
| 1120 | (provide 'complete) |
| 1121 | |
| 1122 | ;;; complete.el ends here |