(fancy-splash-text): New variable.

(fancy-splash-delay, fancy-splash-image): New user-options.
(fancy-splash-insert, fancy-splash-head, fancy-splash-tail)
(fancy-splash-screens): New functions.
(command-line-1): If display has a `display' frame parameter, has
colors, and we have XPM support, show more fancy splash screens.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 41376f5b764d63f4eff564354f20e4381b61c001..faabcbd7430be97b7033ba9ac38e9e73d9292cb1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2000-09-19  Gerd Moellmann  <gerd@gnu.org>
+
+       * startup.el (fancy-splash-text): New variable.
+       (fancy-splash-delay, fancy-splash-image): New user-options.
+       (fancy-splash-insert, fancy-splash-head, fancy-splash-tail)
+       (fancy-splash-screens): New functions.
+       (command-line-1): If display has a `display' frame parameter, has
+       colors, and we have XPM support, show more fancy splash screens.
+       
 2000-09-19  Dave Love  <fx@gnu.org>
 
        * map-ynp.el (map-y-or-n-p): Check use-dialog-box.  Don't lose

diff --git a/lisp/startup.el b/lisp/startup.el
index cf6208becd1d83805eac54b8def44e8db43cd23a..bb2bb667be33a0b709c17ca2950ae7d4c7d76320 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -836,6 +836,119 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 If this is nil, no message will be displayed."
   :type 'string)
 
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fancy splash screen
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar fancy-splash-text
+  '((:face 'variable-pitch
+          "The menu bar and scroll bar are sufficient \
+for basic editing with the mouse.\n\n"
+          :face '(variable-pitch :weight bold)
+          "Useful Files menu items:\n"
+          :face 'variable-pitch "\
+Exit Emacs             (or type Control-x followed by Control-c)
+Recover Session                recover files you were editing before a crash
+
+
+"
+          )
+  (:face 'variable-pitch
+          "The menu bar and scroll bar are sufficient \
+for basic editing with the mouse.\n\n"
+          :face '(variable-pitch :weight bold)
+          "Important Help menu items:\n"
+          :face 'variable-pitch "\
+Emacs Tutorial         Learn-by-doing tutorial for using Emacs efficiently.
+Emacs FAQ              Frequently asked questions and answers
+\(Non)Warranty         GNU Emacs comes with "
+          :face '(variable-pitch :slant oblique)
+          "ABSOLUTELY NO WARRANTY\n"
+          :face `variable-pitch
+          "Copying Conditions  Conditions for redistributing and \
+changing Emacs\n"))
+  "A list of texts to show in the middle part of splash screens.
+Each element in the list should be a list of strings or pairs
+`:face FACE', like `fancy-splash-insert' accepts them.")
+
+
+(defcustom fancy-splash-delay 5
+  "Delay in seconds between splash screens."
+  :group 'splash-screen
+  :type 'integer)
+
+
+(defcustom fancy-splash-image "splash.xpm"
+  "The image to show in the splash screens."
+  :group 'splash-screen
+  :type 'file)
+
+
+(defun fancy-splash-insert (&rest args)
+  "Insert text into the current buffer, with faces.
+Arguments from ARGS should be either strings or pairs `:face FACE',
+where FACE is a valid face specification, as it can be used with
+`put-text-properties'."
+  (let ((current-face nil))
+    (while args
+      (if (eq (car args) :face)
+         (setq args (cdr args) current-face (car args))
+       (insert (propertize (car args) 'face current-face)))
+      (setq args (cdr args)))))
+
+
+(defun fancy-splash-head ()
+  "Insert the head part of the splash screen into the current buffer."
+  (let* ((img (create-image fancy-splash-image))
+        (image-width (and img (car (image-size img))))
+        (window-width (window-width (selected-window))))
+    (when img
+      (when (> window-width image-width)
+       (let ((pos (/ (- window-width image-width) 2)))
+         (insert (propertize " " 'display `(space :align-to ,pos))))
+       (insert-image img)
+       (insert "\n"))))
+  (when (eq system-type 'gnu/linux)
+    (fancy-splash-insert
+     :face '(variable-pitch :foreground "red")
+     "GNU Emacs is one component of a Linux-based GNU system."))
+  (insert "\n"))
+
+
+(defun fancy-splash-tail ()
+  "Insert the tail part of the splash screen into the current buffer."
+  (fancy-splash-insert
+   :face '(variable-pitch :foreground "darkblue")
+   "\nThis is "
+   (emacs-version)
+   "\n"
+   :face '(variable-pitch :height 0.5)
+   "Copyright (C) 2000 Free Software Foundation, Inc."))
+
+
+(defun fancy-splash-screens ()
+  (let* ((old-cursor-type cursor-type)
+        stop)
+    (unwind-protect
+       (progn
+         (setq cursor-type nil)
+         (while (not stop)
+           (let ((texts fancy-splash-text))
+             (while (and texts (not stop))
+               (erase-buffer)
+               (fancy-splash-head)
+               (apply #'fancy-splash-insert (car texts))
+               (fancy-splash-tail)
+               (goto-char (point-min))
+               (set-buffer-modified-p nil)
+               (force-mode-line-update)
+               (setq texts (cdr texts))
+               (setq stop (not (sit-for fancy-splash-delay)))))))
+      (setq cursor-type old-cursor-type))
+    (erase-buffer)))
+
+
 (defun command-line-1 (command-line-args-left)
   (or noninteractive (input-pending-p) init-file-had-error
       (and inhibit-startup-echo-area-message
@@ -910,8 +1023,11 @@ If this is nil, no message will be displayed."
                           (insert ", one component of a Linux-based GNU system."))
                       (insert "\n")
                       (if (assq 'display (frame-parameters))
-                          (progn
-                            (insert "\
+                          (if (and (display-color-p)
+                                   (image-type-available-p 'xpm))
+                              (fancy-splash-screens)
+                            (progn
+                              (insert "\
 The menu bar and scroll bar are sufficient for basic editing with the mouse.
 
 Useful Files menu items:
@@ -925,9 +1041,9 @@ Emacs FAQ          Frequently asked questions and answers
 Copying Conditions     Conditions for redistributing and changing Emacs.
 Getting New Versions   How to obtain the latest version of Emacs.
 ")
-                            (insert "\n\n" (emacs-version)
+                              (insert "\n\n" (emacs-version)
                                     "
-Copyright (C) 2000 Free Software Foundation, Inc."))
+Copyright (C) 2000 Free Software Foundation, Inc.")))
                         ;; If keys have their default meanings,
                         ;; use precomputed string to save lots of time.
                         (if (and (eq (key-binding "\C-h") 'help-command)