Mercurial > emacs
comparison lisp/simple.el @ 83099:9cb7ecf775c9
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-219
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-139
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Fri, 16 Apr 2004 13:36:07 +0000 |
| parents | 0d3eea319893 2ac3325ab7ec |
| children | 30dd490f06f2 |
comparison
equal
deleted
inserted
replaced
| 83098:0643dc72a250 | 83099:9cb7ecf775c9 |
|---|---|
| 985 (if undo-in-region | 985 (if undo-in-region |
| 986 (undo-start (region-beginning) (region-end)) | 986 (undo-start (region-beginning) (region-end)) |
| 987 (undo-start)) | 987 (undo-start)) |
| 988 ;; get rid of initial undo boundary | 988 ;; get rid of initial undo boundary |
| 989 (undo-more 1)) | 989 (undo-more 1)) |
| 990 ;; If we got this far, the next command should be a consecutive undo. | 990 ;; If we got this far, the next command should be a consecutive undo. |
| 991 (setq this-command 'undo) | 991 (setq this-command 'undo) |
| 992 ;; Check to see whether we're hitting a redo record, and if | 992 ;; Check to see whether we're hitting a redo record, and if |
| 993 ;; so, ask the user whether she wants to skip the redo/undo pair. | 993 ;; so, ask the user whether she wants to skip the redo/undo pair. |
| 994 (let ((equiv (gethash pending-undo-list undo-equiv-table))) | 994 (let ((equiv (gethash pending-undo-list undo-equiv-table))) |
| 995 (or (eq (selected-window) (minibuffer-window)) | 995 (or (eq (selected-window) (minibuffer-window)) |
| 4118 command to display the completion list buffer was run. | 4118 command to display the completion list buffer was run. |
| 4119 The completion list buffer is available as the value of `standard-output'.") | 4119 The completion list buffer is available as the value of `standard-output'.") |
| 4120 | 4120 |
| 4121 ;; This function goes in completion-setup-hook, so that it is called | 4121 ;; This function goes in completion-setup-hook, so that it is called |
| 4122 ;; after the text of the completion list buffer is written. | 4122 ;; after the text of the completion list buffer is written. |
| 4123 (defface completion-emphasis | 4123 (defface completions-first-difference |
| 4124 '((t (:inherit bold))) | 4124 '((t (:inherit bold))) |
| 4125 "Face put on the first uncommon character in completions in *Completions* buffer." | 4125 "Face put on the first uncommon character in completions in *Completions* buffer." |
| 4126 :group 'completion) | 4126 :group 'completion) |
| 4127 | 4127 |
| 4128 (defface completion-de-emphasis | 4128 (defface completions-common-part |
| 4129 '((t (:inherit default))) | 4129 '((t (:inherit default))) |
| 4130 "Face put on the common prefix substring in completions in *Completions* buffer." | 4130 "Face put on the common prefix substring in completions in *Completions* buffer." |
| 4131 :group 'completion) | 4131 :group 'completion) |
| 4132 | 4132 |
| 4133 (defun completion-setup-function () | 4133 (defun completion-setup-function () |
| 4156 (- (point) (minibuffer-prompt-end)))) | 4156 (- (point) (minibuffer-prompt-end)))) |
| 4157 ;; Otherwise, in minibuffer, the whole input is being completed. | 4157 ;; Otherwise, in minibuffer, the whole input is being completed. |
| 4158 (save-match-data | 4158 (save-match-data |
| 4159 (if (minibufferp mainbuf) | 4159 (if (minibufferp mainbuf) |
| 4160 (setq completion-base-size 0)))) | 4160 (setq completion-base-size 0)))) |
| 4161 ;; Put emphasis and de-emphasis faces on completions. | 4161 ;; Put faces on first uncommon characters and common parts. |
| 4162 (when completion-base-size | 4162 (when completion-base-size |
| 4163 (let ((common-string-length (length | 4163 (let* ((common-string-length (length |
| 4164 (substring mbuf-contents | 4164 (substring mbuf-contents |
| 4165 completion-base-size))) | 4165 completion-base-size))) |
| 4166 (element-start (next-single-property-change | 4166 (element-start (next-single-property-change |
| 4167 (point-min) | 4167 (point-min) |
| 4168 'mouse-face)) | 4168 'mouse-face)) |
| 4169 element-common-end) | 4169 (element-common-end (+ element-start common-string-length)) |
| 4170 (while element-start | 4170 (maxp (point-max))) |
| 4171 (setq element-common-end (+ element-start common-string-length)) | 4171 (while (and element-start (< element-common-end maxp)) |
| 4172 (when (and (get-char-property element-start 'mouse-face) | 4172 (when (and (get-char-property element-start 'mouse-face) |
| 4173 (get-char-property element-common-end 'mouse-face)) | 4173 (get-char-property element-common-end 'mouse-face)) |
| 4174 (put-text-property element-start element-common-end | 4174 (put-text-property element-start element-common-end |
| 4175 'font-lock-face 'completion-de-emphasis) | 4175 'font-lock-face 'completions-common-part) |
| 4176 (put-text-property element-common-end (1+ element-common-end) | 4176 (put-text-property element-common-end (1+ element-common-end) |
| 4177 'font-lock-face 'completion-emphasis)) | 4177 'font-lock-face 'completions-first-difference)) |
| 4178 (setq element-start (next-single-property-change | 4178 (setq element-start (next-single-property-change |
| 4179 element-start | 4179 element-start |
| 4180 'mouse-face))))) | 4180 'mouse-face)) |
| 4181 (if element-start | |
| 4182 (setq element-common-end (+ element-start common-string-length)))))) | |
| 4181 ;; Insert help string. | 4183 ;; Insert help string. |
| 4182 (goto-char (point-min)) | 4184 (goto-char (point-min)) |
| 4183 (if (display-mouse-p) | 4185 (if (display-mouse-p) |
| 4184 (insert (substitute-command-keys | 4186 (insert (substitute-command-keys |
| 4185 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) | 4187 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) |