;;; 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 <daveg@synaptics.com>
;; Keywords: abbrev convenience
;; 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)
env-on
regex
p offset
+ abbreviated
(poss nil)
helpposs
(case-fold-search completion-ignore-case))
"*"
(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))
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
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)
(and p (setq poss p))))
;; Now we have a list of possible completions
+
(cond
;; No valid completions found
(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]"
(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)
(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)
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)
(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.
(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))))
+ (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)))
\f
HCoop / bpt / emacs.git / blobdiff