diff options
| author | Stefan Monnier | 2009-11-19 03:12:51 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2009-11-19 03:12:51 +0000 |
| commit | a185548b1cd687da0f31c0556c003e7a544b35d7 (patch) | |
| tree | ac50feb064aef7c1dd14729fc9980e797473f51a | |
| parent | 87e32266f0fc8467bc8280c9b73b7c5ab9d5f951 (diff) | |
| download | emacs-a185548b1cd687da0f31c0556c003e7a544b35d7.tar.gz emacs-a185548b1cd687da0f31c0556c003e7a544b35d7.zip | |
* abbrev.el (abbrev-with-wrapper-hook): (re)move...
* simple.el (with-wrapper-hook): ...to here. Add argument `args'.
* minibuffer.el (completion-in-region-functions): New hook.
(completion-in-region): New function.
* emacs-lisp/lisp.el (lisp-complete-symbol):
* pcomplete.el (pcomplete-std-complete): Use it.
| -rw-r--r-- | etc/NEWS | 3 | ||||
| -rw-r--r-- | lisp/abbrev.el | 39 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 12 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 31 | ||||
| -rw-r--r-- | lisp/pcomplete.el | 28 | ||||
| -rw-r--r-- | lisp/simple.el | 47 |
6 files changed, 93 insertions, 67 deletions
| @@ -299,6 +299,9 @@ the variable `byte-compile-compatibility') has been removed. | |||
| 299 | 299 | ||
| 300 | * Lisp changes in Emacs 23.2 | 300 | * Lisp changes in Emacs 23.2 |
| 301 | 301 | ||
| 302 | ** New function `completion-in-region' to use the standard completion | ||
| 303 | facilities on a particular region of text. | ||
| 304 | |||
| 302 | ** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. | 305 | ** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. |
| 303 | 306 | ||
| 304 | ** read-file-name-predicate is obsolete. It was used to pass the predicate | 307 | ** read-file-name-predicate is obsolete. It was used to pass the predicate |
diff --git a/lisp/abbrev.el b/lisp/abbrev.el index f45f4c1860c..88c87dafa77 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el | |||
| @@ -392,43 +392,6 @@ See `define-abbrev' for the effect of some special properties. | |||
| 392 | 392 | ||
| 393 | \(fn ABBREV PROP VAL)") | 393 | \(fn ABBREV PROP VAL)") |
| 394 | 394 | ||
| 395 | (defmacro abbrev-with-wrapper-hook (var &rest body) | ||
| 396 | "Run BODY wrapped with the VAR hook. | ||
| 397 | VAR is a special hook: its functions are called with one argument which | ||
| 398 | is the \"original\" code (the BODY), so the hook function can wrap the | ||
| 399 | original function, can call it several times, or even not call it at all. | ||
| 400 | VAR is normally a symbol (a variable) in which case it is treated like a hook, | ||
| 401 | with a buffer-local and a global part. But it can also be an arbitrary expression. | ||
| 402 | This is similar to an `around' advice." | ||
| 403 | (declare (indent 1) (debug t)) | ||
| 404 | ;; We need those two gensyms because CL's lexical scoping is not available | ||
| 405 | ;; for function arguments :-( | ||
| 406 | (let ((funs (make-symbol "funs")) | ||
| 407 | (global (make-symbol "global"))) | ||
| 408 | ;; Since the hook is a wrapper, the loop has to be done via | ||
| 409 | ;; recursion: a given hook function will call its parameter in order to | ||
| 410 | ;; continue looping. | ||
| 411 | `(labels ((runrestofhook (,funs ,global) | ||
| 412 | ;; `funs' holds the functions left on the hook and `global' | ||
| 413 | ;; holds the functions left on the global part of the hook | ||
| 414 | ;; (in case the hook is local). | ||
| 415 | (lexical-let ((funs ,funs) | ||
| 416 | (global ,global)) | ||
| 417 | (if (consp funs) | ||
| 418 | (if (eq t (car funs)) | ||
| 419 | (runrestofhook (append global (cdr funs)) nil) | ||
| 420 | (funcall (car funs) | ||
| 421 | (lambda () (runrestofhook (cdr funs) global)))) | ||
| 422 | ;; Once there are no more functions on the hook, run | ||
| 423 | ;; the original body. | ||
| 424 | ,@body)))) | ||
| 425 | (runrestofhook ,var | ||
| 426 | ;; The global part of the hook, if any. | ||
| 427 | ,(if (symbolp var) | ||
| 428 | `(if (local-variable-p ',var) | ||
| 429 | (default-value ',var))))))) | ||
| 430 | |||
| 431 | |||
| 432 | ;;; Code that used to be implemented in src/abbrev.c | 395 | ;;; Code that used to be implemented in src/abbrev.c |
| 433 | 396 | ||
| 434 | (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table | 397 | (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table |
| @@ -799,7 +762,7 @@ Effective when explicitly called even when `abbrev-mode' is nil. | |||
| 799 | Returns the abbrev symbol, if expansion took place." | 762 | Returns the abbrev symbol, if expansion took place." |
| 800 | (interactive) | 763 | (interactive) |
| 801 | (run-hooks 'pre-abbrev-expand-hook) | 764 | (run-hooks 'pre-abbrev-expand-hook) |
| 802 | (abbrev-with-wrapper-hook abbrev-expand-functions | 765 | (with-wrapper-hook abbrev-expand-functions () |
| 803 | (destructuring-bind (&optional sym name wordstart wordend) | 766 | (destructuring-bind (&optional sym name wordstart wordend) |
| 804 | (abbrev--before-point) | 767 | (abbrev--before-point) |
| 805 | (when sym | 768 | (when sym |
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 9b48c497eba..0edd6556dbf 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el | |||
| @@ -647,17 +647,11 @@ considered." | |||
| 647 | ;; Maybe a `let' varlist or something. | 647 | ;; Maybe a `let' varlist or something. |
| 648 | nil | 648 | nil |
| 649 | ;; Else, we assume that a function name is expected. | 649 | ;; Else, we assume that a function name is expected. |
| 650 | 'fboundp))))) | 650 | 'fboundp)))))) |
| 651 | (ol (make-overlay beg end nil nil t))) | ||
| 652 | (overlay-put ol 'field 'completion) | ||
| 653 | (let ((completion-annotate-function | 651 | (let ((completion-annotate-function |
| 654 | (unless (eq predicate 'fboundp) | 652 | (unless (eq predicate 'fboundp) |
| 655 | (lambda (str) (if (fboundp (intern-soft str)) " <f>")))) | 653 | (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))) |
| 656 | (minibuffer-completion-table obarray) | 654 | (completion-in-region beg end obarray predicate)))) |
| 657 | (minibuffer-completion-predicate predicate)) | ||
| 658 | (unwind-protect | ||
| 659 | (call-interactively 'minibuffer-complete) | ||
| 660 | (delete-overlay ol))))) | ||
| 661 | 655 | ||
| 662 | ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e | 656 | ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e |
| 663 | ;;; lisp.el ends here | 657 | ;;; lisp.el ends here |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 40d36500525..223817ddc75 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -1022,10 +1022,33 @@ variables.") | |||
| 1022 | (ding)) | 1022 | (ding)) |
| 1023 | (exit-minibuffer)) | 1023 | (exit-minibuffer)) |
| 1024 | 1024 | ||
| 1025 | ;;; Key bindings. | 1025 | (defvar completion-in-region-functions nil |
| 1026 | 1026 | "Wrapper hook around `complete-in-region'. | |
| 1027 | (define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map | 1027 | The functions on this special hook are called with 5 arguments: |
| 1028 | 'minibuffer-local-filename-must-match-map "23.1") | 1028 | NEXT-FUN START END COLLECTION PREDICATE. |
| 1029 | NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE) | ||
| 1030 | that performs the default operation. The other four argument are like | ||
| 1031 | the ones passed to `complete-in-region'. The functions on this hook | ||
| 1032 | are expected to perform completion on START..END using COLLECTION | ||
| 1033 | and PREDICATE, either by calling NEXT-FUN or by doing it themselves.") | ||
| 1034 | |||
| 1035 | (defun completion-in-region (start end collection &optional predicate) | ||
| 1036 | "Complete the text between START and END using COLLECTION. | ||
| 1037 | Point needs to be somewhere between START and END." | ||
| 1038 | ;; FIXME: some callers need to setup completion-ignore-case, | ||
| 1039 | ;; completion-ignored-extensions. The latter can be embedded in the | ||
| 1040 | ;; completion tables, but the first cannot (actually, maybe it should). | ||
| 1041 | (assert (<= start (point)) (<= (point) end)) | ||
| 1042 | ;; FIXME: undisplay the *Completions* buffer once the completion is done. | ||
| 1043 | (with-wrapper-hook | ||
| 1044 | completion-in-region-functions (start end collection predicate) | ||
| 1045 | (let ((minibuffer-completion-table collection) | ||
| 1046 | (minibuffer-completion-predicate predicate) | ||
| 1047 | (ol (make-overlay start end nil nil t))) | ||
| 1048 | (overlay-put ol 'field 'completion) | ||
| 1049 | (unwind-protect | ||
| 1050 | (call-interactively 'minibuffer-complete) | ||
| 1051 | (delete-overlay ol))))) | ||
| 1029 | 1052 | ||
| 1030 | (let ((map minibuffer-local-map)) | 1053 | (let ((map minibuffer-local-map)) |
| 1031 | (define-key map "\C-g" 'abort-recursive-edit) | 1054 | (define-key map "\C-g" 'abort-recursive-edit) |
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 65b48f49fa9..387aa106a43 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el | |||
| @@ -513,22 +513,18 @@ Same as `pcomplete' but using the standard completion UI." | |||
| 513 | (directory-file-name f)) | 513 | (directory-file-name f)) |
| 514 | pcomplete-seen)))))) | 514 | pcomplete-seen)))))) |
| 515 | 515 | ||
| 516 | (let ((ol (make-overlay beg (point) nil nil t)) | 516 | (completion-in-region |
| 517 | (minibuffer-completion-table | 517 | beg (point) |
| 518 | ;; Add a space at the end of completion. Use a terminator-regexp | 518 | ;; Add a space at the end of completion. Use a terminator-regexp |
| 519 | ;; that never matches since the terminator cannot appear | 519 | ;; that never matches since the terminator cannot appear |
| 520 | ;; within the completion field anyway. | 520 | ;; within the completion field anyway. |
| 521 | (if (zerop (length pcomplete-termination-string)) | 521 | (if (zerop (length pcomplete-termination-string)) |
| 522 | table | 522 | table |
| 523 | (apply-partially 'completion-table-with-terminator | 523 | (apply-partially 'completion-table-with-terminator |
| 524 | (cons pcomplete-termination-string | 524 | (cons pcomplete-termination-string |
| 525 | "\\`a\\`") | 525 | "\\`a\\`") |
| 526 | table))) | 526 | table)) |
| 527 | (minibuffer-completion-predicate pred)) | 527 | pred)))) |
| 528 | (overlay-put ol 'field 'pcomplete) | ||
| 529 | (unwind-protect | ||
| 530 | (call-interactively 'minibuffer-complete) | ||
| 531 | (delete-overlay ol)))))) | ||
| 532 | 528 | ||
| 533 | ;;; Pcomplete's native UI. | 529 | ;;; Pcomplete's native UI. |
| 534 | 530 | ||
diff --git a/lisp/simple.el b/lisp/simple.el index 60d47e733cd..87e65eebce8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -6479,6 +6479,7 @@ saving the value of `buffer-invisibility-spec' and setting it to nil." | |||
| 6479 | (setq buffer-invisibility-spec nil))) | 6479 | (setq buffer-invisibility-spec nil))) |
| 6480 | 6480 | ||
| 6481 | ;; Partial application of functions (similar to "currying"). | 6481 | ;; Partial application of functions (similar to "currying"). |
| 6482 | ;; This function is here rather than in subr.el because it uses CL. | ||
| 6482 | (defun apply-partially (fun &rest args) | 6483 | (defun apply-partially (fun &rest args) |
| 6483 | "Return a function that is a partial application of FUN to ARGS. | 6484 | "Return a function that is a partial application of FUN to ARGS. |
| 6484 | ARGS is a list of the first N arguments to pass to FUN. | 6485 | ARGS is a list of the first N arguments to pass to FUN. |
| @@ -6487,6 +6488,52 @@ the first N arguments are fixed at the values with which this function | |||
| 6487 | was called." | 6488 | was called." |
| 6488 | (lexical-let ((fun fun) (args1 args)) | 6489 | (lexical-let ((fun fun) (args1 args)) |
| 6489 | (lambda (&rest args2) (apply fun (append args1 args2))))) | 6490 | (lambda (&rest args2) (apply fun (append args1 args2))))) |
| 6491 | |||
| 6492 | ;; This function is here rather than in subr.el because it uses CL. | ||
| 6493 | (defmacro with-wrapper-hook (var args &rest body) | ||
| 6494 | "Run BODY wrapped with the VAR hook. | ||
| 6495 | VAR is a special hook: its functions are called with a first argument | ||
| 6496 | which is the \"original\" code (the BODY), so the hook function can wrap | ||
| 6497 | the original function, or call it any number of times (including not calling | ||
| 6498 | it at all). This is similar to an `around' advice. | ||
| 6499 | VAR is normally a symbol (a variable) in which case it is treated like | ||
| 6500 | a hook, with a buffer-local and a global part. But it can also be an | ||
| 6501 | arbitrary expression. | ||
| 6502 | ARGS is a list of variables which will be passed as additional arguments | ||
| 6503 | to each function, after the inital argument, and which the first argument | ||
| 6504 | expects to receive when called." | ||
| 6505 | (declare (indent 2) (debug t)) | ||
| 6506 | ;; We need those two gensyms because CL's lexical scoping is not available | ||
| 6507 | ;; for function arguments :-( | ||
| 6508 | (let ((funs (make-symbol "funs")) | ||
| 6509 | (global (make-symbol "global")) | ||
| 6510 | (argssym (make-symbol "args"))) | ||
| 6511 | ;; Since the hook is a wrapper, the loop has to be done via | ||
| 6512 | ;; recursion: a given hook function will call its parameter in order to | ||
| 6513 | ;; continue looping. | ||
| 6514 | `(labels ((runrestofhook (,funs ,global ,argssym) | ||
| 6515 | ;; `funs' holds the functions left on the hook and `global' | ||
| 6516 | ;; holds the functions left on the global part of the hook | ||
| 6517 | ;; (in case the hook is local). | ||
| 6518 | (lexical-let ((funs ,funs) | ||
| 6519 | (global ,global)) | ||
| 6520 | (if (consp funs) | ||
| 6521 | (if (eq t (car funs)) | ||
| 6522 | (apply 'runrestofhook | ||
| 6523 | (append global (cdr funs)) nil ,argssym) | ||
| 6524 | (apply (car funs) | ||
| 6525 | (lambda (&rest args) | ||
| 6526 | (runrestofhook (cdr funs) global args)) | ||
| 6527 | ,argssym)) | ||
| 6528 | ;; Once there are no more functions on the hook, run | ||
| 6529 | ;; the original body. | ||
| 6530 | (apply (lambda ,args ,@body) ,argssym))))) | ||
| 6531 | (runrestofhook ,var | ||
| 6532 | ;; The global part of the hook, if any. | ||
| 6533 | ,(if (symbolp var) | ||
| 6534 | `(if (local-variable-p ',var) | ||
| 6535 | (default-value ',var))) | ||
| 6536 | (list ,@args))))) | ||
| 6490 | 6537 | ||
| 6491 | ;; Minibuffer prompt stuff. | 6538 | ;; Minibuffer prompt stuff. |
| 6492 | 6539 | ||