🚀 go-pugleaf

Dan Jacobson writes:
 > Why not have the minibuffer do filename expansions after you hit M-x
 > compile, M-!, M-|, like the minibuffer does after you hit C-x C-f
 > (find-file)?

OK, here it is.  Installation instructions are in the comments at the
top of the file.  completion-ignored-extensions and completion-auto-help
alter behavior as you would expect.  There's also a variable
completion-auto-correct that causes minibuffer-complete-file to
aggressively correct input like Gosling's Emacs used to do.

Enjoy,

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.")

(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 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 the filename fully so we can compare to the full pathname.
    (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)
	(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))))
       ;; The word prefixed more than one string, but we can't complete
       ;; any further.  Either give help or say "Ambiguous".
       ((zerop diff)
	(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)
    (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 ))