* 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:
parent
87e32266f0
commit
a185548b1c
6 changed files with 92 additions and 66 deletions
3
etc/NEWS
3
etc/NEWS
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue