; File name completion
;
; complete-file-name replaces the filename preceeding the point with
; its completion, displaying a completion list if ambiguous.  If the
; filename in the buffer doesn't start with "/", then completion 
; happens in the specified directory (or in default-directory, if not
; specified)

(defun complete-file-name (&optional in-directory)
  "Completes filename before point.
If the filename does not begin with a slash, the optional argument
IN-DIRECTORY (or the current value of default-directory) is prepended."
  (interactive)
  (let (start file new-file dir home)
    (save-excursion
      (setq file (buffer-substring (save-excursion 
				     (if (re-search-backward "[^\\.~a-z0-9@/_-]"
							     (point-min) t)
					 (setq start (1+ (point)))
				       (setq start (point-min))))
				   (point)))
      (if (not (string-match "^/" file))
	  (setq file (concat (or in-directory default-directory) file)))
      (setq home (string-match "\\`~/" file)
	    new-file (file-name-completion
		      (file-name-nondirectory file)
		      (setq dir (expand-file-name (file-name-directory file))))))
    (if new-file
	(progn
	  (setq new-file (if home 
			     (unexpand-file-name (concat dir new-file))
			   (concat dir new-file)))
	  (if (equal file new-file)
	      (display-file-completions (file-name-nondirectory file) dir)
	      (progn 
		(delete-region start (point))
		(insert new-file))))
	(beep t))))

(defun unexpand-file-name (filename)
  (if (string-match (getenv "HOME") filename)
      (concat "~" 
	      (substring filename 
			 (length (getenv "HOME"))
			 (length filename)))
      filename))

(defun display-file-completions (file dir)
  (message "Making completion list...")
  (save-window-excursion
    (with-output-to-temp-buffer " *Completions*"
      (display-completion-list 
       (sort (file-name-all-completions file dir)
	     'string<)))
    (momentary-string-display "" (point) 32 "Hit SPC to remove window.")))