diff options
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/subr.el | 48 |
2 files changed, 25 insertions, 29 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6cb365666a4..e4ea386e686 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2007-01-04 Kevin Rodgers <kevin.d.rodgers@gmail.com> | ||
| 2 | |||
| 3 | * subr.el (momentary): New face. | ||
| 4 | (momentary-string-display): Display the string via a temporary | ||
| 5 | overlay using the new face, instead of inserting it in the buffer. | ||
| 6 | |||
| 1 | 2007-01-04 Andreas Schwab <schwab@suse.de> | 7 | 2007-01-04 Andreas Schwab <schwab@suse.de> |
| 2 | 8 | ||
| 3 | * progmodes/ebrowse.el (ebrowse-global-prefix-key): Fix typo in | 9 | * progmodes/ebrowse.el (ebrowse-global-prefix-key): Fix typo in |
diff --git a/lisp/subr.el b/lisp/subr.el index c98e14b6334..31d220a8dd3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1884,6 +1884,11 @@ 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. |
| @@ -1895,32 +1900,21 @@ 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) |
| @@ -1940,11 +1934,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." | |||
| 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 |