comparison lisp/subr.el @ 95778:c9b3cb8a81ec

(momentary-string-display): Use an overlay.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 10 Jun 2008 16:12:18 +0000
parents 5be5ad6047d1
children b4e36ff621b3
comparison
equal deleted inserted replaced
95777:edc51d72cb17 95778:c9b3cb8a81ec
2032 EXIT-CHAR it is swallowed; otherwise it is then available as 2032 EXIT-CHAR it is swallowed; otherwise it is then available as
2033 input (as a command if nothing else). 2033 input (as a command if nothing else).
2034 Display MESSAGE (optional fourth arg) in the echo area. 2034 Display MESSAGE (optional fourth arg) in the echo area.
2035 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." 2035 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
2036 (or exit-char (setq exit-char ?\s)) 2036 (or exit-char (setq exit-char ?\s))
2037 (let ((inhibit-read-only t) 2037 (let ((ol (make-overlay pos pos))
2038 ;; Don't modify the undo list at all. 2038 (message (copy-sequence string)))
2039 (buffer-undo-list t)
2040 (modified (buffer-modified-p))
2041 (name buffer-file-name)
2042 insert-end)
2043 (unwind-protect 2039 (unwind-protect
2044 (progn 2040 (progn
2045 (save-excursion 2041 (save-excursion
2046 (goto-char pos) 2042 (overlay-put ol 'after-string message)
2047 ;; To avoid trouble with out-of-bounds position 2043 (goto-char pos)
2048 (setq pos (point)) 2044 ;; To avoid trouble with out-of-bounds position
2049 ;; defeat file locking... don't try this at home, kids! 2045 (setq pos (point))
2050 (setq buffer-file-name nil) 2046 ;; If the message end is off screen, recenter now.
2051 (insert-before-markers string) 2047 (if (<= (window-end nil t) pos)
2052 (setq insert-end (point)) 2048 (recenter (/ (window-height) 2))))
2053 ;; If the message end is off screen, recenter now. 2049 (message (or message "Type %s to continue editing.")
2054 (if (< (window-end nil t) insert-end) 2050 (single-key-description exit-char))
2055 (recenter (/ (window-height) 2))) 2051 (let (char)
2056 ;; If that pushed message start off the screen, 2052 (if (integerp exit-char)
2057 ;; scroll to start it at the top of the screen. 2053 (condition-case nil
2058 (move-to-window-line 0) 2054 (progn
2059 (if (> (point) pos) 2055 (setq char (read-char))
2060 (progn 2056 (or (eq char exit-char)
2061 (goto-char pos) 2057 (setq unread-command-events (list char))))
2062 (recenter 0)))) 2058 (error
2063 (message (or message "Type %s to continue editing.") 2059 ;; `exit-char' is a character, hence it differs
2064 (single-key-description exit-char)) 2060 ;; from char, which is an event.
2065 (let (char) 2061 (setq unread-command-events (list char))))
2066 (if (integerp exit-char) 2062 ;; `exit-char' can be an event, or an event description list.
2067 (condition-case nil 2063 (setq char (read-event))
2068 (progn 2064 (or (eq char exit-char)
2069 (setq char (read-char)) 2065 (eq char (event-convert-list exit-char))
2070 (or (eq char exit-char) 2066 (setq unread-command-events (list char))))))
2071 (setq unread-command-events (list char)))) 2067 (delete-overlay ol))))
2072 (error
2073 ;; `exit-char' is a character, hence it differs
2074 ;; from char, which is an event.
2075 (setq unread-command-events (list char))))
2076 ;; `exit-char' can be an event, or an event description
2077 ;; list.
2078 (setq char (read-event))
2079 (or (eq char exit-char)
2080 (eq char (event-convert-list exit-char))
2081 (setq unread-command-events (list char))))))
2082 (if insert-end
2083 (save-excursion
2084 (delete-region pos insert-end)))
2085 (setq buffer-file-name name)
2086 (set-buffer-modified-p modified))))
2087 2068
2088 2069
2089 ;;;; Overlay operations 2070 ;;;; Overlay operations
2090 2071
2091 (defun copy-overlay (o) 2072 (defun copy-overlay (o)