mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
* minibuffer.el (completion-common-substring): Mark obsolete.
(completions-first-difference, completions-common-part): Move from simple.el. (completion-hilit-commonality): New fun. (display-completion-list, completion-emacs21-all-completions) (completion-emacs22-all-completions): Use it. * simple.el (completions-first-difference, completions-common-part): Move to minibuffer.el. (choose-completion-string): Use field functions and minibufferp. (completion-setup-function): Don't set completions faces.
This commit is contained in:
parent
62a918cab4
commit
6138158d86
3 changed files with 79 additions and 64 deletions
|
|
@ -1,3 +1,16 @@
|
|||
2008-04-29 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* minibuffer.el (completion-common-substring): Mark obsolete.
|
||||
(completions-first-difference, completions-common-part):
|
||||
Move from simple.el.
|
||||
(completion-hilit-commonality): New fun.
|
||||
(display-completion-list, completion-emacs21-all-completions)
|
||||
(completion-emacs22-all-completions): Use it.
|
||||
* simple.el (completions-first-difference, completions-common-part):
|
||||
Move to minibuffer.el.
|
||||
(choose-completion-string): Use field functions and minibufferp.
|
||||
(completion-setup-function): Don't set completions faces.
|
||||
|
||||
2008-04-29 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* calendar/calendar.el (calendar-nth-named-absday)
|
||||
|
|
@ -29,8 +42,8 @@
|
|||
|
||||
2008-04-29 Nick Roberts <nickrob@snap.net.nz>
|
||||
|
||||
* progmodes/gdb-ui.el (gdb-info-stack-custom): Use
|
||||
gud-tool-bar-item-visible-no-fringe.
|
||||
* progmodes/gdb-ui.el (gdb-info-stack-custom):
|
||||
Use gud-tool-bar-item-visible-no-fringe.
|
||||
(gdb-display-buffer): Don't pop new buffer if gud-comint-buffer
|
||||
is already visible in frame. Remove optional size parameter
|
||||
and add optional frame parameter.
|
||||
|
|
|
|||
|
|
@ -621,15 +621,54 @@ It also eliminates runs of equal strings."
|
|||
(put-text-property (point) (progn (insert (cadr str)) (point))
|
||||
'mouse-face nil)))))))
|
||||
|
||||
(defvar completion-common-substring)
|
||||
(defvar completion-common-substring nil)
|
||||
(make-obsolete-variable 'completion-common-substring nil "23.1")
|
||||
|
||||
(defvar completion-setup-hook nil
|
||||
"Normal hook run at the end of setting up a completion list buffer.
|
||||
When this hook is run, the current buffer is the one in which the
|
||||
command to display the completion list buffer was run.
|
||||
The completion list buffer is available as the value of `standard-output'.
|
||||
The common prefix substring for completion may be available as the value
|
||||
of `completion-common-substring'. See also `display-completion-list'.")
|
||||
See also `display-completion-list'.")
|
||||
|
||||
(defface completions-first-difference
|
||||
'((t (:inherit bold)))
|
||||
"Face put on the first uncommon character in completions in *Completions* buffer."
|
||||
:group 'completion)
|
||||
|
||||
(defface completions-common-part
|
||||
'((t (:inherit default)))
|
||||
"Face put on the common prefix substring in completions in *Completions* buffer.
|
||||
The idea of `completions-common-part' is that you can use it to
|
||||
make the common parts less visible than normal, so that the rest
|
||||
of the differing parts is, by contrast, slightly highlighted."
|
||||
:group 'completion)
|
||||
|
||||
(defun completion-hilit-commonality (completions prefix-len)
|
||||
(when completions
|
||||
(let* ((last (last completions))
|
||||
(base-size (cdr last))
|
||||
(com-str-len (- prefix-len (or base-size 0))))
|
||||
;; Remove base-size during mapcar, and add it back later.
|
||||
(setcdr last nil)
|
||||
(nconc
|
||||
(mapcar
|
||||
(lambda (elem)
|
||||
(let ((str
|
||||
(if (consp elem)
|
||||
(car (setq elem (cons (copy-sequence (car elem))
|
||||
(cdr elem))))
|
||||
(setq elem (copy-sequence elem)))))
|
||||
(put-text-property 0 com-str-len
|
||||
'font-lock-face 'completions-common-part
|
||||
str)
|
||||
(if (> (length str) com-str-len)
|
||||
(put-text-property com-str-len (1+ com-str-len)
|
||||
'font-lock-face 'completions-first-difference
|
||||
str)))
|
||||
elem)
|
||||
completions)
|
||||
base-size))))
|
||||
|
||||
(defun display-completion-list (completions &optional common-substring)
|
||||
"Display the list of completions, COMPLETIONS, using `standard-output'.
|
||||
|
|
@ -642,14 +681,14 @@ The actual completion alternatives, as inserted, are given `mouse-face'
|
|||
properties of `highlight'.
|
||||
At the end, this runs the normal hook `completion-setup-hook'.
|
||||
It can find the completion buffer in `standard-output'.
|
||||
The optional second arg COMMON-SUBSTRING is a string.
|
||||
The obsolete optional second arg COMMON-SUBSTRING is a string.
|
||||
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'."
|
||||
specified by COMMON-SUBSTRING."
|
||||
(if common-substring
|
||||
(setq completions (completion-hilit-commonality
|
||||
completions (length common-substring))))
|
||||
(if (not (bufferp standard-output))
|
||||
;; This *never* (ever) happens, so there's no point trying to be clever.
|
||||
(with-temp-buffer
|
||||
|
|
@ -670,6 +709,8 @@ during running `completion-setup-hook'."
|
|||
(setcdr last nil)) ;Make completions a properly nil-terminated list.
|
||||
(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.
|
||||
(let ((completion-common-substring common-substring))
|
||||
(run-hooks 'completion-setup-hook))
|
||||
nil)
|
||||
|
|
@ -1000,7 +1041,9 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
|
|||
completion)))
|
||||
|
||||
(defun completion-emacs21-all-completions (string table pred point)
|
||||
(all-completions string table pred t))
|
||||
(completion-hilit-commonality
|
||||
(all-completions string table pred t)
|
||||
(length string)))
|
||||
|
||||
;;; Basic completion, used in Emacs-22.
|
||||
|
||||
|
|
@ -1025,7 +1068,9 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
|
|||
(cons (concat completion suffix) (length completion)))))
|
||||
|
||||
(defun completion-emacs22-all-completions (string table pred point)
|
||||
(all-completions (substring string 0 point) table pred t))
|
||||
(completion-hilit-commonality
|
||||
(all-completions (substring string 0 point) table pred t)
|
||||
point))
|
||||
|
||||
(defun completion-basic-try-completion (string table pred point)
|
||||
(let ((suffix (substring string point))
|
||||
|
|
|
|||
|
|
@ -5425,11 +5425,15 @@ to decide what to delete."
|
|||
'choose-completion-string-functions
|
||||
choice buffer mini-p base-size)
|
||||
;; 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 (if mini-p
|
||||
(minibuffer-prompt-end)
|
||||
(point-min)))
|
||||
(point))
|
||||
(delete-region (+ base-size (field-beginning)) (point))
|
||||
(choose-completion-delete-max-match choice))
|
||||
(insert choice)
|
||||
(remove-text-properties (- (point) (length choice)) (point)
|
||||
|
|
@ -5439,7 +5443,7 @@ to decide what to delete."
|
|||
(set-window-point window (point)))
|
||||
;; If completing for the minibuffer, exit it with this choice.
|
||||
(and (not completion-no-auto-exit)
|
||||
(equal buffer (window-buffer (minibuffer-window)))
|
||||
(minibufferp buffer)
|
||||
minibuffer-completion-table
|
||||
;; If this is reading a file name, and the file name chosen
|
||||
;; is a directory, don't exit the minibuffer.
|
||||
|
|
@ -5478,34 +5482,12 @@ Called from `temp-buffer-show-hook'."
|
|||
:version "22.1"
|
||||
:group 'completion)
|
||||
|
||||
(defface completions-first-difference
|
||||
'((t (:inherit bold)))
|
||||
"Face put on the first uncommon character in completions in *Completions* buffer."
|
||||
:group 'completion)
|
||||
|
||||
(defface completions-common-part
|
||||
'((t (:inherit default)))
|
||||
"Face put on the common prefix substring in completions in *Completions* buffer.
|
||||
The idea of `completions-common-part' is that you can use it to
|
||||
make the common parts less visible than normal, so that the rest
|
||||
of the differing parts is, by contrast, slightly highlighted."
|
||||
: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.")
|
||||
|
||||
(defvar completion-common-substring nil
|
||||
"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 ()
|
||||
|
|
@ -5539,31 +5521,6 @@ of the minibuffer before point is always the common substring.)")
|
|||
(minibuffer-completing-symbol nil)
|
||||
;; 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 (and (integerp common-string-length) (>= common-string-length 0))
|
||||
(let ((element-start (point-min))
|
||||
(maxp (point-max))
|
||||
element-common-end)
|
||||
(while (and (setq element-start
|
||||
(next-single-property-change
|
||||
element-start 'mouse-face))
|
||||
(< (setq element-common-end
|
||||
(+ element-start common-string-length))
|
||||
maxp))
|
||||
(when (get-char-property element-start '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)
|
||||
(put-text-property element-common-end (1+ element-common-end)
|
||||
'font-lock-face 'completions-first-difference))))))
|
||||
;; Maybe insert help string.
|
||||
(when completion-show-help
|
||||
(goto-char (point-min))
|
||||
|
|
|
|||
Loading…
Reference in a new issue