diff options
| -rw-r--r-- | lisp/hippie-exp.el | 593 |
1 files changed, 424 insertions, 169 deletions
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 9e7334ab569..408b80ee393 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el | |||
| @@ -1,11 +1,11 @@ | |||
| 1 | ;;; hippie-exp.el --- expand text trying various ways to find its expansion. | 1 | ;;; hippie-exp.el --- expand text trying various ways to find its expansion. |
| 2 | 2 | ||
| 3 | ;; Author: Anders Holst <aho@sans.kth.se> | 3 | ;; Author: Anders Holst <aho@sans.kth.se> |
| 4 | ;; Last change: 2 September 1993 | 4 | ;; Last change: 6 August 1995 |
| 5 | ;; Version: 1.3 | 5 | ;; Version: 1.4 |
| 6 | ;; Keywords: abbrev | 6 | ;; Keywords: abbrev |
| 7 | 7 | ||
| 8 | ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. | 8 | ;; Copyright (C) 1992 Free Software Foundation, Inc. |
| 9 | ;; | 9 | ;; |
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 11 | 11 | ||
| @@ -79,6 +79,16 @@ | |||
| 79 | ;; like `dabbrev-expand' but searches all Emacs buffers (except the | 79 | ;; like `dabbrev-expand' but searches all Emacs buffers (except the |
| 80 | ;; current) for matching words. (No, I don't find this one | 80 | ;; current) for matching words. (No, I don't find this one |
| 81 | ;; particularly slow.) | 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". | ||
| 82 | ;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes | 92 | ;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes |
| 83 | ;; through all possibilities instead of completing what is unique. | 93 | ;; through all possibilities instead of completing what is unique. |
| 84 | ;; Might be tedious (usually a lot of possible completions) and | 94 | ;; Might be tedious (usually a lot of possible completions) and |
| @@ -123,7 +133,7 @@ | |||
| 123 | ;; There is also a variable: `he-tried-table' which is meant to contain | 133 | ;; There is also a variable: `he-tried-table' which is meant to contain |
| 124 | ;; all tried expansions so far. The try-function can check this | 134 | ;; all tried expansions so far. The try-function can check this |
| 125 | ;; variable to see whether an expansion has already been tried | 135 | ;; variable to see whether an expansion has already been tried |
| 126 | ;; (hint: `he-string-member'), and add its own tried expansions to it. | 136 | ;; (hint: `he-string-member'). |
| 127 | ;; | 137 | ;; |
| 128 | ;; Known bugs | 138 | ;; Known bugs |
| 129 | ;; | 139 | ;; |
| @@ -131,8 +141,8 @@ | |||
| 131 | ;; spite of the use of `he-tried-table' to prevent that. This is | 141 | ;; spite of the use of `he-tried-table' to prevent that. This is |
| 132 | ;; because different try-functions may try to complete different | 142 | ;; because different try-functions may try to complete different |
| 133 | ;; lengths of text, and thus put different amounts of the | 143 | ;; lengths of text, and thus put different amounts of the |
| 134 | ;; text in `he-try-table'. Anyway this seems to occur seldom enough not | 144 | ;; text in `he-tried-table'. Anyway this seems to occur seldom enough |
| 135 | ;; to be too disturbing. Also it should NOT be possible for the | 145 | ;; not to be too disturbing. Also it should NOT be possible for the |
| 136 | ;; opposite situation to occur, that `hippie-expand' misses some | 146 | ;; opposite situation to occur, that `hippie-expand' misses some |
| 137 | ;; suggestion because it thinks it has already tried it. | 147 | ;; suggestion because it thinks it has already tried it. |
| 138 | ;; | 148 | ;; |
| @@ -141,7 +151,7 @@ | |||
| 141 | ;; I want to thank Mikael Djurfeldt in discussions with whom the idea | 151 | ;; I want to thank Mikael Djurfeldt in discussions with whom the idea |
| 142 | ;; of this function took form. | 152 | ;; of this function took form. |
| 143 | ;; I am also grateful to all those who have given me suggestions on | 153 | ;; I am also grateful to all those who have given me suggestions on |
| 144 | ;; how to improve it. | 154 | ;; how to improve it, and all those who helped to find and remove bugs. |
| 145 | ;; | 155 | ;; |
| 146 | 156 | ||
| 147 | ;;; Code: | 157 | ;;; Code: |
| @@ -160,19 +170,26 @@ | |||
| 160 | 170 | ||
| 161 | (defvar he-search-loc (make-marker)) | 171 | (defvar he-search-loc (make-marker)) |
| 162 | 172 | ||
| 173 | (defvar he-search-loc2 ()) | ||
| 174 | |||
| 163 | (defvar he-search-bw ()) | 175 | (defvar he-search-bw ()) |
| 164 | 176 | ||
| 165 | (defvar he-search-bufs ()) | 177 | (defvar he-search-bufs ()) |
| 166 | 178 | ||
| 167 | (defvar he-searched-n-bufs ()) | 179 | (defvar he-searched-n-bufs ()) |
| 168 | 180 | ||
| 181 | (defvar he-search-window ()) | ||
| 182 | |||
| 169 | ;;;###autoload | 183 | ;;;###autoload |
| 170 | (defvar hippie-expand-try-functions-list '(try-complete-file-name | 184 | (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially |
| 185 | try-complete-file-name | ||
| 171 | try-expand-all-abbrevs | 186 | try-expand-all-abbrevs |
| 172 | try-expand-list | 187 | try-expand-list |
| 173 | try-expand-line | 188 | try-expand-line |
| 174 | try-expand-dabbrev | 189 | try-expand-dabbrev |
| 175 | try-expand-dabbrev-all-buffers | 190 | try-expand-dabbrev-all-buffers |
| 191 | try-expand-dabbrev-from-kill | ||
| 192 | try-complete-lisp-symbol-partially | ||
| 176 | try-complete-lisp-symbol) | 193 | try-complete-lisp-symbol) |
| 177 | "The list of expansion functions tried in order by `hippie-expand'. | 194 | "The list of expansion functions tried in order by `hippie-expand'. |
| 178 | To change the behavior of `hippie-expand', remove, change the order of, | 195 | To change the behavior of `hippie-expand', remove, change the order of, |
| @@ -229,16 +246,17 @@ undoes the expansion." | |||
| 229 | (message "No further expansions found")) | 246 | (message "No further expansions found")) |
| 230 | (ding)) | 247 | (ding)) |
| 231 | (if (and hippie-expand-verbose | 248 | (if (and hippie-expand-verbose |
| 232 | (not (window-minibuffer-p (selected-window)))) | 249 | (not (window-minibuffer-p (selected-window)))) |
| 233 | (message (concat "Using " | 250 | (message (concat "Using " |
| 234 | (prin1-to-string (nth he-num | 251 | (prin1-to-string (nth he-num |
| 235 | hippie-expand-try-functions-list))))))) | 252 | hippie-expand-try-functions-list))))))) |
| 236 | (if (>= he-num 0) | 253 | (if (and (>= he-num 0) |
| 254 | (eq (marker-buffer he-string-beg) (current-buffer))) | ||
| 237 | (progn | 255 | (progn |
| 238 | (setq he-num -1) | 256 | (setq he-num -1) |
| 239 | (he-reset-string) | 257 | (he-reset-string) |
| 240 | (if (and hippie-expand-verbose | 258 | (if (and hippie-expand-verbose |
| 241 | (not (window-minibuffer-p (selected-window)))) | 259 | (not (window-minibuffer-p (selected-window)))) |
| 242 | (message "Undoing expansions")))))) | 260 | (message "Undoing expansions")))))) |
| 243 | 261 | ||
| 244 | ;; Initializes the region to expand (to between BEG and END). | 262 | ;; Initializes the region to expand (to between BEG and END). |
| @@ -250,13 +268,10 @@ undoes the expansion." | |||
| 250 | ;; Resets the expanded region to its original contents. | 268 | ;; Resets the expanded region to its original contents. |
| 251 | (defun he-reset-string () | 269 | (defun he-reset-string () |
| 252 | (let ((newpos (point-marker))) | 270 | (let ((newpos (point-marker))) |
| 253 | (delete-region he-string-beg he-string-end) | ||
| 254 | (goto-char he-string-beg) | 271 | (goto-char he-string-beg) |
| 255 | (insert he-search-string) | 272 | (insert he-search-string) |
| 256 | (set-marker he-string-end (point)) | 273 | (delete-region (point) he-string-end) |
| 257 | (if (= newpos he-string-beg) | 274 | (goto-char newpos))) |
| 258 | (goto-char he-string-end) | ||
| 259 | (goto-char newpos)))) | ||
| 260 | 275 | ||
| 261 | ;; Substitutes an expansion STR into the correct region (the region | 276 | ;; Substitutes an expansion STR into the correct region (the region |
| 262 | ;; initialized with `he-init-string'). | 277 | ;; initialized with `he-init-string'). |
| @@ -266,53 +281,66 @@ undoes the expansion." | |||
| 266 | (defun he-substitute-string (str &optional trans-case) | 281 | (defun he-substitute-string (str &optional trans-case) |
| 267 | (let ((trans-case (and trans-case | 282 | (let ((trans-case (and trans-case |
| 268 | case-replace | 283 | case-replace |
| 269 | case-fold-search | 284 | case-fold-search)) |
| 270 | (he-transfer-case-ok str he-search-string))) | 285 | (newpos (point-marker)) |
| 271 | (newpos (point-marker))) | 286 | (subst ())) |
| 272 | (he-reset-string) | ||
| 273 | (goto-char he-string-beg) | 287 | (goto-char he-string-beg) |
| 274 | (search-forward he-search-string) | 288 | (setq subst (if trans-case (he-transfer-case he-search-string str) str)) |
| 275 | (replace-match (if trans-case (downcase str) str) | 289 | (setq he-tried-table (cons subst he-tried-table)) |
| 276 | (not trans-case) | 290 | (insert subst) |
| 277 | 'literal) | 291 | (delete-region (point) he-string-end) |
| 278 | (set-marker he-string-end (point)) | 292 | (goto-char newpos))) |
| 279 | (if (= newpos he-string-beg) | 293 | |
| 280 | (goto-char he-string-end) | 294 | (defun he-capitalize-first (str) |
| 281 | (goto-char newpos)))) | 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))) | ||
| 282 | 302 | ||
| 283 | (defun he-ordinary-case-p (str) | 303 | (defun he-ordinary-case-p (str) |
| 284 | (or (string= str (downcase str)) | 304 | (or (string= str (downcase str)) |
| 285 | (string= str (upcase str)) | 305 | (string= str (upcase str)) |
| 286 | (string= str (capitalize str)))) | 306 | (string= str (capitalize str)) |
| 287 | 307 | (string= str (he-capitalize-first str)))) | |
| 288 | (defun he-transfer-case-ok (to-str from-str) | 308 | |
| 289 | (and (not (string= from-str (substring to-str 0 (min (length from-str) | 309 | (defun he-transfer-case (from-str to-str) |
| 290 | (length to-str))))) | 310 | (cond ((string= from-str (substring to-str 0 (min (length from-str) |
| 291 | ;; otherwise transfer is not needed (and this also solves | 311 | (length to-str)))) |
| 292 | ;; some obscure situations) | 312 | to-str) |
| 293 | (he-ordinary-case-p to-str) | 313 | ((not (he-ordinary-case-p to-str)) |
| 294 | ;; otherwise case may be significant | 314 | to-string) |
| 295 | (he-ordinary-case-p from-str) | 315 | ((string= from-str (downcase from-str)) |
| 296 | ;; otherwise replace-match wont know what to do | 316 | (downcase to-str)) |
| 297 | )) | 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 | |||
| 298 | 326 | ||
| 299 | ;; Check if STR is a member of LST. | 327 | ;; Check if STR is a member of LST. |
| 300 | ;; Ignore case if `case-replace' and `case-fold-search' are both t. | 328 | ;; Transform to the final case if optional TRANS-CASE is non-NIL. |
| 301 | (defun he-string-member (str lst) | 329 | (defun he-string-member (str lst &optional trans-case) |
| 302 | (while (and lst | 330 | (if str |
| 303 | (not | 331 | (member (if (and trans-case |
| 304 | (if (and case-fold-search case-replace) | 332 | case-replace |
| 305 | (string= (downcase (car lst)) (downcase str)) | 333 | case-fold-search) |
| 306 | (string= (car lst) str)))) | 334 | (he-transfer-case he-search-string str) |
| 307 | (setq lst (cdr lst))) | 335 | str) |
| 308 | lst) | 336 | lst))) |
| 309 | 337 | ||
| 310 | ;; Check if STR matches any regexp in LST. | 338 | ;; Check if STR matches any regexp in LST. |
| 311 | ;; Ignore possible non-strings in LST. | 339 | ;; Ignore possible non-strings in LST. |
| 312 | (defun he-regexp-member (str lst) | 340 | (defun he-regexp-member (str lst) |
| 313 | (while (and lst | 341 | (while (and lst |
| 314 | (or (not (stringp (car lst))) | 342 | (or (not (stringp (car lst))) |
| 315 | (not (string-match (car lst) str)))) | 343 | (not (string-match (car lst) str)))) |
| 316 | (setq lst (cdr lst))) | 344 | (setq lst (cdr lst))) |
| 317 | lst) | 345 | lst) |
| 318 | 346 | ||
| @@ -334,7 +362,7 @@ Make it use the expansion functions in TRY-LIST. An optional second | |||
| 334 | argument VERBOSE non-nil makes the function verbose." | 362 | argument VERBOSE non-nil makes the function verbose." |
| 335 | (` (function (lambda (arg) | 363 | (` (function (lambda (arg) |
| 336 | (, (concat | 364 | (, (concat |
| 337 | "Try to expand text before point, using the following functions: \n" | 365 | "Try to expand text before point, using the following functions: \n" |
| 338 | (mapconcat 'prin1-to-string (eval try-list) ", "))) | 366 | (mapconcat 'prin1-to-string (eval try-list) ", "))) |
| 339 | (interactive "P") | 367 | (interactive "P") |
| 340 | (let ((hippie-expand-try-functions-list (, try-list)) | 368 | (let ((hippie-expand-try-functions-list (, try-list)) |
| @@ -344,6 +372,7 @@ argument VERBOSE non-nil makes the function verbose." | |||
| 344 | 372 | ||
| 345 | ;;; Here follows the try-functions and their requisites: | 373 | ;;; Here follows the try-functions and their requisites: |
| 346 | 374 | ||
| 375 | |||
| 347 | (defun try-complete-file-name (old) | 376 | (defun try-complete-file-name (old) |
| 348 | "Try to complete text as a file name. | 377 | "Try to complete text as a file name. |
| 349 | The argument OLD has to be nil the first call of this function, and t | 378 | The argument OLD has to be nil the first call of this function, and t |
| @@ -352,13 +381,13 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 352 | (if (not old) | 381 | (if (not old) |
| 353 | (progn | 382 | (progn |
| 354 | (he-init-string (he-file-name-beg) (point)) | 383 | (he-init-string (he-file-name-beg) (point)) |
| 355 | (let ((name-part (file-name-nondirectory he-search-string)) | 384 | (let ((name-part (he-file-name-nondirectory he-search-string)) |
| 356 | (dir-part (expand-file-name (or (file-name-directory | 385 | (dir-part (expand-file-name (or (he-file-name-directory |
| 357 | he-search-string) "")))) | 386 | he-search-string) "")))) |
| 358 | (if (not (he-string-member name-part he-tried-table)) | 387 | (if (not (he-string-member name-part he-tried-table)) |
| 359 | (setq he-tried-table (cons name-part he-tried-table))) | 388 | (setq he-tried-table (cons name-part he-tried-table))) |
| 360 | (if (and (not (equal he-search-string "")) | 389 | (if (and (not (equal he-search-string "")) |
| 361 | (file-directory-p dir-part)) | 390 | (he-file-directory-p dir-part)) |
| 362 | (setq he-expand-list (sort (file-name-all-completions | 391 | (setq he-expand-list (sort (file-name-all-completions |
| 363 | name-part | 392 | name-part |
| 364 | dir-part) | 393 | dir-part) |
| @@ -370,12 +399,13 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 370 | (setq he-expand-list (cdr he-expand-list))) | 399 | (setq he-expand-list (cdr he-expand-list))) |
| 371 | (if (null he-expand-list) | 400 | (if (null he-expand-list) |
| 372 | (progn | 401 | (progn |
| 373 | (if old (he-reset-string)) | 402 | (if old (he-reset-string)) |
| 374 | ()) | 403 | ()) |
| 375 | (let ((filename (concat (file-name-directory he-search-string) | 404 | (let ((filename (he-concat-directory-file-name |
| 376 | (car he-expand-list)))) | 405 | (he-file-name-directory he-search-string) |
| 406 | (car he-expand-list)))) | ||
| 377 | (he-substitute-string filename) | 407 | (he-substitute-string filename) |
| 378 | (setq he-tried-table (cons (car he-expand-list) he-tried-table)) | 408 | (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) |
| 379 | (setq he-expand-list (cdr he-expand-list)) | 409 | (setq he-expand-list (cdr he-expand-list)) |
| 380 | t))) | 410 | t))) |
| 381 | 411 | ||
| @@ -388,33 +418,88 @@ otherwise." | |||
| 388 | (if (not old) | 418 | (if (not old) |
| 389 | (progn | 419 | (progn |
| 390 | (he-init-string (he-file-name-beg) (point)) | 420 | (he-init-string (he-file-name-beg) (point)) |
| 391 | (let ((name-part (file-name-nondirectory he-search-string)) | 421 | (let ((name-part (he-file-name-nondirectory he-search-string)) |
| 392 | (dir-part (expand-file-name (or (file-name-directory | 422 | (dir-part (expand-file-name (or (he-file-name-directory |
| 393 | he-search-string) "")))) | 423 | he-search-string) "")))) |
| 394 | (if (and (not (equal he-search-string "")) | 424 | (if (and (not (equal he-search-string "")) |
| 395 | (file-directory-p dir-part)) | 425 | (he-file-directory-p dir-part)) |
| 396 | (setq expansion (file-name-completion name-part | 426 | (setq expansion (file-name-completion name-part |
| 397 | dir-part))) | 427 | dir-part))) |
| 398 | (if (or (eq expansion t) | 428 | (if (or (eq expansion t) |
| 399 | (string= expansion name-part)) | 429 | (string= expansion name-part) |
| 430 | (he-string-member expansion he-tried-table)) | ||
| 400 | (setq expansion ()))))) | 431 | (setq expansion ()))))) |
| 401 | 432 | ||
| 402 | (if (not expansion) | 433 | (if (not expansion) |
| 403 | (progn | 434 | (progn |
| 404 | (if old (he-reset-string)) | 435 | (if old (he-reset-string)) |
| 405 | ()) | 436 | ()) |
| 406 | (let ((filename (concat (file-name-directory he-search-string) | 437 | (let ((filename (he-concat-directory-file-name |
| 407 | expansion))) | 438 | (he-file-name-directory he-search-string) |
| 439 | expansion))) | ||
| 408 | (he-substitute-string filename) | 440 | (he-substitute-string filename) |
| 409 | (setq he-tried-table (cons expansion he-tried-table)) | 441 | (setq he-tried-table (cons expansion (cdr he-tried-table))) |
| 410 | t)))) | 442 | t)))) |
| 411 | 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 | |||
| 412 | (defun he-file-name-beg () | 453 | (defun he-file-name-beg () |
| 413 | (let ((skips "-a-zA-Z0-9_./~^#$")) | 454 | (save-excursion |
| 414 | (save-excursion | 455 | (skip-chars-backward he-file-name-chars) |
| 415 | (skip-chars-backward skips) | 456 | (point))) |
| 416 | (point)))) | ||
| 417 | 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 | |||
| 418 | (defun try-complete-lisp-symbol (old) | 503 | (defun try-complete-lisp-symbol (old) |
| 419 | "Try to complete word as an Emacs Lisp symbol. | 504 | "Try to complete word as an Emacs Lisp symbol. |
| 420 | The argument OLD has to be nil the first call of this function, and t | 505 | The argument OLD has to be nil the first call of this function, and t |
| @@ -438,11 +523,10 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 438 | (setq he-expand-list (cdr he-expand-list))) | 523 | (setq he-expand-list (cdr he-expand-list))) |
| 439 | (if (null he-expand-list) | 524 | (if (null he-expand-list) |
| 440 | (progn | 525 | (progn |
| 441 | (if old (he-reset-string)) | 526 | (if old (he-reset-string)) |
| 442 | ()) | 527 | ()) |
| 443 | (progn | 528 | (progn |
| 444 | (he-substitute-string (car he-expand-list)) | 529 | (he-substitute-string (car he-expand-list)) |
| 445 | (setq he-tried-table (cons (car he-expand-list) he-tried-table)) | ||
| 446 | (setq he-expand-list (cdr he-expand-list)) | 530 | (setq he-expand-list (cdr he-expand-list)) |
| 447 | t))) | 531 | t))) |
| 448 | 532 | ||
| @@ -463,16 +547,16 @@ otherwise." | |||
| 463 | (fboundp sym) | 547 | (fboundp sym) |
| 464 | (symbol-plist sym))))))) | 548 | (symbol-plist sym))))))) |
| 465 | (if (or (eq expansion t) | 549 | (if (or (eq expansion t) |
| 466 | (string= expansion he-search-string)) | 550 | (string= expansion he-search-string) |
| 551 | (he-string-member expansion he-tried-table)) | ||
| 467 | (setq expansion ())))) | 552 | (setq expansion ())))) |
| 468 | 553 | ||
| 469 | (if (not expansion) | 554 | (if (not expansion) |
| 470 | (progn | 555 | (progn |
| 471 | (if old (he-reset-string)) | 556 | (if old (he-reset-string)) |
| 472 | ()) | 557 | ()) |
| 473 | (progn | 558 | (progn |
| 474 | (he-substitute-string expansion) | 559 | (he-substitute-string expansion) |
| 475 | (setq he-tried-table (cons expansion he-tried-table)) | ||
| 476 | t)))) | 560 | t)))) |
| 477 | 561 | ||
| 478 | (defun he-lisp-symbol-beg () | 562 | (defun he-lisp-symbol-beg () |
| @@ -518,11 +602,10 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 518 | 602 | ||
| 519 | (if (not expansion) | 603 | (if (not expansion) |
| 520 | (progn | 604 | (progn |
| 521 | (if old (he-reset-string)) | 605 | (if old (he-reset-string)) |
| 522 | ()) | 606 | ()) |
| 523 | (progn | 607 | (progn |
| 524 | (he-substitute-string expansion t) | 608 | (he-substitute-string expansion t) |
| 525 | (setq he-tried-table (cons expansion he-tried-table)) | ||
| 526 | t)))) | 609 | t)))) |
| 527 | 610 | ||
| 528 | (defun try-expand-line-all-buffers (old) | 611 | (defun try-expand-line-all-buffers (old) |
| @@ -533,43 +616,45 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 533 | (let ((expansion ()) | 616 | (let ((expansion ()) |
| 534 | (strip-prompt (and (get-buffer-process (current-buffer)) | 617 | (strip-prompt (and (get-buffer-process (current-buffer)) |
| 535 | comint-prompt-regexp)) | 618 | comint-prompt-regexp)) |
| 536 | (buf (current-buffer))) | 619 | (buf (current-buffer)) |
| 620 | (orig-case-fold-search case-fold-search)) | ||
| 537 | (if (not old) | 621 | (if (not old) |
| 538 | (progn | 622 | (progn |
| 539 | (he-init-string (he-line-beg strip-prompt) (point)) | 623 | (he-init-string (he-line-beg strip-prompt) (point)) |
| 540 | (setq he-search-bufs (buffer-list)) | 624 | (setq he-search-bufs (buffer-list)) |
| 541 | (setq he-searched-n-bufs 0) | 625 | (setq he-searched-n-bufs 0) |
| 542 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 626 | (set-marker he-search-loc 1 (car he-search-bufs)))) |
| 543 | 627 | ||
| 544 | (if (not (equal he-search-string "")) | 628 | (if (not (equal he-search-string "")) |
| 545 | (while (and he-search-bufs | 629 | (while (and he-search-bufs |
| 546 | (not expansion) | 630 | (not expansion) |
| 547 | (or (not hippie-expand-max-buffers) | 631 | (or (not hippie-expand-max-buffers) |
| 548 | (< he-searched-n-bufs hippie-expand-max-buffers))) | 632 | (< he-searched-n-bufs hippie-expand-max-buffers))) |
| 549 | (set-buffer (car he-search-bufs)) | 633 | (set-buffer (car he-search-bufs)) |
| 550 | (if (and (not (eq (current-buffer) buf)) | 634 | (if (and (not (eq (current-buffer) buf)) |
| 551 | (not (memq major-mode hippie-expand-ignore-buffers)) | 635 | (not (memq major-mode hippie-expand-ignore-buffers)) |
| 552 | (not (he-regexp-member (buffer-name) | 636 | (not (he-regexp-member (buffer-name) |
| 553 | hippie-expand-ignore-buffers))) | 637 | hippie-expand-ignore-buffers))) |
| 554 | (save-excursion | 638 | (save-excursion |
| 555 | (goto-char he-search-loc) | 639 | (goto-char he-search-loc) |
| 556 | (setq strip-prompt (and (get-buffer-process (current-buffer)) | 640 | (setq strip-prompt (and (get-buffer-process (current-buffer)) |
| 557 | comint-prompt-regexp)) | 641 | comint-prompt-regexp)) |
| 558 | (setq expansion (he-line-search he-search-string | 642 | (setq expansion (let ((case-fold-search orig-case-fold-search)) |
| 559 | strip-prompt nil)) | 643 | (he-line-search he-search-string |
| 644 | strip-prompt nil))) | ||
| 560 | (set-marker he-search-loc (point)) | 645 | (set-marker he-search-loc (point)) |
| 561 | (if expansion | 646 | (if (not expansion) |
| 562 | (setq he-tried-table (cons expansion he-tried-table)) | 647 | (progn |
| 563 | (setq he-search-bufs (cdr he-search-bufs)) | 648 | (setq he-search-bufs (cdr he-search-bufs)) |
| 564 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) | 649 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) |
| 565 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 650 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 566 | (setq he-search-bufs (cdr he-search-bufs)) | 651 | (setq he-search-bufs (cdr he-search-bufs)) |
| 567 | (set-marker he-search-loc 1 (car he-search-bufs))))) | 652 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 568 | 653 | ||
| 569 | (set-buffer buf) | 654 | (set-buffer buf) |
| 570 | (if (not expansion) | 655 | (if (not expansion) |
| 571 | (progn | 656 | (progn |
| 572 | (if old (he-reset-string)) | 657 | (if old (he-reset-string)) |
| 573 | ()) | 658 | ()) |
| 574 | (progn | 659 | (progn |
| 575 | (he-substitute-string expansion t) | 660 | (he-substitute-string expansion t) |
| @@ -586,18 +671,16 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 586 | (he-line-search-regexp str strip-prompt) | 671 | (he-line-search-regexp str strip-prompt) |
| 587 | nil t))) | 672 | nil t))) |
| 588 | (setq result (buffer-substring (match-beginning 2) (match-end 2))) | 673 | (setq result (buffer-substring (match-beginning 2) (match-end 2))) |
| 589 | (if (he-string-member result he-tried-table) | 674 | (if (he-string-member result he-tried-table t) |
| 590 | (setq result nil))) ; if already in table, ignore | 675 | (setq result nil))) ; if already in table, ignore |
| 591 | result)) | 676 | result)) |
| 592 | 677 | ||
| 593 | (defun he-line-beg (strip-prompt) | 678 | (defun he-line-beg (strip-prompt) |
| 594 | (save-excursion | 679 | (save-excursion |
| 595 | (end-of-line) | ||
| 596 | (if (re-search-backward (he-line-search-regexp "" strip-prompt) | 680 | (if (re-search-backward (he-line-search-regexp "" strip-prompt) |
| 597 | (save-excursion (beginning-of-line) | 681 | (save-excursion (beginning-of-line) |
| 598 | (point)) t) | 682 | (point)) t) |
| 599 | (match-beginning 2) | 683 | (match-beginning 2) |
| 600 | (beginning-of-line) | ||
| 601 | (point)))) | 684 | (point)))) |
| 602 | 685 | ||
| 603 | (defun he-line-search-regexp (pat strip-prompt) | 686 | (defun he-line-search-regexp (pat strip-prompt) |
| @@ -646,7 +729,6 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 646 | ()) | 729 | ()) |
| 647 | (progn | 730 | (progn |
| 648 | (he-substitute-string expansion t) | 731 | (he-substitute-string expansion t) |
| 649 | (setq he-tried-table (cons expansion he-tried-table)) | ||
| 650 | t)))) | 732 | t)))) |
| 651 | 733 | ||
| 652 | (defun try-expand-list-all-buffers (old) | 734 | (defun try-expand-list-all-buffers (old) |
| @@ -655,40 +737,42 @@ The argument OLD has to be nil the first call of this function, and t | |||
| 655 | for subsequent calls (for further possible completions of the same | 737 | for subsequent calls (for further possible completions of the same |
| 656 | string). It returns t if a new completion is found, nil otherwise." | 738 | string). It returns t if a new completion is found, nil otherwise." |
| 657 | (let ((expansion ()) | 739 | (let ((expansion ()) |
| 658 | (buf (current-buffer))) | 740 | (buf (current-buffer)) |
| 741 | (orig-case-fold-search case-fold-search)) | ||
| 659 | (if (not old) | 742 | (if (not old) |
| 660 | (progn | 743 | (progn |
| 661 | (he-init-string (he-list-beg) (point)) | 744 | (he-init-string (he-list-beg) (point)) |
| 662 | (setq he-search-bufs (buffer-list)) | 745 | (setq he-search-bufs (buffer-list)) |
| 663 | (setq he-searched-n-bufs 0) | 746 | (setq he-searched-n-bufs 0) |
| 664 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 747 | (set-marker he-search-loc 1 (car he-search-bufs)))) |
| 665 | 748 | ||
| 666 | (if (not (equal he-search-string "")) | 749 | (if (not (equal he-search-string "")) |
| 667 | (while (and he-search-bufs | 750 | (while (and he-search-bufs |
| 668 | (not expansion) | 751 | (not expansion) |
| 669 | (or (not hippie-expand-max-buffers) | 752 | (or (not hippie-expand-max-buffers) |
| 670 | (< he-searched-n-bufs hippie-expand-max-buffers))) | 753 | (< he-searched-n-bufs hippie-expand-max-buffers))) |
| 671 | (set-buffer (car he-search-bufs)) | 754 | (set-buffer (car he-search-bufs)) |
| 672 | (if (and (not (eq (current-buffer) buf)) | 755 | (if (and (not (eq (current-buffer) buf)) |
| 673 | (not (memq major-mode hippie-expand-ignore-buffers)) | 756 | (not (memq major-mode hippie-expand-ignore-buffers)) |
| 674 | (not (he-regexp-member (buffer-name) | 757 | (not (he-regexp-member (buffer-name) |
| 675 | hippie-expand-ignore-buffers))) | 758 | hippie-expand-ignore-buffers))) |
| 676 | (save-excursion | 759 | (save-excursion |
| 677 | (goto-char he-search-loc) | 760 | (goto-char he-search-loc) |
| 678 | (setq expansion (he-list-search he-search-string nil)) | 761 | (setq expansion (let ((case-fold-search orig-case-fold-search)) |
| 762 | (he-list-search he-search-string nil))) | ||
| 679 | (set-marker he-search-loc (point)) | 763 | (set-marker he-search-loc (point)) |
| 680 | (if expansion | 764 | (if (not expansion) |
| 681 | (setq he-tried-table (cons expansion he-tried-table)) | 765 | (progn |
| 682 | (setq he-search-bufs (cdr he-search-bufs)) | 766 | (setq he-search-bufs (cdr he-search-bufs)) |
| 683 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) | 767 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) |
| 684 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 768 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 685 | (setq he-search-bufs (cdr he-search-bufs)) | 769 | (setq he-search-bufs (cdr he-search-bufs)) |
| 686 | (set-marker he-search-loc 1 (car he-search-bufs))))) | 770 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 687 | 771 | ||
| 688 | (set-buffer buf) | 772 | (set-buffer buf) |
| 689 | (if (not expansion) | 773 | (if (not expansion) |
| 690 | (progn | 774 | (progn |
| 691 | (if old (he-reset-string)) | 775 | (if old (he-reset-string)) |
| 692 | ()) | 776 | ()) |
| 693 | (progn | 777 | (progn |
| 694 | (he-substitute-string expansion t) | 778 | (he-substitute-string expansion t) |
| @@ -696,7 +780,7 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 696 | 780 | ||
| 697 | (defun he-list-search (str reverse) | 781 | (defun he-list-search (str reverse) |
| 698 | (let ((result ()) | 782 | (let ((result ()) |
| 699 | beg pos err) | 783 | beg pos err) |
| 700 | (while (and (not result) | 784 | (while (and (not result) |
| 701 | (if reverse | 785 | (if reverse |
| 702 | (search-backward str nil t) | 786 | (search-backward str nil t) |
| @@ -706,23 +790,23 @@ string). It returns t if a new completion is found, nil otherwise." | |||
| 706 | (goto-char beg) | 790 | (goto-char beg) |
| 707 | (setq err ()) | 791 | (setq err ()) |
| 708 | (condition-case () | 792 | (condition-case () |
| 709 | (forward-list 1) | 793 | (forward-list 1) |
| 710 | (error (setq err t))) | 794 | (error (setq err t))) |
| 711 | (if (and reverse | 795 | (if (and reverse |
| 712 | (> (point) he-string-beg)) | 796 | (> (point) he-string-beg)) |
| 713 | (setq err t)) | 797 | (setq err t)) |
| 714 | (if (not err) | 798 | (if (not err) |
| 715 | (progn | 799 | (progn |
| 716 | (setq result (buffer-substring beg (point))) | 800 | (setq result (buffer-substring beg (point))) |
| 717 | (if (he-string-member result he-tried-table) | 801 | (if (he-string-member result he-tried-table t) |
| 718 | (setq result nil)))) ; if already in table, ignore | 802 | (setq result nil)))) ; if already in table, ignore |
| 719 | (goto-char pos)) | 803 | (goto-char pos)) |
| 720 | result)) | 804 | result)) |
| 721 | 805 | ||
| 722 | (defun he-list-beg () | 806 | (defun he-list-beg () |
| 723 | (save-excursion | 807 | (save-excursion |
| 724 | (condition-case () | 808 | (condition-case () |
| 725 | (backward-up-list 1) | 809 | (backward-up-list 1) |
| 726 | (error ())) | 810 | (error ())) |
| 727 | (point))) | 811 | (point))) |
| 728 | 812 | ||
| @@ -737,22 +821,22 @@ string). It returns t if a new expansion is found, nil otherwise." | |||
| 737 | (setq he-expand-list | 821 | (setq he-expand-list |
| 738 | (and (not (equal he-search-string "")) | 822 | (and (not (equal he-search-string "")) |
| 739 | (mapcar (function (lambda (sym) | 823 | (mapcar (function (lambda (sym) |
| 740 | (abbrev-expansion (downcase he-search-string) | 824 | (if (and (boundp sym) (vectorp (eval sym))) |
| 741 | (eval sym)))) | 825 | (abbrev-expansion (downcase he-search-string) |
| 826 | (eval sym))))) | ||
| 742 | (append '(local-abbrev-table | 827 | (append '(local-abbrev-table |
| 743 | global-abbrev-table) | 828 | global-abbrev-table) |
| 744 | abbrev-table-name-list)))))) | 829 | abbrev-table-name-list)))))) |
| 745 | (while (and he-expand-list | 830 | (while (and he-expand-list |
| 746 | (or (not (car he-expand-list)) | 831 | (or (not (car he-expand-list)) |
| 747 | (he-string-member (car he-expand-list) he-tried-table))) | 832 | (he-string-member (car he-expand-list) he-tried-table t))) |
| 748 | (setq he-expand-list (cdr he-expand-list))) | 833 | (setq he-expand-list (cdr he-expand-list))) |
| 749 | (if (null he-expand-list) | 834 | (if (null he-expand-list) |
| 750 | (progn | 835 | (progn |
| 751 | (if old (he-reset-string)) | 836 | (if old (he-reset-string)) |
| 752 | ()) | 837 | ()) |
| 753 | (progn | 838 | (progn |
| 754 | (he-substitute-string (car he-expand-list) t) | 839 | (he-substitute-string (car he-expand-list) t) |
| 755 | (setq he-tried-table (cons (car he-expand-list) he-tried-table)) | ||
| 756 | (setq he-expand-list (cdr he-expand-list)) | 840 | (setq he-expand-list (cdr he-expand-list)) |
| 757 | t))) | 841 | t))) |
| 758 | 842 | ||
| @@ -774,7 +858,7 @@ string). It returns t if a new expansion is found, nil otherwise." | |||
| 774 | (if he-search-bw | 858 | (if he-search-bw |
| 775 | (progn | 859 | (progn |
| 776 | (goto-char he-search-loc) | 860 | (goto-char he-search-loc) |
| 777 | (setq expansion (he-dab-search he-search-string t)) | 861 | (setq expansion (he-dabbrev-search he-search-string t)) |
| 778 | (set-marker he-search-loc (point)) | 862 | (set-marker he-search-loc (point)) |
| 779 | (if (not expansion) | 863 | (if (not expansion) |
| 780 | (progn | 864 | (progn |
| @@ -784,16 +868,15 @@ string). It returns t if a new expansion is found, nil otherwise." | |||
| 784 | (if (not expansion) ; Then look forward. | 868 | (if (not expansion) ; Then look forward. |
| 785 | (progn | 869 | (progn |
| 786 | (goto-char he-search-loc) | 870 | (goto-char he-search-loc) |
| 787 | (setq expansion (he-dab-search he-search-string nil)) | 871 | (setq expansion (he-dabbrev-search he-search-string nil)) |
| 788 | (set-marker he-search-loc (point)))))) | 872 | (set-marker he-search-loc (point)))))) |
| 789 | 873 | ||
| 790 | (if (not expansion) | 874 | (if (not expansion) |
| 791 | (progn | 875 | (progn |
| 792 | (if old (he-reset-string)) | 876 | (if old (he-reset-string)) |
| 793 | ()) | 877 | ()) |
| 794 | (progn | 878 | (progn |
| 795 | (he-substitute-string expansion t) | 879 | (he-substitute-string expansion t) |
| 796 | (setq he-tried-table (cons expansion he-tried-table)) | ||
| 797 | t)))) | 880 | t)))) |
| 798 | 881 | ||
| 799 | (defun try-expand-dabbrev-all-buffers (old) | 882 | (defun try-expand-dabbrev-all-buffers (old) |
| @@ -802,68 +885,240 @@ The argument OLD has to be nil the first call of this function, and t | |||
| 802 | for subsequent calls (for further possible expansions of the same | 885 | for subsequent calls (for further possible expansions of the same |
| 803 | string). It returns t if a new expansion is found, nil otherwise." | 886 | string). It returns t if a new expansion is found, nil otherwise." |
| 804 | (let ((expansion ()) | 887 | (let ((expansion ()) |
| 805 | (buf (current-buffer))) | 888 | (buf (current-buffer)) |
| 889 | (orig-case-fold-search case-fold-search)) | ||
| 806 | (if (not old) | 890 | (if (not old) |
| 807 | (progn | 891 | (progn |
| 808 | (he-init-string (he-dabbrev-beg) (point)) | 892 | (he-init-string (he-dabbrev-beg) (point)) |
| 809 | (setq he-search-bufs (buffer-list)) | 893 | (setq he-search-bufs (buffer-list)) |
| 810 | (setq he-searched-n-bufs 0) | 894 | (setq he-searched-n-bufs 0) |
| 811 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 895 | (set-marker he-search-loc 1 (car he-search-bufs)))) |
| 812 | 896 | ||
| 813 | (if (not (equal he-search-string "")) | 897 | (if (not (equal he-search-string "")) |
| 814 | (while (and he-search-bufs | 898 | (while (and he-search-bufs |
| 815 | (not expansion) | 899 | (not expansion) |
| 816 | (or (not hippie-expand-max-buffers) | 900 | (or (not hippie-expand-max-buffers) |
| 817 | (< he-searched-n-bufs hippie-expand-max-buffers))) | 901 | (< he-searched-n-bufs hippie-expand-max-buffers))) |
| 818 | (set-buffer (car he-search-bufs)) | 902 | (set-buffer (car he-search-bufs)) |
| 819 | (if (and (not (eq (current-buffer) buf)) | 903 | (if (and (not (eq (current-buffer) buf)) |
| 820 | (not (memq major-mode hippie-expand-ignore-buffers)) | 904 | (not (memq major-mode hippie-expand-ignore-buffers)) |
| 821 | (not (he-regexp-member (buffer-name) | 905 | (not (he-regexp-member (buffer-name) |
| 822 | hippie-expand-ignore-buffers))) | 906 | hippie-expand-ignore-buffers))) |
| 823 | (save-excursion | 907 | (save-excursion |
| 824 | (goto-char he-search-loc) | 908 | (goto-char he-search-loc) |
| 825 | (setq expansion (he-dab-search he-search-string nil)) | 909 | (setq expansion (let ((case-fold-search orig-case-fold-search)) |
| 910 | (he-dabbrev-search he-search-string nil))) | ||
| 826 | (set-marker he-search-loc (point)) | 911 | (set-marker he-search-loc (point)) |
| 827 | (if expansion | 912 | (if (not expansion) |
| 828 | (setq he-tried-table (cons expansion he-tried-table)) | 913 | (progn |
| 829 | (setq he-search-bufs (cdr he-search-bufs)) | 914 | (setq he-search-bufs (cdr he-search-bufs)) |
| 830 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) | 915 | (setq he-searched-n-bufs (1+ he-searched-n-bufs)) |
| 831 | (set-marker he-search-loc 1 (car he-search-bufs)))) | 916 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 832 | (setq he-search-bufs (cdr he-search-bufs)) | 917 | (setq he-search-bufs (cdr he-search-bufs)) |
| 833 | (set-marker he-search-loc 1 (car he-search-bufs))))) | 918 | (set-marker he-search-loc 1 (car he-search-bufs))))) |
| 834 | 919 | ||
| 835 | (set-buffer buf) | 920 | (set-buffer buf) |
| 836 | (if (not expansion) | 921 | (if (not expansion) |
| 837 | (progn | 922 | (progn |
| 838 | (if old (he-reset-string)) | 923 | (if old (he-reset-string)) |
| 839 | ()) | 924 | ()) |
| 840 | (progn | 925 | (progn |
| 841 | (he-substitute-string expansion t) | 926 | (he-substitute-string expansion t) |
| 842 | t)))) | 927 | t)))) |
| 843 | 928 | ||
| 844 | (defun he-dab-search-regexp (pat) | 929 | ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who |
| 845 | (concat "\\<" (regexp-quote pat) | 930 | ;; suggested this one. |
| 846 | "\\(\\sw\\|\\s_\\)+")) | 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)))) | ||
| 847 | 978 | ||
| 848 | (defun he-dab-search (pattern reverse) | 979 | (defun he-dabbrev-search (pattern &optional reverse limit) |
| 849 | (let ((result ())) | 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_\\)+")))) | ||
| 850 | (while (and (not result) | 984 | (while (and (not result) |
| 851 | (if reverse | 985 | (if reverse |
| 852 | (re-search-backward (he-dab-search-regexp pattern) | 986 | (re-search-backward regpat limit t) |
| 853 | nil t) | 987 | (re-search-forward regpat limit t))) |
| 854 | (re-search-forward (he-dab-search-regexp pattern) | ||
| 855 | nil t))) | ||
| 856 | (setq result (buffer-substring (match-beginning 0) (match-end 0))) | 988 | (setq result (buffer-substring (match-beginning 0) (match-end 0))) |
| 857 | (if (he-string-member result he-tried-table) | 989 | (if (or (and (> (match-beginning 0) (point-min)) |
| 858 | (setq result nil))) ; if already in table, ignore | 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 | ||
| 859 | result)) | 994 | result)) |
| 860 | 995 | ||
| 996 | (defvar he-dabbrev-skip-space () | ||
| 997 | "Non-NIL means tolerate trailing spaces in the abbreviation to expand.") | ||
| 998 | |||
| 861 | (defun he-dabbrev-beg () | 999 | (defun he-dabbrev-beg () |
| 862 | (min (point) | 1000 | (let ((op (point))) |
| 863 | (save-excursion | 1001 | (save-excursion |
| 864 | (skip-syntax-backward "w_") | 1002 | (if he-dabbrev-skip-space |
| 865 | (skip-syntax-forward "_") | 1003 | (skip-syntax-backward ". ")) |
| 866 | (point)))) | 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 | |||
| 867 | 1122 | ||
| 868 | (provide 'hippie-exp) | 1123 | (provide 'hippie-exp) |
| 869 | 1124 | ||