X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e468b87f91f26e66a8cde087c1a9c89c67b96d12..2ca2ebe6f1a1e675e2e27afaaa0d9f114d83167b:/lisp/complete.el diff --git a/lisp/complete.el b/lisp/complete.el index 9be68d833e..95e116f753 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -1,7 +1,7 @@ ;;; complete.el --- partial completion mechanism plus other goodies ;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Keywords: abbrev convenience @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -381,9 +379,9 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Returns the sequence of non-delimiter characters that follow regexp in string. (defun PC-chunk-after (string regexp) (if (not (string-match regexp string)) - (let ((message (format "String %s didn't match regexp %s" string regexp))) - (message message) - (error message))) + (let ((message "String %s didn't match regexp %s")) + (message message string regexp) + (error message string regexp))) (let ((result (substring string (match-end 0)))) ;; result may contain multiple chunks (if (string-match PC-delim-regex result) @@ -450,6 +448,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." env-on regex p offset + abbreviated (poss nil) helpposs (case-fold-search completion-ignore-case)) @@ -490,8 +489,9 @@ GOTO-END is non-nil, however, it instead replaces up to END." (and filename (let ((dir (file-name-directory str)) (file (file-name-nondirectory str)) - ;; The base dir for file-completion is passed in `predicate'. - (default-directory (expand-file-name pred))) + ;; The base dir for file-completion was passed in `predicate'. + (default-directory (if (stringp pred) (expand-file-name pred) + default-directory))) (while (and (stringp dir) (not (file-directory-p dir))) (setq dir (directory-file-name dir)) (setq file (concat (replace-regexp-in-string @@ -505,8 +505,9 @@ GOTO-END is non-nil, however, it instead replaces up to END." (and filename (string-match "\\*.*/" str) (let ((pat str) - ;; The base dir for file-completion is passed in `predicate'. - (default-directory (expand-file-name pred)) + ;; The base dir for file-completion was passed in `predicate'. + (default-directory (if (stringp pred) (expand-file-name pred) + default-directory)) files) (setq p (1+ (string-match "/[^/]*\\'" pat))) (while (setq p (string-match PC-delim-regex pat p)) @@ -514,14 +515,15 @@ GOTO-END is non-nil, however, it instead replaces up to END." "*" (substring pat p)) p (+ p 2))) - (setq files (PC-expand-many-files (concat pat "*"))) + (setq files (file-expand-wildcards (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 + (setq filename nil table nil + pred (if (stringp pred) nil pred) ambig t) (delete-region beg end) (setq str (concat dir (file-name-nondirectory str))) @@ -534,7 +536,8 @@ GOTO-END is non-nil, however, it instead replaces up to END." ;; even if we couldn't, so remove the added ;; wildcards. (setq str origstr) - (setq filename nil table nil pred nil))))) + (setq filename nil table nil + pred (if (stringp pred) nil pred)))))) ;; Strip directory name if appropriate (if filename @@ -586,17 +589,45 @@ GOTO-END is non-nil, however, it instead replaces up to END." pred nil)) ;; Find an initial list of possible completions - (if (not (setq p (string-match (concat PC-delim-regex + (unless (setq p (string-match (concat PC-delim-regex (if filename "\\|\\*" "")) str - (+ (length dirname) offset)))) + (+ (length dirname) offset))) ;; Minibuffer contains no hyphens -- simple case! - (setq poss (all-completions (if env-on - basestr str) + (setq poss (all-completions (if env-on basestr str) table pred)) - + (unless (or poss (string-equal str "")) + ;; Try completion as an abbreviation, e.g. "mvb" -> + ;; "m-v-b" -> "multiple-value-bind", but only for + ;; non-empty strings. + (setq origstr str + abbreviated t) + (if filename + (cond + ;; "alpha" or "/alpha" -> expand whole path. + ((string-match "^/?\\([A-Za-z0-9]+\\)$" str) + (setq + basestr "" + p nil + poss (file-expand-wildcards + (concat "/" + (mapconcat #'list (match-string 1 str) "*/") + "*")) + beg (1- beg))) + ;; Alphanumeric trailer -> expand trailing file + ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str) + (setq regex (concat "\\`" + (mapconcat #'list + (match-string 2 str) + "[A-Za-z0-9]*[^A-Za-z0-9]")) + p (1+ (length (match-string 1 str)))))) + (setq regex (concat "\\`" (mapconcat (lambda (c) + (regexp-quote (string c))) + str "[^-]*-")) + p 1)))) + (when p ;; Use all-completions to do an initial cull. This is a big win, ;; since all-completions is written in C! (let ((compl (all-completions (if env-on @@ -605,12 +636,24 @@ GOTO-END is non-nil, however, it instead replaces up to END." table pred))) (setq p compl) + (when (and compl abbreviated) + (if filename + (progn + (setq p nil) + (dolist (x compl) + (when (string-match regex x) + (push x p))) + (setq basestr (try-completion "" p))) + (setq basestr (mapconcat 'list str "-")) + (delete-region beg end) + (setq end (+ beg (length basestr))) + (insert basestr)))) (while p (and (string-match regex (car p)) (progn (set-text-properties 0 (length (car p)) '() (car p)) (setq poss (cons (car p) poss)))) - (setq p (cdr p))))) + (setq p (cdr p)))) ;; If table had duplicates, they can be here. (delete-dups poss) @@ -644,6 +687,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (and p (setq poss p)))) ;; Now we have a list of possible completions + (cond ;; No valid completions found @@ -653,6 +697,9 @@ GOTO-END is non-nil, however, it instead replaces up to END." (let ((PC-word-failed-flag t)) (delete-backward-char 1) (PC-do-completion 'word)) + (when abbreviated + (delete-region beg end) + (insert origstr)) (beep) (PC-temp-minibuffer-message (if ambig " [Ambiguous dir name]" @@ -789,13 +836,18 @@ GOTO-END is non-nil, however, it instead replaces up to END." (setq completion-base-size (if dirname dirlength (- beg prompt-end)))))) - (PC-temp-minibuffer-message " [Next char not unique]")) - nil))))) + (PC-temp-minibuffer-message " [Next char not unique]")) + ;; Expansion of filenames is not reversible, + ;; so just keep the prefix. + (when (and abbreviated filename) + (delete-region (point) end)) + nil))))) ;; Only one possible completion (t (if (and (equal basestr (car poss)) - (not (and env-on filename))) + (not (and env-on filename)) + (not abbreviated)) (if (null mode) (PC-temp-minibuffer-message " [Sole completion]")) (delete-region beg end) @@ -821,7 +873,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (defun PC-temp-minibuffer-message (message) "A Lisp version of `temp_minibuffer_message' from minibuf.c." (cond (PC-not-minibuffer - (message message) + (message "%s" message) (sit-for 2) (message "")) ((fboundp 'temp-minibuffer-message) @@ -853,13 +905,11 @@ only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered." (interactive) - (let* ((end (point)) - ;; To complete the word under point, rather than just the portion - ;; before point, use this: -;;; (save-excursion -;;; (with-syntax-table lisp-mode-syntax-table -;;; (forward-sexp 1) -;;; (point)))) + (let* ((end + (save-excursion + (with-syntax-table lisp-mode-syntax-table + (skip-syntax-forward "_w") + (point)))) (beg (save-excursion (with-syntax-table lisp-mode-syntax-table (backward-sexp 1) @@ -883,7 +933,7 @@ or properties are considered." ;; completions of "(ne", which is presumably not what one wants. ;; ;; This is arguably (at least, it seems to be the existing intended - ;; behaviour) what one _does_ want if point has been explicitly + ;; behavior) what one _does_ want if point has been explicitly ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds ;; completion-base-size to nil, then completion does not replace the ;; correct amount of text in such cases. @@ -895,12 +945,12 @@ or properties are considered." ;; the minibuffer. The same is not true for lisp symbols. ;; ;; [1] An alternate fix would be to not move point to the hyphen - ;; in such cases, but that would make the behaviour different from + ;; in such cases, but that would make the behavior different from ;; that for filenames. It seems PC moves point to the site of the ;; first difference between the possible completions. ;; ;; Alternatively alternatively, maybe end should be computed in - ;; the same way as beg. That would change the behaviour though. + ;; the same way as beg. That would change the behavior though. (if (equal last-command 'PC-lisp-complete-symbol) (PC-do-completion nil beg PC-lisp-complete-end t) (if PC-lisp-complete-end @@ -918,66 +968,11 @@ or properties are considered." (+ (point) 2) (point-min))) (minibuffer-completion-table 'PC-read-file-name-internal) - (minibuffer-completion-predicate "") + (minibuffer-completion-predicate nil) (PC-not-minibuffer t)) (goto-char end) (PC-do-completion nil beg end))) -;; Use the shell to do globbing. -;; This could now use file-expand-wildcards instead. - -(defun PC-expand-many-files (name) - (with-current-buffer (generate-new-buffer " *Glob Output*") - (erase-buffer) - (when (and (file-name-absolute-p name) - (not (file-directory-p default-directory))) - ;; If the current working directory doesn't exist `shell-command' - ;; signals an error. So if the file names we're looking for don't - ;; depend on the working directory, switch to a valid directory first. - (setq default-directory "/")) - (shell-command (concat "echo " name) t) - (goto-char (point-min)) - ;; CSH-style shells were known to output "No match", whereas - ;; SH-style shells tend to simply output `name' when no match is found. - (if (looking-at (concat ".*No match\\|\\(^\\| \\)\\(" - (regexp-quote name) - "\\|" - (regexp-quote (expand-file-name name)) - "\\)\\( \\|$\\)")) - 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))) (p nil)) - (kill-buffer (current-buffer)) - (or (equal completion-ignored-extensions PC-ignored-extensions) - (setq PC-ignored-regexp - (concat "\\(" - (mapconcat - 'regexp-quote - (setq PC-ignored-extensions - completion-ignored-extensions) - "\\|") - "\\)\\'"))) - (setq p nil) - (while files - ;; This whole process of going through to shell, to echo, and - ;; finally parsing the output is a hack. It breaks as soon as - ;; there are spaces in the file names or when the no-match - ;; message changes. To make up for it, we check that what we read - ;; indeed exists, so we may miss some files, but we at least won't - ;; list non-existent ones. - (or (not (file-exists-p (car files))) - (string-match PC-ignored-regexp (car files)) - (setq p (cons (car files) p))) - (setq files (cdr files))) - p)))) - ;; 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. @@ -1103,7 +1098,7 @@ absolute rather than relative to some directory on the SEARCH-PATH." (setq sorted (cdr sorted))) compressed)))) -(defun PC-read-file-name-internal (string dir action) +(defun PC-read-file-name-internal (string pred action) "Extend `read-file-name-internal' to handle include files. This is only used by " (if (string-match "<\\([^\"<>]*\\)>?\\'" string) @@ -1114,12 +1109,12 @@ This is only used by " (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) (PC-include-file-all-completions name (PC-include-file-path))))) - (cond - ((not completion-table) nil) - ((eq action 'lambda) (test-completion str2 completion-table nil)) - ((eq action nil) (PC-try-completion str2 completion-table nil)) - ((eq action t) (all-completions str2 completion-table nil)))) - (read-file-name-internal string dir action))) + (cond + ((not completion-table) nil) + ((eq action 'lambda) (test-completion str2 completion-table nil)) + ((eq action nil) (PC-try-completion str2 completion-table nil)) + ((eq action t) (all-completions str2 completion-table nil)))) + (read-file-name-internal string pred action))) (provide 'complete)