(completion-in-region): Pop down *Completions* automatically.
* lisp/minibuffer.el (completion-table-dynamic): Optimize `boundaries'. (completion-in-region-mode): New minor mode. (completion-in-region): Use it. (completion-in-region--data, completion-in-region-mode-map): New vars. (completion-in-region--postch): New function. (completion--capf-misbehave-funs, completion--capf-safe-funs): New vars. (completion--capf-wrapper): New function. (completion-at-point): Use it to track well-behavedness of hook functions. (completion-help-at-point): New command.
This commit is contained in:
parent
f3e4086c9d
commit
3e2d70fd42
3 changed files with 157 additions and 12 deletions
3
etc/NEWS
3
etc/NEWS
|
@ -67,6 +67,9 @@ from load-path. -Q now implies this.
|
|||
|
||||
* Changes in Emacs 24.1
|
||||
|
||||
** Completion in a non-minibuffer now tries to detect the end of completion
|
||||
and pops down the *Completions* buffer accordingly.
|
||||
|
||||
** emacsclient changes
|
||||
|
||||
*** New emacsclient argument --parent-id ID can be used to open a
|
||||
|
|
|
@ -1,3 +1,17 @@
|
|||
2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* minibuffer.el (completion-table-dynamic): Optimize `boundaries'.
|
||||
(completion-in-region-mode): New minor mode.
|
||||
(completion-in-region): Use it.
|
||||
(completion-in-region--data, completion-in-region-mode-map): New vars.
|
||||
(completion-in-region--postch): New function.
|
||||
(completion--capf-misbehave-funs, completion--capf-safe-funs):
|
||||
New vars.
|
||||
(completion--capf-wrapper): New function.
|
||||
(completion-at-point): Use it to track well-behavedness of
|
||||
hook functions.
|
||||
(completion-help-at-point): New command.
|
||||
|
||||
2011-03-30 Jason Merrill <jason@redhat.com> (tiny change)
|
||||
|
||||
* vc/add-log.el (add-change-log-entry): Don't use whitespace
|
||||
|
|
|
@ -173,10 +173,14 @@ that can be used as the COLLECTION argument to `try-completion' and
|
|||
`all-completions'. See Info node `(elisp)Programmed Completion'."
|
||||
(lexical-let ((fun fun))
|
||||
(lambda (string pred action)
|
||||
(with-current-buffer (let ((win (minibuffer-selected-window)))
|
||||
(if (window-live-p win) (window-buffer win)
|
||||
(current-buffer)))
|
||||
(complete-with-action action (funcall fun string) string pred)))))
|
||||
(if (eq (car-safe action) 'boundaries)
|
||||
;; `fun' is not supposed to return another function but a plain old
|
||||
;; completion table, whose boundaries are always trivial.
|
||||
nil
|
||||
(with-current-buffer (let ((win (minibuffer-selected-window)))
|
||||
(if (window-live-p win) (window-buffer win)
|
||||
(current-buffer)))
|
||||
(complete-with-action action (funcall fun string) string pred))))))
|
||||
|
||||
(defmacro lazy-completion-table (var fun)
|
||||
"Initialize variable VAR as a lazy completion table.
|
||||
|
@ -240,6 +244,10 @@ in which case TERMINATOR-REGEXP is a regular expression whose submatch
|
|||
number 1 should match TERMINATOR. This is used when there is a need to
|
||||
distinguish occurrences of the TERMINATOR strings which are really terminators
|
||||
from others (e.g. escaped)."
|
||||
;; FIXME: This implementation is not right since it only adds the terminator
|
||||
;; in try-completion, so any completion-style that builds the completion via
|
||||
;; all-completions won't get the terminator, and selecting an entry in
|
||||
;; *Completions* won't get the terminator added either.
|
||||
(cond
|
||||
((eq (car-safe action) 'boundaries)
|
||||
(let* ((suffix (cdr action))
|
||||
|
@ -716,6 +724,8 @@ scroll the window of possible completions."
|
|||
(< (or s1 (length c1))
|
||||
(or s2 (length c2))))))))
|
||||
;; Prefer recently used completions.
|
||||
;; FIXME: Additional sorting ideas:
|
||||
;; - for M-x, prefer commands that have no key binding.
|
||||
(let ((hist (symbol-value minibuffer-history-variable)))
|
||||
(setq all (sort all (lambda (c1 c2)
|
||||
(> (length (member c1 hist))
|
||||
|
@ -1008,8 +1018,8 @@ It also eliminates runs of equal strings."
|
|||
;; a space displayed.
|
||||
(set-text-properties (- (point) 1) (point)
|
||||
;; We can't just set tab-width, because
|
||||
;; completion-setup-function will kill all
|
||||
;; local variables :-(
|
||||
;; completion-setup-function will kill
|
||||
;; all local variables :-(
|
||||
`(display (space :align-to ,column)))
|
||||
nil))))
|
||||
(if (not (consp str))
|
||||
|
@ -1237,6 +1247,8 @@ the ones passed to `completion-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.")
|
||||
|
||||
(defvar completion-in-region--data nil)
|
||||
|
||||
(defun completion-in-region (start end collection &optional predicate)
|
||||
"Complete the text between START and END using COLLECTION.
|
||||
Return nil if there is no valid completion, else t.
|
||||
|
@ -1251,15 +1263,78 @@ Point needs to be somewhere between START and END."
|
|||
(minibuffer-completion-predicate predicate)
|
||||
(ol (make-overlay start end nil nil t)))
|
||||
(overlay-put ol 'field 'completion)
|
||||
(completion-in-region-mode 1)
|
||||
(setq completion-in-region--data
|
||||
(list (current-buffer) start end collection))
|
||||
(unwind-protect
|
||||
(call-interactively 'minibuffer-complete)
|
||||
(delete-overlay ol)))))
|
||||
|
||||
(defvar completion-in-region-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "?" 'completion-help-at-point)
|
||||
(define-key map "\t" 'completion-at-point)
|
||||
map)
|
||||
"Keymap activated during `completion-in-region'.")
|
||||
|
||||
;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
|
||||
;; the *Completions*).
|
||||
;; - lisp-mode: never.
|
||||
;; - comint: only do it if you hit SPC at the right time.
|
||||
;; - pcomplete: pop it down on SPC or after some time-delay.
|
||||
;; - semantic: use a post-command-hook check similar to this one.
|
||||
(defun completion-in-region--postch ()
|
||||
(message "completion-in-region--postch: cmd=%s" this-command)
|
||||
(or unread-command-events ;Don't pop down the completions in the middle of
|
||||
;mouse-drag-region/mouse-set-point.
|
||||
(and completion-in-region--data
|
||||
(and (eq (car completion-in-region--data)
|
||||
(current-buffer))
|
||||
(>= (point) (nth 1 completion-in-region--data))
|
||||
(<= (point)
|
||||
(save-excursion
|
||||
(goto-char (nth 2 completion-in-region--data))
|
||||
(line-end-position)))
|
||||
(let ((comp-data (run-hook-wrapped
|
||||
'completion-at-point-functions
|
||||
;; Only use the known-safe functions.
|
||||
#'completion--capf-wrapper 'safe)))
|
||||
(eq (car comp-data)
|
||||
;; We're still in the same completion field.
|
||||
(nth 1 completion-in-region--data)))))
|
||||
(completion-in-region-mode -1)))
|
||||
|
||||
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
|
||||
|
||||
(define-minor-mode completion-in-region-mode
|
||||
"Transient minor mode used during `completion-in-region'."
|
||||
:global t
|
||||
(setq completion-in-region--data nil)
|
||||
;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
|
||||
(remove-hook 'post-command-hook #'completion-in-region--postch)
|
||||
(setq minor-mode-overriding-map-alist
|
||||
(delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
|
||||
minor-mode-overriding-map-alist))
|
||||
(if (null completion-in-region-mode)
|
||||
(progn
|
||||
(unless (equal "*Completions*" (buffer-name (window-buffer)))
|
||||
(minibuffer-hide-completions))
|
||||
(message "Leaving completion-in-region-mode"))
|
||||
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
|
||||
(add-hook 'post-command-hook #'completion-in-region--postch)
|
||||
(push `(completion-in-region-mode . ,completion-in-region-mode-map)
|
||||
minor-mode-overriding-map-alist)))
|
||||
|
||||
;; Define-minor-mode added our keymap to minor-mode-map-alist, but we want it
|
||||
;; on minor-mode-overriding-map-alist instead.
|
||||
(setq minor-mode-map-alist
|
||||
(delq (assq 'completion-in-region-mode minor-mode-map-alist)
|
||||
minor-mode-map-alist))
|
||||
|
||||
(defvar completion-at-point-functions '(tags-completion-at-point-function)
|
||||
"Special hook to find the completion table for the thing at point.
|
||||
Each function on this hook is called in turns without any argument and should
|
||||
return either nil to mean that it is not applicable at point,
|
||||
or t to mean that it already performed completion (discouraged),
|
||||
or a function of no argument to perform completion (discouraged),
|
||||
or a list of the form (START END COLLECTION &rest PROPS) where
|
||||
START and END delimit the entity to complete and should include point,
|
||||
|
@ -1269,12 +1344,34 @@ Currently supported properties are:
|
|||
`:predicate' a predicate that completion candidates need to satisfy.
|
||||
`:annotation-function' the value to use for `completion-annotate-function'.")
|
||||
|
||||
(defvar completion--capf-misbehave-funs nil
|
||||
"List of functions found on `completion-at-point-functions' that misbehave.")
|
||||
(defvar completion--capf-safe-funs nil
|
||||
"List of well-behaved functions found on `completion-at-point-functions'.")
|
||||
|
||||
(defun completion--capf-wrapper (fun which)
|
||||
(if (case which
|
||||
(all t)
|
||||
(safe (member fun completion--capf-safe-funs))
|
||||
(optimist (not (member fun completion--capf-misbehave-funs))))
|
||||
(let ((res (funcall fun)))
|
||||
(cond
|
||||
((consp res)
|
||||
(unless (member fun completion--capf-safe-funs)
|
||||
(push fun completion--capf-safe-funs)))
|
||||
((not (or (listp res) (functionp res)))
|
||||
(unless (member fun completion--capf-misbehave-funs)
|
||||
(message
|
||||
"Completion function %S uses a deprecated calling convention" fun)
|
||||
(push fun completion--capf-misbehave-funs))))
|
||||
res)))
|
||||
|
||||
(defun completion-at-point ()
|
||||
"Perform completion on the text around point.
|
||||
The completion method is determined by `completion-at-point-functions'."
|
||||
(interactive)
|
||||
(let ((res (run-hook-with-args-until-success
|
||||
'completion-at-point-functions)))
|
||||
(let ((res (run-hook-wrapped 'completion-at-point-functions
|
||||
#'completion--capf-wrapper 'all)))
|
||||
(cond
|
||||
((functionp res) (funcall res))
|
||||
((consp res)
|
||||
|
@ -1288,6 +1385,37 @@ The completion method is determined by `completion-at-point-functions'."
|
|||
(plist-get plist :predicate))))
|
||||
(res)))) ;Maybe completion already happened and the function returned t.
|
||||
|
||||
(defun completion-help-at-point ()
|
||||
"Display the completions on the text around point.
|
||||
The completion method is determined by `completion-at-point-functions'."
|
||||
(interactive)
|
||||
(let ((res (run-hook-wrapped 'completion-at-point-functions
|
||||
;; Ignore misbehaving functions.
|
||||
#'completion--capf-wrapper 'optimist)))
|
||||
(cond
|
||||
((functionp res)
|
||||
(message "Don't know how to show completions for %S" res))
|
||||
((consp res)
|
||||
(let* ((plist (nthcdr 3 res))
|
||||
(minibuffer-completion-table (nth 2 res))
|
||||
(minibuffer-completion-predicate (plist-get plist :predicate))
|
||||
(completion-annotate-function
|
||||
(or (plist-get plist :annotation-function)
|
||||
completion-annotate-function))
|
||||
(ol (make-overlay (nth 0 res) (nth 1 res) nil nil t)))
|
||||
;; FIXME: We should somehow (ab)use completion-in-region-function or
|
||||
;; introduce a corresponding hook (plus another for word-completion,
|
||||
;; and another for force-completion, maybe?).
|
||||
(overlay-put ol 'field 'completion)
|
||||
(unwind-protect
|
||||
(call-interactively 'minibuffer-completion-help)
|
||||
(delete-overlay ol))))
|
||||
(res
|
||||
;; The hook function already performed completion :-(
|
||||
;; Not much we can do at this point.
|
||||
nil)
|
||||
(t (message "Nothing to complete at point")))))
|
||||
|
||||
;;; Key bindings.
|
||||
|
||||
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
|
||||
|
@ -1910,9 +2038,9 @@ or a symbol chosen among `any', `star', `point', `prefix'."
|
|||
(append (completion-pcm--string->pattern prefix)
|
||||
'(point)
|
||||
(completion-pcm--string->pattern suffix)))
|
||||
(let ((pattern nil)
|
||||
(p 0)
|
||||
(p0 0))
|
||||
(let* ((pattern nil)
|
||||
(p 0)
|
||||
(p0 p))
|
||||
|
||||
(while (and (setq p (string-match completion-pcm--delim-wild-regex
|
||||
string p))
|
||||
|
|
Loading…
Add table
Reference in a new issue