comparison lisp/subr.el @ 75088:bd256d0d5e8e

(momentary): New face. (momentary-string-display): Display the string via a temporary overlay using the new face, instead of inserting it in the buffer.
author Richard M. Stallman <rms@gnu.org>
date Thu, 04 Jan 2007 21:46:06 +0000
parents 394073868e11
children a6b4f9a69719
comparison
equal deleted inserted replaced
75087:420404d9fc69 75088:bd256d0d5e8e
1882 header lines. This function also forces recomputation of the 1882 header lines. This function also forces recomputation of the
1883 menu bar menus and the frame title." 1883 menu bar menus and the frame title."
1884 (if all (save-excursion (set-buffer (other-buffer)))) 1884 (if all (save-excursion (set-buffer (other-buffer))))
1885 (set-buffer-modified-p (buffer-modified-p))) 1885 (set-buffer-modified-p (buffer-modified-p)))
1886 1886
1887 (defface momentary
1888 '((t (:inherit mode-line)))
1889 "Face for momentarily displaying text in the current buffer."
1890 :group 'display)
1891
1887 (defun momentary-string-display (string pos &optional exit-char message) 1892 (defun momentary-string-display (string pos &optional exit-char message)
1888 "Momentarily display STRING in the buffer at POS. 1893 "Momentarily display STRING in the buffer at POS.
1889 Display remains until next event is input. 1894 Display remains until next event is input.
1890 If POS is a marker, only its position is used; its buffer is ignored. 1895 If POS is a marker, only its position is used; its buffer is ignored.
1891 Optional third arg EXIT-CHAR can be a character, event or event 1896 Optional third arg EXIT-CHAR can be a character, event or event
1893 EXIT-CHAR it is swallowed; otherwise it is then available as 1898 EXIT-CHAR it is swallowed; otherwise it is then available as
1894 input (as a command if nothing else). 1899 input (as a command if nothing else).
1895 Display MESSAGE (optional fourth arg) in the echo area. 1900 Display MESSAGE (optional fourth arg) in the echo area.
1896 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." 1901 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
1897 (or exit-char (setq exit-char ?\s)) 1902 (or exit-char (setq exit-char ?\s))
1898 (let ((inhibit-read-only t) 1903 (let ((momentary-overlay (make-overlay pos pos nil t)))
1899 ;; Don't modify the undo list at all. 1904 (overlay-put momentary-overlay 'before-string
1900 (buffer-undo-list t) 1905 (propertize string 'face 'momentary))
1901 (modified (buffer-modified-p))
1902 (name buffer-file-name)
1903 insert-end)
1904 (unwind-protect 1906 (unwind-protect
1905 (progn 1907 (progn
1906 (save-excursion 1908 ;; If the message end is off screen, recenter now.
1907 (goto-char pos) 1909 (if (< (window-end nil t) (+ pos (length string)))
1908 ;; To avoid trouble with out-of-bounds position 1910 (recenter (/ (window-height) 2)))
1909 (setq pos (point)) 1911 ;; If that pushed message start off the screen,
1910 ;; defeat file locking... don't try this at home, kids! 1912 ;; scroll to start it at the top of the screen.
1911 (setq buffer-file-name nil) 1913 (move-to-window-line 0)
1912 (insert-before-markers string) 1914 (if (> (point) pos)
1913 (setq insert-end (point)) 1915 (progn
1914 ;; If the message end is off screen, recenter now. 1916 (goto-char pos)
1915 (if (< (window-end nil t) insert-end) 1917 (recenter 0)))
1916 (recenter (/ (window-height) 2)))
1917 ;; If that pushed message start off the screen,
1918 ;; scroll to start it at the top of the screen.
1919 (move-to-window-line 0)
1920 (if (> (point) pos)
1921 (progn
1922 (goto-char pos)
1923 (recenter 0))))
1924 (message (or message "Type %s to continue editing.") 1918 (message (or message "Type %s to continue editing.")
1925 (single-key-description exit-char)) 1919 (single-key-description exit-char))
1926 (let (char) 1920 (let (char)
1927 (if (integerp exit-char) 1921 (if (integerp exit-char)
1928 (condition-case nil 1922 (condition-case nil
1938 ;; list. 1932 ;; list.
1939 (setq char (read-event)) 1933 (setq char (read-event))
1940 (or (eq char exit-char) 1934 (or (eq char exit-char)
1941 (eq char (event-convert-list exit-char)) 1935 (eq char (event-convert-list exit-char))
1942 (setq unread-command-events (list char)))))) 1936 (setq unread-command-events (list char))))))
1943 (if insert-end 1937 (delete-overlay momentary-overlay))))
1944 (save-excursion
1945 (delete-region pos insert-end)))
1946 (setq buffer-file-name name)
1947 (set-buffer-modified-p modified))))
1948 1938
1949 1939
1950 ;;;; Overlay operations 1940 ;;;; Overlay operations
1951 1941
1952 (defun copy-overlay (o) 1942 (defun copy-overlay (o)