diff lisp/startup.el @ 83541:694bbb62a75d

Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-371 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-372 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-373 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-374 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-375 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-376 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-377 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-378 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-379 Merge from erc--emacs--21 * emacs@sv.gnu.org/emacs--devo--0--patch-380 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-381 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-382 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-383 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-384 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-385 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-386 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-387 Fix ERC bug introduced in last patch * emacs@sv.gnu.org/emacs--devo--0--patch-388 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-389 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-390 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-391 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-392 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-393 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-394 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-395 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-396 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-397 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-398 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-399 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-400 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-401 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-402 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-403 Rcirc update from Ryan Yeske * emacs@sv.gnu.org/emacs--devo--0--patch-404 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-405 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-406 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-407 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-408 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-409 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-410 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-411 Miscellaneous tq-related fixes. * emacs@sv.gnu.org/emacs--devo--0--patch-412 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-121 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-122 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-123 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-124 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-125 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-126 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-127 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-581
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 14 Oct 2006 16:56:21 +0000
parents 02e39decdc84 6cc945ca398a
children 2d56e13fd23d
line wrap: on
line diff
--- a/lisp/startup.el	Sun Jul 30 10:19:46 2006 +0000
+++ b/lisp/startup.el	Sat Oct 14 16:56:21 2006 +0000
@@ -1249,11 +1249,16 @@
        "GNU Emacs is one component of the GNU/Linux operating system."
      "GNU Emacs is one component of the GNU operating system."))
   (insert "\n")
-  (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
-    (fancy-splash-insert :face 'variable-pitch
-			 (substitute-command-keys
-			  "Type \\[recenter] to begin editing your file.\n"))))
-
+  (if fancy-splash-outer-buffer
+      (fancy-splash-insert
+       :face 'variable-pitch
+       (substitute-command-keys
+	(concat
+	 "Type \\[recenter] to begin editing"
+	 (if (equal (buffer-name fancy-splash-outer-buffer)
+		    "*scratch*")
+	     ".\n"
+	   " your file.\n"))))))
 
 (defun fancy-splash-tail ()
   "Insert the tail part of the splash screen into the current buffer."
@@ -1333,55 +1338,74 @@
   (if (frame-live-p frame)
       (run-at-time 0 nil 'fancy-splash-exit)))
 
-(defun fancy-splash-screens ()
+(defun fancy-splash-screens (&optional hide-on-input)
   "Display fancy splash screens when Emacs starts."
   (setq fancy-splash-help-echo (startup-echo-area-message))
-  (let ((old-hourglass display-hourglass)
-	(fancy-splash-outer-buffer (current-buffer))
-	splash-buffer
-	(old-minor-mode-map-alist minor-mode-map-alist)
-	(old-emulation-mode-map-alists emulation-mode-map-alists)
-	(frame (fancy-splash-frame))
-	timer)
-    (save-selected-window
-      (select-frame frame)
-      (switch-to-buffer "GNU Emacs")
-      (setq tab-width 20)
-      (setq splash-buffer (current-buffer))
-      (catch 'stop-splashing
-	(unwind-protect
-	    (let* ((map (make-sparse-keymap))
-		   (overriding-local-map map)
-		   ;; Catch if our frame is deleted; the delete-frame
-		   ;; event is unreliable and is handled by
-		   ;; `special-event-map' anyway.
-		   (delete-frame-functions (cons 'fancy-splash-delete-frame
-						 delete-frame-functions)))
-	      (define-key map [t] 'fancy-splash-default-action)
-	      (define-key map [mouse-movement] 'ignore)
-	      (define-key map [mode-line t] 'ignore)
-	      (define-key map [select-window] 'ignore)
-	      (setq cursor-type nil
-		    display-hourglass nil
-		    minor-mode-map-alist nil
-		    emulation-mode-map-alists nil
-		    buffer-undo-list t
-		    mode-line-format (propertize "---- %b %-"
-						 'face 'mode-line-buffer-id)
-		    fancy-splash-stop-time (+ (float-time)
-					      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-hourglass old-hourglass
-		minor-mode-map-alist old-minor-mode-map-alist
-		emulation-mode-map-alists old-emulation-mode-map-alists)
-	  (kill-buffer splash-buffer)
-	  (when (frame-live-p frame)
-	    (select-frame frame)
-	    (switch-to-buffer fancy-splash-outer-buffer)))))))
+  (if hide-on-input
+      (let ((old-hourglass display-hourglass)
+	    (fancy-splash-outer-buffer (current-buffer))
+	    splash-buffer
+	    (old-minor-mode-map-alist minor-mode-map-alist)
+	    (old-emulation-mode-map-alists emulation-mode-map-alists)
+	    (frame (fancy-splash-frame))
+	    timer)
+	(save-selected-window
+	  (select-frame frame)
+	  (switch-to-buffer "GNU Emacs")
+	  (setq tab-width 20)
+	  (setq splash-buffer (current-buffer))
+	  (catch 'stop-splashing
+	    (unwind-protect
+		(let* ((map (make-sparse-keymap))
+		       (overriding-local-map map)
+		       ;; Catch if our frame is deleted; the delete-frame
+		       ;; event is unreliable and is handled by
+		       ;; `special-event-map' anyway.
+		       (delete-frame-functions (cons 'fancy-splash-delete-frame
+						     delete-frame-functions)))
+		  (define-key map [t] 'fancy-splash-default-action)
+		  (define-key map [mouse-movement] 'ignore)
+		  (define-key map [mode-line t] 'ignore)
+		  (define-key map [select-window] 'ignore)
+		  (setq cursor-type nil
+			display-hourglass nil
+			minor-mode-map-alist nil
+			emulation-mode-map-alists nil
+			buffer-undo-list t
+			mode-line-format (propertize "---- %b %-"
+						     'face 'mode-line-buffer-id)
+			fancy-splash-stop-time (+ (float-time)
+						  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-hourglass old-hourglass
+		    minor-mode-map-alist old-minor-mode-map-alist
+		    emulation-mode-map-alists old-emulation-mode-map-alists)
+	      (kill-buffer splash-buffer)
+	      (when (frame-live-p frame)
+		(select-frame frame)
+		(switch-to-buffer fancy-splash-outer-buffer))))))
+    ;; If hide-on-input is non-nil, don't hide the buffer on input.
+    (if (or (window-minibuffer-p)
+	    (window-dedicated-p (selected-window)))
+	(pop-to-buffer (current-buffer))
+      (switch-to-buffer "GNU Emacs"))
+    (erase-buffer)
+    (if pure-space-overflow
+	(insert "\
+Warning Warning!!!  Pure space overflow    !!!Warning Warning
+\(See the node Pure Storage in the Lisp manual for details.)\n"))
+    (let (fancy-splash-outer-buffer)
+      (fancy-splash-head)
+      (dolist (text fancy-splash-text)
+	(apply #'fancy-splash-insert text))
+      (fancy-splash-tail)
+      (set-buffer-modified-p nil)
+      (goto-char (point-min)))))
+
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1412,14 +1436,16 @@
 	  (> window-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen ()
+(defun normal-splash-screen (&optional hide-on-input)
   "Display splash screen when Emacs starts."
   (let ((prev-buffer (current-buffer)))
     (unwind-protect
 	(with-current-buffer (get-buffer-create "GNU Emacs")
+	  (erase-buffer)
 	  (set (make-local-variable 'tab-width) 8)
-          (set (make-local-variable 'mode-line-format)
-               (propertize "---- %b %-" 'face 'mode-line-buffer-id))
+	  (if hide-on-input
+	      (set (make-local-variable 'mode-line-format)
+		   (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
 
           (if pure-space-overflow
               (insert "\
@@ -1435,9 +1461,13 @@
                ", one component of the GNU/Linux operating system.\n"
              ", a part of the GNU operating system.\n"))
 
-          (unless (equal (buffer-name prev-buffer) "*scratch*")
-            (insert (substitute-command-keys
-                     "\nType \\[recenter] to begin editing your file.\n")))
+	  (if hide-on-input
+	      (insert (substitute-command-keys
+		       (concat
+			"\nType \\[recenter] to begin editing"
+			(if (equal (buffer-name prev-buffer) "*scratch*")
+			    ".\n"
+			  " your file.\n")))))
 
           (if (display-mouse-p)
               ;; The user can use the mouse to activate menus
@@ -1548,20 +1578,23 @@
 		       "type M-x recover-session RET\nto recover"
 		       " the files you were editing."))
 
-	  ;; Display the input that we set up in the buffer.
-	  (set-buffer-modified-p nil)
-	  (goto-char (point-min))
-          (if (or (window-minibuffer-p)
-                  (window-dedicated-p (selected-window)))
-              ;; There's no point is using pop-to-buffer since creating
-              ;; a new frame will generate enough events that the
-              ;; subsequent `sit-for' will immediately return anyway.
-              nil ;; (pop-to-buffer (current-buffer))
-            (save-window-excursion
-              (switch-to-buffer (current-buffer))
-              (sit-for 120))))
-    ;; Unwind ... ensure splash buffer is killed
-    (kill-buffer "GNU Emacs"))))
+          ;; Display the input that we set up in the buffer.
+          (set-buffer-modified-p nil)
+          (goto-char (point-min))
+	  (if (or (window-minibuffer-p)
+		  (window-dedicated-p (selected-window)))
+	      ;; If hide-on-input is nil, creating a new frame will
+	      ;; generate enough events that the subsequent `sit-for'
+	      ;; will immediately return anyway.
+	      (pop-to-buffer (current-buffer))
+	    (if hide-on-input
+		(save-window-excursion
+		  (switch-to-buffer (current-buffer))
+		  (sit-for 120))
+	      (switch-to-buffer (current-buffer)))))
+      ;; Unwind ... ensure splash buffer is killed
+      (if hide-on-input
+	  (kill-buffer "GNU Emacs")))))
 
 
 (defun startup-echo-area-message ()
@@ -1615,7 +1648,7 @@
 	  (message "%s" (startup-echo-area-message))))))
 
 
-(defun display-splash-screen ()
+(defun display-splash-screen (&optional hide-on-input)
   "Display splash screen according to display.
 Fancy splash screens are used on graphic displays,
 normal otherwise."
@@ -1623,8 +1656,8 @@
   ;; Prevent recursive calls from server-process-filter.
   (if (not (get-buffer "GNU Emacs"))
       (if (use-fancy-splash-screens-p)
-	  (fancy-splash-screens)
-	(normal-splash-screen))))
+	  (fancy-splash-screens hide-on-input)
+	(normal-splash-screen hide-on-input))))
 
 (defun command-line-1 (command-line-args-left)
   (display-startup-echo-area-message)
@@ -1888,7 +1921,7 @@
     ;; If user typed input during all that work,
     ;; abort the startup screen.  Otherwise, display it now.
     (unless (input-pending-p)
-      (display-splash-screen))))
+      (display-splash-screen t))))
 
 
 (defun command-line-normalize-file-name (file)