;; Partial completion mechanism for GNU Emacs. Version 2.00. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Written by Dave Gillespie, daveg@synaptics.com. ;; 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. ;; 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.) ;; 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. ;; In addition, this package includes a feature for accessing include ;; files. For example, `C-x C-f 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. (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) )) (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) (let* ((table minibuffer-completion-table) (pred minibuffer-completion-predicate) (filename (memq table '(read-file-name-internal read-directory-name-internal))) (dirname nil) (str (buffer-string)) (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 (erase-buffer) (insert p) (setq str p))) ;; 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) (erase-buffer) (setq str (concat dir (file-name-nondirectory str))) (insert 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 (+ (point-min) (length dirname))) (while (and (progn (setq i 0) (while (< i (length prefix)) (if (and (not (eobp)) (eq (aref prefix i) (following-char))) (forward-char 1) (if (and (not (eobp)) (or (and (looking-at " ") (memq (aref prefix i) PC-delims-list)) (eq (downcase (aref prefix i)) (downcase (following-char))))) (delete-char 1) (setq improved t)) (insert (substring prefix i (1+ i)))) (setq i (1+ i))) (or pt (equal (point) (point-min)) (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) (point-max) (or pt (point-min)))))) (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- (point-max))) table pred) (delete-region (1- (point-max)) (point-max)))) (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)")) (erase-buffer) (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))) (defun PC-temp-minibuffer-message (m) "A Lisp version of temp_minibuffer_message from minibuf.c." (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)))))) (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. (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))) 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)))) (error "Not on an #include line"))))) (or (string-match "\\.[a-zA-Z0-9]+$" name) (setq name (concat name ".h"))) (if (eq punc ?\<) (let ((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 nil ; no need to verify last-modified time for this! (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)) (file (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 file (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))) ;;; End.