comparison lisp/startup.el @ 32141:ad30e402b113

(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.

32140:6c61e0dbf542

	   (progn
	     (x-popup-menu nil (cdr (cdr (car submap))))
	     (if purify-flag
		 (garbage-collect))))
      (setq submap (cdr submap))))
  (setq define-key-rebound-commands t))

(defun command-line ()
  (setq command-line-default-directory default-directory)

  ;; Choose a reasonable location for temporary files.

  (interactive)
  (push last-command-event unread-command-events)
  (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)))))


(defun startup-echo-area-message ()
  (if (eq (key-binding "\C-h\C-p") 'describe-project)
      "For information about the GNU Project and its goals, type C-h C-p."

	     ;; It's important to notice the user settings before we
	     ;; 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)
	     ;; 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))
		 (unwind-protect
		     (when (not (input-pending-p))
		       (goto-char (point-max))
		       ;; The convention for this piece of code is that
		       ;; each piece of output starts with one or two newlines
		       ;; and does not end with any newlines.
		       (insert "Welcome to GNU Emacs")
		       (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
			       (insert "\
You can do basic editing with the menu bar and scroll bar using the mouse.

Useful Files menu items:

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)
				  (eq (key-binding "\C-xu") 'advertised-undo)
				  (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)

of Emacs and modify it; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version."))))
		       (goto-char (point-min))

		       (set-buffer-modified-p nil)
		       (sit-for 120)
		       )
		   (with-current-buffer (get-buffer "*scratch*")
		     (erase-buffer)
		     (and initial-scratch-message
			  (insert initial-scratch-message))
		     (set-buffer-modified-p nil)))))))
    ;; Delay 2 seconds after the init file error message
    ;; was displayed, so user can read it.
    (if init-file-had-error
	(sit-for 2))
    (let ((dir command-line-default-directory)

32141:ad30e402b113

	   (progn
	     (x-popup-menu nil (cdr (cdr (car submap))))
	     (if purify-flag
		 (garbage-collect))))
      (setq submap (cdr submap))))
    (setq define-key-rebound-commands t))

(defun command-line ()
  (setq command-line-default-directory default-directory)

  ;; Choose a reasonable location for temporary files.

  (interactive)
  (push last-command-event unread-command-events)
  (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."
  (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 ()
  (if (eq (key-binding "\C-h\C-p") 'describe-project)
      "For information about the GNU Project and its goals, type C-h C-p."

	     ;; It's important to notice the user settings before we
	     ;; display the startup message; otherwise, the settings
	     ;; won't take effect until the user gives the first
	     ;; keystroke, and that's distracting.
	     (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 (= (buffer-size) 0)
	       (let ((buffer-undo-list t)
		     (wait-for-input t))
		 (unwind-protect
		     (when (not (input-pending-p))
		       (goto-char (point-max))
		       ;; The convention for this piece of code is that
		       ;; each piece of output starts with one or two newlines
		       ;; and does not end with any newlines.
		       (insert "Welcome to GNU Emacs")
		       (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))
			       (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.

Useful Files menu items:

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)
				  (eq (key-binding "\C-xu") 'advertised-undo)
				  (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)

of Emacs and modify it; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version."))))
		       (goto-char (point-min))

		       (set-buffer-modified-p nil)
		       (when wait-for-input
			 (sit-for 120)))
		   
		   (with-current-buffer (get-buffer "*scratch*")
		     (erase-buffer)
		     (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
	(sit-for 2))
    (let ((dir command-line-default-directory)