From: aho@thalamus.sans.kth.se (Anders Holst)
Subject: hippie-expand.el : One key for many kinds of expansions
Organization: /home/aho/.organization
Date: Sat, 7 Nov 1992 16:16:12 GMT

This is a function I wrote which turned out to be very useful. I
haven't seen so much similar things posted, but I may have missed them
of course. 

Anyway, it is meant to complete or expand text before point just as
one wants it, or rather to try to complete it in a lot of different
ways in succession. First it tries to complete it as a file name,
then by looking in all abbrev tables, thereafter it tries to find an
entire line to complete with, then to expand like dabbrev, then like
dabbrev but looking in all buffers (this turned out to be a hit
actually) and finally expanding it like a lisp emacs symbol. 
No, it is *not* very slow, since it works incrementally. What might
be disturbing is the large number of possible completions if the
string to expand is to unspecific, but used with sense it can be as
mentioned very useful. It is nearly the only completion/expansion
mechanism I use nowadays.

So take the chance and at least try it, you will like it (but please
read the included instructions below first):

;;----------------------------------------------------------------------------
;;
;;  File: hippie-expand.el
;; 
;;  Author: Anders Holst (aho@sans.kth.se)
;;
;;  Last change: 5 November 1992
;;
;;  Copyright (C) Anders Holst
;;
;;  --------------------------------------------------------------------------
;;  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.
;; 
;;  You should have received a copy of the GNU General Public License
;;  along with your copy of Emacs; if not, write to the Free Software
;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;  --------------------------------------------------------------------------
;;
;;  INSTALLATION
;;
;;  To install this file, put it in your load-path, and put the
;;  following or something similar in your .emacs :
;;  
;;    (autoload 'hippie-expand "hippie-expand" "Try to expand text before point")
;;    (define-key esc-map " " 'hippie-expand)
;;
;;  (Note that hippie-expand must be bound to a key to work properly,
;;  since it uses the variables last-command and this-command. So don't
;;  try to test it without first binding it to a key.)
;;  
;;  DESCRIPTION
;;  
;;  Hippie-expand is a single function for a lot of different kinds
;;  of completions and expansions. Called repeatedly it tries all
;;  possible completions in succession. Given a numeric argument it
;;  undoes the tried completion. 
;;  Which kinds of completions to try, and in which order, is
;;  determined by the contents of he-try-functions-list. Much
;;  customization of hippie-expand can be made by changing the order
;;  of, removing, or inserting new functions in this list.
;;  
;;  A short description of the current try-functions in this file:
;;    try-complete-filename: very convenient to have in any buffer,
;;      and not just in the minibuffer or (some) shell-mode. It goes
;;      through all possible completions instead of just completing as
;;      much as is unique.
;;    try-expand-all-abbrevs: can be removed if you don't use abbrevs.
;;      Otherwise it looks through all abbrev-tables, starting with
;;      the local and thereafter the global. 
;;    try-expand-line: Searches backwards in the buffer for an entire
;;      line that begins exactly as the current line. Convenient
;;      sometimes, for example as a substitute for (or complement to)
;;      the history list in shell-like buffers. Remove it if you find
;;      it confusing in general.  
;;    try-expand-dabbrev: works exactly as dabbrev-expand (but of
;;      course in a way compatible with the other try-functions).
;;    try-expand-dabbrev-all-buffers: perhaps the most useful of them,
;;      like dabbrev-expand but searches all emacs-buffers (except the
;;      current) for matching words. (No, I don't find it particularly
;;      slow, but then I seldom use more than 10-15 buffers at once.)
;;    try-complete-lisp-symb: like lisp-complete-symbol, but goes
;;      through all possibilities instead of completing what is unique.
;;      Might be tedious (usually a lot of possible completions) and
;;      since its function is anyway nearly as lisp-complete-symbol,
;;      which already has a key of its own, you might want to remove
;;      this.
;;
;;  To write new try-functions, consider the following:
;;  Each try-function takes one argument OLD which is nil the first
;;  time the function is called and true in succeeding calls for the
;;  same string to complete. The first time the function has to
;;  extract the string before point to complete, and substitute the
;;  first completion alternative for it. On following calls it has to
;;  substitute the next possible completion for the last tried string.
;;  The try-function is to return true as long as it finds new
;;  possible completions. When there are no more alternatives it has
;;  to restore the text before point to its original contents, and
;;  return nil (don't beep or message or anything).
;;  The try-function can (ought to) use the following functions:
;;    he-init-string: Initializes the text to substitute to the
;;      contents of the region BEGIN to END. Also sets the variable
;;      he-search-string to the text to expand.
;;    he-substitute-string: substitutes STR into the region
;;      initialized with he-init-string.
;;    he-reset-string: Resets the initialized region to its original
;;      contents.
;;  There is also a variable: he-tried-table which is meant to contain
;;  all tried expansions so far. The try-function can check this 
;;  variable to see whether an expansion has been already tried
;;  (hint: he-string-member), and add its own tried expansions to it.
;;
;;  Good Luck !


(defvar he-num -1)

(defvar he-string-beg ())

(defvar he-string-end ())

(defvar he-search-string ())

(defvar he-expand-list ())

(defvar he-tried-table ())

(defvar he-line-loc ())

(defvar he-dab-loc ())

(defvar he-dab-bw ())

(defvar he-dab-bufs ())

(defvar he-try-functions-list '(try-complete-file-name
				try-expand-all-abbrevs
				try-expand-line
				try-expand-dabbrev
				try-expand-dabbrev-all-buffers
				try-complete-lisp-symb)
  "The list of completion and expansion functions tried in order by hippie-expand.
To change the behavior of hippie-expand, remove, change the order of, or insert 
functions in this list.")


(defun hippie-expand (arg)
  "Try to expand text before point. With numeric argument, undoes expansion.
Repeated application of hippie-expand inserts the next possible expansion. 
The different functions in he-try-functions-list are tried in order."
  (interactive "P")
  (if (not arg)
      (progn
	(if (not (equal this-command last-command))
	    (setq he-num -1))
	(if (= he-num -1)
	    (setq he-tried-table nil))
	(let ((i (max he-num 0)))
	  (while (not (or (>= i (length he-try-functions-list))
			  (apply (nth i he-try-functions-list) 
				 (list (= he-num i)))))
	    (setq i (1+ i)))
	  (setq he-num i))
	(if (>= he-num (length he-try-functions-list))
	    (progn
	      (setq he-num -1)
	      (message "I'm sorry, I really tried.")
	      (ding))))
      (if (>= he-num 0)
	  (progn
	    (setq he-num -1)
	    (he-reset-string)))))
      
(defun he-init-string (beg end)
  (setq he-string-beg beg)
  (setq he-string-end end)
  (setq he-search-string (buffer-substring beg end)))

(defun he-substitute-string (str)
  (delete-region he-string-beg he-string-end)
  (insert str)
  (setq he-string-end (point)))

(defun he-reset-string ()
  (delete-region he-string-beg he-string-end)
  (insert he-search-string)
  (setq he-string-end (point)))

(defun he-string-member (str lst)
  (while (and lst
	      (not
	       (if (and case-fold-search case-replace)
		   (string= (downcase (car lst)) (downcase str))
		   (string= (car lst) str))))
    (setq lst (cdr lst)))
  lst)

(defun try-complete-file-name (old)
  "Tries file name completion of text before point"
  (if (not old)
      (progn 
	(he-init-string (find-file-name-beg) (point))
	(setq he-expand-list 
	      (and (not (equal he-search-string ""))
		   (file-directory-p (file-name-directory (expand-file-name he-search-string)))
		   (sort (file-name-all-completions 
			  (file-name-nondirectory he-search-string)
			  (file-name-directory (expand-file-name he-search-string)))
			 'string-lessp)))))
  (while (and he-expand-list
	      (he-string-member (car he-expand-list) he-tried-table))
    (setq he-expand-list (cdr he-expand-list)))
  (if (null he-expand-list)
      (progn
	(he-reset-string)
	())
      (let ((filename (concat (file-name-directory he-search-string)
			      (car he-expand-list))))
	(he-substitute-string filename)
	(setq he-tried-table (cons filename he-tried-table))
	(setq he-expand-list (cdr he-expand-list))
	t)))

(defun find-file-name-beg ()
  (let ((skips 
	 "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_./~^"))
    (save-excursion
      (skip-chars-backward skips)
      (point))))

(defun try-complete-lisp-symb (old)
  "Tries to complete text before point as a emacs-lisp symbol"
  (if (not old)
      (progn 
	(he-init-string (find-lisp-symb-beg) (point))
	(setq he-expand-list 
	      (and (not (equal he-search-string ""))
		   (sort (all-completions he-search-string obarray
					  (function (lambda (sym)
					    (or (boundp sym)
						(fboundp sym)
						(symbol-plist sym)))))
			 'string-lessp)))))
  (while (and he-expand-list
	      (he-string-member (car he-expand-list) he-tried-table))
    (setq he-expand-list (cdr he-expand-list)))
  (if (null he-expand-list)
      (progn
	(he-reset-string)
	())
      (progn
	(he-substitute-string (car he-expand-list))
	(setq he-tried-table (cons (car he-expand-list) he-tried-table))
	(setq he-expand-list (cdr he-expand-list))
	t)))

(defun find-lisp-symb-beg ()
  (let ((skips 
	 "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_."))
    (save-excursion
      (skip-chars-backward skips)
      (point))))

(defun try-expand-line (old)
  "Tries to complete the line before point to an entire line earlier in the buffer"
  (let ((expansion ())
	(strip-prompt (and (get-buffer-process (current-buffer))
			   shell-prompt-pattern)))
    (if (not old)
	(progn 
	  (he-init-string (find-line-beg strip-prompt) (point))
	  (setq he-line-loc he-string-beg)))
    (if (not (equal he-search-string ""))
	(save-excursion
	  (goto-char he-line-loc)
	  (setq expansion (he-line-search he-search-string strip-prompt))
	  (setq he-line-loc (point))))
    (if (not expansion)
	(progn
	  (he-reset-string)
	  ())
	(progn
	  (he-substitute-string expansion)
	  (setq he-tried-table (cons expansion he-tried-table))
	  t))))

(defun he-line-search (str strip-prompt)
  (let ((result ()))
    (while (and (not result)
		(re-search-backward (he-line-search-regexp str strip-prompt) nil t))
      (setq result (buffer-substring (match-beginning 2) (match-end 2)))
      (if (he-string-member result he-tried-table)
	  (setq result nil)))	            ; if already in table, ignore
    result))

(defun find-line-beg (strip-prompt)
  (save-excursion
    (end-of-line)
    (if (re-search-backward (he-line-search-regexp "" strip-prompt) 
			    (save-excursion (beginning-of-line) (point)) t)
	(match-beginning 2)
      (beginning-of-line)
      (point))))

(defun he-line-search-regexp (pat strip-prompt)
  (if strip-prompt
      (concat "\\(" shell-prompt-pattern "\\|^\\s-*\\)\\("
	      (regexp-quote pat)
	      "[^\n]*[^ \t\n]\\)")
      (concat "^\\(\\s-*\\)\\(" 
	      (regexp-quote pat)
	      "[^\n]*[^ \t\n]\\)")))

(defun remove-if-null (lst)
  (cond ((null lst) ())
	((null (car lst))
	 (remove-if-null (cdr lst)))
	(t 
	 (cons (car lst) (remove-if-null (cdr lst))))))

(defun try-expand-all-abbrevs (old)
  "Tries to expand text before point according to all abbrev tables"
  (if (not old)
      (progn
	(he-init-string (find-dabbrev-beg) (point))
	(setq he-expand-list 
	      (and (not (equal he-search-string ""))
		   (remove-if-null (mapcar '(lambda (sym)
					     (abbrev-expansion he-search-string
							       (eval sym)))
					   abbrev-table-name-list))))))
  (while (and he-expand-list
	      (he-string-member (car he-expand-list) he-tried-table))
    (setq he-expand-list (cdr he-expand-list)))
  (if (null he-expand-list)
      (progn
	(he-reset-string)
	())
      (progn
	(he-substitute-string (car he-expand-list))
	(setq he-tried-table (cons (car he-expand-list) he-tried-table))
	(setq he-expand-list (cdr he-expand-list))
	t)))

(defun try-expand-dabbrev (old)
  "Tries to expand text before point dynamically, searching in the same buffer before and after point."
  (let ((expansion ()))
    (if (not old)
	(progn
	  (he-init-string (find-dabbrev-beg) (point))
	  (setq he-dab-loc he-string-beg)
	  (setq he-dab-bw t)))

    (if (not (equal he-search-string ""))
	(save-excursion
	  ;; Try looking backward unless inhibited.
	  (if he-dab-bw
	      (progn 
		(goto-char he-dab-loc)
		(setq expansion (he-dab-search he-search-string t))
		(setq he-dab-loc (point-marker))
		(if expansion
		    (setq he-tried-table (cons expansion he-tried-table))
		    (progn
		      (setq he-dab-loc he-string-end)
		      (setq he-dab-bw ())))))
	  
	  (if (not expansion) ; Then look forward.
	      (progn 
		(goto-char he-dab-loc)
		(setq expansion (he-dab-search he-search-string nil))
		(setq he-dab-loc (point-marker))
		(if expansion
		    (setq he-tried-table (cons expansion he-tried-table)))))))
	
    (if (not expansion)
	(progn
	  (he-reset-string)
	  ())
	(progn
	  (he-substitute-string expansion)
	  t))))

(defun try-expand-dabbrev-all-buffers (old)
  "Tries to expand text before point dynamically, searching all emacs buffers but the current."
  (let ((expansion ())
	(buf (current-buffer)))
    (if (not old)
	(progn
	  (he-init-string (find-dabbrev-beg) (point))
	  (setq he-dab-loc 0)
	  (setq he-dab-bufs (buffer-list))))

    (if (not (equal he-search-string ""))
	(while (and he-dab-bufs (not expansion))
	  (if (not (equal (car he-dab-bufs) buf))
	      (progn
		(set-buffer (car he-dab-bufs))
		(save-excursion
		  (goto-char he-dab-loc)
		  (setq expansion (he-dab-search he-search-string nil))
		  (setq he-dab-loc (point-marker)))))
	  (if expansion
	      (setq he-tried-table (cons expansion he-tried-table))
	      (progn
		(setq he-dab-loc 0)
		(setq he-dab-bufs (cdr he-dab-bufs))))))

    (set-buffer buf)
    (if (not expansion)
	(progn
	  (he-reset-string)
	  ())
	(progn
	  (he-substitute-string expansion)
	  t))))

(defun he-dab-search-regexp (pat)
  (concat "\\b" (regexp-quote pat) 
	  "\\(\\sw\\|\\s_\\)+"))

(defun he-dab-search (pattern reverse)
  (let ((result ()))
    (while (and (not result) 
		(if reverse
		     (re-search-backward (he-dab-search-regexp pattern) nil t)
		     (re-search-forward (he-dab-search-regexp pattern) nil t)))
      (setq result (buffer-substring (match-beginning 0) (match-end 0)))
      (if (he-string-member result he-tried-table)
	  (setq result nil)))	            ; if already in table, ignore
    result))

(defun find-dabbrev-beg ()
  (let ((skips 
	 "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_."))
    (save-excursion
      (skip-chars-backward skips)
      (skip-chars-forward "-_.")
      (point))))


Newsgroups: gnu.emacs.sources