* Re: Wrong common substring highlighted in Completion buffer
2005-12-13 3:15 ` Richard M. Stallman
@ 2005-12-14 7:59 ` Juri Linkov
2005-12-15 2:07 ` Richard M. Stallman
0 siblings, 1 reply; 7+ messages in thread
From: Juri Linkov @ 2005-12-14 7:59 UTC (permalink / raw)
Cc: emacs-devel
> If your fix needs fixing, please just do it.
I hesitated to install this fix, because I felt this is not the right thing.
Now I've completely reworked the function completion-setup-function and some
related functions to make highlighting of common strings correct in many cases:
* in normal minibuffer completion and in file name minibuffer completion;
* for both above cases if point is at the end of the minibuffer and
if point is in the middle of the minibuffer;
* for partial-completion-mode with combinations of all cases above
and with leading `-';
* for Info node/file completion (which uses completion-base-size-function);
* for crm-minibuffer-completion (which reads multiple strings with completion).
In the patch below the following changes were made:
* Revert the change in display_completion_list_1 that explicitly
uses minibuffer_completion_contents. Use nil as before.
* Make the function minibuffer_completion_contents available to Lisp.
Its Lisp name is minibuffer-completion-contents.
* Use this function in completion-setup-function to get the correct
completion part of the minibuffer.
* Due to using this function in completion-setup-function,
partial-completion-mode doesn't need to set the argument common-substring
for display-completion-list. Completion-setup-function now does the
right thing for it.
There was one inconsistency in partial-completion-mode that needed
special handling in completion-setup-function. I tracked it down to
the dubious condition in `PC-do-completion': (equal (point) beg).
This condition prevented point to be placed at the first different
character in the minibuffer (as normal completion does) *if* this
position is at the beginning of the minibuffer. After removing this
condition this works consistently for the case of completions like
`-function'. It puts point before `-function' and highlights the
first character of available completions in the *Completions* buffer.
So this change also removes the need for special handling
of partial-completion-mode in completion-setup-function.
* Another FIXME in completion-setup-function was saying about the need
of an extra argument for completion-base-size-function. I replaced it
with the advice to use the global value of completion-common-substring
or directly the contents of the minibuffer in a function called via
completion-base-size-function. Also I changed the lambda on
Info-read-node-name-1 to match `(' on the global value of
completion-common-substring or (minibuffer-completion-contents).
Index: src/minibuf.c
===================================================================
RCS file: /sources/emacs/emacs/src/minibuf.c,v
retrieving revision 1.295
diff -c -r1.295 minibuf.c
*** src/minibuf.c 11 Dec 2005 09:50:53 -0000 1.295
--- src/minibuf.c 14 Dec 2005 07:57:15 -0000
***************
*** 388,393 ****
--- 388,406 ----
return make_buffer_string (prompt_end, ZV, 0);
}
+ DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
+ Sminibuffer_completion_contents, 0, 0, 0,
+ doc: /* Return the user input in a minibuffer before point as a string.
+ That is what completion commands operate on.
+ The current buffer must be a minibuffer. */)
+ ()
+ {
+ int prompt_end = XINT (Fminibuffer_prompt_end ());
+ if (PT < prompt_end)
+ error ("Cannot do completion in the prompt");
+ return make_buffer_string (prompt_end, PT, 1);
+ }
+
DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents,
Sdelete_minibuffer_contents, 0, 0, 0,
doc: /* Delete all user input in a minibuffer.
***************
*** 400,416 ****
return Qnil;
}
- /* Get the text in the minibuffer before point.
- That is what completion commands operate on. */
-
- Lisp_Object
- minibuffer_completion_contents ()
- {
- int prompt_end = XINT (Fminibuffer_prompt_end ());
- if (PT < prompt_end)
- error ("Cannot do completion in the prompt");
- return make_buffer_string (prompt_end, PT, 1);
- }
\f
/* Read from the minibuffer using keymap MAP and initial contents INITIAL,
putting point minus BACKUP_N bytes from the end of INITIAL,
--- 413,418 ----
***************
*** 1899,1905 ****
Lisp_Object last;
struct gcpro gcpro1, gcpro2;
! completion = Ftry_completion (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
last = last_exact_completion;
--- 1904,1910 ----
Lisp_Object last;
struct gcpro gcpro1, gcpro2;
! completion = Ftry_completion (Fminibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
last = last_exact_completion;
***************
*** 1921,1927 ****
return 1;
}
! string = minibuffer_completion_contents ();
/* COMPLETEDP should be true if some completion was done, which
doesn't include simply changing the case of the entered string.
--- 1926,1932 ----
return 1;
}
! string = Fminibuffer_completion_contents ();
/* COMPLETEDP should be true if some completion was done, which
doesn't include simply changing the case of the entered string.
***************
*** 1988,1994 ****
last_exact_completion = completion;
if (!NILP (last))
{
! tem = minibuffer_completion_contents ();
if (!NILP (Fequal (tem, last)))
Fminibuffer_completion_help ();
}
--- 1993,1999 ----
last_exact_completion = completion;
if (!NILP (last))
{
! tem = Fminibuffer_completion_contents ();
if (!NILP (Fequal (tem, last)))
Fminibuffer_completion_help ();
}
***************
*** 2191,2197 ****
/* We keep calling Fbuffer_string rather than arrange for GC to
hold onto a pointer to one of the strings thus made. */
! completion = Ftry_completion (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
if (NILP (completion))
--- 2196,2202 ----
/* We keep calling Fbuffer_string rather than arrange for GC to
hold onto a pointer to one of the strings thus made. */
! completion = Ftry_completion (Fminibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
if (NILP (completion))
***************
*** 2223,2229 ****
int buffer_nchars, completion_nchars;
CHECK_STRING (completion);
! tem = minibuffer_completion_contents ();
GCPRO2 (completion, tem);
/* If reading a file name,
expand any $ENVVAR refs in the buffer and in TEM. */
--- 2228,2234 ----
int buffer_nchars, completion_nchars;
CHECK_STRING (completion);
! tem = Fminibuffer_completion_contents ();
GCPRO2 (completion, tem);
/* If reading a file name,
expand any $ENVVAR refs in the buffer and in TEM. */
***************
*** 2287,2293 ****
if (i == SCHARS (completion))
{
GCPRO1 (completion);
! tem = Ftry_completion (concat2 (minibuffer_completion_contents (),
build_string (" ")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
--- 2292,2298 ----
if (i == SCHARS (completion))
{
GCPRO1 (completion);
! tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (),
build_string (" ")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
***************
*** 2299,2305 ****
{
GCPRO1 (completion);
tem =
! Ftry_completion (concat2 (minibuffer_completion_contents (),
build_string ("-")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
--- 2304,2310 ----
{
GCPRO1 (completion);
tem =
! Ftry_completion (concat2 (Fminibuffer_completion_contents (),
build_string ("-")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
***************
*** 2371,2378 ****
It is used to put faces, `completions-first-difference' and
`completions-common-part' on the completion buffer. The
`completions-common-part' face is put on the common substring
! specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil,
! the faces are not put.
Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
during running `completion-setup-hook'. */)
(completions, common_substring)
--- 2376,2383 ----
It is used to put faces, `completions-first-difference' and
`completions-common-part' on the completion buffer. The
`completions-common-part' face is put on the common substring
! specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
! and the current buffer is not the minibuffer, the faces are not put.
Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
during running `completion-setup-hook'. */)
(completions, common_substring)
***************
*** 2563,2569 ****
display_completion_list_1 (list)
Lisp_Object list;
{
! return Fdisplay_completion_list (list, minibuffer_completion_contents ());
}
DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
--- 2568,2574 ----
display_completion_list_1 (list)
Lisp_Object list;
{
! return Fdisplay_completion_list (list, Qnil);
}
DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
***************
*** 2574,2580 ****
Lisp_Object completions;
message ("Making completion list...");
! completions = Fall_completions (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate,
Qt);
--- 2579,2585 ----
Lisp_Object completions;
message ("Making completion list...");
! completions = Fall_completions (Fminibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate,
Qt);
***************
*** 2883,2888 ****
--- 2888,2894 ----
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
defsubr (&Sminibuffer_contents_no_properties);
+ defsubr (&Sminibuffer_completion_contents);
defsubr (&Sdelete_minibuffer_contents);
defsubr (&Stry_completion);
Index: lisp/simple.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/simple.el,v
retrieving revision 1.778
diff -c -r1.778 simple.el
*** lisp/simple.el 10 Dec 2005 01:12:25 -0000 1.778
--- lisp/simple.el 14 Dec 2005 07:57:45 -0000
***************
*** 4901,4968 ****
"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.)")
;; 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)))
;; 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))))
;; 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)))
(let ((element-start (point-min))
(maxp (point-max))
element-common-end)
--- 4958,5011 ----
"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'
! 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 (and (minibufferp mainbuf)
! (minibuffer-completion-contents)))
! (common-substring (or completion-common-substring mbuf-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 (and minibuffer-completing-file-name mbuf-contents)
(with-current-buffer mainbuf
(setq default-directory (file-name-directory mbuf-contents))))
(with-current-buffer standard-output
(completion-list-mode)
(set (make-local-variable 'completion-reference-buffer) mainbuf)
! (if mbuf-contents
! (setq completion-base-size
! (cond
! ((and (symbolp minibuffer-completion-table)
! (get minibuffer-completion-table 'completion-base-size-function))
! ;; To compute base size, this function can use the global value
! ;; of completion-common-substring or directly the contents of
! ;; the minibuffer.
! (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))))))))
! (setq common-string-length
! (- (length common-substring)
! (if (and (integerp completion-base-size)
! (> completion-base-size 0))
! completion-base-size
! 0)))
;; Put faces on first uncommon characters and common parts.
! (when (and (integerp common-string-length) (>= common-string-length 0))
(let ((element-start (point-min))
(maxp (point-max))
element-common-end)
Index: lisp/complete.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/complete.el,v
retrieving revision 1.47
diff -c -r1.47 complete.el
*** lisp/complete.el 27 Nov 2005 20:53:55 -0000 1.47
--- lisp/complete.el 14 Dec 2005 07:55:34 -0000
***************
*** 613,620 ****
(insert (substring prefix i (1+ i)))
(setq end (1+ end)))
(setq i (1+ i)))
! (or pt (equal (point) beg)
! (setq pt (point)))
(looking-at PC-delim-regex))
(setq skip (concat skip
(regexp-quote prefix)
--- 613,619 ----
(insert (substring prefix i (1+ i)))
(setq end (1+ end)))
(setq i (1+ i)))
! (or pt (setq pt (point)))
(looking-at PC-delim-regex))
(setq skip (concat skip
(regexp-quote prefix)
Index: lisp/info.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/info.el,v
retrieving revision 1.467
diff -c -r1.467 info.el
*** lisp/info.el 12 Dec 2005 05:15:53 -0000 1.467
--- lisp/info.el 14 Dec 2005 07:54:54 -0000
***************
*** 1517,1523 ****
;; Arrange to highlight the proper letters in the completion list buffer.
(put 'Info-read-node-name-1 'completion-base-size-function
! (lambda () 1))
(defun Info-read-node-name (prompt &optional default)
(let* ((completion-ignore-case t)
--- 1523,1533 ----
;; Arrange to highlight the proper letters in the completion list buffer.
(put 'Info-read-node-name-1 'completion-base-size-function
! (lambda ()
! (if (string-match "\\`([^)]*\\'"
! (or completion-common-substring
! (minibuffer-completion-contents)))
! 1)))
(defun Info-read-node-name (prompt &optional default)
(let* ((completion-ignore-case t)
Index: lisp/emacs-lisp/crm.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/emacs-lisp/crm.el,v
retrieving revision 1.9
diff -c -r1.9 crm.el
*** lisp/emacs-lisp/crm.el 6 Aug 2005 17:08:59 -0000 1.9
--- lisp/emacs-lisp/crm.el 14 Dec 2005 07:52:34 -0000
***************
*** 234,240 ****
t
nil)))
! (defun crm-minibuffer-completion-help ()
"Display a list of possible completions of the current minibuffer element."
(interactive)
(message "Making completion list...")
--- 234,240 ----
t
nil)))
! (defun crm-minibuffer-completion-help (&optional common-substring)
"Display a list of possible completions of the current minibuffer element."
(interactive)
(message "Making completion list...")
***************
*** 247,253 ****
(if (null completions)
(crm-temp-echo-area-glyphs " [No completions]")
(with-output-to-temp-buffer "*Completions*"
! (display-completion-list (sort completions 'string-lessp))))))
nil)
(defun crm-do-completion ()
--- 247,255 ----
(if (null completions)
(crm-temp-echo-area-glyphs " [No completions]")
(with-output-to-temp-buffer "*Completions*"
! (display-completion-list
! (sort completions 'string-lessp)
! common-substring)))))
nil)
(defun crm-do-completion ()
***************
*** 303,309 ****
(if completedp ; some completion happened
(throw 'crm-exit 5)
(if completion-auto-help
! (crm-minibuffer-completion-help)
(crm-temp-echo-area-glyphs " [Next char not unique]")))
(throw 'crm-exit 6))
(if completedp
--- 305,311 ----
(if completedp ; some completion happened
(throw 'crm-exit 5)
(if completion-auto-help
! (crm-minibuffer-completion-help crm-current-element)
(crm-temp-echo-area-glyphs " [Next char not unique]")))
(throw 'crm-exit 6))
(if completedp
***************
*** 313,319 ****
(if (not (null last))
(progn
(if (not (null (equal crm-current-element last)))
! (crm-minibuffer-completion-help))))
;; returning -- was already an exact completion
(throw 'crm-exit 3)))))
--- 315,321 ----
(if (not (null last))
(progn
(if (not (null (equal crm-current-element last)))
! (crm-minibuffer-completion-help crm-current-element))))
;; returning -- was already an exact completion
(throw 'crm-exit 3)))))
--
Juri Linkov
http://www.jurta.org/emacs/
^ permalink raw reply [flat|nested] 7+ messages in thread