Mercurial > emacs
changeset 106109:42ca82b4620b
* 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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 19 Nov 2009 03:12:51 +0000 |
| parents | 48d6337584da |
| children | a674c104db3d |
| files | etc/NEWS lisp/abbrev.el lisp/emacs-lisp/lisp.el lisp/minibuffer.el lisp/pcomplete.el lisp/simple.el |
| diffstat | 6 files changed, 92 insertions(+), 66 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Thu Nov 19 01:40:22 2009 +0000 +++ b/etc/NEWS Thu Nov 19 03:12:51 2009 +0000 @@ -299,6 +299,9 @@ * Lisp changes in Emacs 23.2 +** New function `completion-in-region' to use the standard completion +facilities on a particular region of text. + ** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. ** read-file-name-predicate is obsolete. It was used to pass the predicate
--- a/lisp/abbrev.el Thu Nov 19 01:40:22 2009 +0000 +++ b/lisp/abbrev.el Thu Nov 19 03:12:51 2009 +0000 @@ -392,43 +392,6 @@ \(fn ABBREV PROP VAL)") -(defmacro abbrev-with-wrapper-hook (var &rest body) - "Run BODY wrapped with the VAR hook. -VAR is a special hook: its functions are called with one argument which -is the \"original\" code (the BODY), so the hook function can wrap the -original function, can call it several times, or even not call it at all. -VAR is normally a symbol (a variable) in which case it is treated like a hook, -with a buffer-local and a global part. But it can also be an arbitrary expression. -This is similar to an `around' advice." - (declare (indent 1) (debug t)) - ;; We need those two gensyms because CL's lexical scoping is not available - ;; for function arguments :-( - (let ((funs (make-symbol "funs")) - (global (make-symbol "global"))) - ;; Since the hook is a wrapper, the loop has to be done via - ;; recursion: a given hook function will call its parameter in order to - ;; continue looping. - `(labels ((runrestofhook (,funs ,global) - ;; `funs' holds the functions left on the hook and `global' - ;; holds the functions left on the global part of the hook - ;; (in case the hook is local). - (lexical-let ((funs ,funs) - (global ,global)) - (if (consp funs) - (if (eq t (car funs)) - (runrestofhook (append global (cdr funs)) nil) - (funcall (car funs) - (lambda () (runrestofhook (cdr funs) global)))) - ;; Once there are no more functions on the hook, run - ;; the original body. - ,@body)))) - (runrestofhook ,var - ;; The global part of the hook, if any. - ,(if (symbolp var) - `(if (local-variable-p ',var) - (default-value ',var))))))) - - ;;; Code that used to be implemented in src/abbrev.c (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table @@ -799,7 +762,7 @@ Returns the abbrev symbol, if expansion took place." (interactive) (run-hooks 'pre-abbrev-expand-hook) - (abbrev-with-wrapper-hook abbrev-expand-functions + (with-wrapper-hook abbrev-expand-functions () (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym
--- a/lisp/emacs-lisp/lisp.el Thu Nov 19 01:40:22 2009 +0000 +++ b/lisp/emacs-lisp/lisp.el Thu Nov 19 03:12:51 2009 +0000 @@ -647,17 +647,11 @@ ;; Maybe a `let' varlist or something. nil ;; Else, we assume that a function name is expected. - 'fboundp))))) - (ol (make-overlay beg end nil nil t))) - (overlay-put ol 'field 'completion) + 'fboundp)))))) (let ((completion-annotate-function (unless (eq predicate 'fboundp) - (lambda (str) (if (fboundp (intern-soft str)) " <f>")))) - (minibuffer-completion-table obarray) - (minibuffer-completion-predicate predicate)) - (unwind-protect - (call-interactively 'minibuffer-complete) - (delete-overlay ol))))) + (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))) + (completion-in-region beg end obarray predicate)))) ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e ;;; lisp.el ends here
--- a/lisp/minibuffer.el Thu Nov 19 01:40:22 2009 +0000 +++ b/lisp/minibuffer.el Thu Nov 19 03:12:51 2009 +0000 @@ -1022,10 +1022,33 @@ (ding)) (exit-minibuffer)) -;;; Key bindings. +(defvar completion-in-region-functions nil + "Wrapper hook around `complete-in-region'. +The functions on this special hook are called with 5 arguments: + NEXT-FUN START END COLLECTION PREDICATE. +NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE) +that performs the default operation. The other four argument are like +the ones passed to `complete-in-region'. The functions on this hook +are expected to perform completion on START..END using COLLECTION +and PREDICATE, either by calling NEXT-FUN or by doing it themselves.") -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") +(defun completion-in-region (start end collection &optional predicate) + "Complete the text between START and END using COLLECTION. +Point needs to be somewhere between START and END." + ;; FIXME: some callers need to setup completion-ignore-case, + ;; completion-ignored-extensions. The latter can be embedded in the + ;; completion tables, but the first cannot (actually, maybe it should). + (assert (<= start (point)) (<= (point) end)) + ;; FIXME: undisplay the *Completions* buffer once the completion is done. + (with-wrapper-hook + completion-in-region-functions (start end collection predicate) + (let ((minibuffer-completion-table collection) + (minibuffer-completion-predicate predicate) + (ol (make-overlay start end nil nil t))) + (overlay-put ol 'field 'completion) + (unwind-protect + (call-interactively 'minibuffer-complete) + (delete-overlay ol))))) (let ((map minibuffer-local-map)) (define-key map "\C-g" 'abort-recursive-edit)
--- a/lisp/pcomplete.el Thu Nov 19 01:40:22 2009 +0000 +++ b/lisp/pcomplete.el Thu Nov 19 03:12:51 2009 +0000 @@ -513,22 +513,18 @@ (directory-file-name f)) pcomplete-seen)))))) - (let ((ol (make-overlay beg (point) nil nil t)) - (minibuffer-completion-table - ;; Add a space at the end of completion. Use a terminator-regexp - ;; that never matches since the terminator cannot appear - ;; within the completion field anyway. - (if (zerop (length pcomplete-termination-string)) - table - (apply-partially 'completion-table-with-terminator - (cons pcomplete-termination-string - "\\`a\\`") - table))) - (minibuffer-completion-predicate pred)) - (overlay-put ol 'field 'pcomplete) - (unwind-protect - (call-interactively 'minibuffer-complete) - (delete-overlay ol)))))) + (completion-in-region + beg (point) + ;; Add a space at the end of completion. Use a terminator-regexp + ;; that never matches since the terminator cannot appear + ;; within the completion field anyway. + (if (zerop (length pcomplete-termination-string)) + table + (apply-partially 'completion-table-with-terminator + (cons pcomplete-termination-string + "\\`a\\`") + table)) + pred)))) ;;; Pcomplete's native UI.
--- a/lisp/simple.el Thu Nov 19 01:40:22 2009 +0000 +++ b/lisp/simple.el Thu Nov 19 03:12:51 2009 +0000 @@ -6479,6 +6479,7 @@ (setq buffer-invisibility-spec nil))) ;; Partial application of functions (similar to "currying"). +;; This function is here rather than in subr.el because it uses CL. (defun apply-partially (fun &rest args) "Return a function that is a partial application of FUN to ARGS. ARGS is a list of the first N arguments to pass to FUN. @@ -6487,6 +6488,52 @@ was called." (lexical-let ((fun fun) (args1 args)) (lambda (&rest args2) (apply fun (append args1 args2))))) + +;; This function is here rather than in subr.el because it uses CL. +(defmacro with-wrapper-hook (var args &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with a first argument +which is the \"original\" code (the BODY), so the hook function can wrap +the original function, or call it any number of times (including not calling +it at all). This is similar to an `around' advice. +VAR is normally a symbol (a variable) in which case it is treated like +a hook, with a buffer-local and a global part. But it can also be an +arbitrary expression. +ARGS is a list of variables which will be passed as additional arguments +to each function, after the inital argument, and which the first argument +expects to receive when called." + (declare (indent 2) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global")) + (argssym (make-symbol "args"))) + ;; Since the hook is a wrapper, the loop has to be done via + ;; recursion: a given hook function will call its parameter in order to + ;; continue looping. + `(labels ((runrestofhook (,funs ,global ,argssym) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (lexical-let ((funs ,funs) + (global ,global)) + (if (consp funs) + (if (eq t (car funs)) + (apply 'runrestofhook + (append global (cdr funs)) nil ,argssym) + (apply (car funs) + (lambda (&rest args) + (runrestofhook (cdr funs) global args)) + ,argssym)) + ;; Once there are no more functions on the hook, run + ;; the original body. + (apply (lambda ,args ,@body) ,argssym))))) + (runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))) + (list ,@args))))) ;; Minibuffer prompt stuff.