(fancy-splash-delay): Set to 10 seconds.

(fancy-splash-max-time): New user-option.
(fancy-splash-stop-time): New variable.
(fancy-splash-screens): Set it.  Catch `stop-splashing'.
(fancy-splash-screens-1): Throw `stop-splashing' when current
time is greater than fancy-splash-stop-time.
This commit is contained in:
Gerd Moellmann 2000-11-06 11:46:54 +00:00
parent 611dbdf022
commit e9da51a1d9
2 changed files with 41 additions and 19 deletions

View file

@ -1,3 +1,12 @@
2000-11-06 Gerd Moellmann <gerd@gnu.org>
* startup.el (fancy-splash-delay): Set to 10 seconds.
(fancy-splash-max-time): New user-option.
(fancy-splash-stop-time): New variable.
(fancy-splash-screens): Set it. Catch `stop-splashing'.
(fancy-splash-screens-1): Throw `stop-splashing' when current
time is greater than fancy-splash-stop-time.
2000-11-06 Stefan Monnier <monnier@cs.yale.edu> 2000-11-06 Stefan Monnier <monnier@cs.yale.edu>
* pcvs.el (cvs-mode-marked): New arg `noquery'. * pcvs.el (cvs-mode-marked): New arg `noquery'.

View file

@ -985,12 +985,19 @@ Each element in the list should be a list of strings or pairs
:group 'initialization) :group 'initialization)
(defcustom fancy-splash-delay 5 (defcustom fancy-splash-delay 10
"*Delay in seconds between splash screens." "*Delay in seconds between splash screens."
:group 'fancy-splash-screen :group 'fancy-splash-screen
:type 'integer) :type 'integer)
(defcustom fancy-splash-max-time 60
"*Show splash screens for at most this number of seconds.
Values less than 60 seconds are ignored."
:group 'fancy-splash-screen
:type 'integer)
(defcustom fancy-splash-image nil (defcustom fancy-splash-image nil
"*The image to show in the splash screens, or nil for defaults." "*The image to show in the splash screens, or nil for defaults."
:group 'fancy-splash-screen :group 'fancy-splash-screen
@ -1002,6 +1009,7 @@ Each element in the list should be a list of strings or pairs
(defvar fancy-current-text nil) (defvar fancy-current-text nil)
(defvar fancy-splash-help-echo nil) (defvar fancy-splash-help-echo nil)
(defvar fancy-splash-stop-time nil)
(defun fancy-splash-insert (&rest args) (defun fancy-splash-insert (&rest args)
@ -1076,6 +1084,8 @@ where FACE is a valid face specification, as it can be used with
(defun fancy-splash-screens-1 (buffer) (defun fancy-splash-screens-1 (buffer)
"Timer function displaying a splash screen." "Timer function displaying a splash screen."
(when (> (float-time) fancy-splash-stop-time)
(throw 'stop-splashing nil))
(unless fancy-current-text (unless fancy-current-text
(setq fancy-current-text fancy-splash-text)) (setq fancy-current-text fancy-splash-text))
(let ((text (car fancy-current-text))) (let ((text (car fancy-current-text)))
@ -1107,24 +1117,27 @@ where FACE is a valid face specification, as it can be used with
(let ((old-busy-cursor display-busy-cursor) (let ((old-busy-cursor display-busy-cursor)
(splash-buffer (current-buffer)) (splash-buffer (current-buffer))
timer) timer)
(unwind-protect (catch 'stop-splashing
(let ((map (make-sparse-keymap)) (unwind-protect
(show-help-function nil)) (let ((map (make-sparse-keymap))
(use-local-map map) (show-help-function nil))
(define-key map [t] 'fancy-splash-default-action) (use-local-map map)
(define-key map [mouse-movement] 'ignore) (define-key map [t] 'fancy-splash-default-action)
(setq cursor-type nil (define-key map [mouse-movement] 'ignore)
display-busy-cursor nil (setq cursor-type nil
buffer-undo-list t display-busy-cursor nil
mode-line-format buffer-undo-list t
(propertize "---- %b %-" 'face '(:weight bold)) mode-line-format
timer (run-with-timer 0 fancy-splash-delay (propertize "---- %b %-" 'face '(:weight bold))
#'fancy-splash-screens-1 fancy-splash-stop-time (+ (float-time)
splash-buffer)) (max 60 fancy-splash-max-time))
(recursive-edit)) timer (run-with-timer 0 fancy-splash-delay
(cancel-timer timer) #'fancy-splash-screens-1
(setq display-busy-cursor old-busy-cursor) splash-buffer))
(kill-buffer splash-buffer)))) (recursive-edit))
(cancel-timer timer)
(setq display-busy-cursor old-busy-cursor)
(kill-buffer splash-buffer)))))
(defun startup-echo-area-message () (defun startup-echo-area-message ()