# HG changeset patch # User Juri Linkov # Date 1134760101 0 # Node ID 0d6832f365fbc04f4dbe55b01f8692d48303e593 # Parent b0794ecc7df65872277c8035f2fd2337cc3c8677 (choose-completion): Use `buffer-substring-no-properties' instead of `buffer-substring'. (completion-common-substring): Doc fix. (completion-setup-function): Use minibuffer-completion-contents instead of minibuffer-contents. Don't set common-string-length initially. Remove special handling of partial-completion-mode. Move computation of completion-base-size into one cond. Call completion-base-size-function in mainbuf. In computation of completion-base-size for file name completion don't move point to the end of the minibuffer. Move computation of common-string-length into one cond. Start putting faces only when common-string-length>=0. Add condition to put completions-common-part when common-string-length>0. diff -r b0794ecc7df6 -r 0d6832f365fb lisp/simple.el --- a/lisp/simple.el Fri Dec 16 19:07:32 2005 +0000 +++ b/lisp/simple.el Fri Dec 16 19:08:21 2005 +0000 @@ -4787,7 +4787,7 @@ (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 beg end)) + (setq completion (buffer-substring-no-properties beg end)) (let ((owindow (selected-window))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) @@ -4944,68 +4944,52 @@ "Common prefix substring to use in `completion-setup-function' to put faces. The value is set by `display-completion-list' during running `completion-setup-hook'. -To put faces, `completions-first-difference' and `completions-common-part' -into \"*Completions*\* buffer, the common prefix substring in completions is -needed as a hint. (Minibuffer is a special case. The content of minibuffer itself -is the substring.)") +To put faces `completions-first-difference' and `completions-common-part' +in the `*Completions*' buffer, the common prefix substring in completions +is needed as a hint. (The minibuffer is a special case. The content +of the minibuffer before point is always the common substring.)") ;; 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 () (let* ((mainbuf (current-buffer)) - (mbuf-contents (minibuffer-contents)) - (common-string-length (length mbuf-contents))) + (mbuf-contents (minibuffer-completion-contents)) + common-string-length) ;; When reading a file name in the minibuffer, ;; set default-directory in the minibuffer ;; so it will get copied into the completion list buffer. (if minibuffer-completing-file-name (with-current-buffer mainbuf (setq default-directory (file-name-directory mbuf-contents)))) - ;; If partial-completion-mode is on, point might not be after the - ;; last character in the minibuffer. - ;; FIXME: This hack should be moved to complete.el where we call - ;; display-completion-list. - (when partial-completion-mode - (setq common-string-length - (if (eq (char-after (field-beginning)) ?-) - ;; If the text to be completed starts with a `-', there is no - ;; common prefix. - ;; FIXME: this probably still doesn't do the right thing - ;; when completing file names. It's not even clear what - ;; is TRT. - 0 - (- common-string-length (- (point-max) (point)))))) (with-current-buffer standard-output (completion-list-mode) (set (make-local-variable 'completion-reference-buffer) mainbuf) (setq completion-base-size - (if minibuffer-completing-file-name - ;; For file name completion, use the number of chars before - ;; the start of the last file name component. - (with-current-buffer mainbuf - (save-excursion - (goto-char (point-max)) - (skip-chars-backward completion-root-regexp) - (- (point) (minibuffer-prompt-end)))) - ;; Otherwise, in minibuffer, the whole input is being completed. - (if (minibufferp mainbuf) 0))) - (if (and (symbolp minibuffer-completion-table) - (get minibuffer-completion-table 'completion-base-size-function)) - (setq completion-base-size - ;; FIXME: without any extra arg, how is this function - ;; expected to return anything else than a constant unless - ;; it redoes part of the work of all-completions? - ;; In most cases this value would better be computed and - ;; returned at the same time as the list of all-completions - ;; is computed. --Stef - (funcall (get minibuffer-completion-table - 'completion-base-size-function)))) + (cond + ((and (symbolp minibuffer-completion-table) + (get minibuffer-completion-table 'completion-base-size-function)) + ;; To compute base size, a function can use the global value of + ;; completion-common-substring or minibuffer-completion-contents. + (with-current-buffer mainbuf + (funcall (get minibuffer-completion-table + 'completion-base-size-function)))) + (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))))) + ;; Otherwise, in minibuffer, the base size is 0. + ((minibufferp mainbuf) 0))) + (setq common-string-length + (cond + (completion-common-substring + (length completion-common-substring)) + (completion-base-size + (- (length mbuf-contents) completion-base-size)))) ;; Put faces on first uncommon characters and common parts. - (when (or completion-common-substring completion-base-size) - (setq common-string-length - (if completion-common-substring - (length completion-common-substring) - (- common-string-length completion-base-size))) + (when (and (integerp common-string-length) (>= common-string-length 0)) (let ((element-start (point-min)) (maxp (point-max)) element-common-end) @@ -5016,7 +5000,8 @@ (+ element-start common-string-length)) maxp)) (when (get-char-property element-start 'mouse-face) - (if (get-char-property (1- element-common-end) 'mouse-face) + (if (and (> common-string-length 0) + (get-char-property (1- element-common-end) 'mouse-face)) (put-text-property element-start element-common-end 'font-lock-face 'completions-common-part)) (if (get-char-property element-common-end 'mouse-face)