-;; complete.el -- partial completion mechanism plus other goodies.
+;;; complete.el --- partial completion mechanism plus other goodies
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
+;; Keywords: abbrev
;; Version: 2.02
;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
-;; Commentary:
+;;; Commentary:
;; Extended completion for the Emacs minibuffer.
;;
;; is supported in include file names.
-;; Code:
+;;; Code:
(defvar PC-meta-flag t
"*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion.
(interactive)
(if (PC-was-meta-key)
(minibuffer-complete)
- (PC-do-completion nil)))
+ ;; If the previous command was not this one,
+ ;; never scroll, always retry completion.
+ (or (eq last-command this-command)
+ (setq minibuffer-scroll-window nil))
+ (let ((window minibuffer-scroll-window))
+ ;; If there's a fresh completion window with a live buffer,
+ ;; and this command is repeated, scroll that window.
+ (if (and window (window-buffer window)
+ (buffer-name (window-buffer window)))
+ (save-excursion
+ (set-buffer (window-buffer window))
+ (if (pos-visible-in-window-p (point-max) window)
+ (set-window-start window (point-min) nil)
+ (scroll-other-window)))
+ (PC-do-completion nil)))))
(defun PC-complete-word ()
(if (or (eq flag 'complete)
(not minibuffer-completion-confirm))
(exit-minibuffer)
- (PC-temp-minibuffer-message " (Confirm)"))))))
+ (PC-temp-minibuffer-message " [Confirm]"))))))
(defun PC-completion-help ()
(defvar PC-ndelims-regex nil)
(defvar PC-delims-list nil)
+(defvar PC-completion-as-file-name-predicate
+ (function
+ (lambda ()
+ (memq minibuffer-completion-table
+ '(read-file-name-internal read-directory-name-internal))))
+ "A function testing whether a minibuffer completion now will work filename-style.
+The function takes no arguments, and typically looks at the value
+of `minibuffer-completion-table' and the minibuffer contents.")
+
(defun PC-do-completion (&optional mode beg end)
(or beg (setq beg (point-min)))
(or end (setq end (point-max)))
(let* ((table minibuffer-completion-table)
(pred minibuffer-completion-predicate)
- (filename (memq table '(read-file-name-internal
- read-directory-name-internal)))
+ (filename (funcall PC-completion-as-file-name-predicate))
(dirname nil)
+ dirlength
(str (buffer-substring beg end))
(incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
(ambig nil)
(PC-is-complete-p str table pred))
'complete
+ ;; Record how many characters at the beginning are not included
+ ;; in completion.
+ (setq dirlength
+ (if filename
+ (length (file-name-directory str))
+ 0))
+
;; Do substitutions in directory names
(and filename
(not (equal str (setq p (substitute-in-file-name str))))
(setq p compl)
(while p
(and (string-match regex (car p))
- (setq poss (cons (car p) poss)))
+ (progn
+ (set-text-properties 0 (length (car p)) '() (car p))
+ (setq poss (cons (car p) poss))))
(setq p (cdr p)))))
;; Now we have a list of possible completions
(PC-do-completion 'word))
(beep)
(PC-temp-minibuffer-message (if ambig
- " (Ambiguous dir name)"
+ " [Ambiguous dir name]"
(if (eq mode 'help)
- " (No completions)"
- " (No match)")))
+ " [No completions]"
+ " [No match]")))
nil))
;; More than one valid completion found
;; 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)))
+ (not (string-equal (car p) basestr)))
(setq p (cdr p)))
- (if p
-
- (progn
- (if (null mode)
- (PC-temp-minibuffer-message " (Complete, but not unique)"))
- t)
+ (and p (null mode)
+ (PC-temp-minibuffer-message " [Complete, but not unique]"))
+ (if (and p
+ (not (and (null mode)
+ (eq this-command last-command))))
+ t
;; If ambiguous, try for a partial completion
(let ((improved nil)
(delete-char 1)
(setq end (1- end))))
(setq improved t))
- ;; Use format to discard text properties.
- (insert (format "%s" (substring prefix i (1+ i))))
+ (insert (substring prefix i (1+ i)))
(setq end (1+ end)))
(setq i (1+ i)))
(or pt (equal (point) beg)
;; 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)"))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list (sort helpposs 'string-lessp))
+ (save-excursion
+ (set-buffer standard-output)
+ ;; Record which part of the buffer we are completing
+ ;; so that choosing a completion from the list
+ ;; knows how much old text to replace.
+ (setq completion-base-size dirlength)))
+ (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)"))
+ (PC-temp-minibuffer-message " [Sole completion]"))
(delete-region beg end)
(insert (format "%s"
(if filename
(kill-buffer (current-buffer))
(or files
(error "No matching files"))
+ ;; Bring the other files (not the first) into buffers.
(save-window-excursion
(while (setq next (cdr next))
(let ((buf (find-file-noselect (car next))))
+ ;; Put this buffer at the front of the buffer list.
(switch-to-buffer buf))))
- ;; This modifies the "buf" variable inside find-file-noselect.
+ ;; 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))
+ ;; This modified `truename' inside find-file-noselect.
+ (setq truename (abbreviate-file-name (file-truename filename)))
(set-buffer buf)
(erase-buffer)
(insert-file-contents filename t))