diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 164 |
1 files changed, 91 insertions, 73 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index 36261d4903..2a9b8508b2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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)) |