Enhance splash screens to work better with emacsclient.

* lisp/startup.el (fancy-splash-screens): Use
  `overriding-terminal-local-map' to set up keymap.  Install a
  `delete-frame-functions' hook to catch `delete-frame' events.  Ignore
  `select-window' events to cope better with `focus-follows-mouse'.
  Don't switch back to the original buffer if the splash frame has been
  killed.  
  (normal-splash-screen): Don't let-bind `mode-line-format'; it changes
  the global binding---setq it instead.  
  (display-splash-screen): Don't do anything if the splash screen is
  already displayed elsewhere.
  (fancy-splash-exit, fancy-splash-delete-frame): New functions.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-477

2 files changed, 62 insertions, 13 deletions

diff --git a/README.multi-tty b/README.multi-tty
index f1a0cde7df4..de9b53b04e4 100644
--- a/README.multi-tty
+++ b/README.multi-tty
@@ -401,6 +401,31 @@ is probably not very interesting for anyone else.)
 THINGS TO DO
 ------------
 
+** `delete-frame' events are handled by `special-event-map'
+   immediately when read by `read_char'.  This is fine but it prevents
+   higher-level keymaps from binding that event to get notified of the
+   deleted frame.
+
+   Sometimes it would be useful for Lisp code to be notified of frame
+   deletions after they have happened, usually because they want to
+   clean up after the deleted frame.  Not all frame-local states can
+   be stored as a frame parameter.  For example,
+   `display-splash-screen' uses `recursive-edit' with a special keymap
+   override to create its buffer---and it leads to all kinds of
+   nastiness if Emacs stays in this recursive edit mode after the
+   frame containing the splash screen is deleted.  Basically, the
+   splash-screen implementation wants to throw out of the recursive
+   edit when the frame is deleted; however, it is not legal to throw
+   from `delete-frame-functions' because `delete-frame' must not fail.
+   (Introducing `delete-frame-after-functions' would not help either
+   because `delete-frame' may not fail at that time either.)
+
+   Currently `fancy-splash-screens' installs a
+   `delete-frame-functions' hook that sets up a timer to exit the
+   recursive edit.  This is an adequate solution, but it would perhaps
+   be better to have something like a `frame-deleted' event that could
+   be bound in the normal way.
+
 ** Trouble: `setenv' doesn't actually set environment variables in the
    Emacs process.  This defeats the purpose of the elaborate
    `server-with-environment' magic around the `tgetent' call in
@@ -1377,5 +1402,12 @@ DIARY OF CHANGES
    environment lists are now stored as frame parameters, so the
    C-level terminal parameters are not strictly necessary any more.)
 
+-- `Fdelete_frame' is called from various critical places where it is
+   not acceptable for the frame deletion to fail, e.g. from
+   x_connection_closed after an X error.  `Fdelete_frame' now protects
+   against `delete-frame-functions' throwing an error and preventing a
+   frame delete. (patch-475)
+
+
 ;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
 
diff --git a/lisp/startup.el b/lisp/startup.el
index 651bbb4d33d..6ae2163687a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1290,7 +1290,6 @@ where FACE is a valid face specification, as it can be used with
     (force-mode-line-update)
     (setq fancy-current-text (cdr fancy-current-text))))
 
-
 (defun fancy-splash-default-action ()
   "Stop displaying the splash screen buffer.
 This is an internal function used to turn off the splash screen after
@@ -1306,6 +1305,17 @@ mouse."
     (push last-command-event unread-command-events))
   (throw 'exit nil))
 
+(defun fancy-splash-exit ()
+  "Exit the splash screen."
+  (if (get-buffer "GNU Emacs")
+      (throw 'stop-splashing nil)))
+
+(defun fancy-splash-delete-frame (frame)
+  "Exit the splash screen after the frame is deleted."
+  ;; We can not throw from `delete-frame-events', so we set up a timer
+  ;; to exit the recursive edit as soon as Emacs is idle again.
+  (if (frame-live-p frame)
+      (run-at-time 0 nil 'fancy-splash-exit)))
 
 (defun fancy-splash-screens ()
   "Display fancy splash screens when Emacs starts."
@@ -1323,12 +1333,17 @@ mouse."
       (setq splash-buffer (current-buffer))
       (catch 'stop-splashing
         (unwind-protect
-            (let ((map (make-sparse-keymap)))
-              (use-local-map map)
-              (define-key map [switch-frame] 'ignore)
+            (let* ((map (make-sparse-keymap))
+                   (overriding-terminal-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
@@ -1345,7 +1360,9 @@ mouse."
           (setq display-hourglass old-hourglass
                 minor-mode-map-alist old-minor-mode-map-alist)
           (kill-buffer splash-buffer)
-          (switch-to-buffer fancy-splash-outer-buffer))))))
+          (when (frame-live-p frame)
+            (select-frame frame)
+            (switch-to-buffer fancy-splash-outer-buffer)))))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1381,10 +1398,9 @@ we put it on this frame."
   (let ((prev-buffer (current-buffer)))
     (unwind-protect
         (with-current-buffer (get-buffer-create "GNU Emacs")
-          (let ((tab-width 8)
-                (mode-line-format (propertize "---- %b %-"
-                                              'face '(:weight bold))))
-
+          (setq mode-line-format (propertize "---- %b %-"
+                                             'face '(:weight bold)))
+          (let ((tab-width 8))
             (if pure-space-overflow
                 (insert "Warning Warning  Pure space overflow   Warning Warning\n"))
 
@@ -1538,10 +1554,11 @@ Type \\[describe-distribution] for information on getting the latest version."))
 Fancy splash screens are used on graphic displays,
 normal otherwise."
   (interactive)
-  (if (use-fancy-splash-screens-p)
-      (fancy-splash-screens)
-    (normal-splash-screen)))
-
+  ;; 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))))
 
 (defun command-line-1 (command-line-args-left)
   (or noninteractive (input-pending-p) init-file-had-error