[comp.emacs] filec.el

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