Mercurial > emacs
changeset 94464:66b02cd7b956
* 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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 29 Apr 2008 05:36:55 +0000 |
| parents | 33cbbd41a93f |
| children | e2562e0fe05e |
| files | lisp/ChangeLog lisp/minibuffer.el lisp/simple.el |
| diffstat | 3 files changed, 79 insertions(+), 64 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Apr 29 03:42:15 2008 +0000 +++ b/lisp/ChangeLog Tue Apr 29 05:36:55 2008 +0000 @@ -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.
--- a/lisp/minibuffer.el Tue Apr 29 03:42:15 2008 +0000 +++ b/lisp/minibuffer.el Tue Apr 29 05:36:55 2008 +0000 @@ -621,15 +621,54 @@ (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 @@ 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 @@ (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 @@ 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 @@ (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))
--- a/lisp/simple.el Tue Apr 29 03:42:15 2008 +0000 +++ b/lisp/simple.el Tue Apr 29 05:36:55 2008 +0000 @@ -5425,11 +5425,15 @@ '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 @@ (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 @@ :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 @@ (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))