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