home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #26 / NN_1992_26.iso / spool / gnu / emacs / sources / 781 < prev    next >
Encoding:
Text File  |  1992-11-08  |  15.7 KB  |  460 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!mcsun!sunic!kth.se!news.kth.se!aho
  3. From: aho@thalamus.sans.kth.se (Anders Holst)
  4. Subject: hippie-expand.el : One key for many kinds of expansions
  5. Message-ID: <AHO.92Nov7171612@thalamus.sans.kth.se>
  6. Sender: usenet@kth.se (Usenet)
  7. Nntp-Posting-Host: thalamus.sans.kth.se
  8. Organization: /home/aho/.organization
  9. Date: Sat, 7 Nov 1992 16:16:12 GMT
  10. Lines: 448
  11.  
  12. This is a function I wrote which turned out to be very useful. I
  13. haven't seen so much similar things posted, but I may have missed them
  14. of course. 
  15.  
  16. Anyway, it is meant to complete or expand text before point just as
  17. one wants it, or rather to try to complete it in a lot of different
  18. ways in succession. First it tries to complete it as a file name,
  19. then by looking in all abbrev tables, thereafter it tries to find an
  20. entire line to complete with, then to expand like dabbrev, then like
  21. dabbrev but looking in all buffers (this turned out to be a hit
  22. actually) and finally expanding it like a lisp emacs symbol. 
  23. No, it is *not* very slow, since it works incrementally. What might
  24. be disturbing is the large number of possible completions if the
  25. string to expand is to unspecific, but used with sense it can be as
  26. mentioned very useful. It is nearly the only completion/expansion
  27. mechanism I use nowadays.
  28.  
  29. So take the chance and at least try it, you will like it (but please
  30. read the included instructions below first):
  31.  
  32. ;;----------------------------------------------------------------------------
  33. ;;
  34. ;;  File: hippie-expand.el
  35. ;; 
  36. ;;  Author: Anders Holst (aho@sans.kth.se)
  37. ;;
  38. ;;  Last change: 5 November 1992
  39. ;;
  40. ;;  Copyright (C) Anders Holst
  41. ;;
  42. ;;  --------------------------------------------------------------------------
  43. ;;  This program is free software; you can redistribute it and/or modify
  44. ;;  it under the terms of the GNU General Public License as published by
  45. ;;  the Free Software Foundation; either version 1, or (at your option)
  46. ;;  any later version.
  47. ;; 
  48. ;;  This program is distributed in the hope that it will be useful,
  49. ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  50. ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  51. ;;  GNU General Public License for more details.
  52. ;; 
  53. ;;  You should have received a copy of the GNU General Public License
  54. ;;  along with your copy of Emacs; if not, write to the Free Software
  55. ;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  56. ;;  --------------------------------------------------------------------------
  57. ;;
  58. ;;  INSTALLATION
  59. ;;
  60. ;;  To install this file, put it in your load-path, and put the
  61. ;;  following or something similar in your .emacs :
  62. ;;  
  63. ;;    (autoload 'hippie-expand "hippie-expand" "Try to expand text before point")
  64. ;;    (define-key esc-map " " 'hippie-expand)
  65. ;;
  66. ;;  (Note that hippie-expand must be bound to a key to work properly,
  67. ;;  since it uses the variables last-command and this-command. So don't
  68. ;;  try to test it without first binding it to a key.)
  69. ;;  
  70. ;;  DESCRIPTION
  71. ;;  
  72. ;;  Hippie-expand is a single function for a lot of different kinds
  73. ;;  of completions and expansions. Called repeatedly it tries all
  74. ;;  possible completions in succession. Given a numeric argument it
  75. ;;  undoes the tried completion. 
  76. ;;  Which kinds of completions to try, and in which order, is
  77. ;;  determined by the contents of he-try-functions-list. Much
  78. ;;  customization of hippie-expand can be made by changing the order
  79. ;;  of, removing, or inserting new functions in this list.
  80. ;;  
  81. ;;  A short description of the current try-functions in this file:
  82. ;;    try-complete-filename: very convenient to have in any buffer,
  83. ;;      and not just in the minibuffer or (some) shell-mode. It goes
  84. ;;      through all possible completions instead of just completing as
  85. ;;      much as is unique.
  86. ;;    try-expand-all-abbrevs: can be removed if you don't use abbrevs.
  87. ;;      Otherwise it looks through all abbrev-tables, starting with
  88. ;;      the local and thereafter the global. 
  89. ;;    try-expand-line: Searches backwards in the buffer for an entire
  90. ;;      line that begins exactly as the current line. Convenient
  91. ;;      sometimes, for example as a substitute for (or complement to)
  92. ;;      the history list in shell-like buffers. Remove it if you find
  93. ;;      it confusing in general.  
  94. ;;    try-expand-dabbrev: works exactly as dabbrev-expand (but of
  95. ;;      course in a way compatible with the other try-functions).
  96. ;;    try-expand-dabbrev-all-buffers: perhaps the most useful of them,
  97. ;;      like dabbrev-expand but searches all emacs-buffers (except the
  98. ;;      current) for matching words. (No, I don't find it particularly
  99. ;;      slow, but then I seldom use more than 10-15 buffers at once.)
  100. ;;    try-complete-lisp-symb: like lisp-complete-symbol, but goes
  101. ;;      through all possibilities instead of completing what is unique.
  102. ;;      Might be tedious (usually a lot of possible completions) and
  103. ;;      since its function is anyway nearly as lisp-complete-symbol,
  104. ;;      which already has a key of its own, you might want to remove
  105. ;;      this.
  106. ;;
  107. ;;  To write new try-functions, consider the following:
  108. ;;  Each try-function takes one argument OLD which is nil the first
  109. ;;  time the function is called and true in succeeding calls for the
  110. ;;  same string to complete. The first time the function has to
  111. ;;  extract the string before point to complete, and substitute the
  112. ;;  first completion alternative for it. On following calls it has to
  113. ;;  substitute the next possible completion for the last tried string.
  114. ;;  The try-function is to return true as long as it finds new
  115. ;;  possible completions. When there are no more alternatives it has
  116. ;;  to restore the text before point to its original contents, and
  117. ;;  return nil (don't beep or message or anything).
  118. ;;  The try-function can (ought to) use the following functions:
  119. ;;    he-init-string: Initializes the text to substitute to the
  120. ;;      contents of the region BEGIN to END. Also sets the variable
  121. ;;      he-search-string to the text to expand.
  122. ;;    he-substitute-string: substitutes STR into the region
  123. ;;      initialized with he-init-string.
  124. ;;    he-reset-string: Resets the initialized region to its original
  125. ;;      contents.
  126. ;;  There is also a variable: he-tried-table which is meant to contain
  127. ;;  all tried expansions so far. The try-function can check this 
  128. ;;  variable to see whether an expansion has been already tried
  129. ;;  (hint: he-string-member), and add its own tried expansions to it.
  130. ;;
  131. ;;  Good Luck !
  132.  
  133.  
  134. (defvar he-num -1)
  135.  
  136. (defvar he-string-beg ())
  137.  
  138. (defvar he-string-end ())
  139.  
  140. (defvar he-search-string ())
  141.  
  142. (defvar he-expand-list ())
  143.  
  144. (defvar he-tried-table ())
  145.  
  146. (defvar he-line-loc ())
  147.  
  148. (defvar he-dab-loc ())
  149.  
  150. (defvar he-dab-bw ())
  151.  
  152. (defvar he-dab-bufs ())
  153.  
  154. (defvar he-try-functions-list '(try-complete-file-name
  155.                 try-expand-all-abbrevs
  156.                 try-expand-line
  157.                 try-expand-dabbrev
  158.                 try-expand-dabbrev-all-buffers
  159.                 try-complete-lisp-symb)
  160.   "The list of completion and expansion functions tried in order by hippie-expand.
  161. To change the behavior of hippie-expand, remove, change the order of, or insert 
  162. functions in this list.")
  163.  
  164.  
  165. (defun hippie-expand (arg)
  166.   "Try to expand text before point. With numeric argument, undoes expansion.
  167. Repeated application of hippie-expand inserts the next possible expansion. 
  168. The different functions in he-try-functions-list are tried in order."
  169.   (interactive "P")
  170.   (if (not arg)
  171.       (progn
  172.     (if (not (equal this-command last-command))
  173.         (setq he-num -1))
  174.     (if (= he-num -1)
  175.         (setq he-tried-table nil))
  176.     (let ((i (max he-num 0)))
  177.       (while (not (or (>= i (length he-try-functions-list))
  178.               (apply (nth i he-try-functions-list) 
  179.                  (list (= he-num i)))))
  180.         (setq i (1+ i)))
  181.       (setq he-num i))
  182.     (if (>= he-num (length he-try-functions-list))
  183.         (progn
  184.           (setq he-num -1)
  185.           (message "I'm sorry, I really tried.")
  186.           (ding))))
  187.       (if (>= he-num 0)
  188.       (progn
  189.         (setq he-num -1)
  190.         (he-reset-string)))))
  191.       
  192. (defun he-init-string (beg end)
  193.   (setq he-string-beg beg)
  194.   (setq he-string-end end)
  195.   (setq he-search-string (buffer-substring beg end)))
  196.  
  197. (defun he-substitute-string (str)
  198.   (delete-region he-string-beg he-string-end)
  199.   (insert str)
  200.   (setq he-string-end (point)))
  201.  
  202. (defun he-reset-string ()
  203.   (delete-region he-string-beg he-string-end)
  204.   (insert he-search-string)
  205.   (setq he-string-end (point)))
  206.  
  207. (defun he-string-member (str lst)
  208.   (while (and lst
  209.           (not
  210.            (if (and case-fold-search case-replace)
  211.            (string= (downcase (car lst)) (downcase str))
  212.            (string= (car lst) str))))
  213.     (setq lst (cdr lst)))
  214.   lst)
  215.  
  216. (defun try-complete-file-name (old)
  217.   "Tries file name completion of text before point"
  218.   (if (not old)
  219.       (progn 
  220.     (he-init-string (find-file-name-beg) (point))
  221.     (setq he-expand-list 
  222.           (and (not (equal he-search-string ""))
  223.            (file-directory-p (file-name-directory (expand-file-name he-search-string)))
  224.            (sort (file-name-all-completions 
  225.               (file-name-nondirectory he-search-string)
  226.               (file-name-directory (expand-file-name he-search-string)))
  227.              'string-lessp)))))
  228.   (while (and he-expand-list
  229.           (he-string-member (car he-expand-list) he-tried-table))
  230.     (setq he-expand-list (cdr he-expand-list)))
  231.   (if (null he-expand-list)
  232.       (progn
  233.     (he-reset-string)
  234.     ())
  235.       (let ((filename (concat (file-name-directory he-search-string)
  236.                   (car he-expand-list))))
  237.     (he-substitute-string filename)
  238.     (setq he-tried-table (cons filename he-tried-table))
  239.     (setq he-expand-list (cdr he-expand-list))
  240.     t)))
  241.  
  242. (defun find-file-name-beg ()
  243.   (let ((skips 
  244.      "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_./~^"))
  245.     (save-excursion
  246.       (skip-chars-backward skips)
  247.       (point))))
  248.  
  249. (defun try-complete-lisp-symb (old)
  250.   "Tries to complete text before point as a emacs-lisp symbol"
  251.   (if (not old)
  252.       (progn 
  253.     (he-init-string (find-lisp-symb-beg) (point))
  254.     (setq he-expand-list 
  255.           (and (not (equal he-search-string ""))
  256.            (sort (all-completions he-search-string obarray
  257.                       (function (lambda (sym)
  258.                         (or (boundp sym)
  259.                         (fboundp sym)
  260.                         (symbol-plist sym)))))
  261.              'string-lessp)))))
  262.   (while (and he-expand-list
  263.           (he-string-member (car he-expand-list) he-tried-table))
  264.     (setq he-expand-list (cdr he-expand-list)))
  265.   (if (null he-expand-list)
  266.       (progn
  267.     (he-reset-string)
  268.     ())
  269.       (progn
  270.     (he-substitute-string (car he-expand-list))
  271.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  272.     (setq he-expand-list (cdr he-expand-list))
  273.     t)))
  274.  
  275. (defun find-lisp-symb-beg ()
  276.   (let ((skips 
  277.      "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_."))
  278.     (save-excursion
  279.       (skip-chars-backward skips)
  280.       (point))))
  281.  
  282. (defun try-expand-line (old)
  283.   "Tries to complete the line before point to an entire line earlier in the buffer"
  284.   (let ((expansion ())
  285.     (strip-prompt (and (get-buffer-process (current-buffer))
  286.                shell-prompt-pattern)))
  287.     (if (not old)
  288.     (progn 
  289.       (he-init-string (find-line-beg strip-prompt) (point))
  290.       (setq he-line-loc he-string-beg)))
  291.     (if (not (equal he-search-string ""))
  292.     (save-excursion
  293.       (goto-char he-line-loc)
  294.       (setq expansion (he-line-search he-search-string strip-prompt))
  295.       (setq he-line-loc (point))))
  296.     (if (not expansion)
  297.     (progn
  298.       (he-reset-string)
  299.       ())
  300.     (progn
  301.       (he-substitute-string expansion)
  302.       (setq he-tried-table (cons expansion he-tried-table))
  303.       t))))
  304.  
  305. (defun he-line-search (str strip-prompt)
  306.   (let ((result ()))
  307.     (while (and (not result)
  308.         (re-search-backward (he-line-search-regexp str strip-prompt) nil t))
  309.       (setq result (buffer-substring (match-beginning 2) (match-end 2)))
  310.       (if (he-string-member result he-tried-table)
  311.       (setq result nil)))                ; if already in table, ignore
  312.     result))
  313.  
  314. (defun find-line-beg (strip-prompt)
  315.   (save-excursion
  316.     (end-of-line)
  317.     (if (re-search-backward (he-line-search-regexp "" strip-prompt) 
  318.                 (save-excursion (beginning-of-line) (point)) t)
  319.     (match-beginning 2)
  320.       (beginning-of-line)
  321.       (point))))
  322.  
  323. (defun he-line-search-regexp (pat strip-prompt)
  324.   (if strip-prompt
  325.       (concat "\\(" shell-prompt-pattern "\\|^\\s-*\\)\\("
  326.           (regexp-quote pat)
  327.           "[^\n]*[^ \t\n]\\)")
  328.       (concat "^\\(\\s-*\\)\\(" 
  329.           (regexp-quote pat)
  330.           "[^\n]*[^ \t\n]\\)")))
  331.  
  332. (defun remove-if-null (lst)
  333.   (cond ((null lst) ())
  334.     ((null (car lst))
  335.      (remove-if-null (cdr lst)))
  336.     (t 
  337.      (cons (car lst) (remove-if-null (cdr lst))))))
  338.  
  339. (defun try-expand-all-abbrevs (old)
  340.   "Tries to expand text before point according to all abbrev tables"
  341.   (if (not old)
  342.       (progn
  343.     (he-init-string (find-dabbrev-beg) (point))
  344.     (setq he-expand-list 
  345.           (and (not (equal he-search-string ""))
  346.            (remove-if-null (mapcar '(lambda (sym)
  347.                          (abbrev-expansion he-search-string
  348.                                    (eval sym)))
  349.                        abbrev-table-name-list))))))
  350.   (while (and he-expand-list
  351.           (he-string-member (car he-expand-list) he-tried-table))
  352.     (setq he-expand-list (cdr he-expand-list)))
  353.   (if (null he-expand-list)
  354.       (progn
  355.     (he-reset-string)
  356.     ())
  357.       (progn
  358.     (he-substitute-string (car he-expand-list))
  359.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  360.     (setq he-expand-list (cdr he-expand-list))
  361.     t)))
  362.  
  363. (defun try-expand-dabbrev (old)
  364.   "Tries to expand text before point dynamically, searching in the same buffer before and after point."
  365.   (let ((expansion ()))
  366.     (if (not old)
  367.     (progn
  368.       (he-init-string (find-dabbrev-beg) (point))
  369.       (setq he-dab-loc he-string-beg)
  370.       (setq he-dab-bw t)))
  371.  
  372.     (if (not (equal he-search-string ""))
  373.     (save-excursion
  374.       ;; Try looking backward unless inhibited.
  375.       (if he-dab-bw
  376.           (progn 
  377.         (goto-char he-dab-loc)
  378.         (setq expansion (he-dab-search he-search-string t))
  379.         (setq he-dab-loc (point-marker))
  380.         (if expansion
  381.             (setq he-tried-table (cons expansion he-tried-table))
  382.             (progn
  383.               (setq he-dab-loc he-string-end)
  384.               (setq he-dab-bw ())))))
  385.       
  386.       (if (not expansion) ; Then look forward.
  387.           (progn 
  388.         (goto-char he-dab-loc)
  389.         (setq expansion (he-dab-search he-search-string nil))
  390.         (setq he-dab-loc (point-marker))
  391.         (if expansion
  392.             (setq he-tried-table (cons expansion he-tried-table)))))))
  393.     
  394.     (if (not expansion)
  395.     (progn
  396.       (he-reset-string)
  397.       ())
  398.     (progn
  399.       (he-substitute-string expansion)
  400.       t))))
  401.  
  402. (defun try-expand-dabbrev-all-buffers (old)
  403.   "Tries to expand text before point dynamically, searching all emacs buffers but the current."
  404.   (let ((expansion ())
  405.     (buf (current-buffer)))
  406.     (if (not old)
  407.     (progn
  408.       (he-init-string (find-dabbrev-beg) (point))
  409.       (setq he-dab-loc 0)
  410.       (setq he-dab-bufs (buffer-list))))
  411.  
  412.     (if (not (equal he-search-string ""))
  413.     (while (and he-dab-bufs (not expansion))
  414.       (if (not (equal (car he-dab-bufs) buf))
  415.           (progn
  416.         (set-buffer (car he-dab-bufs))
  417.         (save-excursion
  418.           (goto-char he-dab-loc)
  419.           (setq expansion (he-dab-search he-search-string nil))
  420.           (setq he-dab-loc (point-marker)))))
  421.       (if expansion
  422.           (setq he-tried-table (cons expansion he-tried-table))
  423.           (progn
  424.         (setq he-dab-loc 0)
  425.         (setq he-dab-bufs (cdr he-dab-bufs))))))
  426.  
  427.     (set-buffer buf)
  428.     (if (not expansion)
  429.     (progn
  430.       (he-reset-string)
  431.       ())
  432.     (progn
  433.       (he-substitute-string expansion)
  434.       t))))
  435.  
  436. (defun he-dab-search-regexp (pat)
  437.   (concat "\\b" (regexp-quote pat) 
  438.       "\\(\\sw\\|\\s_\\)+"))
  439.  
  440. (defun he-dab-search (pattern reverse)
  441.   (let ((result ()))
  442.     (while (and (not result) 
  443.         (if reverse
  444.              (re-search-backward (he-dab-search-regexp pattern) nil t)
  445.              (re-search-forward (he-dab-search-regexp pattern) nil t)))
  446.       (setq result (buffer-substring (match-beginning 0) (match-end 0)))
  447.       (if (he-string-member result he-tried-table)
  448.       (setq result nil)))                ; if already in table, ignore
  449.     result))
  450.  
  451. (defun find-dabbrev-beg ()
  452.   (let ((skips 
  453.      "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_."))
  454.     (save-excursion
  455.       (skip-chars-backward skips)
  456.       (skip-chars-forward "-_.")
  457.       (point))))
  458.  
  459.  
  460.