From: Gerd Moellmann Date: Wed, 4 Oct 2000 19:01:37 +0000 (+0000) Subject: (fancy-splash-pending-command): New variable. X-Git-Tag: emacs-pretest-21.0.90~1161 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5b61c6a782b52f17a9f7e951eff00f007bbedf2f;p=emacs.git (fancy-splash-pending-command): New variable. (fancy-splash-pre-command): New function. (fancy-splash-screens): Rewritten. (command-line-1): If fancy-splash-pending-command is set, call it interactively. --- diff --git a/lisp/startup.el b/lisp/startup.el index ac29ad87a9e..ca7c2d4b403 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -495,7 +495,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (if purify-flag (garbage-collect)))) (setq submap (cdr submap)))) - (setq define-key-rebound-commands t)) + (setq define-key-rebound-commands t)) (defun command-line () (setq command-line-default-directory default-directory) @@ -998,40 +998,51 @@ where FACE is a valid face specification, as it can be used with (throw 'exit nil)) +(defvar fancy-splash-pending-command nil + "If non-nil, a command to be executed after the splash screen display.") + +(defun fancy-splash-pre-command () + (unless (memq this-command + '(ignore fancy-splash-default-action browse-url)) + (setq fancy-splash-pending-command this-command) + (throw 'exit nil))) + + (defun fancy-splash-screens () "Display fancy splash screens when Emacs starts." - (let ((old-buffer (current-buffer))) - (setq fancy-splash-help-echo (startup-echo-area-message)) - (switch-to-buffer "GNU Emacs") - (let ((old-local-map (current-local-map)) - (old-global-map (current-global-map)) - (old-busy-cursor display-busy-cursor) - (splash-buffer (current-buffer)) - (show-help-function nil) - (fontification-functions nil) - timer) - (unwind-protect - (let ((map (make-sparse-keymap))) - (setq map (nconc map '((t . fancy-splash-default-action)))) - (define-key map [mouse-movement] 'ignore) - (define-key map [menu-bar] (lookup-key old-global-map [menu-bar])) - (define-key map [tool-bar] (lookup-key old-global-map [tool-bar])) - (use-global-map map) - (use-local-map nil) - (setq cursor-type nil - display-busy-cursor nil - mode-line-format - (propertize "---- %b %-" 'face '(:weight bold))) - (setq timer (run-with-timer 0 5 #'fancy-splash-screens-1 - splash-buffer)) - (recursive-edit)) - (use-local-map old-local-map) - (use-global-map old-global-map) - (cancel-timer timer) - (switch-to-buffer old-buffer) - (kill-buffer splash-buffer) - (erase-buffer) - (setq display-busy-cursor old-busy-cursor))))) + (setq fancy-splash-help-echo (startup-echo-area-message)) + (switch-to-buffer "GNU Emacs") + (let ((old-global-map (current-global-map)) + (old-busy-cursor display-busy-cursor) + (splash-buffer (current-buffer)) + ;; Don't update menu bindings in the following. Since + ;; C-x etc. are not bound in the map installed below, + ;; there wouldn't be any bindings shown otherwise. + (update-menu-bindings nil) + timer) + (unwind-protect + (let ((map (nconc (make-sparse-keymap) + '((t . fancy-splash-default-action)))) + (show-help-function nil)) + (use-global-map map) + (use-local-map nil) + (define-key map [mouse-movement] 'ignore) + (define-key map [menu-bar] (lookup-key old-global-map [menu-bar])) + (define-key map [tool-bar] (lookup-key old-global-map [tool-bar])) + (setq cursor-type nil + display-busy-cursor nil + mode-line-format + (propertize "---- %b %-" 'face '(:weight bold)) + timer (run-with-timer 0 5 #'fancy-splash-screens-1 + splash-buffer)) + (add-hook 'pre-command-hook 'fancy-splash-pre-command) + (recursive-edit)) + (trace-to-stderr "EXITTT\n") + (cancel-timer timer) + (remove-hook 'pre-command-hook 'fancy-splash-pre-command) + (use-global-map old-global-map) + (setq display-busy-cursor old-busy-cursor) + (kill-buffer splash-buffer)))) (defun startup-echo-area-message () @@ -1093,19 +1104,22 @@ where FACE is a valid face specification, as it can be used with ;; display the startup message; otherwise, the settings ;; won't take effect until the user gives the first ;; keystroke, and that's distracting. - (if (fboundp 'frame-notice-user-settings) - (frame-notice-user-settings)) - - (and window-setup-hook - (run-hooks 'window-setup-hook)) - (setq window-setup-hook nil) + (when (fboundp 'frame-notice-user-settings) + (frame-notice-user-settings)) + + (when window-setup-hook + (run-hooks 'window-setup-hook) + (setq window-setup-hook nil)) + + (when (memq window-system '(x w32)) + (precompute-menubar-bindings)) + (setq menubar-bindings-done t) + ;; Do this now to avoid an annoying delay if the user ;; clicks the menu bar during the sit-for. - (when (memq window-system '(x w32)) - (precompute-menubar-bindings)) - (setq menubar-bindings-done t) (when (= (buffer-size) 0) - (let ((buffer-undo-list t)) + (let ((buffer-undo-list t) + (wait-for-input t)) (unwind-protect (when (not (input-pending-p)) (goto-char (point-max)) @@ -1116,11 +1130,15 @@ where FACE is a valid face specification, as it can be used with (if (eq system-type 'gnu/linux) (insert ", one component of a Linux-based GNU system.")) (insert "\n") + (if (assq 'display (frame-parameters)) + (if (or (and (display-color-p) (image-type-available-p 'xpm)) (image-type-available-p 'pbm)) - (fancy-splash-screens) + (progn + (setq wait-for-input nil) + (fancy-splash-screens)) (progn (insert "\ You can do basic editing with the menu bar and scroll bar using the mouse. @@ -1139,6 +1157,7 @@ Getting New Versions How to obtain the latest version of Emacs. (insert "\n\n" (emacs-version) " 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) @@ -1219,13 +1238,18 @@ Type \\[describe-distribution] for information on getting the latest version.")) (goto-char (point-min)) (set-buffer-modified-p nil) - (sit-for 120) - ) + (when wait-for-input + (sit-for 120))) + (with-current-buffer (get-buffer "*scratch*") (erase-buffer) - (and initial-scratch-message - (insert initial-scratch-message)) - (set-buffer-modified-p nil))))))) + (when initial-scratch-message + (insert initial-scratch-message)) + (set-buffer-modified-p nil)) + + (when fancy-splash-pending-command + (call-interactively fancy-splash-pending-command))))))) + ;; Delay 2 seconds after the init file error message ;; was displayed, so user can read it. (if init-file-had-error