bard@THEORY.LCS.MIT.EDU (Bard Bloom) (04/20/88)
Some time ago, someone (I've lost the name -- sorry) posted a command to
complete a partially-typed file name. I've cleaned it up, and tweaked it:
with a prefix argument, if there are several completions, it does a
completing-read asking you which one to use. A good thing to bind to
TAB if you're a tcsh fan, or C-c C-f in shell mode.
-- Bard the \x.gargoyle
;;; I hereby contribute this partially plagarized code to the world.
(defun member-general (x l comparison)
"Is X a member of L under COMPARISON? E.g.: (memq x l) is about the same as
to (member-general x l (function eq))."
(let ((not-found t))
(while (and l not-found)
(setq not-found (not (funcall comparison x (car l)))
l (cdr-safe l)))
(not not-found)))
(defun shell-expand-file-name (prompt-if-many)
"Expand the file name before point. With a prefix argument,
if there is more than one completion, it completing-reads a name."
(interactive "P")
(skip-chars-backward " \t")
(let ((place (point))
(stop (save-excursion (beginning-of-line 1) (point)))
path start name full-name
possible-completions possible-completions-alist)
(setq start ; starting pos of prev filename
(if (re-search-backward "[ ;`!#$^&*()':,?<>|\]" stop 'move)
(1+ (point)) ; filename starts at delimiter
(point))) ; filename starts at bol
(goto-char place)
;; now, go to the beginning of the file name proper
(cond
((search-backward "/" start t)
(setq path (buffer-substring start (1+ (point))))
(forward-char 1))
(t
(setq path "")
(goto-char start)))
;; Now, point is at the beginning of the filename part
(setq name (buffer-substring (point) place))
(setq full-name
(file-name-completion name (concat default-directory path)))
(setq possible-completions (file-name-all-completions
name (concat default-directory path)))
(if (equal full-name 't)
(setq full-name name))
(cond
((null full-name)
(goto-char place)
(error "No completions."))
((= (length possible-completions) 1)
(delete-region (point) place)
(insert full-name)
(message "Completed"))
(prompt-if-many
(setq possible-completions-alist
(mapcar (function list) possible-completions))
(setq full-name (completing-read "Insert filename: "
possible-completions-alist
nil nil full-name))
;; Don't modify the buffer 'till now, because the luser might quit
;; inside the completing-read. That's why I keep repeating this:
(delete-region (point) place)
(insert full-name))
(t
(delete-region (point) place)
(insert full-name)
(if (member-general
full-name possible-completions (function string=))
(message "Complete but not unique")
(message "Not complete..."))))))