;;; complete.el --- partial completion mechanism plus other goodies
;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
;; 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
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
(funcall
(if partial-completion-mode 'add-hook 'remove-hook)
'choose-completion-string-functions
- (lambda (choice buffer mini-p base-size)
+ (lambda (choice buffer &rest ignored)
;; When completing M-: (lisp- ) with point before the ), it is
;; not appropriate to go to point-max (unlike the filename case).
(if (and (not PC-goto-end)
- mini-p)
+ (minibufferp buffer))
(goto-char (point-max))
;; Need a similar hack for the non-minibuffer-case -- gm.
(when PC-do-completion-end
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 ? )
+ (if (eq last-command-event ? )
(minibuffer-complete-word)
(self-insert-command 1))
(self-insert-command 1)
((= (point-max) (minibuffer-prompt-end))
;; Duplicate the "bug" that Info-menu relies on...
(exit-minibuffer))
- ((eq minibuffer-completion-confirm 'confirm-only)
+ ((eq minibuffer-completion-confirm 'confirm)
(if (or (eq last-command this-command)
(test-completion (field-string)
minibuffer-completion-table
minibuffer-completion-predicate))
(exit-minibuffer)
(PC-temp-minibuffer-message " [Confirm]")))
+ ((eq minibuffer-completion-confirm 'confirm-after-completion)
+ ;; Similar to the above, but only if trying to exit immediately
+ ;; after typing TAB (this catches most minibuffer typos).
+ (if (and (memq last-command minibuffer-confirm-exit-commands)
+ (not (test-completion (field-string)
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
+ (PC-temp-minibuffer-message " [Confirm]")
+ (exit-minibuffer)))
(t
(let ((flag (PC-do-completion 'exit)))
(and flag
;; Check if buffer contents can already be considered complete
(if (and (eq mode 'exit)
(test-completion str table pred))
- (progn
- ;; If completion-ignore-case is non-nil, insert the
- ;; completion string since that may have a different case.
- (when completion-ignore-case
- (setq str (PC-try-completion str table pred))
- (delete-region beg end)
- (insert str))
- 'complete)
+ 'complete
;; Do substitutions in directory names
(and filename
(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
(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))
(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)))
;; 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
(match-string 2 str)
"[A-Za-z0-9]*[^A-Za-z0-9]"))
p (1+ (length (match-string 1 str))))))
- (setq regex (concat "\\`" (mapconcat #'list str "[^-]*-"))
- p 1))))
+ (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!
(setq prefix (PC-try-completion
(PC-chunk-after basestr skip) poss)))
(let ((first t) i)
- ;; Retain capitalization of user input even if
- ;; completion-ignore-case is set.
(if (eq mode 'word)
(setq prefix (PC-chop-word prefix basestr)))
(goto-char (+ beg (length dirname)))
(setq i 0) ; index into prefix string
(while (< i (length prefix))
(if (and (< (point) end)
- (eq (downcase (aref prefix i))
- (downcase (following-char))))
- ;; same char (modulo case); no action
- (forward-char 1)
- (if (and (< (point) end)
- (and (looking-at " ")
- (memq (aref prefix i)
- PC-delims-list)))
- ;; replace " " by the actual delimiter
- (progn
- (delete-char 1)
- (insert (substring prefix i (1+ i))))
- ;; insert a new character
+ (or (eq (downcase (aref prefix i))
+ (downcase (following-char)))
+ (and (looking-at " ")
+ (memq (aref prefix i)
+ PC-delims-list))))
+ ;; replace " " by the actual delimiter
+ ;; or input char by prefix char
(progn
- (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)))))
+ (delete-char 1)
+ (insert (substring prefix i (1+ i))))
+ ;; insert a new character
+ (progn
+ (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 (setq pt (point)))
(looking-at PC-delim-regex))
(if improved
;; We changed it... would it be complete without the space?
- (if (test-completion (buffer-substring 1 (1- end))
+ (if (test-completion (buffer-substring
+ (field-beginning) (1- end))
table pred)
(delete-region (1- end) end)))
;; 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.
;; 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
(+ (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)))
(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)
(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)))
\f
(provide 'complete)