Mercurial > emacs
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) |