* 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.
This commit is contained in:
Stefan Monnier 2009-11-19 03:12:51 +00:00
parent 87e32266f0
commit a185548b1c
6 changed files with 92 additions and 66 deletions

View file

@ -299,6 +299,9 @@ the variable `byte-compile-compatibility') has been removed.
* 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

View file

@ -392,43 +392,6 @@ See `define-abbrev' for the effect of some special properties.
\(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 @@ Effective when explicitly called even when `abbrev-mode' is nil.
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

View file

@ -647,17 +647,11 @@ considered."
;; 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

View file

@ -1022,10 +1022,33 @@ variables.")
(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)

View file

@ -513,22 +513,18 @@ Same as `pcomplete' but using the standard completion UI."
(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.

View file

@ -6479,6 +6479,7 @@ saving the value of `buffer-invisibility-spec' and setting it to nil."
(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 @@ the first N arguments are fixed at the values with which this function
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.