From f70c4736283e4e96330548ee6c45a324db43456f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jun 2008 16:12:18 +0000 Subject: [PATCH] (momentary-string-display): Use an overlay. --- lisp/ChangeLog | 2 ++ lisp/subr.el | 79 +++++++++++++++++++------------------------------- 2 files changed, 32 insertions(+), 49 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 690be169092..97a2f40a1f7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2008-06-10 Stefan Monnier + * subr.el (momentary-string-display): Use an overlay. + * progmodes/compile.el (compilation-mode): Set window-point-insertion-type. (compilation-filter): Don't use insert-before-markers any more. diff --git a/lisp/subr.el b/lisp/subr.el index 804cb9a0d76..467d569fc49 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2034,56 +2034,37 @@ input (as a command if nothing else). Display MESSAGE (optional fourth arg) in the echo area. If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." (or exit-char (setq exit-char ?\s)) - (let ((inhibit-read-only t) - ;; Don't modify the undo list at all. - (buffer-undo-list t) - (modified (buffer-modified-p)) - (name buffer-file-name) - insert-end) + (let ((ol (make-overlay pos pos)) + (message (copy-sequence string))) (unwind-protect - (progn - (save-excursion - (goto-char pos) - ;; To avoid trouble with out-of-bounds position - (setq pos (point)) - ;; defeat file locking... don't try this at home, kids! - (setq buffer-file-name nil) - (insert-before-markers string) - (setq insert-end (point)) - ;; If the message end is off screen, recenter now. - (if (< (window-end nil t) insert-end) - (recenter (/ (window-height) 2))) - ;; If that pushed message start off the screen, - ;; scroll to start it at the top of the screen. - (move-to-window-line 0) - (if (> (point) pos) - (progn - (goto-char pos) - (recenter 0)))) - (message (or message "Type %s to continue editing.") - (single-key-description exit-char)) - (let (char) - (if (integerp exit-char) - (condition-case nil - (progn - (setq char (read-char)) - (or (eq char exit-char) - (setq unread-command-events (list char)))) - (error - ;; `exit-char' is a character, hence it differs - ;; from char, which is an event. - (setq unread-command-events (list char)))) - ;; `exit-char' can be an event, or an event description - ;; list. - (setq char (read-event)) - (or (eq char exit-char) - (eq char (event-convert-list exit-char)) - (setq unread-command-events (list char)))))) - (if insert-end - (save-excursion - (delete-region pos insert-end))) - (setq buffer-file-name name) - (set-buffer-modified-p modified)))) + (progn + (save-excursion + (overlay-put ol 'after-string message) + (goto-char pos) + ;; To avoid trouble with out-of-bounds position + (setq pos (point)) + ;; If the message end is off screen, recenter now. + (if (<= (window-end nil t) pos) + (recenter (/ (window-height) 2)))) + (message (or message "Type %s to continue editing.") + (single-key-description exit-char)) + (let (char) + (if (integerp exit-char) + (condition-case nil + (progn + (setq char (read-char)) + (or (eq char exit-char) + (setq unread-command-events (list char)))) + (error + ;; `exit-char' is a character, hence it differs + ;; from char, which is an event. + (setq unread-command-events (list char)))) + ;; `exit-char' can be an event, or an event description list. + (setq char (read-event)) + (or (eq char exit-char) + (eq char (event-convert-list exit-char)) + (setq unread-command-events (list char)))))) + (delete-overlay ol)))) ;;;; Overlay operations -- 2.39.2