elves@magic-tree.keebler.com (The Keebler Elves) (03/22/90)
Two new variables: completion-use-environment set non-nil support expansion of
references to enviromental variables, and completion-slashify-directories set
non-nil causes the automatic appending of a slash to unambiguously completed
directory names. There is a tiny bug fix to minibuffer-completion-message.
Installation instructions are in the comments at the top of the file.
Scream at the peacocks,
kyle jones <kjones@talos.pm.com> ...!uunet!talos!kjones
------------------------------------------------------------
;;; Filename completion in the minibuffer
;;; Copyright (C) 1990 Kyle E. Jones
;;;
;;; This program 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 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to kyle@cs.odu.edu.
;; This package provides filename completion for the normally
;; non-completing types of minibuffer input. The central function is
;; minibuffer-complete-file. This function should be bound to a key in
;; minibuffer-local-map that you want to use to invoke filename
;; completion. The installtion instructions below assumes your choice
;; will be TAB; change the define-key call to suit your own tastes.
;;
;; To use this package, put it in a file called "filec.el" in a Lisp
;; directory that Emacs knows about, and byte-compile it.
;;
;; At this point you can either:
;;
;; 1. Put the lines:
;; (require 'filec)
;; (define-key minibuffer-local-map "\t" 'minibuffer-complete-file)
;; in your .emacs file.
;;
;; 2. Put the lines:
;; (autoload 'minibuffer-complete-file "filec" nil t)
;; (define-key minibuffer-local-map "\t" 'minibuffer-complete-file)
;; in your .emacs file.
(provide 'filec)
(defvar completion-auto-correct nil
"*Non-nil means that minibuffer-complete-file should aggressively erase
the trailing part of a word that caused completion to fail, and retry
the completion with the resulting word.")
(defvar completion-use-environment nil
"*Non-nil value means that minibuffer-complete-file should expand
references to environmental variables. Such references should appear as
$var, where var is an environmental variable. To get a $ interpreted
normally in a filename when this variable is set non-nil, you must type $$.")
(defvar completion-slashify-directories nil
"*Non-nil value means that minibuffer-complete-file should automatically
append a slash to directory names that complete unambiguously.")
(defun minibuffer-complete-file ()
"Interpret the word under or before the cursor as a filename and complete
it as far as possible."
(interactive)
(let ((opoint (point)) beg end unexpanded-word word completion c-list
directory file-regexp)
;; find the beginning and end of the word we're trying to complete
(if (or (eobp) (memq (following-char) '(?\t ?\n ?\ )))
(progn
(skip-chars-backward " \t\n")
(and (not (eobp)) (forward-char))
(setq end (point)))
(skip-chars-forward "^ \t\n")
(setq end (point)))
(skip-chars-backward "^ \t\n")
(setq beg (point))
(goto-char opoint)
;; copy the word into a string
(setq word (buffer-substring beg end))
;; expand environmental variables if the user requested it.
(and completion-use-environment
(not (eq word (setq word (substitute-in-file-name word))))
(progn
(delete-region beg end)
(insert word)
(setq end (+ beg (length word)))))
(setq unexpanded-word word)
;; expand the filename fully so we can compare to the full pathname.
;; expand-file-name "resolves" . and .., so we have to shield them.
(if (and (string-match "\\(^\\|/\\)?\.\.?$" word)
(file-directory-p word))
(setq word
(concat (expand-file-name
(or (file-name-directory word)
default-directory))
(file-name-nondirectory word)))
(while (not (eq word (setq word (expand-file-name word))))))
;; extract the directory information from the word
(setq directory (file-name-directory word))
;; extract the file part of the word and convert it to a regular
;; expression that matches itself and any other string prefixed by
;; it.
(setq file-regexp
(concat "^" (regexp-quote (file-name-nondirectory word))))
;; Generate a completion list consisting of the filenames in the
;; specified directory (see above), taking into account
;; completion-ignored-extensions.
(setq c-list (directory-files directory t file-regexp)
c-list (or (delete-matching-strings
(concat (mapconcat 'regexp-quote
completion-ignored-extensions
"\\|")
"$")
c-list)
c-list)
c-list (mapcar 'list c-list))
;; Try the word against the completion list.
(and c-list (setq completion (try-completion word c-list)))
;; If completion is nil, figure out what prefix of the word would prefix
;; something in the completion list... but only if the user is interested.
(if (and (null completion) completion-auto-correct)
(let ((c-list (mapcar 'list (directory-files directory t nil)))
(i -1))
(while (null (setq completion
(try-completion (substring word 0 i) c-list)))
(setq i (1- i)))
(setq completion (substring word 0 i))))
;; If completion is t, we had a perfect match already.
(if (eq completion t)
(cond ((cdr c-list)
(minibuffer-completion-message "[Complete, but not unique]"))
((and completion-slashify-directories
(file-directory-p word)
(/= ?/ (substring word -1 (length word))))
(goto-char end)
(insert "/"))
(t
(minibuffer-completion-message "[Sole completion]")))
;; Compute the difference in length between the completion and the
;; word. A negative difference means no match and the magnitude
;; indicates the number of chars that need to be shaved off the end
;; before a match will occur. A positive difference means a match
;; occurred and the magnitude specifies the number of new chars that
;; can be appended to the word as a completion.
;;
;; Because of file name expansion, the magnitude of a negative
;; difference can be greater than the length of the unexpanded word.
;; Therefore the floor value is limited by negative length of the word.
;;
;; `completion' can be nil here, but the code works anyway because
;; (length nil) still equals 0!
(setq diff (max (- beg end) (- (length completion) (length word))))
(cond
;; We have some completion chars. Insert them.
((> diff 0)
(goto-char end)
(insert (substring completion (- diff)))
(if (and completion-slashify-directories
(null (cdr c-list))
(file-directory-p completion))
(insert "/")))
;; The word prefixed more than one string, but we can't complete
;; any further. Either give help or say "Ambiguous".
((zerop diff)
(if (assoc word c-list)
(minibuffer-completion-message "[Complete, but not unique]")
(if (not completion-auto-help)
(minibuffer-completion-message "[Ambiguous]")
(minibuffer-show-completions
(sort
(directory-files
directory nil
(concat "^" (regexp-quote (file-name-nondirectory word))))
'string-lessp)))))
;; The word didn't prefix anything... if completion-auto-correct is
;; non-nil strip the offending characters and try again.
(completion-auto-correct
(goto-char end)
(delete-char diff)
(minibuffer-complete-file))
;; completion utterly failed, tell the user so.
(t
(minibuffer-completion-message "[No match]"))))))
(defun minibuffer-completion-message (string &optional seconds)
"Briefly display STRING to the right of the current minibuffer input.
Optional second arg SECONDS specifies how long to keep the message visible;
the default is 2 seconds.
A keypress causes the immediate erasure of the STRING, and return of control
to the calling program."
(let (omax (inhibit-quit t))
(save-excursion
(goto-char (point-max))
(setq omax (point))
(insert " " string))
(sit-for (or seconds 2))
(delete-region omax (point-max))))
(defun minibuffer-show-completions (list)
"Display LIST in a multi-column listing in the \" *Completions*\" buffer.
LIST should be a list of strings."
(save-excursion
(let (longest rows columns list-length q i)
(set-buffer (get-buffer-create " *Completions*"))
(erase-buffer)
(insert "Possible completions are:\n")
(setq q list
list-length 0
longest 0)
(while q
(setq longest (max longest (length (car q)))
list-length (1+ list-length)
q (cdr q)))
;; provide for separation between columns
(setq longest (+ 3 longest))
(setq columns (/ (- (screen-width) 2) longest)
rows (/ list-length columns)
rows
(+ (if (zerop (% list-length columns)) 0 1)
rows))
(setq i columns
tab-stop-list nil)
(while (not (zerop i))
(setq tab-stop-list (cons (* longest i) tab-stop-list)
i (1- i)))
(setq q list
i 0)
(while q
(insert (car q))
(setq i (1+ i)
q (cdr q))
(if (zerop (% i columns))
(insert "\n")
(tab-to-tab-stop)))
(goto-char (point-min))
(display-buffer " *Completions*"))))
(defun delete-matching-strings (regexp list &optional destructively)
"Delete strings matching REGEXP from LIST.
Optional third arg non-nil means to destructively alter LIST, instead of
working on a copy.
The new version of the list, minus the deleted strings, is returned."
(or destructively (setq list (copy-sequence list)))
(let ((curr list) (prev nil))
(while curr
(if (not (string-match regexp (car curr)))
(setq prev curr
curr (cdr curr))
(if (null prev)
(setq list (cdr list)
curr list)
(setcdr prev (cdr curr))
(setq curr (cdr curr)))))
list ))