Commit d5e63715 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Replace completion-base-size by completion-base-position to fix bugs

such as (bug#4699).
* simple.el (completion-base-position): New var.
(completion-base-size): Mark as obsolete.
(choose-completion): Make it work for mouse events as well.
Pass the new base-position to choose-completion-string.
(choose-completion-guess-base-position): New function, extracted from
choose-completion-delete-max-match.
(choose-completion-delete-max-match): Use it.  Make obsolete.
(choose-completion-string): Use the new base-position info.
(completion-root-regexp): Delete.
(completion-setup-function): Preserve completion-base-position.
Eliminate obsolete base-size manipulation.
* minibuffer.el (display-completion-list): Don't mess with base-size.
(minibuffer-completion-help): Set completion-base-position instead.
* mouse.el (mouse-choose-completion): Redefine as a mere alias to
choose-completion.
* textmodes/bibtex.el (bibtex-complete):
* emacs-lisp/crm.el (crm--choose-completion-string):
Adjust to new calling convention.
* complete.el (partial-completion-mode): Use minibufferp to avoid
bumping into incompatible change to choose-completion-string-functions.
* ido.el (ido-choose-completion-string): Make its calling convention
more permissive.
* comint.el (comint-dynamic-list-input-ring-select): Remove obsolete
base-size manipulation.
(comint-dynamic-list-input-ring): Use dotimes and push.
* iswitchb.el (iswitchb-completion-help): Remove dead-code call to
fundamental-mode.  Use `or'.
parent b0d6136e
......@@ -251,6 +251,12 @@ Command*'.
* Lisp changes in Emacs 23.2
** completion-base-size is obsoleted by completion-base-position.
This change causes a few backward incompatibilities, mostly with
choose-completion-string-functions where the `mini-p' argument has
been replaced by a `base-position' argument, and where the `base-size'
argument is now always nil.
** called-interactively-p now takes one argument and replaces interactive-p
which is now marked obsolete.
** New function set-advertised-calling-convention makes it possible
......
2009-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
Replace completion-base-size by completion-base-position to fix bugs
such as (bug#4699).
* simple.el (completion-base-position): New var.
(completion-base-size): Mark as obsolete.
(choose-completion): Make it work for mouse events as well.
Pass the new base-position to choose-completion-string.
(choose-completion-guess-base-position): New function, extracted from
choose-completion-delete-max-match.
(choose-completion-delete-max-match): Use it. Make obsolete.
(choose-completion-string): Use the new base-position info.
(completion-root-regexp): Delete.
(completion-setup-function): Preserve completion-base-position.
Eliminate obsolete base-size manipulation.
* minibuffer.el (display-completion-list): Don't mess with base-size.
(minibuffer-completion-help): Set completion-base-position instead.
* mouse.el (mouse-choose-completion): Redefine as a mere alias to
choose-completion.
* textmodes/bibtex.el (bibtex-complete):
* emacs-lisp/crm.el (crm--choose-completion-string):
Adjust to new calling convention.
* complete.el (partial-completion-mode): Use minibufferp to avoid
bumping into incompatible change to choose-completion-string-functions.
* ido.el (ido-choose-completion-string): Make its calling convention
more permissive.
* comint.el (comint-dynamic-list-input-ring-select): Remove obsolete
base-size manipulation.
(comint-dynamic-list-input-ring): Use dotimes and push.
* iswitchb.el (iswitchb-completion-help): Remove dead-code call to
fundamental-mode. Use `or'.
2009-10-14 Juri Linkov <juri@jurta.org>
* misearch.el (multi-isearch-next-buffer-from-list)
......
......@@ -968,7 +968,6 @@ See also `comint-read-input-ring'."
"Choose the input history entry that point is in or next to."
(interactive)
(let ((buffer completion-reference-buffer)
(base-size completion-base-size)
beg end completion)
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
(setq end (point) beg (1+ (point))))
......@@ -980,7 +979,7 @@ See also `comint-read-input-ring'."
(setq end (or (next-single-property-change end 'mouse-face) (point-max)))
(setq completion (buffer-substring beg end))
(set-window-configuration comint-dynamic-list-input-ring-window-conf)
(choose-completion-string completion buffer base-size)))
(choose-completion-string completion buffer)))
(defun comint-dynamic-list-input-ring ()
"List in help buffer the buffer's input history."
......@@ -993,9 +992,10 @@ See also `comint-read-input-ring'."
(index (1- (ring-length comint-input-ring)))
(conf (current-window-configuration)))
;; We have to build up a list ourselves from the ring vector.
(while (>= index 0)
(setq history (cons (ring-ref comint-input-ring index) history)
index (1- index)))
(dotimes (index (ring-length comint-input-ring))
(push (ring-ref comint-input-ring index) history))
;; Show them most-recent-first.
(setq history (nreverse history))
;; Change "completion" to "history reference"
;; to make the display accurate.
(with-output-to-temp-buffer history-buffer
......
......@@ -231,11 +231,11 @@ second TAB brings up the `*Completions*' buffer."
(funcall
(if partial-completion-mode 'add-hook 'remove-hook)
'choose-completion-string-functions
(lambda (choice buffer mini-p base-size)
(lambda (choice buffer &rest ignored)
;; When completing M-: (lisp- ) with point before the ), it is
;; not appropriate to go to point-max (unlike the filename case).
(if (and (not PC-goto-end)
mini-p)
(minibufferp buffer))
(goto-char (point-max))
;; Need a similar hack for the non-minibuffer-case -- gm.
(when PC-do-completion-end
......
......@@ -228,21 +228,16 @@ This function is modeled after `minibuffer-complete-and-exit'."
(forward-char 1))
(if doexit (exit-minibuffer))))
(defun crm--choose-completion-string (choice buffer mini-p base-size)
(defun crm--choose-completion-string (choice buffer base-position
&rest ignored)
"Completion string chooser for `completing-read-multiple'.
This is called from `choose-completion-string-functions'.
It replaces the string that is currently being completed, without
exiting the minibuffer."
(let ((ol (crm--select-current-element)))
(if base-size
(delete-region (+ base-size (field-beginning)) (point))
(choose-completion-delete-max-match choice))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer t)))
(set-window-point window (point)))))
(let ((completion-no-auto-exit t)
(choose-completion-string-functions nil))
(choose-completion-string choice buffer base-position)
t))
;; superemulates behavior of completing_read in src/minibuf.c
;;;###autoload
......
......@@ -3757,7 +3757,7 @@ for first matching file."
;; Return dotted pair (RES . 1).
(cons res 1))
(defun ido-choose-completion-string (choice buffer mini-p base-size)
(defun ido-choose-completion-string (choice &rest ignored)
(when (ido-active)
;; Insert the completion into the buffer where completion was requested.
(if (get-buffer ido-completion-buffer)
......
......@@ -2242,13 +2242,15 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
(defun quail-mouse-choose-completion (event)
"Click on an alternative in the `*Quail Completions*' buffer to choose it."
(interactive "e")
;; This function is an exact copy of the mouse.el function
;; `mouse-choose-completion' except that we:
;; 1) add two lines from `choose-completion' in simple.el to give
;; the `mouse-2' click a little more leeway.
;; 2) don't bury *Quail Completions* buffer, so comment a section, and
;; 3) delete/terminate the current quail selection here.
;; FIXME: Consolidate with `choose-completion'. The point number
;; 1 has been done, already. The point number 3 should be fairly
;; easy to move to a choose-completion-string-function. So all
;; that's left is point number 2.
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
......@@ -2288,6 +2290,7 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
;; previous implementation.
(defun quail-choose-completion-string (choice &optional buffer base-size)
(setq quail-current-str choice)
;; FIXME: We need to pass `base-position' here.
(choose-completion-string choice buffer))
(defun quail-build-decode-map (map-list key decode-map num
......
......@@ -1013,19 +1013,13 @@ Return the modified list with the last element prepended to it."
;; XEmacs extents are put on by default, doesn't seem to be
;; any way of switching them off.
(display-completion-list (if iswitchb-matches
iswitchb-matches
iswitchb-buflist)
(display-completion-list (or iswitchb-matches iswitchb-buflist)
:help-string "iswitchb "
:activate-callback
(lambda (x y z)
(message "doesn't work yet, sorry!")))
;; else running Emacs
(with-current-buffer standard-output
(fundamental-mode))
(display-completion-list (if iswitchb-matches
iswitchb-matches
iswitchb-buflist))))
(display-completion-list (or iswitchb-matches iswitchb-buflist))))
(setq iswitchb-common-match-inserted nil))))
;;; KILL CURRENT BUFFER
......
......@@ -871,19 +871,12 @@ the completions buffer."
(display-completion-list completions common-substring))
(princ (buffer-string)))
(let ((mainbuf (current-buffer)))
(with-current-buffer standard-output
(goto-char (point-max))
(if (null completions)
(insert "There are no possible completions of what you have typed.")
(insert "Possible completions are:\n")
(let ((last (last completions)))
;; Set base-size from the tail of the list.
(set (make-local-variable 'completion-base-size)
(or (cdr last)
(and (minibufferp mainbuf) 0)))
(setcdr last nil)) ; Make completions a properly nil-terminated list.
(completion--insert-strings completions)))))
(with-current-buffer standard-output
(goto-char (point-max))
(if (null completions)
(insert "There are no possible completions of what you have typed.")
(insert "Possible completions are:\n")
(completion--insert-strings completions))))
;; The hilit used to be applied via completion-setup-hook, so there
;; may still be some code that uses completion-common-substring.
......@@ -913,7 +906,8 @@ variables.")
"Display a list of possible completions of the current minibuffer contents."
(interactive)
(message "Making completion list...")
(let* ((string (field-string))
(let* ((start (field-beginning))
(string (field-string))
(completions (completion-all-completions
string
minibuffer-completion-table
......@@ -937,7 +931,13 @@ variables.")
(funcall completion-annotate-function s)))
(if ann (list s ann) s)))
completions)))
(display-completion-list (nconc completions base-size))))
(with-current-buffer standard-output
(set (make-local-variable 'completion-base-position)
;; FIXME: We should provide the END part as well, but
;; currently completion-all-completions does not give
;; us the necessary information.
(list (+ start base-size) nil)))
(display-completion-list completions)))
;; If there are no completions, or if the current input is already the
;; only possible completion, then hide (previous&stale) completions.
......
......@@ -2337,43 +2337,9 @@ and selects that window."
;;!! (- (car relative-coordinate) (current-column)) " "))
;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
;; Choose a completion with the mouse.
(define-obsolete-function-alias
'mouse-choose-completion 'choose-completion "23.2")
(defun mouse-choose-completion (event)
"Click on an alternative in the `*Completions*' buffer to choose it."
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
choice
base-size)
(save-excursion
(set-buffer (window-buffer (posn-window (event-start event))))
(if completion-reference-buffer
(setq buffer completion-reference-buffer))
(setq base-size completion-base-size)
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg end)
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
(setq end (point) beg (1+ (point))))
(if (null beg)
(error "No completion here"))
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
(setq choice (buffer-substring-no-properties beg end)))))
(let ((owindow (selected-window)))
(select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
(window-dedicated-p (selected-window)))
;; This is a special buffer's frame
(iconify-frame (selected-frame))
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window owindow))
(choose-completion-string choice buffer base-size)))
;; Font selection.
(defun font-menu-add-default ()
......
......@@ -5738,6 +5738,13 @@ Initial value is nil to avoid some compiler warnings.")
This also applies to other functions such as `choose-completion'
and `mouse-choose-completion'.")
(defvar completion-base-position nil
"Position of the base of the text corresponding to the shown completions.
This variable is used in the *Completions* buffers.
Its value is a list of the form (START END) where START is the place
where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.")
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
This is a local variable in the completion list buffer.
......@@ -5748,6 +5755,7 @@ Only characters in the field at point are included.
If nil, Emacs determines which part of the tail end of the
buffer's text is involved in completion by comparing the text
directly.")
(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
(defun delete-completion-window ()
"Delete the completion list window.
......@@ -5794,54 +5802,82 @@ With prefix argument N, move N items (negative N means move backward)."
(point) 'mouse-face nil beg))
(setq n (1+ n))))))
(defun choose-completion ()
"Choose the completion that point is in or next to."
(interactive)
(let (beg end completion (buffer completion-reference-buffer)
(base-size completion-base-size))
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
(setq end (point) beg (1+ (point))))
(if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
(setq end (1- (point)) beg (point)))
(if (null beg)
(error "No completion here"))
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face) (point-max)))
(setq completion (buffer-substring-no-properties beg end))
(defun choose-completion (&optional event)
"Choose the completion at point."
(interactive (list last-nonmenu-event))
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let (buffer base-size base-position choice)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(setq buffer completion-reference-buffer)
(setq base-size completion-base-size)
(setq base-position completion-base-position)
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg end)
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
(setq end (point) beg (1+ (point))))
(if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
(setq end (1- (point)) beg (point)))
(if (null beg)
(error "No completion here"))
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
(setq choice (buffer-substring-no-properties beg end)))))
(let ((owindow (selected-window)))
(select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
(window-dedicated-p owindow))
(window-dedicated-p (selected-window)))
;; This is a special buffer's frame
(iconify-frame (selected-frame))
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window
(or (and (buffer-live-p buffer)
(get-buffer-window buffer))
(get-buffer-window buffer 0))
owindow)))
(choose-completion-string completion buffer base-size)))
(choose-completion-string
choice buffer
(or base-position
(when base-size
;; Someone's using old completion code that doesn't know
;; about base-position yet.
(list (+ base-size (with-current-buffer buffer (field-beginning)))))
;; If all else fails, just guess.
(with-current-buffer buffer
(list (choose-completion-guess-base-position choice)))))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
(defun choose-completion-guess-base-position (string)
(save-excursion
(let ((opoint (point))
len)
;; Try moving back by the length of the string.
(goto-char (max (- (point) (length string))
(minibuffer-prompt-end)))
;; See how far back we were actually able to move. That is the
;; upper bound on how much we can match and delete.
(setq len (- opoint (point)))
(if completion-ignore-case
(setq string (downcase string)))
(while (and (> len 0)
(let ((tail (buffer-substring (point) opoint)))
(if completion-ignore-case
(setq tail (downcase tail)))
(not (string= tail (substring string 0 len)))))
(setq len (1- len))
(forward-char 1))
(point))))
(defun choose-completion-delete-max-match (string)
(let ((opoint (point))
len)
;; Try moving back by the length of the string.
(goto-char (max (- (point) (length string))
(minibuffer-prompt-end)))
;; See how far back we were actually able to move. That is the
;; upper bound on how much we can match and delete.
(setq len (- opoint (point)))
(if completion-ignore-case
(setq string (downcase string)))
(while (and (> len 0)
(let ((tail (buffer-substring (point) opoint)))
(if completion-ignore-case
(setq tail (downcase tail)))
(not (string= tail (substring string 0 len)))))
(setq len (1- len))
(forward-char 1))
(delete-char len)))
(delete-region (choose-completion-guess-base-position string) (point)))
(make-obsolete 'choose-completion-delete-max-match
'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
......@@ -5859,16 +5895,21 @@ the minibuffer; no further functions will be called.
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
(defun choose-completion-string (choice &optional buffer base-size)
(defun choose-completion-string (choice &optional buffer base-position)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-SIZE, if non-nil, says how many characters of BUFFER's text
to keep. If it is nil, we call `choose-completion-delete-max-match'
to decide what to delete."
BASE-POSITION, says where to insert the completion."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
;; Some older code may call us passing `base-size' instead of
;; `base-position'. It's difficult to make any use of `base-size',
;; so we just ignore it.
(unless (consp base-position)
(message "Obsolete `base-size' passed to choose-completion-string")
(setq base-position nil))
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
......@@ -5882,18 +5923,14 @@ to decide what to delete."
(set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
choice buffer mini-p base-size)
;; The fourth arg used to be `mini-p' but was useless
;; (since minibufferp can be used on the `buffer' arg)
;; and indeed unused. The last used to be `base-size', so we
;; keep it to try and avoid breaking old code.
choice buffer base-position nil)
;; Insert the completion into the buffer where it was requested.
;; FIXME:
;; - There may not be a field at point, or there may be a field but
;; it's not a "completion field", in which case we have to
;; call choose-completion-delete-max-match even if base-size is set.
;; - we may need to delete further than (point) to (field-end),
;; depending on the completion-style, and for that we need to
;; extra data `completion-extra-size'.
(if base-size
(delete-region (+ base-size (field-beginning)) (point))
(choose-completion-delete-max-match choice))
(delete-region (or (car base-position) (point))
(or (cadr base-position) (point)))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
......@@ -5947,12 +5984,6 @@ Called from `temp-buffer-show-hook'."
:version "22.1"
:group 'completion)
;; This is for packages that need to bind it to a non-default regexp
;; in order to make the first-differing character highlight work
;; to their liking
(defvar completion-root-regexp "^/"
"Regexp to use in `completion-setup-function' to find the root directory.")
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
......@@ -5968,26 +5999,13 @@ Called from `temp-buffer-show-hook'."
(substring (minibuffer-completion-contents)
0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
(let ((base-size completion-base-size)) ;Read before killing localvars.
(let ((base-size completion-base-size) ;Read before killing localvars.
(base-position completion-base-position))
(completion-list-mode)
(set (make-local-variable 'completion-base-size) base-size))
(set (make-local-variable 'completion-base-size) base-size)
(set (make-local-variable 'completion-base-position) base-position))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(if base-dir (setq default-directory base-dir))
(unless completion-base-size
;; This shouldn't be needed any more, but further analysis is needed
;; to make sure it's the case.
(setq completion-base-size
(cond
(minibuffer-completing-file-name
;; For file name completion, use the number of chars before
;; the start of the file name component at point.
(with-current-buffer mainbuf
(save-excursion
(skip-chars-backward completion-root-regexp)
(- (point) (minibuffer-prompt-end)))))
(minibuffer-completing-symbol nil)
;; Otherwise, in minibuffer, the base size is 0.
((minibufferp mainbuf) 0))))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
......
......@@ -4527,9 +4527,9 @@ An error is signaled if point is outside key or BibTeX field."
;; is requested.
(let (completion-ignore-case)
(setq choose-completion-string-functions
(lambda (choice buffer mini-p base-size)
(lambda (choice buffer base-position &rest ignored)
(setq choose-completion-string-functions nil)
(choose-completion-string choice buffer base-size)
(choose-completion-string choice buffer base-position)
(bibtex-complete-crossref-cleanup choice)
t)) ; needed by choose-completion-string-functions
(bibtex-complete-crossref-cleanup
......@@ -4545,9 +4545,9 @@ An error is signaled if point is outside key or BibTeX field."
;; string completion
(let ((completion-ignore-case t))
(setq choose-completion-string-functions
`(lambda (choice buffer mini-p base-size)
`(lambda (choice buffer base-position &rest ignored)
(setq choose-completion-string-functions nil)
(choose-completion-string choice buffer base-size)
(choose-completion-string choice buffer base-position)
(bibtex-complete-string-cleanup choice ',compl)
t)) ; needed by `choose-completion-string-functions'
(bibtex-complete-string-cleanup (bibtex-complete-internal compl)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment