Mercurial > emacs
changeset 3725:bd468d77adce
Initial revision
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Mon, 14 Jun 1993 14:58:03 +0000 |
parents | dc73f3152d2f |
children | 33e82e88a210 |
files | lisp/complete.el |
diffstat | 1 files changed, 859 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/complete.el Mon Jun 14 14:58:03 1993 +0000 @@ -0,0 +1,859 @@ +;; complete.el -- partial completion mechanism plus other goodies. + +;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. + +;; Author: Dave Gillespie <daveg@synaptics.com> +;; Version: 2.02 +;; Special thanks to Hallvard Furuseth for his many ideas and contributions. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + + +;; Commentary: + +;; Extended completion for the Emacs minibuffer. +;; +;; The basic idea is that the command name or other completable text is +;; divided into words and each word is completed separately, so that +;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous +;; each word is completed as much as possible and then the cursor is +;; left at the first position where typing another letter will resolve +;; the ambiguity. +;; +;; Word separators for this purpose are hyphen, space, and period. +;; These would most likely occur in command names, Info menu items, +;; and file names, respectively. But all word separators are treated +;; alike at all times. +;; +;; This completion package replaces the old-style completer's key +;; bindings for TAB, SPC, RET, and `?'. The old completer is still +;; available on the Meta versions of those keys. If you set +;; PC-meta-flag to nil, the old completion keys will be left alone +;; and the partial completer will use the Meta versions of the keys. + + +;; Usage: Load this file. Now, during completable minibuffer entry, +;; +;; TAB means to do a partial completion; +;; SPC means to do a partial complete-word; +;; RET means to do a partial complete-and-exit; +;; ? means to do a partial completion-help. +;; +;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform +;; original Emacs completions, and M-TAB etc. do partial completion. +;; To do this, put the command, +;; +;; (setq PC-meta-flag nil) +;; +;; in your .emacs file. To load partial completion automatically, put +;; +;; (load "complete") +;; +;; in your .emacs file, too. Things will be faster if you byte-compile +;; this file when you install it. +;; +;; As an extra feature, in cases where RET would not normally +;; complete (such as `C-x b'), the M-RET key will always do a partial +;; complete-and-exit. Thus `C-x b f.c RET' will select or create a +;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing +;; buffer whose name matches that pattern (perhaps "filing.c"). +;; (PC-meta-flag does not affect this behavior; M-RET used to be +;; undefined in this situation.) +;; +;; The regular M-TAB (lisp-complete-symbol) command also supports +;; partial completion in this package. + +;; This package also contains a wildcard feature for C-x C-f (find-file). +;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly +;; as if you had typed C-x C-f separately for each file. Completion +;; is supported in connection with wildcards. Currently only the `*' +;; wildcard character works. + +;; File name completion does not do partial completion of directories +;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo", +;; but you can put *'s in the path to accomplish this: "/u*/b*/f". +;; Stars are required for performance reasons. + +;; In addition, this package includes a feature for accessing include +;; files. For example, `C-x C-f <sys/time.h> RET' reads the file +;; /usr/include/sys/time.h. The variable PC-include-file-path is a +;; list of directories in which to search for include files. Completion +;; is supported in include file names. + + +;; Code: + +(defvar PC-meta-flag t + "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion. +If t, TAB does Partial Completion and M-TAB does normal completion.") + + +(defvar PC-word-delimiters "-_. " + "*A string of characters which are to be treated as word delimiters +by the Partial Completion system. + +Some arcane rules: If `]' is in this string it must come first. +If `^' is in this string it must NOT come first. If `-' is in this +string, it must come first or right after `]'. In other words, if +S is this string, then `[S]' must be a legal Emacs regular expression +(not containing character ranges like `a-z').") + + +(defvar PC-first-char 'x + "*If t, first character of a string to be completed is always taken literally. +If nil, word delimiters are handled even if they appear as first character. +This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil). +If neither nil nor t, first char is literal only for filename completion.") + + +(defvar PC-include-file-path '("/usr/include") + "*List of directories in which to look for include files. +If this is nil, uses the colon-separated path in $INCPATH instead.") + + +(defvar PC-disable-wildcards nil + "Set this to non-nil to disable wildcard support in \\[find-file].") + +(defvar PC-disable-includes nil + "Set this to non-nil to disable include-file support in \\[find-file].") + + +(defvar PC-default-bindings t + "Set this to nil to suppress the default partial completion key bindings.") + +(if PC-default-bindings (progn +(define-key minibuffer-local-completion-map "\t" 'PC-complete) +(define-key minibuffer-local-completion-map " " 'PC-complete-word) +(define-key minibuffer-local-completion-map "?" 'PC-completion-help) + +(define-key minibuffer-local-completion-map "\e\t" 'PC-complete) +(define-key minibuffer-local-completion-map "\e " 'PC-complete-word) +(define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit) +(define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit) +(define-key minibuffer-local-completion-map "\e?" 'PC-completion-help) + +(define-key minibuffer-local-must-match-map "\t" 'PC-complete) +(define-key minibuffer-local-must-match-map " " 'PC-complete-word) +(define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit) +(define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit) +(define-key minibuffer-local-must-match-map "?" 'PC-completion-help) + +(define-key minibuffer-local-must-match-map "\e\t" 'PC-complete) +(define-key minibuffer-local-must-match-map "\e " 'PC-complete-word) +(define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit) +(define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit) +(define-key minibuffer-local-must-match-map "\e?" 'PC-completion-help) + +(define-key global-map "\e\t" 'PC-lisp-complete-symbol) +)) + + +(defun PC-complete () + "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. +For example, \"M-x b--di\" would match `byte-recompile-directory', or any +name which consists of three or more words, the first beginning with \"b\" +and the third beginning with \"di\". + +The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and +`beginning-of-defun', so this would produce a list of completions +just like when normal Emacs completions are ambiguous. + +Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", +\".\", and SPC." + (interactive) + (if (PC-was-meta-key) + (minibuffer-complete) + (PC-do-completion nil))) + + +(defun PC-complete-word () + "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details. +This can be bound to other keys, like `-' and `.', if you wish." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (if (eq last-command-char ? ) + (minibuffer-complete-word) + (self-insert-command 1)) + (self-insert-command 1) + (if (eobp) + (PC-do-completion 'word)))) + + +(defun PC-complete-space () + "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details. +This is suitable for binding to other keys which should act just like SPC." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-complete-word) + (insert " ") + (if (eobp) + (PC-do-completion 'word)))) + + +(defun PC-complete-and-exit () + "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-complete-and-exit) + (PC-do-complete-and-exit))) + +(defun PC-force-complete-and-exit () + "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (let ((minibuffer-completion-confirm nil)) + (PC-do-complete-and-exit))) + +(defun PC-do-complete-and-exit () + (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on... + (exit-minibuffer) + (let ((flag (PC-do-completion 'exit))) + (and flag + (if (or (eq flag 'complete) + (not minibuffer-completion-confirm)) + (exit-minibuffer) + (PC-temp-minibuffer-message " (Confirm)")))))) + + +(defun PC-completion-help () + "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-completion-help) + (PC-do-completion 'help))) + +(defun PC-was-meta-key () + (or (/= (length (this-command-keys)) 1) + (let ((key (aref (this-command-keys) 0))) + (if (integerp key) + (>= key 128) + (not (null (memq 'meta (event-modifiers key)))))))) + + +(defvar PC-ignored-extensions 'empty-cache) +(defvar PC-delims 'empty-cache) +(defvar PC-ignored-regexp nil) +(defvar PC-word-failed-flag nil) +(defvar PC-delim-regex nil) +(defvar PC-ndelims-regex nil) +(defvar PC-delims-list nil) + +(defun PC-do-completion (&optional mode beg end) + (or beg (setq beg (point-min))) + (or end (setq end (point-max))) + (let* ((table minibuffer-completion-table) + (pred minibuffer-completion-predicate) + (filename (memq table '(read-file-name-internal + read-directory-name-internal))) + (dirname nil) + (str (buffer-substring beg end)) + (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) + (ambig nil) + basestr + regex + p offset + (poss nil) + helpposs + (case-fold-search completion-ignore-case)) + + ;; Check if buffer contents can already be considered complete + (if (and (eq mode 'exit) + (PC-is-complete-p str table pred)) + 'complete + + ;; Do substitutions in directory names + (and filename + (not (equal str (setq p (substitute-in-file-name str)))) + (progn + (delete-region beg end) + (insert p) + (setq str p end (+ beg (length str))))) + + ;; Prepare various delimiter strings + (or (equal PC-word-delimiters PC-delims) + (setq PC-delims PC-word-delimiters + PC-delim-regex (concat "[" PC-delims "]") + PC-ndelims-regex (concat "[^" PC-delims "]*") + PC-delims-list (append PC-delims nil))) + + ;; Look for wildcard expansions in directory name + (and filename + (string-match "\\*.*/" str) + (let ((pat str) + files) + (setq p (1+ (string-match "/[^/]*\\'" pat))) + (while (setq p (string-match PC-delim-regex pat p)) + (setq pat (concat (substring pat 0 p) + "*" + (substring pat p)) + p (+ p 2))) + (setq files (PC-expand-many-files (concat pat "*"))) + (if files + (let ((dir (file-name-directory (car files))) + (p files)) + (while (and (setq p (cdr p)) + (equal dir (file-name-directory (car p))))) + (if p + (setq filename nil table nil pred nil + ambig t) + (delete-region beg end) + (setq str (concat dir (file-name-nondirectory str))) + (insert str) + (setq end (+ beg (length str))))) + (setq filename nil table nil pred nil)))) + + ;; Strip directory name if appropriate + (if filename + (if incname + (setq basestr (substring str incname) + dirname (substring str 0 incname)) + (setq basestr (file-name-nondirectory str) + dirname (file-name-directory str))) + (setq basestr str)) + + ;; Convert search pattern to a standard regular expression + (setq regex (regexp-quote basestr) + offset (if (and (> (length regex) 0) + (not (eq (aref basestr 0) ?\*)) + (or (eq PC-first-char t) + (and PC-first-char filename))) 1 0) + p offset) + (while (setq p (string-match PC-delim-regex regex p)) + (if (eq (aref regex p) ? ) + (setq regex (concat (substring regex 0 p) + PC-ndelims-regex + PC-delim-regex + (substring regex (1+ p))) + p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) + (let ((bump (if (memq (aref regex p) + '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) + -1 0))) + (setq regex (concat (substring regex 0 (+ p bump)) + PC-ndelims-regex + (substring regex (+ p bump))) + p (+ p (length PC-ndelims-regex) 1))))) + (setq p 0) + (if filename + (while (setq p (string-match "\\\\\\*" regex p)) + (setq regex (concat (substring regex 0 p) + "[^/]*" + (substring regex (+ p 2)))))) + ;;(setq the-regex regex) + (setq regex (concat "\\`" regex)) + + ;; Find an initial list of possible completions + (if (not (setq p (string-match (concat PC-delim-regex + (if filename "\\|\\*" "")) + str + (+ (length dirname) offset)))) + + ;; Minibuffer contains no hyphens -- simple case! + (setq poss (all-completions str + table + pred)) + + ;; Use all-completions to do an initial cull. This is a big win, + ;; since all-completions is written in C! + (let ((compl (all-completions (substring str 0 p) + table + pred))) + (setq p compl) + (while p + (and (string-match regex (car p)) + (setq poss (cons (car p) poss))) + (setq p (cdr p))))) + + ;; Now we have a list of possible completions + (cond + + ;; No valid completions found + ((null poss) + (if (and (eq mode 'word) + (not PC-word-failed-flag)) + (let ((PC-word-failed-flag t)) + (delete-backward-char 1) + (PC-do-completion 'word)) + (beep) + (PC-temp-minibuffer-message (if ambig + " (Ambiguous dir name)" + (if (eq mode 'help) + " (No completions)" + " (No match)"))) + nil)) + + ;; More than one valid completion found + ((or (cdr (setq helpposs poss)) + (memq mode '(help word))) + + ;; Handle completion-ignored-extensions + (and filename + (not (eq mode 'help)) + (let ((p2 poss)) + + ;; Build a regular expression representing the extensions list + (or (equal completion-ignored-extensions PC-ignored-extensions) + (setq PC-ignored-regexp + (concat "\\(" + (mapconcat + 'regexp-quote + (setq PC-ignored-extensions + completion-ignored-extensions) + "\\|") + "\\)\\'"))) + + ;; Check if there are any without an ignored extension + (setq p nil) + (while p2 + (or (string-match PC-ignored-regexp (car p2)) + (setq p (cons (car p2) p))) + (setq p2 (cdr p2))) + + ;; If there are "good" names, use them + (and p (setq poss p)))) + + ;; Is the actual string one of the possible completions? + (setq p (and (not (eq mode 'help)) poss)) + (while (and p + (not (equal (car p) basestr))) + (setq p (cdr p))) + (if p + + (progn + (if (null mode) + (PC-temp-minibuffer-message " (Complete, but not unique)")) + t) + + ;; If ambiguous, try for a partial completion + (let ((improved nil) + prefix + (pt nil) + (skip "\\`")) + + ;; Check if next few letters are the same in all cases + (if (and (not (eq mode 'help)) + (setq prefix (try-completion "" (mapcar 'list poss)))) + (let ((first t) i) + (if (eq mode 'word) + (setq prefix (PC-chop-word prefix basestr))) + (goto-char (+ beg (length dirname))) + (while (and (progn + (setq i 0) + (while (< i (length prefix)) + (if (and (< (point) end) + (eq (aref prefix i) + (following-char))) + (forward-char 1) + (if (and (< (point) end) + (or (and (looking-at " ") + (memq (aref prefix i) + PC-delims-list)) + (eq (downcase (aref prefix i)) + (downcase + (following-char))))) + (progn + (delete-char 1) + (setq end (1- end))) + (and filename (looking-at "\\*") + (progn + (delete-char 1) + (setq end (1- end)))) + (setq improved t)) + (insert (substring prefix i (1+ i))) + (setq end (1+ end))) + (setq i (1+ i))) + (or pt (equal (point) beg) + (setq pt (point))) + (looking-at PC-delim-regex)) + (setq skip (concat skip + (regexp-quote prefix) + PC-ndelims-regex) + prefix (try-completion + "" + (mapcar + (function + (lambda (x) + (list + (and (string-match skip x) + (substring + x + (match-end 0)))))) + poss))) + (or (> i 0) (> (length prefix) 0)) + (or (not (eq mode 'word)) + (and first (> (length prefix) 0) + (setq first nil + prefix (substring prefix 0 1)))))) + (goto-char (if (eq mode 'word) end + (or pt beg))))) + + (if (and (eq mode 'word) + (not PC-word-failed-flag)) + + (if improved + + ;; We changed it... would it be complete without the space? + (if (PC-is-complete-p (buffer-substring 1 (1- end)) + table pred) + (delete-region (1- end) end))) + + (if improved + + ;; We changed it... enough to be complete? + (and (eq mode 'exit) + (PC-is-complete-p (buffer-string) table pred)) + + ;; If totally ambiguous, display a list of completions + (if (or completion-auto-help + (eq mode 'help)) + (with-output-to-temp-buffer " *Completions*" + (display-completion-list (sort helpposs 'string-lessp))) + (PC-temp-minibuffer-message " (Next char not unique)")) + nil))))) + + ;; Only one possible completion + (t + (if (equal basestr (car poss)) + (if (null mode) + (PC-temp-minibuffer-message " (Sole completion)")) + (delete-region beg end) + (insert (if filename + (substitute-in-file-name (concat dirname (car poss))) + (car poss)))) + t))))) + + +(defun PC-is-complete-p (str table pred) + (let ((res (if (listp table) + (assoc str table) + (if (vectorp table) + (or (equal str "nil") ; heh, heh, heh + (intern-soft str table)) + (funcall table str pred 'lambda))))) + (and res + (or (not pred) + (and (not (listp table)) (not (vectorp table))) + (funcall pred res)) + res))) + +(defun PC-chop-word (new old) + (let ((i -1) + (j -1)) + (while (and (setq i (string-match PC-delim-regex old (1+ i))) + (setq j (string-match PC-delim-regex new (1+ j))))) + (if (and j + (or (not PC-word-failed-flag) + (setq j (string-match PC-delim-regex new (1+ j))))) + (substring new 0 (1+ j)) + new))) + +(defvar PC-not-minibuffer nil) + +(defun PC-temp-minibuffer-message (m) + "A Lisp version of `temp_minibuffer_message' from minibuf.c." + (if PC-not-minibuffer + (progn + (message m) + (sit-for 2) + (message "")) + (if (fboundp 'temp-minibuffer-message) + (temp-minibuffer-message m) + (let ((savemax (point-max))) + (save-excursion + (goto-char (point-max)) + (insert m)) + (let ((inhibit-quit t)) + (sit-for 2) + (delete-region savemax (point-max)) + (if quit-flag + (setq quit-flag nil + unread-command-char 7))))))) + + +(defun PC-lisp-complete-symbol () + "Perform completion on Lisp symbol preceding point. +That symbol is compared against the symbols that exist +and any additional characters determined by what is there +are inserted. +If the symbol starts just after an open-parenthesis, +only symbols with function definitions are considered. +Otherwise, all symbols with function definitions, values +or properties are considered." + (interactive) + (let* ((end (point)) + (buffer-syntax (syntax-table)) + (beg (unwind-protect + (save-excursion + (if lisp-mode-syntax-table + (set-syntax-table lisp-mode-syntax-table)) + (backward-sexp 1) + (while (= (char-syntax (following-char)) ?\') + (forward-char 1)) + (point)) + (set-syntax-table buffer-syntax))) + (minibuffer-completion-table obarray) + (minibuffer-completion-predicate + (if (eq (char-after (1- beg)) ?\() + 'fboundp + (function (lambda (sym) + (or (boundp sym) (fboundp sym) + (symbol-plist sym)))))) + (PC-not-minibuffer t)) + (PC-do-completion nil beg end))) + + +;;; Wildcards in `C-x C-f' command. This is independent from the main +;;; completion code, except for `PC-expand-many-files' which is called +;;; when "*"'s are found in the path during filename completion. (The +;;; above completion code always understands "*"'s, except in file paths, +;;; without relying on the following code.) + +(defvar PC-many-files-list nil) + +(defun PC-try-load-many-files () + (if (string-match "\\*" buffer-file-name) + (let* ((pat buffer-file-name) + (files (PC-expand-many-files pat)) + (first (car files)) + (next files)) + (kill-buffer (current-buffer)) + (or files + (error "No matching files")) + (save-window-excursion + (while (setq next (cdr next)) + (let ((buf (find-file-noselect (car next)))) + (switch-to-buffer buf)))) + ;; This modifies the "buf" variable inside find-file-noselect. + (setq buf (get-file-buffer first)) + (if buf + nil ; should do verify-visited-file-modtime stuff. + (setq filename first) + (setq buf (create-file-buffer filename)) + (set-buffer buf) + (erase-buffer) + (insert-file-contents filename t)) + (if (cdr files) + (setq PC-many-files-list (mapconcat + (if (string-match "\\*.*/" pat) + 'identity + 'file-name-nondirectory) + (cdr files) ", ") + find-file-hooks (cons 'PC-after-load-many-files + find-file-hooks))) + ;; This modifies the "error" variable inside find-file-noselect. + (setq error nil) + t) + nil)) + +(defun PC-after-load-many-files () + (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks)) + (message "Also loaded %s." PC-many-files-list)) + +(defun PC-expand-many-files (name) + (save-excursion + (set-buffer (generate-new-buffer " *Glob Output*")) + (erase-buffer) + (shell-command (concat "echo " name) t) + (goto-char (point-min)) + (if (looking-at ".*No match") + nil + (insert "(\"") + (while (search-forward " " nil t) + (delete-backward-char 1) + (insert "\" \"")) + (goto-char (point-max)) + (delete-backward-char 1) + (insert "\")") + (goto-char (point-min)) + (let ((files (read (current-buffer)))) + (kill-buffer (current-buffer)) + files)))) + +(or PC-disable-wildcards + (memq 'PC-try-load-many-files find-file-not-found-hooks) + (setq find-file-not-found-hooks (cons 'PC-try-load-many-files + find-file-not-found-hooks))) + + + +;;; Facilities for loading C header files. This is independent from the +;;; main completion code. See also the variable `PC-include-file-path' +;;; at top of this file. + +(defun PC-look-for-include-file () + (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) + (let ((name (substring (buffer-file-name) + (match-beginning 1) (match-end 1))) + (punc (aref (buffer-file-name) (match-beginning 0))) + (path nil) + new-buf) + (kill-buffer (current-buffer)) + (if (equal name "") + (save-excursion + (set-buffer (car (buffer-list))) + (save-excursion + (beginning-of-line) + (if (looking-at + "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") + (setq name (buffer-substring (match-beginning 1) + (match-end 1)) + punc (char-after (1- (match-beginning 1)))) + ;; Suggested by Frank Siebenlist: + (if (or (looking-at + "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") + (looking-at + "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") + (looking-at + "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) + (progn + (setq name (buffer-substring (match-beginning 1) + (match-end 1)) + punc ?\< + path load-path) + (if (string-match "\\.elc$" name) + (setq name (substring name 0 -1)) + (or (string-match "\\.el$" name) + (setq name (concat name ".el"))))) + (error "Not on an #include line")))))) + (or (string-match "\\.[a-zA-Z0-9]+$" name) + (setq name (concat name ".h"))) + (if (eq punc ?\<) + (let ((path (or path (PC-include-file-path)))) + (while (and path + (not (file-exists-p + (concat (file-name-as-directory (car path)) + name)))) + (setq path (cdr path))) + (if path + (setq name (concat (file-name-as-directory (car path)) name)) + (error "No such include file: <%s>" name))) + (let ((dir (save-excursion + (set-buffer (car (buffer-list))) + default-directory))) + (if (file-exists-p (concat dir name)) + (setq name (concat dir name)) + (error "No such include file: \"%s\"" name)))) + (setq new-buf (get-file-buffer name)) + (if new-buf + ;; no need to verify last-modified time for this! + (set-buffer new-buf) + (setq new-buf (create-file-buffer name)) + (set-buffer new-buf) + (erase-buffer) + (insert-file-contents name t)) + (setq filename name + error nil + buf new-buf) + t) + nil)) + +(defun PC-include-file-path () + (or PC-include-file-path + (let ((env (getenv "INCPATH")) + (path nil) + pos) + (or env (error "No include file path specified")) + (while (setq pos (string-match ":[^:]+$" env)) + (setq path (cons (substring env (1+ pos)) path) + env (substring env 0 pos))) + path))) + +;;; This is adapted from lib-complete.el, by Mike Williams. +(defun PC-include-file-all-completions (file search-path &optional full) + "Return all completions for FILE in any directory on SEARCH-PATH. +If optional third argument FULL is non-nil, returned pathnames should be +absolute rather than relative to some directory on the SEARCH-PATH." + (setq search-path + (mapcar '(lambda (dir) + (if dir (file-name-as-directory dir) default-directory)) + search-path)) + (if (file-name-absolute-p file) + ;; It's an absolute file name, so don't need search-path + (progn + (setq file (expand-file-name file)) + (file-name-all-completions + (file-name-nondirectory file) (file-name-directory file))) + (let ((subdir (file-name-directory file)) + (ndfile (file-name-nondirectory file)) + file-lists) + ;; Append subdirectory part to each element of search-path + (if subdir + (setq search-path + (mapcar '(lambda (dir) (concat dir subdir)) + search-path) + file )) + ;; Make list of completions in each directory on search-path + (while search-path + (let* ((dir (car search-path)) + (subdir (if full dir subdir))) + (if (file-directory-p dir) + (progn + (setq file-lists + (cons + (mapcar '(lambda (file) (concat subdir file)) + (file-name-all-completions ndfile + (car search-path))) + file-lists)))) + (setq search-path (cdr search-path)))) + ;; Compress out duplicates while building complete list (slloooow!) + (let ((sorted (sort (apply 'nconc file-lists) + '(lambda (x y) (not (string-lessp x y))))) + compressed) + (while sorted + (if (equal (car sorted) (car compressed)) nil + (setq compressed (cons (car sorted) compressed))) + (setq sorted (cdr sorted))) + compressed)))) + +(defvar PC-old-read-file-name-internal nil) + +(defun PC-read-include-file-name-internal (string dir action) + (if (string-match "<\\([^\"<>]*\\)>?$" string) + (let* ((name (substring string (match-beginning 1) (match-end 1))) + (str2 (substring string (match-beginning 0))) + (completion-table + (mapcar (function (lambda (x) (list (format "<%s>" x)))) + (PC-include-file-all-completions + name (PC-include-file-path))))) + (cond + ((not completion-table) nil) + ((eq action nil) (try-completion str2 completion-table nil)) + ((eq action t) (all-completions str2 completion-table nil)) + ((eq action 'lambda) + (eq (try-completion str2 completion-table nil) t)))) + (funcall PC-old-read-file-name-internal string dir action))) + +(or PC-disable-includes + (memq 'PC-look-for-include-file find-file-not-found-hooks) + (setq find-file-not-found-hooks (cons 'PC-look-for-include-file + find-file-not-found-hooks))) + +(or PC-disable-includes + PC-old-read-file-name-internal + (progn + (setq PC-old-read-file-name-internal + (symbol-function 'read-file-name-internal)) + (fset 'read-file-name-internal 'PC-read-include-file-name-internal))) + + +(provide 'complete) + +;;; End.