lisp/hippie-exp.el

   1 ;;; hippie-exp.el --- expand text trying various ways to find its expansion.
   2
   3 ;; Author: Anders Holst <aho@sans.kth.se>
   4 ;; Last change: 6 August 1995
   5 ;; Version: 1.4
   6 ;; Keywords: abbrev
   7
   8 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;;  `hippie-expand' is a single function for a lot of different kinds
  29 ;;  of completions and expansions.  Called repeatedly it tries all
  30 ;;  possible completions in succession.
  31 ;;  Which kinds of completions to try, and in which order, is
  32 ;;  determined by the contents of `hippie-expand-try-functions-list'.
  33 ;;  Much customization of `hippie-expand' can be made by changing the
  34 ;;  order of, removing, or inserting new functions in this list.
  35 ;;  Given a positive numeric argument, `hippie-expand' jumps directly
  36 ;;  ARG functions forward in this list.  Given some other argument
  37 ;;  (a negative argument or just Ctrl-U) it undoes the tried
  38 ;;  completion.
  39 ;;
  40 ;;  If the variable `hippie-expand-verbose' is non-nil, `hippie-expand'
  41 ;;  outputs in a message which try-function in the list that is used
  42 ;;  currently (ie. was used currently and will be tried first the next
  43 ;;  time).
  44 ;;  The variable `hippie-expand-max-buffers' determines in how many
  45 ;;  buffers, apart from the current, to search for expansions in.  It
  46 ;;  is used by the try-functions named "-all-buffers".
  47 ;;  The variable `hippie-expand-ignore-buffers' is a list of regexps
  48 ;;  matching buffer names (as strings) or major modes (as atoms) of
  49 ;;  buffers that should not be searched by the try-functions named
  50 ;;  "-all-buffers".
  51 ;;  See also the macro `make-hippie-expand-function' below.
  52 ;;
  53 ;;  A short description of the current try-functions in this file:
  54 ;;    `try-complete-file-name' : very convenient to have in any buffer,
  55 ;;      and not just in the minibuffer or (some) shell-mode.  It goes
  56 ;;      through all possible completions instead of just completing as
  57 ;;      much as is unique.
  58 ;;    `try-complete-file-name-partially' : To insert in the list just
  59 ;;      before `try-complete-file-name' for those who want first to get
  60 ;;      a file name completed only as many characters as is unique.
  61 ;;    `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
  62 ;;      Otherwise it looks through all abbrev-tables, starting with
  63 ;;      the local followed by the global.
  64 ;;    `try-expand-line' : Searches the buffer for an entire line that
  65 ;;      begins exactly as the current line.  Convenient sometimes, for
  66 ;;      example as a substitute for (or complement to) the history
  67 ;;      list in shell-like buffers.  At other times, only confusing.
  68 ;;    `try-expand-line-all-buffers' : Like `try-expand-line' but searches
  69 ;;      in all buffers (except the current).  (This may be a little
  70 ;;      slow, don't use it unless you are really fond of `hippie-expand'.)
  71 ;;    `try-expand-list' : Tries to expand the text back to the nearest
  72 ;;      open delimiter, to a whole list from the buffer. Convenient for
  73 ;;      example when writing lisp or TeX.
  74 ;;    `try-expand-list-all-buffers' : Like `try-expand-list' but searches
  75 ;;      in all buffers (except the current).
  76 ;;    `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
  77 ;;      course in a way compatible with the other try-functions).
  78 ;;    `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
  79 ;;      like `dabbrev-expand' but searches all Emacs buffers (except the
  80 ;;      current) for matching words.  (No, I don't find this one
  81 ;;      particularly slow.)
  82 ;;    `try-expand-dabbrev-visible': Searches the currently visible parts of
  83 ;;      all windows.  Can be put before `try-expand-dabbrev-all-buffers' to
  84 ;;      first try the expansions you can see.
  85 ;;    `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable
  86 ;;      completion of the word.  Good to have, just in case the word was not
  87 ;;      found elsewhere.
  88 ;;    `try-expand-whole-kill' : Tries to complete text with a whole entry
  89 ;;      from the kill ring.  May be good if you don't know how far up in
  90 ;;      the kill-ring the required entry is, and don't want to mess with
  91 ;;      "Choose Next Paste".
  92 ;;    `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
  93 ;;      through all possibilities instead of completing what is unique.
  94 ;;      Might be tedious (usually a lot of possible completions) and
  95 ;;      since its function is much like `lisp-complete-symbol', which
  96 ;;      already has a key of its own, you might want to remove this.
  97 ;;    `try-complete-lisp-symbol-partially' : To insert in the list just
  98 ;;      before `try-complete-lisp-symbol' for those who first want to get
  99 ;;      completion of what is unique in the name.
 100 ;;
 101 ;;  Not all of the above functions are by default in
 102 ;;  `hippie-expand-try-functions-list'.  This variable is better set
 103 ;;  in ".emacs" to make `hippie-expand' behave maximally convenient
 104 ;;  according to personal taste.  Also, instead of loading the
 105 ;;  variable with all kinds of try-functions above, it might be an
 106 ;;  idea to use `make-hippie-expand-function' to construct different
 107 ;;  `hippie-expand'-like functions, with different try-lists and bound
 108 ;;  to different keys. It is also possible to make
 109 ;;  `hippie-expand-try-functions-list' a buffer local variable, and
 110 ;;  let it depend on the mode (by setting it in the mode-hooks).
 111 ;;
 112 ;;  To write new try-functions, consider the following:
 113 ;;  Each try-function takes one argument OLD which is nil the first
 114 ;;  time the function is called and true in succeeding calls for the
 115 ;;  same string to complete.  The first time the function has to
 116 ;;  extract the string before point to complete, and substitute the
 117 ;;  first completion alternative for it.  On following calls it has to
 118 ;;  substitute the next possible completion for the last tried string.
 119 ;;  The try-function is to return t as long as it finds new
 120 ;;  possible completions.  When there are no more alternatives it has
 121 ;;  to restore the text before point to its original contents, and
 122 ;;  return nil (don't beep or message or anything).
 123 ;;  The try-function can (should) use the following functions:
 124 ;;    `he-init-string' : Initializes the text to substitute to the
 125 ;;      contents of the region BEGIN to END.  Also sets the variable
 126 ;;      `he-search-string' to the text to expand.
 127 ;;    `he-substitute-string' : substitutes STR into the region
 128 ;;      initialized with `he-init-string'.  (An optional second argument
 129 ;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
 130 ;;      to the expansion is ok if that is enabled in the buffer.)
 131 ;;    `he-reset-string' : Resets the initialized region to its original
 132 ;;      contents.
 133 ;;  There is also a variable: `he-tried-table' which is meant to contain
 134 ;;  all tried expansions so far.  The try-function can check this
 135 ;;  variable to see whether an expansion has already been tried
 136 ;;  (hint: `he-string-member').
 137 ;;
 138 ;;  Known bugs
 139 ;;
 140 ;;  It may happen that some completion suggestion occurs twice, in
 141 ;;  spite of the use of `he-tried-table' to prevent that.  This is
 142 ;;  because different try-functions may try to complete different
 143 ;;  lengths of text, and thus put different amounts of the
 144 ;;  text in `he-tried-table'.  Anyway this seems to occur seldom enough
 145 ;;  not to be too disturbing.  Also it should NOT be possible for the
 146 ;;  opposite situation to occur, that `hippie-expand' misses some
 147 ;;  suggestion because it thinks it has already tried it.
 148 ;;
 149 ;;  Acknowledgement
 150 ;;
 151 ;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
 152 ;;  of this function took form.
 153 ;;  I am also grateful to all those who have given me suggestions on
 154 ;;  how to improve it, and all those who helped to find and remove bugs.
 155 ;;
 156
 157 ;;; Code:
 158
 159 (defvar he-num -1)
 160
 161 (defvar he-string-beg (make-marker))
 162
 163 (defvar he-string-end (make-marker))
 164
 165 (defvar he-search-string ())
 166
 167 (defvar he-expand-list ())
 168
 169 (defvar he-tried-table ())
 170
 171 (defvar he-search-loc (make-marker))
 172
 173 (defvar he-search-loc2 ())
 174
 175 (defvar he-search-bw ())
 176
 177 (defvar he-search-bufs ())
 178
 179 (defvar he-searched-n-bufs ())
 180
 181 (defvar he-search-window ())
 182
 183 ;;;###autoload
 184 (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially
 185                                            try-complete-file-name
 186                                            try-expand-all-abbrevs
 187                                            try-expand-list
 188                                            try-expand-line
 189                                            try-expand-dabbrev
 190                                            try-expand-dabbrev-all-buffers
 191                                            try-expand-dabbrev-from-kill
 192                                            try-complete-lisp-symbol-partially
 193                                            try-complete-lisp-symbol)
 194   "The list of expansion functions tried in order by `hippie-expand'.
 195 To change the behavior of `hippie-expand', remove, change the order of,
 196 or insert functions in this list.")
 197
 198 ;;;###autoload
 199 (defvar hippie-expand-verbose t
 200   "*Non-nil makes `hippie-expand' output which function it is trying.")
 201
 202 ;;;###autoload
 203 (defvar hippie-expand-max-buffers ()
 204   "*The maximum number of buffers (apart from the current) searched.
 205 If nil, all buffers are searched.")
 206
 207 ;;;###autoload
 208 (defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
 209   "*A list specifying which buffers not to search (if not current).
 210 Can contain both regexps matching buffer names (as strings) and major modes
 211 \(as atoms)")
 212
 213 ;;;###autoload
 214 (defun hippie-expand (arg)
 215   "Try to expand text before point, using multiple methods.
 216 The expansion functions in `hippie-expand-try-functions-list' are
 217 tried in order, until a possible expansion is found.  Repeated
 218 application of `hippie-expand' inserts successively possible
 219 expansions.
 220 With a positive numeric argument, jumps directly to the ARG next
 221 function in this list.  With a negative argument or just \\[universal-argument],
 222 undoes the expansion."
 223   (interactive "P")
 224   (if (or (not arg)
 225           (and (integerp arg) (> arg 0)))
 226       (let ((first (or (= he-num -1)
 227                        (not (equal this-command last-command)))))
 228         (if first
 229             (progn
 230               (setq he-num -1)
 231               (setq he-tried-table nil)))
 232         (if arg
 233             (if (not first) (he-reset-string))
 234             (setq arg 0))
 235         (let ((i (max (+ he-num arg) 0)))
 236           (while (not (or (>= i (length hippie-expand-try-functions-list))
 237                           (apply (nth i hippie-expand-try-functions-list)
 238                                  (list (= he-num i)))))
 239             (setq i (1+ i)))
 240           (setq he-num i))
 241         (if (>= he-num (length hippie-expand-try-functions-list))
 242             (progn
 243               (setq he-num -1)
 244               (if first
 245                   (message "No expansion found")
 246                   (message "No further expansions found"))
 247               (ding))
 248             (if (and hippie-expand-verbose
 249                      (not (window-minibuffer-p (selected-window))))
 250                 (message (concat "Using "
 251                                  (prin1-to-string (nth he-num
 252                                    hippie-expand-try-functions-list)))))))
 253       (if (and (>= he-num 0)
 254                (eq (marker-buffer he-string-beg) (current-buffer)))
 255           (progn
 256             (setq he-num -1)
 257             (he-reset-string)
 258             (if (and hippie-expand-verbose
 259                      (not (window-minibuffer-p (selected-window))))
 260                 (message "Undoing expansions"))))))
 261
 262 ;; Initializes the region to expand (to between BEG and END).
 263 (defun he-init-string (beg end)
 264   (set-marker he-string-beg beg)
 265   (set-marker he-string-end end)
 266   (setq he-search-string (buffer-substring beg end)))
 267
 268 ;; Resets the expanded region to its original contents.
 269 (defun he-reset-string ()
 270   (let ((newpos (point-marker)))
 271     (goto-char he-string-beg)
 272     (insert he-search-string)
 273     (delete-region (point) he-string-end)
 274     (goto-char newpos)))
 275
 276 ;; Substitutes an expansion STR into the correct region (the region
 277 ;; initialized with `he-init-string').
 278 ;; An optional argument TRANS-CASE means that it is ok to transfer case
 279 ;; from the abbreviation to the expansion if that is possible, and is
 280 ;; enabled in the buffer.
 281 (defun he-substitute-string (str &optional trans-case)
 282   (let ((trans-case (and trans-case
 283                          case-replace
 284                          case-fold-search))
 285         (newpos (point-marker))
 286         (subst ()))
 287     (goto-char he-string-beg)
 288     (setq subst (if trans-case (he-transfer-case he-search-string str) str))
 289     (setq he-tried-table (cons subst he-tried-table))
 290     (insert subst)
 291     (delete-region (point) he-string-end)
 292     (goto-char newpos)))
 293
 294 (defun he-capitalize-first (str)
 295   (save-match-data
 296     (if (string-match "\\Sw*\\(\\sw\\).*" str)
 297         (let ((res (downcase str))
 298               (no (match-beginning 1)))
 299           (aset res no (upcase (aref str no)))
 300           res)
 301       str)))
 302
 303 (defun he-ordinary-case-p (str)
 304   (or (string= str (downcase str))
 305       (string= str (upcase str))
 306       (string= str (capitalize str))
 307       (string= str (he-capitalize-first str))))
 308
 309 (defun he-transfer-case (from-str to-str)
 310   (cond ((string= from-str (substring to-str 0 (min (length from-str)
 311                                                     (length to-str))))
 312          to-str)
 313         ((not (he-ordinary-case-p to-str))
 314          to-str)
 315         ((string= from-str (downcase from-str))
 316          (downcase to-str))
 317         ((string= from-str (upcase from-str))
 318          (upcase to-str))
 319         ((string= from-str (he-capitalize-first from-str))
 320          (he-capitalize-first to-str))
 321         ((string= from-str (capitalize from-str))
 322          (capitalize to-str))
 323         (t
 324          to-str)))
 325
 326
 327 ;; Check if STR is a member of LST.
 328 ;; Transform to the final case if optional TRANS-CASE is non-NIL.
 329 (defun he-string-member (str lst &optional trans-case)
 330   (if str
 331       (member (if (and trans-case
 332                        case-replace
 333                        case-fold-search)
 334                   (he-transfer-case he-search-string str)
 335                 str)
 336               lst)))
 337
 338 ;; Check if STR matches any regexp in LST.
 339 ;; Ignore possible non-strings in LST.
 340 (defun he-regexp-member (str lst)
 341   (while (and lst
 342               (or (not (stringp (car lst)))
 343                   (not (string-match (car lst) str))))
 344     (setq lst (cdr lst)))
 345   lst)
 346
 347 ;;  For the real hippie-expand enthusiast: A macro that makes it
 348 ;;  possible to use many functions like hippie-expand, but with
 349 ;;  different try-functions-lists.
 350 ;;  Usage is for example:
 351 ;;    (fset 'my-complete-file (make-hippie-expand-function
 352 ;;                             '(try-complete-file-name-partially
 353 ;;                               try-complete-file-name)))
 354 ;;    (fset 'my-complete-line (make-hippie-expand-function
 355 ;;                             '(try-expand-line
 356 ;;                               try-expand-line-all-buffers)))
 357 ;;
 358 ;;;###autoload
 359 (defmacro make-hippie-expand-function (try-list &optional verbose)
 360   "Construct a function similar to `hippie-expand'.
 361 Make it use the expansion functions in TRY-LIST.  An optional second
 362 argument VERBOSE non-nil makes the function verbose."
 363   (` (function (lambda (arg)
 364        (, (concat
 365            "Try to expand text before point, using the following functions: \n"
 366            (mapconcat 'prin1-to-string (eval try-list) ", ")))
 367        (interactive "P")
 368        (let ((hippie-expand-try-functions-list (, try-list))
 369              (hippie-expand-verbose (, verbose)))
 370          (hippie-expand arg))))))
 371
 372
 373 ;;;  Here follows the try-functions and their requisites:
 374
 375
 376 (defun try-complete-file-name (old)
 377   "Try to complete text as a file name.
 378 The argument OLD has to be nil the first call of this function, and t
 379 for subsequent calls (for further possible completions of the same
 380 string).  It returns t if a new completion is found, nil otherwise."
 381   (if (not old)
 382       (progn
 383         (he-init-string (he-file-name-beg) (point))
 384         (let ((name-part (he-file-name-nondirectory he-search-string))
 385               (dir-part (expand-file-name (or (he-file-name-directory
 386                                                he-search-string) ""))))
 387           (if (not (he-string-member name-part he-tried-table))
 388               (setq he-tried-table (cons name-part he-tried-table)))
 389           (if (and (not (equal he-search-string ""))
 390                    (he-file-directory-p dir-part))
 391               (setq he-expand-list (sort (file-name-all-completions
 392                                           name-part
 393                                           dir-part)
 394                                          'string-lessp))
 395               (setq he-expand-list ())))))
 396
 397   (while (and he-expand-list
 398               (he-string-member (car he-expand-list) he-tried-table))
 399     (setq he-expand-list (cdr he-expand-list)))
 400   (if (null he-expand-list)
 401       (progn
 402         (if old (he-reset-string))
 403         ())
 404       (let ((filename (he-concat-directory-file-name
 405                        (he-file-name-directory he-search-string)
 406                        (car he-expand-list))))
 407         (he-substitute-string filename)
 408         (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
 409         (setq he-expand-list (cdr he-expand-list))
 410         t)))
 411
 412 (defun try-complete-file-name-partially (old)
 413   "Try to complete text as a file name, as many characters as unique.
 414 The argument OLD has to be nil the first call of this function.  It
 415 returns t if a unique, possibly partial, completion is found, nil
 416 otherwise."
 417   (let ((expansion ()))
 418     (if (not old)
 419         (progn
 420           (he-init-string (he-file-name-beg) (point))
 421           (let ((name-part (he-file-name-nondirectory he-search-string))
 422                 (dir-part (expand-file-name (or (he-file-name-directory
 423                                                  he-search-string) ""))))
 424             (if (and (not (equal he-search-string ""))
 425                      (he-file-directory-p dir-part))
 426                 (setq expansion (file-name-completion name-part
 427                                                       dir-part)))
 428             (if (or (eq expansion t)
 429                     (string= expansion name-part)
 430                     (he-string-member expansion he-tried-table))
 431                 (setq expansion ())))))
 432
 433     (if (not expansion)
 434         (progn
 435           (if old (he-reset-string))
 436           ())
 437         (let ((filename (he-concat-directory-file-name
 438                          (he-file-name-directory he-search-string)
 439                          expansion)))
 440           (he-substitute-string filename)
 441           (setq he-tried-table (cons expansion (cdr he-tried-table)))
 442           t))))
 443
 444 (defvar he-file-name-chars
 445   (cond ((memq system-type '(vax-vms axp-vms))
 446          "-a-zA-Z0-9_/.,~^#$+=:\\[\\]")
 447         ((memq system-type '(ms-dos ms-windows))
 448          "-a-zA-Z0-9_/.,~^#$+=:\\\\")
 449         (t                          ;; More strange file formats ?
 450          "-a-zA-Z0-9_/.,~^#$+="))
 451   "Characters that are considered part of the file name to expand.")
 452
 453 (defun he-file-name-beg ()
 454   (save-excursion
 455     (skip-chars-backward he-file-name-chars)
 456     (point)))
 457
 458 ;; Thanks go to Richard Levitte <levitte@e.kth.se> who helped to make these
 459 ;; work under VMS, and to David Hughes <ukchugd@ukpmr.cs.philips.nl> who
 460 ;; helped to make it work on PC.
 461 (defun he-file-name-nondirectory (file)
 462   "Fix to make `file-name-nondirectory' work for hippie-expand under VMS."
 463   (if (memq system-type '(axp-vms vax-vms))
 464       (let ((n (file-name-nondirectory file)))
 465         (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
 466             (concat "[." (substring n (match-beginning 2) (match-end 2)))
 467           n))
 468     (file-name-nondirectory file)))
 469
 470 (defun he-file-name-directory (file)
 471   "Fix to make `file-name-directory' work for hippie-expand under VMS."
 472   (if (memq system-type '(axp-vms vax-vms))
 473       (let ((n (file-name-nondirectory file))
 474             (d (file-name-directory file)))
 475         (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
 476             (concat d (substring n (match-beginning 1) (match-end 1)) "]")
 477           d))
 478     (file-name-directory file)))
 479
 480 (defun he-file-directory-p (file)
 481   "Fix to make `file-directory-p' work for hippie-expand under VMS."
 482   (if (memq system-type '(vax-vms axp-vms))
 483       (or (file-directory-p file)
 484           (file-directory-p (concat file "[000000]")))
 485     (file-directory-p dir-part)))
 486
 487 (defun he-concat-directory-file-name (dir-part name-part)
 488   "Try to slam together two parts of a file specification, system dependently."
 489   (cond ((memq system-type '(axp-vms vax-vms))
 490          (if (and (string= (substring dir-part -1) "]")
 491                   (string= (substring name-part 0 2) "[."))
 492              (concat (substring dir-part 0 -1) (substring name-part 1))
 493            (concat dir-part name-part)))
 494         ((memq system-type '(ms-dos ms-windows))
 495          (if (and (string-match "\\\\" dir-part)
 496                   (not (string-match "/" dir-part))
 497                   (= (aref name-part (1- (length name-part))) ?/))
 498              (aset name-part (1- (length name-part)) ?\\))
 499          (concat dir-part name-part))
 500         (t
 501          (concat dir-part name-part))))
 502
 503 (defun try-complete-lisp-symbol (old)
 504   "Try to complete word as an Emacs Lisp symbol.
 505 The argument OLD has to be nil the first call of this function, and t
 506 for subsequent calls (for further possible completions of the same
 507 string).  It returns t if a new completion is found, nil otherwise."
 508   (if (not old)
 509       (progn
 510         (he-init-string (he-lisp-symbol-beg) (point))
 511         (if (not (he-string-member he-search-string he-tried-table))
 512             (setq he-tried-table (cons he-search-string he-tried-table)))
 513         (setq he-expand-list
 514               (and (not (equal he-search-string ""))
 515                    (sort (all-completions he-search-string obarray
 516                                           (function (lambda (sym)
 517                                             (or (boundp sym)
 518                                                 (fboundp sym)
 519                                                 (symbol-plist sym)))))
 520                          'string-lessp)))))
 521   (while (and he-expand-list
 522               (he-string-member (car he-expand-list) he-tried-table))
 523     (setq he-expand-list (cdr he-expand-list)))
 524   (if (null he-expand-list)
 525       (progn
 526         (if old (he-reset-string))
 527         ())
 528       (progn
 529         (he-substitute-string (car he-expand-list))
 530         (setq he-expand-list (cdr he-expand-list))
 531         t)))
 532
 533 (defun try-complete-lisp-symbol-partially (old)
 534   "Try to complete as an Emacs Lisp symbol, as many characters as unique.
 535 The argument OLD has to be nil the first call of this function.  It
 536 returns t if a unique, possibly partial, completion is found, nil
 537 otherwise."
 538   (let ((expansion ()))
 539     (if (not old)
 540         (progn
 541           (he-init-string (he-lisp-symbol-beg) (point))
 542           (if (not (string= he-search-string ""))
 543               (setq expansion
 544                     (try-completion he-search-string obarray
 545                                     (function (lambda (sym)
 546                                       (or (boundp sym)
 547                                           (fboundp sym)
 548                                           (symbol-plist sym)))))))
 549           (if (or (eq expansion t)
 550                   (string= expansion he-search-string)
 551                   (he-string-member expansion he-tried-table))
 552               (setq expansion ()))))
 553
 554   (if (not expansion)
 555       (progn
 556         (if old (he-reset-string))
 557         ())
 558       (progn
 559         (he-substitute-string expansion)
 560         t))))
 561
 562 (defun he-lisp-symbol-beg ()
 563   (let ((skips "-a-zA-Z0-9_."))
 564     (save-excursion
 565       (skip-chars-backward skips)
 566       (point))))
 567
 568 (defun try-expand-line (old)
 569   "Try to complete the current line to an entire line in the buffer.
 570 The argument OLD has to be nil the first call of this function, and t
 571 for subsequent calls (for further possible completions of the same
 572 string).  It returns t if a new completion is found, nil otherwise."
 573   (let ((expansion ())
 574         (strip-prompt (and (get-buffer-process (current-buffer))
 575                            comint-prompt-regexp)))
 576     (if (not old)
 577         (progn
 578           (he-init-string (he-line-beg strip-prompt) (point))
 579           (set-marker he-search-loc he-string-beg)
 580           (setq he-search-bw t)))
 581
 582     (if (not (equal he-search-string ""))
 583         (save-excursion
 584           ;; Try looking backward unless inhibited.
 585           (if he-search-bw
 586               (progn
 587                 (goto-char he-search-loc)
 588                 (setq expansion (he-line-search he-search-string
 589                                                 strip-prompt t))
 590                 (set-marker he-search-loc (point))
 591                 (if (not expansion)
 592                     (progn
 593                       (set-marker he-search-loc he-string-end)
 594                       (setq he-search-bw ())))))
 595
 596           (if (not expansion) ; Then look forward.
 597               (progn
 598                 (goto-char he-search-loc)
 599                 (setq expansion (he-line-search he-search-string
 600                                                 strip-prompt nil))
 601                 (set-marker he-search-loc (point))))))
 602
 603     (if (not expansion)
 604         (progn
 605           (if old (he-reset-string))
 606           ())
 607         (progn
 608           (he-substitute-string expansion t)
 609           t))))
 610
 611 (defun try-expand-line-all-buffers (old)
 612   "Try to complete the current line, searching all other buffers.
 613 The argument OLD has to be nil the first call of this function, and t
 614 for subsequent calls (for further possible completions of the same
 615 string).  It returns t if a new completion is found, nil otherwise."
 616   (let ((expansion ())
 617         (strip-prompt (and (get-buffer-process (current-buffer))
 618                            comint-prompt-regexp))
 619         (buf (current-buffer))
 620         (orig-case-fold-search case-fold-search))
 621     (if (not old)
 622         (progn
 623           (he-init-string (he-line-beg strip-prompt) (point))
 624           (setq he-search-bufs (buffer-list))
 625           (setq he-searched-n-bufs 0)
 626           (set-marker he-search-loc 1 (car he-search-bufs))))
 627
 628     (if (not (equal he-search-string ""))
 629         (while (and he-search-bufs
 630                     (not expansion)
 631                     (or (not hippie-expand-max-buffers)
 632                         (< he-searched-n-bufs hippie-expand-max-buffers)))
 633           (set-buffer (car he-search-bufs))
 634           (if (and (not (eq (current-buffer) buf))
 635                    (not (memq major-mode hippie-expand-ignore-buffers))
 636                    (not (he-regexp-member (buffer-name)
 637                                           hippie-expand-ignore-buffers)))
 638               (save-excursion
 639                 (goto-char he-search-loc)
 640                 (setq strip-prompt (and (get-buffer-process (current-buffer))
 641                                         comint-prompt-regexp))
 642                 (setq expansion (let ((case-fold-search orig-case-fold-search))
 643                                   (he-line-search he-search-string
 644                                                   strip-prompt nil)))
 645                 (set-marker he-search-loc (point))
 646                 (if (not expansion)
 647                     (progn
 648                       (setq he-search-bufs (cdr he-search-bufs))
 649                       (setq he-searched-n-bufs (1+ he-searched-n-bufs))
 650                       (set-marker he-search-loc 1 (car he-search-bufs)))))
 651             (setq he-search-bufs (cdr he-search-bufs))
 652             (set-marker he-search-loc 1 (car he-search-bufs)))))
 653
 654     (set-buffer buf)
 655     (if (not expansion)
 656         (progn
 657           (if old (he-reset-string))
 658           ())
 659         (progn
 660           (he-substitute-string expansion t)
 661           t))))
 662
 663 (defun he-line-search (str strip-prompt reverse)
 664   (let ((result ()))
 665     (while (and (not result)
 666                 (if reverse
 667                     (re-search-backward
 668                      (he-line-search-regexp str strip-prompt)
 669                      nil t)
 670                     (re-search-forward
 671                      (he-line-search-regexp str strip-prompt)
 672                      nil t)))
 673       (setq result (buffer-substring (match-beginning 2) (match-end 2)))
 674       (if (he-string-member result he-tried-table t)
 675           (setq result nil)))               ; if already in table, ignore
 676     result))
 677
 678 (defun he-line-beg (strip-prompt)
 679   (save-excursion
 680     (if (re-search-backward (he-line-search-regexp "" strip-prompt)
 681                             (save-excursion (beginning-of-line)
 682                                             (point)) t)
 683         (match-beginning 2)
 684       (point))))
 685
 686 (defun he-line-search-regexp (pat strip-prompt)
 687   (if strip-prompt
 688       (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
 689               (regexp-quote pat)
 690               "[^\n]*[^ \t\n]\\)")
 691       (concat "^\\(\\s-*\\)\\("
 692               (regexp-quote pat)
 693               "[^\n]*[^ \t\n]\\)")))
 694
 695 (defun try-expand-list (old)
 696   "Try to complete the current beginning of a list.
 697 The argument OLD has to be nil the first call of this function, and t
 698 for subsequent calls (for further possible completions of the same
 699 string).  It returns t if a new completion is found, nil otherwise."
 700   (let ((expansion ()))
 701     (if (not old)
 702         (progn
 703           (he-init-string (he-list-beg) (point))
 704           (set-marker he-search-loc he-string-beg)
 705           (setq he-search-bw t)))
 706
 707     (if (not (equal he-search-string ""))
 708         (save-excursion
 709           ;; Try looking backward unless inhibited.
 710           (if he-search-bw
 711               (progn
 712                 (goto-char he-search-loc)
 713                 (setq expansion (he-list-search he-search-string t))
 714                 (set-marker he-search-loc (point))
 715                 (if (not expansion)
 716                     (progn
 717                       (set-marker he-search-loc he-string-end)
 718                       (setq he-search-bw ())))))
 719
 720           (if (not expansion) ; Then look forward.
 721               (progn
 722                 (goto-char he-search-loc)
 723                 (setq expansion (he-list-search he-search-string nil))
 724                 (set-marker he-search-loc (point))))))
 725
 726     (if (not expansion)
 727         (progn
 728           (if old (he-reset-string))
 729           ())
 730         (progn
 731           (he-substitute-string expansion t)
 732           t))))
 733
 734 (defun try-expand-list-all-buffers (old)
 735   "Try to complete the current list, searching all other buffers.
 736 The argument OLD has to be nil the first call of this function, and t
 737 for subsequent calls (for further possible completions of the same
 738 string).  It returns t if a new completion is found, nil otherwise."
 739   (let ((expansion ())
 740         (buf (current-buffer))
 741         (orig-case-fold-search case-fold-search))
 742     (if (not old)
 743         (progn
 744           (he-init-string (he-list-beg) (point))
 745           (setq he-search-bufs (buffer-list))
 746           (setq he-searched-n-bufs 0)
 747           (set-marker he-search-loc 1 (car he-search-bufs))))
 748
 749     (if (not (equal he-search-string ""))
 750         (while (and he-search-bufs
 751                     (not expansion)
 752                     (or (not hippie-expand-max-buffers)
 753                         (< he-searched-n-bufs hippie-expand-max-buffers)))
 754           (set-buffer (car he-search-bufs))
 755           (if (and (not (eq (current-buffer) buf))
 756                    (not (memq major-mode hippie-expand-ignore-buffers))
 757                    (not (he-regexp-member (buffer-name)
 758                                           hippie-expand-ignore-buffers)))
 759               (save-excursion
 760                 (goto-char he-search-loc)
 761                 (setq expansion (let ((case-fold-search orig-case-fold-search))
 762                                   (he-list-search he-search-string nil)))
 763                 (set-marker he-search-loc (point))
 764                 (if (not expansion)
 765                     (progn
 766                       (setq he-search-bufs (cdr he-search-bufs))
 767                       (setq he-searched-n-bufs (1+ he-searched-n-bufs))
 768                       (set-marker he-search-loc 1 (car he-search-bufs)))))
 769             (setq he-search-bufs (cdr he-search-bufs))
 770             (set-marker he-search-loc 1 (car he-search-bufs)))))
 771
 772     (set-buffer buf)
 773     (if (not expansion)
 774         (progn
 775           (if old (he-reset-string))
 776           ())
 777         (progn
 778           (he-substitute-string expansion t)
 779           t))))
 780
 781 (defun he-list-search (str reverse)
 782   (let ((result ())
 783         beg pos err)
 784     (while (and (not result)
 785                 (if reverse
 786                     (search-backward str nil t)
 787                     (search-forward str nil t)))
 788       (setq pos (point))
 789       (setq beg (match-beginning 0))
 790       (goto-char beg)
 791       (setq err ())
 792       (condition-case ()
 793           (forward-list 1)
 794         (error (setq err t)))
 795       (if (and reverse
 796                (> (point) he-string-beg))
 797           (setq err t))
 798       (if (not err)
 799           (progn
 800             (setq result (buffer-substring beg (point)))
 801             (if (he-string-member result he-tried-table t)
 802                 (setq result nil))))           ; if already in table, ignore
 803       (goto-char pos))
 804     result))
 805
 806 (defun he-list-beg ()
 807   (save-excursion
 808     (condition-case ()
 809         (backward-up-list 1)
 810       (error ()))
 811     (point)))
 812
 813 (defun try-expand-all-abbrevs (old)
 814   "Try to expand word before point according to all abbrev tables.
 815 The argument OLD has to be nil the first call of this function, and t
 816 for subsequent calls (for further possible expansions of the same
 817 string).  It returns t if a new expansion is found, nil otherwise."
 818   (if (not old)
 819       (progn
 820         (he-init-string (he-dabbrev-beg) (point))
 821         (setq he-expand-list
 822               (and (not (equal he-search-string ""))
 823                    (mapcar (function (lambda (sym)
 824                              (if (and (boundp sym) (vectorp (eval sym)))
 825                                  (abbrev-expansion (downcase he-search-string)
 826                                                    (eval sym)))))
 827                            (append '(local-abbrev-table
 828                                      global-abbrev-table)
 829                                    abbrev-table-name-list))))))
 830   (while (and he-expand-list
 831               (or (not (car he-expand-list))
 832                   (he-string-member (car he-expand-list) he-tried-table t)))
 833     (setq he-expand-list (cdr he-expand-list)))
 834   (if (null he-expand-list)
 835       (progn
 836         (if old (he-reset-string))
 837         ())
 838       (progn
 839         (he-substitute-string (car he-expand-list) t)
 840         (setq he-expand-list (cdr he-expand-list))
 841         t)))
 842
 843 (defun try-expand-dabbrev (old)
 844   "Try to expand word \"dynamically\", searching the current buffer.
 845 The argument OLD has to be nil the first call of this function, and t
 846 for subsequent calls (for further possible expansions of the same
 847 string).  It returns t if a new expansion is found, nil otherwise."
 848   (let ((expansion ()))
 849     (if (not old)
 850         (progn
 851           (he-init-string (he-dabbrev-beg) (point))
 852           (set-marker he-search-loc he-string-beg)
 853           (setq he-search-bw t)))
 854
 855     (if (not (equal he-search-string ""))
 856         (save-excursion
 857           ;; Try looking backward unless inhibited.
 858           (if he-search-bw
 859               (progn
 860                 (goto-char he-search-loc)
 861                 (setq expansion (he-dabbrev-search he-search-string t))
 862                 (set-marker he-search-loc (point))
 863                 (if (not expansion)
 864                     (progn
 865                       (set-marker he-search-loc he-string-end)
 866                       (setq he-search-bw ())))))
 867
 868           (if (not expansion) ; Then look forward.
 869               (progn
 870                 (goto-char he-search-loc)
 871                 (setq expansion (he-dabbrev-search he-search-string nil))
 872                 (set-marker he-search-loc (point))))))
 873
 874     (if (not expansion)
 875         (progn
 876           (if old (he-reset-string))
 877           ())
 878         (progn
 879           (he-substitute-string expansion t)
 880           t))))
 881
 882 (defun try-expand-dabbrev-all-buffers (old)
 883   "Tries to expand word \"dynamically\", searching all other buffers.
 884 The argument OLD has to be nil the first call of this function, and t
 885 for subsequent calls (for further possible expansions of the same
 886 string).  It returns t if a new expansion is found, nil otherwise."
 887   (let ((expansion ())
 888         (buf (current-buffer))
 889         (orig-case-fold-search case-fold-search))
 890     (if (not old)
 891         (progn
 892           (he-init-string (he-dabbrev-beg) (point))
 893           (setq he-search-bufs (buffer-list))
 894           (setq he-searched-n-bufs 0)
 895           (set-marker he-search-loc 1 (car he-search-bufs))))
 896
 897     (if (not (equal he-search-string ""))
 898         (while (and he-search-bufs
 899                     (not expansion)
 900                     (or (not hippie-expand-max-buffers)
 901                         (< he-searched-n-bufs hippie-expand-max-buffers)))
 902           (set-buffer (car he-search-bufs))
 903           (if (and (not (eq (current-buffer) buf))
 904                    (not (memq major-mode hippie-expand-ignore-buffers))
 905                    (not (he-regexp-member (buffer-name)
 906                                           hippie-expand-ignore-buffers)))
 907               (save-excursion
 908                 (goto-char he-search-loc)
 909                 (setq expansion (let ((case-fold-search orig-case-fold-search))
 910                                   (he-dabbrev-search he-search-string nil)))
 911                 (set-marker he-search-loc (point))
 912                 (if (not expansion)
 913                     (progn
 914                       (setq he-search-bufs (cdr he-search-bufs))
 915                       (setq he-searched-n-bufs (1+ he-searched-n-bufs))
 916                       (set-marker he-search-loc 1 (car he-search-bufs)))))
 917             (setq he-search-bufs (cdr he-search-bufs))
 918             (set-marker he-search-loc 1 (car he-search-bufs)))))
 919
 920     (set-buffer buf)
 921     (if (not expansion)
 922         (progn
 923           (if old (he-reset-string))
 924           ())
 925         (progn
 926           (he-substitute-string expansion t)
 927           t))))
 928
 929 ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
 930 ;; suggested this one.
 931 (defun try-expand-dabbrev-visible (old)
 932   "Try to expand word \"dynamically\", searching visible window parts.
 933 The argument OLD has to be nil the first call of this function, and t
 934 for subsequent calls (for further possible expansions of the same
 935 string).  It returns t if a new expansion is found, nil otherwise."
 936   (let ((expansion ())
 937         (buf (current-buffer))
 938         (flag (if (frame-visible-p (window-frame (selected-window)))
 939                   'visible t)))
 940     (if (not old)
 941         (progn
 942            (he-init-string (he-dabbrev-beg) (point))
 943            (setq he-search-window (selected-window))
 944            (set-marker he-search-loc
 945                        (window-start he-search-window)
 946                        (window-buffer he-search-window))))
 947
 948     (while (and (not (equal he-search-string ""))
 949                 (marker-position he-search-loc)
 950                 (not expansion))
 951       (save-excursion
 952         (set-buffer (marker-buffer he-search-loc))
 953         (goto-char he-search-loc)
 954         (setq expansion (he-dabbrev-search he-search-string ()
 955                                            (window-end he-search-window)))
 956         (if (and expansion
 957                  (eq (marker-buffer he-string-beg) (current-buffer))
 958                  (eq (marker-position he-string-beg) (match-beginning 0)))
 959             (setq expansion (he-dabbrev-search he-search-string ()
 960                                                (window-end he-search-window))))
 961         (set-marker he-search-loc (point) (current-buffer)))
 962       (if (not expansion)
 963           (progn
 964             (setq he-search-window (next-window he-search-window nil flag))
 965             (if (eq he-search-window (selected-window))
 966                 (set-marker he-search-loc nil)
 967               (set-marker he-search-loc (window-start he-search-window)
 968                           (window-buffer he-search-window))))))
 969
 970     (set-buffer buf)
 971     (if (not expansion)
 972         (progn
 973           (if old (he-reset-string))
 974           ())
 975         (progn
 976           (he-substitute-string expansion t)
 977           t))))
 978
 979 (defun he-dabbrev-search (pattern &optional reverse limit)
 980   (let ((result ())
 981         (regpat (if (eq (char-syntax (aref pattern 0)) ?_)
 982                     (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
 983                   (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))))
 984     (while (and (not result)
 985                 (if reverse
 986                      (re-search-backward regpat limit t)
 987                      (re-search-forward regpat limit t)))
 988       (setq result (buffer-substring (match-beginning 0) (match-end 0)))
 989       (if (or (and (> (match-beginning 0) (point-min))
 990                    (memq (char-syntax (char-after (1- (match-beginning 0))))
 991                          '(?_ ?w)))
 992               (he-string-member result he-tried-table t))
 993           (setq result nil)))     ; ignore if bad prefix or already in table
 994     result))
 995
 996 (defvar he-dabbrev-skip-space ()
 997   "Non-NIL means tolerate trailing spaces in the abbreviation to expand.")
 998
 999 (defun he-dabbrev-beg ()
1000   (let ((op (point)))
1001     (save-excursion
1002       (if he-dabbrev-skip-space
1003           (skip-syntax-backward ". "))
1004       (if (= (skip-syntax-backward "w_") 0)
1005           op
1006         (point)))))
1007
1008 (defun try-expand-dabbrev-from-kill (old)
1009   "Try to expand word \"dynamically\", searching the kill ring.
1010 The argument OLD has to be nil the first call of this function, and t
1011 for subsequent calls (for further possible completions of the same
1012 string).  It returns t if a new completion is found, nil otherwise."
1013   (let ((expansion ()))
1014     (if (not old)
1015         (progn
1016           (he-init-string (he-dabbrev-beg) (point))
1017           (setq he-expand-list
1018                 (if (not (equal he-search-string ""))
1019                     kill-ring))
1020           (setq he-search-loc2 0)))
1021     (if (not (equal he-search-string ""))
1022         (setq expansion (he-dabbrev-kill-search he-search-string)))
1023     (if (not expansion)
1024         (progn
1025           (if old (he-reset-string))
1026           ())
1027         (progn
1028           (he-substitute-string expansion t)
1029           t))))
1030
1031 (defun he-dabbrev-kill-search (pattern)
1032   (let ((result ())
1033         (regpat (if (eq (char-syntax (aref pattern 0)) ?_)
1034                     (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
1035                   (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")))
1036         (killstr (car he-expand-list)))
1037     (while (and (not result)
1038                 he-expand-list)
1039       (while (and (not result)
1040                   (string-match regpat killstr he-search-loc2))
1041         (setq result (substring killstr (match-beginning 0) (match-end 0)))
1042         (setq he-search-loc2 (1+ (match-beginning 0)))
1043         (if (or (and (> (match-beginning 0) 0)
1044                      (memq (char-syntax (aref killstr (1- (match-beginning 0))))
1045                            '(?_ ?w)))
1046                 (he-string-member result he-tried-table t))
1047             (setq result nil)))     ; ignore if bad prefix or already in table
1048       (if (and (not result)
1049                 he-expand-list)
1050           (progn
1051             (setq he-expand-list (cdr he-expand-list))
1052             (setq killstr (car he-expand-list))
1053             (setq he-search-loc2 0))))
1054     result))
1055
1056 (defun try-expand-whole-kill (old)
1057   "Try to complete text with something from the kill ring.
1058 The argument OLD has to be nil the first call of this function, and t
1059 for subsequent calls (for further possible completions of the same
1060 string).  It returns t if a new completion is found, nil otherwise."
1061   (let ((expansion ()))
1062     (if (not old)
1063         (progn
1064           (he-init-string (he-kill-beg) (point))
1065           (if (not (he-string-member he-search-string he-tried-table))
1066               (setq he-tried-table (cons he-search-string he-tried-table)))
1067           (setq he-expand-list
1068                 (if (not (equal he-search-string ""))
1069                     kill-ring))
1070           (setq he-search-loc2 ())))
1071     (if (not (equal he-search-string ""))
1072         (setq expansion (he-whole-kill-search he-search-string)))
1073     (if (not expansion)
1074         (progn
1075           (if old (he-reset-string))
1076           ())
1077         (progn
1078           (he-substitute-string expansion)
1079           t))))
1080
1081 (defun he-whole-kill-search (str)
1082   (let ((case-fold-search ())
1083         (result ())
1084         (str (regexp-quote str))
1085         (killstr (car he-expand-list))
1086         (pos -1))
1087     (while (and (not result)
1088                 he-expand-list)
1089       (if (not he-search-loc2)
1090           (while (setq pos (string-match str killstr (1+ pos)))
1091             (setq he-search-loc2 (cons pos he-search-loc2))))
1092       (while (and (not result)
1093                   he-search-loc2)
1094         (setq pos (car he-search-loc2))
1095         (setq he-search-loc2 (cdr he-search-loc2))
1096         (save-excursion
1097           (goto-char he-string-beg)
1098           (if (and (>= (- (point) pos) (point-min))   ; avoid some string GC
1099                    (eq (char-after (- (point) pos)) (aref killstr 0))
1100                    (search-backward (substring killstr 0 pos)
1101                                     (- (point) pos) t))
1102               (setq result (substring killstr pos))))
1103         (if (and result
1104                  (he-string-member result he-tried-table))
1105             (setq result nil)))     ; ignore if already in table
1106       (if (and (not result)
1107                 he-expand-list)
1108           (progn
1109             (setq he-expand-list (cdr he-expand-list))
1110             (setq killstr (car he-expand-list))
1111             (setq pos -1))))
1112     result))
1113
1114 (defun he-kill-beg ()
1115   (let ((op (point)))
1116     (save-excursion
1117       (skip-syntax-backward "^w_")
1118       (if (= (skip-syntax-backward "w_") 0)
1119           op
1120         (point)))))
1121
1122
1123 (provide 'hippie-exp)
1124
1125 ;;; hippie-exp.el ends here