(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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 587ac7a72edf1803cfb04060a97c85094305d6c1..62276d314d9512bf223962ac9f62ec92a8cfcd0b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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>
 
        * pcvs.el (cvs-mode-marked): New arg `noquery'.

diff --git a/lisp/startup.el b/lisp/startup.el
index 40075d82bfe00b44cd85427f16747240c3cf6af5..1c0f9814cf17933fee93f9c4508e6aa7236befd5 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -985,12 +985,19 @@ Each element in the list should be a list of strings or pairs
   :group 'initialization)
 
 
-(defcustom fancy-splash-delay 5
+(defcustom fancy-splash-delay 10
   "*Delay in seconds between splash screens."
   :group 'fancy-splash-screen
   :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
   "*The image to show in the splash screens, or nil for defaults."
   :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-splash-help-echo nil)
+(defvar fancy-splash-stop-time nil)
 
 
 (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)
   "Timer function displaying a splash screen."
+  (when (> (float-time) fancy-splash-stop-time)
+    (throw 'stop-splashing nil))
   (unless fancy-current-text
     (setq fancy-current-text fancy-splash-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)
        (splash-buffer (current-buffer))
        timer)
-    (unwind-protect
-       (let ((map (make-sparse-keymap))
-             (show-help-function nil))
-         (use-local-map map)
-         (define-key map [t] 'fancy-splash-default-action)
-         (define-key map [mouse-movement] 'ignore)
-         (setq cursor-type nil
-               display-busy-cursor nil
-               buffer-undo-list t
-               mode-line-format
-               (propertize "---- %b %-" 'face '(:weight bold))
-               timer (run-with-timer 0 fancy-splash-delay
-                                     #'fancy-splash-screens-1
-                                     splash-buffer))
-         (recursive-edit))
-      (cancel-timer timer)
-      (setq display-busy-cursor old-busy-cursor)
-      (kill-buffer splash-buffer))))
+    (catch 'stop-splashing
+      (unwind-protect
+         (let ((map (make-sparse-keymap))
+               (show-help-function nil))
+           (use-local-map map)
+           (define-key map [t] 'fancy-splash-default-action)
+           (define-key map [mouse-movement] 'ignore)
+           (setq cursor-type nil
+                 display-busy-cursor nil
+                 buffer-undo-list t
+                 mode-line-format
+                 (propertize "---- %b %-" 'face '(:weight bold))
+                 fancy-splash-stop-time (+ (float-time)
+                                           (max 60 fancy-splash-max-time))
+                 timer (run-with-timer 0 fancy-splash-delay
+                                       #'fancy-splash-screens-1
+                                       splash-buffer))
+           (recursive-edit))
+         (cancel-timer timer)
+         (setq display-busy-cursor old-busy-cursor)
+         (kill-buffer splash-buffer)))))
 
 
 (defun startup-echo-area-message ()