mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
* lisp/minibuffer.el (completion--all-sorted-completions-location): New var.
(completion--cache-all-sorted-completions) (completion--flush-all-sorted-completions): Use it. (completion-in-region, completion-in-region--postch) (completion-at-point, completion-help-at-point): Use markers in completion-in-region--data. Fixes: debbugs:12619
This commit is contained in:
Stefan Monnier
parent
9eadb1a907
commit
d92df117f9
@ -1,3 +1,12 @@
|
||||
2012-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* minibuffer.el (completion--all-sorted-completions-location): New var.
|
||||
(completion--cache-all-sorted-completions)
|
||||
(completion--flush-all-sorted-completions): Use it.
|
||||
(completion-in-region, completion-in-region--postch)
|
||||
(completion-at-point, completion-help-at-point): Use markers in
|
||||
completion-in-region--data (bug#12619).
|
||||
|
||||
2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* progmodes/compile.el (compilation-start): Try to handle common
|
||||
|
||||
@ -871,6 +871,7 @@ completion candidates than this number."
|
||||
|
||||
(defvar completion-all-sorted-completions nil)
|
||||
(make-variable-buffer-local 'completion-all-sorted-completions)
|
||||
(defvar-local completion--all-sorted-completions-location nil)
|
||||
(defvar completion-cycling nil)
|
||||
|
||||
(defvar completion-fail-discreetly nil
|
||||
@ -1048,14 +1049,19 @@ scroll the window of possible completions."
|
||||
|
||||
(defun completion--cache-all-sorted-completions (comps)
|
||||
(add-hook 'after-change-functions
|
||||
'completion--flush-all-sorted-completions nil t)
|
||||
'completion--flush-all-sorted-completions nil t)
|
||||
(setq completion--all-sorted-completions-location
|
||||
(cons (copy-marker (field-beginning)) (copy-marker (field-end))))
|
||||
(setq completion-all-sorted-completions comps))
|
||||
|
||||
(defun completion--flush-all-sorted-completions (&rest _ignore)
|
||||
(remove-hook 'after-change-functions
|
||||
'completion--flush-all-sorted-completions t)
|
||||
(setq completion-cycling nil)
|
||||
(setq completion-all-sorted-completions nil))
|
||||
(defun completion--flush-all-sorted-completions (&rest start end len)
|
||||
(unless (and start end
|
||||
(or (> start (cdr completion--all-sorted-completions-location))
|
||||
(< end (car completion--all-sorted-completions-location))))
|
||||
(remove-hook 'after-change-functions
|
||||
'completion--flush-all-sorted-completions t)
|
||||
(setq completion-cycling nil)
|
||||
(setq completion-all-sorted-completions nil)))
|
||||
|
||||
(defun completion--metadata (string base md-at-point table pred)
|
||||
;; Like completion-metadata, but for the specific case of getting the
|
||||
@ -1758,7 +1764,10 @@ exit."
|
||||
(when completion-in-region-mode-predicate
|
||||
(completion-in-region-mode 1)
|
||||
(setq completion-in-region--data
|
||||
(list (current-buffer) start end collection)))
|
||||
(list (if (markerp start) start (copy-marker start))
|
||||
(copy-marker end) collection)))
|
||||
;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
|
||||
;; than the other way around!
|
||||
(unwind-protect
|
||||
(call-interactively 'minibuffer-complete)
|
||||
(delete-overlay ol)))))
|
||||
@ -1782,12 +1791,12 @@ exit."
|
||||
(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)
|
||||
(and (eq (marker-buffer (nth 0 completion-in-region--data))
|
||||
(current-buffer))
|
||||
(>= (point) (nth 1 completion-in-region--data))
|
||||
(>= (point) (nth 0 completion-in-region--data))
|
||||
(<= (point)
|
||||
(save-excursion
|
||||
(goto-char (nth 2 completion-in-region--data))
|
||||
(goto-char (nth 1 completion-in-region--data))
|
||||
(line-end-position)))
|
||||
(funcall completion-in-region-mode--predicate)))
|
||||
(completion-in-region-mode -1)))
|
||||
@ -1892,17 +1901,19 @@ The completion method is determined by `completion-at-point-functions'."
|
||||
(let ((res (run-hook-wrapped 'completion-at-point-functions
|
||||
#'completion--capf-wrapper 'all)))
|
||||
(pcase res
|
||||
(`(,_ . ,(and (pred functionp) f)) (funcall f))
|
||||
(`(,hookfun . (,start ,end ,collection . ,plist))
|
||||
(let* ((completion-extra-properties plist)
|
||||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(eq (car-safe (funcall hookfun)) start))))
|
||||
(completion-in-region start end collection
|
||||
(plist-get plist :predicate))))
|
||||
;; Maybe completion already happened and the function returned t.
|
||||
(_ (cdr res)))))
|
||||
(`(,_ . ,(and (pred functionp) f)) (funcall f))
|
||||
(`(,hookfun . (,start ,end ,collection . ,plist))
|
||||
(unless (markerp start) (setq start (copy-marker start)))
|
||||
(let* ((completion-extra-properties plist)
|
||||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(let ((newstart (car-safe (funcall hookfun))))
|
||||
(and newstart (= newstart start))))))
|
||||
(completion-in-region start end collection
|
||||
(plist-get plist :predicate))))
|
||||
;; Maybe completion already happened and the function returned t.
|
||||
(_ (cdr res)))))
|
||||
|
||||
(defun completion-help-at-point ()
|
||||
"Display the completions on the text around point.
|
||||
@ -1914,32 +1925,34 @@ The completion method is determined by `completion-at-point-functions'."
|
||||
(pcase res
|
||||
(`(,_ . ,(and (pred functionp) f))
|
||||
(message "Don't know how to show completions for %S" f))
|
||||
(`(,hookfun . (,start ,end ,collection . ,plist))
|
||||
(let* ((minibuffer-completion-table collection)
|
||||
(minibuffer-completion-predicate (plist-get plist :predicate))
|
||||
(completion-extra-properties plist)
|
||||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(eq (car-safe (funcall hookfun)) start)))
|
||||
(ol (make-overlay start end 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)
|
||||
(overlay-put ol 'priority 100)
|
||||
(completion-in-region-mode 1)
|
||||
(setq completion-in-region--data
|
||||
(list (current-buffer) start end collection))
|
||||
(unwind-protect
|
||||
(call-interactively 'minibuffer-completion-help)
|
||||
(delete-overlay ol))))
|
||||
(`(,hookfun . ,_)
|
||||
;; The hook function already performed completion :-(
|
||||
;; Not much we can do at this point.
|
||||
(message "%s already performed completion!" hookfun)
|
||||
nil)
|
||||
(_ (message "Nothing to complete at point")))))
|
||||
(`(,hookfun . (,start ,end ,collection . ,plist))
|
||||
(unless (markerp start) (setq start (copy-marker start)))
|
||||
(let* ((minibuffer-completion-table collection)
|
||||
(minibuffer-completion-predicate (plist-get plist :predicate))
|
||||
(completion-extra-properties plist)
|
||||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(let ((newstart (car-safe (funcall hookfun))))
|
||||
(and newstart (= newstart start)))))
|
||||
(ol (make-overlay start end 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)
|
||||
(overlay-put ol 'priority 100)
|
||||
(completion-in-region-mode 1)
|
||||
(setq completion-in-region--data
|
||||
(list start (copy-marker end) collection))
|
||||
(unwind-protect
|
||||
(call-interactively 'minibuffer-completion-help)
|
||||
(delete-overlay ol))))
|
||||
(`(,hookfun . ,_)
|
||||
;; The hook function already performed completion :-(
|
||||
;; Not much we can do at this point.
|
||||
(message "%s already performed completion!" hookfun)
|
||||
nil)
|
||||
(_ (message "Nothing to complete at point")))))
|
||||
|
||||
;;; Key bindings.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user