Re: momentary-string-display

[Kevin Rodgers <kevin.d.rodgers@gmail.com>]

Richard Stallman wrote:
>     As I meant to say, the same heuristic can be used by replacing the
>     reference to insert-end with (+ pos (length string)) -- as long as
>     the new call to overlay-put causes a redisplay that updates window-end
>     just as the original call to insert does.
> 
> I just made a change in window-end which I think will make it handle
> that case correctly.
> 
> So let's have your patch and install it.

2007-01-04  Kevin Rodgers  <kevin.d.rodgers@gmail.com>

	* subr.el (momentary): New face.
	(momentary-string-display): Display the string via a temporary
	overlay using the new face, instead of inserting it in the buffer.


*** subr.el~	Mon Dec 11 09:37:43 2006
--- subr.el	Thu Jan  4 08:16:31 2007
***************
*** 1884,1889 ****
--- 1884,1894 ----
     (if all (save-excursion (set-buffer (other-buffer))))
     (set-buffer-modified-p (buffer-modified-p)))

+ (defface momentary
+   '((t (:inherit mode-line)))
+   "Face for momentarily displaying text in the current buffer."
+   :group 'display)
+
   (defun momentary-string-display (string pos &optional exit-char message)
     "Momentarily display STRING in the buffer at POS.
   Display remains until next event is input.
***************
*** 1894,1915 ****
   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)
       (unwind-protect
   	(progn
! 	  (save-excursion
! 	    (goto-char pos)
! 	    ;; 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.
--- 1899,1911 ----
   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 ((momentary-overlay (make-overlay pos pos nil t)))
       (unwind-protect
   	(progn
! 	  (overlay-put momentary-overlay 'before-string
! 		       (propertize string 'face 'momentary))
   	    ;; If the message end is off screen, recenter now.
! 	    (if (< (window-end nil t) (+ pos (length string)))
   		(recenter (/ (window-height) 2)))
   	    ;; If that pushed message start off the screen,
   	    ;; scroll to start it at the top of the screen.
***************
*** 1937,1947 ****
   	      (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))))

   \f
   ;;;; Overlay operations
--- 1933,1941 ----
   	      (or (eq char exit-char)
   		  (eq char (event-convert-list exit-char))
   		  (setq unread-command-events (list char))))))
!       (when (overlayp momentary-overlay)
! 	(delete-overlay momentary-overlay)))))
!

   \f
   ;;;; Overlay operations

-- 
Kevin Rodgers
Denver, Colorado, USA