X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59ce725a3b68cbc324f01bc8dc5f9e07286431d1..29bbcfa7054e69db0dbe8250af2c809b39ecb54d:/lisp/complete.el diff --git a/lisp/complete.el b/lisp/complete.el index cbc678de97..0f8e52630f 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, 2008 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 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: @@ -233,11 +231,11 @@ second TAB brings up the `*Completions*' buffer." (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 @@ -292,7 +290,7 @@ 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 ? ) + (if (eq last-command-event ? ) (minibuffer-complete-word) (self-insert-command 1)) (self-insert-command 1) @@ -332,13 +330,22 @@ See `PC-complete' for details." ((= (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 @@ -458,14 +465,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." ;; 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 @@ -491,8 +491,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 @@ -506,8 +507,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)) @@ -522,7 +524,8 @@ GOTO-END is non-nil, however, it instead replaces up to END." (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))) @@ -535,7 +538,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 @@ -621,8 +625,10 @@ GOTO-END is non-nil, however, it instead replaces up to END." (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! @@ -731,8 +737,6 @@ GOTO-END is non-nil, however, it instead replaces up to END." (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))) @@ -740,27 +744,25 @@ GOTO-END is non-nil, however, it instead replaces up to END." (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)) @@ -793,7 +795,8 @@ GOTO-END is non-nil, however, it instead replaces up to END." (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))) @@ -929,7 +932,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. @@ -941,12 +944,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 @@ -964,7 +967,7 @@ 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))) @@ -1094,7 +1097,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) @@ -1105,12 +1108,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)