changeset 83437:c415fd182aef

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
author Karoly Lorentey <lorentey@elte.hu>
date Fri, 30 Dec 2005 05:30:57 +0000
parents f67e432d150c
children dc3a189e9e3a
files README.multi-tty lisp/startup.el
diffstat 2 files changed, 62 insertions(+), 13 deletions(-) [+]
line wrap: on
line diff
--- a/README.multi-tty	Fri Dec 30 05:29:31 2005 +0000
+++ b/README.multi-tty	Fri Dec 30 05:30:57 2005 +0000
@@ -401,6 +401,31 @@
 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 @@
    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
 
--- a/lisp/startup.el	Fri Dec 30 05:29:31 2005 +0000
+++ b/lisp/startup.el	Fri Dec 30 05:30:57 2005 +0000
@@ -1290,7 +1290,6 @@
     (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 @@
     (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 @@
       (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 @@
 	  (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 @@
   (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 @@
 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