emacs: lisp/startup.el comparison

comparison lisp/startup.el @ 82468:4f98fbdaf9ce

(splash-screen-keymap): Rename from `fancy-splash-keymap' because it's common to both types of splash screen: fancy and normal. Bind SPC to scroll-up, DEL to scroll-down and `q' to exit-splash-screen. (exit-splash-screen): Rename from `fancy-splash-quit'. Use `quit-window' instead of `kill-buffer'. (fancy-splash-head): Use make-button to insert GNU image link. (fancy-splash-screens, normal-splash-screen): Rename " About GNU Emacs" to "*About GNU Emacs*", and " GNU Emacs" to "*GNU Emacs*". (normal-splash-screen): Put "Browse manuals" on the same line with "Emacs manual". Remove descriptions from "Useful tasks" and put all links in two columns on two lines.

author	Juri Linkov <juri@jurta.org>
date	Sun, 19 Aug 2007 14:43:25 +0000
parents	71b7e41a7415
children	233c02d7607c

comparison

equal deleted inserted replaced

-:ff85cbd27ee2
+:4f98fbdaf9ce
 :group 'fancy-splash-screen
 :type '(choice (const :tag "Default" nil)
 		 (file :tag "File")))
-(defvar fancy-splash-keymap
+(defvar splash-screen-keymap
 (let ((map (make-sparse-keymap)))
 (suppress-keymap map)
 (set-keymap-parent map button-buffer-map)
+(define-key map "\C-?" 'scroll-down)
-(define-key map " " 'fancy-splash-quit)
+(define-key map " " 'scroll-up)
-(define-key map "q" 'fancy-splash-quit)
+(define-key map "q" 'exit-splash-screen)
 map)
 "Keymap for splash screen buffer.")
 ;; These are temporary storage areas for the splash screen display.
 	;; so that it is visible with a dark frame background.
 	(when (and (memq 'xpm img)
 		   (eq (frame-parameter nil 'background-mode) 'dark))
 	  (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
-	;; Insert the image with a help-echo and a keymap.
+	;; Insert the image with a help-echo and a link.
-	(let ((map (make-sparse-keymap))
+	(make-button (prog1 (point) (insert-image img)) (point)
-	      (help-echo "mouse-2: browse http://www.gnu.org/"))
+		     'face 'default
-	  (define-key map [mouse-2]
+		     'help-echo "mouse-2: browse http://www.gnu.org/"
-	    (lambda ()
+		     'action (lambda (button) (browse-url "http://www.gnu.org/"))
-	      (interactive)
+		     'follow-link t)
-	      (browse-url "http://www.gnu.org/")
-	      (throw 'exit nil)))
-	  (define-key map [down-mouse-2] 'ignore)
-	  (define-key map [up-mouse-2] 'ignore)
-	  (insert-image img (propertize "[image]" 'help-echo help-echo
-					'keymap map)))
 	(insert "\n"))))
 (fancy-splash-insert
 :face '(variable-pitch :foreground "red")
 (if (eq system-type 'gnu/linux)
 "GNU Emacs is one component of the GNU/Linux operating system."
 (set-buffer-modified-p nil)
 (goto-char (point-min))
 (force-mode-line-update)
 (setq fancy-current-text (cdr fancy-current-text))))
-(defun fancy-splash-quit ()
+(defun exit-splash-screen ()
 "Stop displaying the splash screen buffer."
 (interactive)
 (if fancy-splash-outer-buffer
 (throw 'exit nil)
-(kill-buffer (current-buffer))))
+(quit-window t)))
 (defun fancy-splash-screens (&optional static)
 "Display fancy splash screens when Emacs starts."
 (if (not static)
 (let ((old-hourglass display-hourglass)
 	    splash-buffer
 	    (frame (fancy-splash-frame))
 	    timer)
 	(save-selected-window
 	  (select-frame frame)
-	  (switch-to-buffer " About GNU Emacs")
+	  (switch-to-buffer "*About GNU Emacs*")
 	  (make-local-variable 'cursor-type)
 	  (setq splash-buffer (current-buffer))
 	  (catch 'stop-splashing
 	    (unwind-protect
 		(let ((cursor-type nil))
 			fancy-splash-stop-time (+ (float-time)
 						  fancy-splash-max-time)
 			timer (run-with-timer 0 fancy-splash-delay
 					      #'fancy-splash-screens-1
 					      splash-buffer))
-		  (use-local-map fancy-splash-keymap)
+		  (use-local-map splash-screen-keymap)
 		  (message "%s" (startup-echo-area-message))
 		  (setq buffer-read-only t)
 		  (recursive-edit))
 	      (cancel-timer timer)
 	      (setq display-hourglass old-hourglass)
 	      (kill-buffer splash-buffer)))))
 ;; If static is non-nil, don't show fancy splash screen.
 (if (or (window-minibuffer-p)
 	    (window-dedicated-p (selected-window)))
 	(pop-to-buffer (current-buffer))
-(switch-to-buffer " GNU Emacs"))
+(switch-to-buffer "*GNU Emacs*"))
 (setq buffer-read-only nil)
 (erase-buffer)
 (if pure-space-overflow
 	(insert "\
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 	(insert "\n"))
 (skip-chars-backward "\n")
 (delete-region (point) (point-max))
 (insert "\n")
 (fancy-splash-tail)
-(use-local-map fancy-splash-keymap)
+(use-local-map splash-screen-keymap)
 (set-buffer-modified-p nil)
 (setq buffer-read-only t)
 (if (and view-read-only (not view-mode))
 	  (view-mode-enter nil 'kill-buffer))
 (goto-char (point-min)))))
 (defun normal-splash-screen (&optional static)
 "Display splash screen when Emacs starts."
 (let ((prev-buffer (current-buffer)))
 (unwind-protect
-	(with-current-buffer (get-buffer-create " About GNU Emacs")
+	(with-current-buffer (get-buffer-create "*About GNU Emacs*")
 	  (setq buffer-read-only nil)
 	  (erase-buffer)
 	  (set (make-local-variable 'tab-width) 8)
 	  (if (not static)
 	      (set (make-local-variable 'mode-line-format)
 (eq (key-binding "\C-hi") 'info)
 (eq (key-binding "\C-hr") 'info-emacs-manual)
 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
 (insert "
 Get help	   C-h  (Hold down CTRL and press h)
-Emacs manual	   C-h r
+Emacs manual	   C-h r           Browse manuals   C-h i
 Emacs tutorial	   C-h t           Undo changes     C-x u
-Buy manuals        C-h C-m         Exit Emacs	    C-x C-c
+Buy manuals        C-h C-m         Exit Emacs	    C-x C-c")
-Browse manuals     C-h i")
 (insert (substitute-command-keys
-(format "\n
+(format "
 Get help	   %s
-Emacs manual	   \\[info-emacs-manual]
+Emacs manual	   \\[info-emacs-manual]\tBrowse manuals\t\\[info]
 Emacs tutorial	   \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
-Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
+Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]"
-Browse manuals     \\[info]"
 (let ((where (where-is-internal
 'help-command nil t)))
 (if where
 (key-description where)
 "M-x help"))))))
 (insert "
 \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
 If you have no Meta key, you may instead type ESC followed by the character.)")
 	    ;; Insert links to useful tasks
-	    (insert "\n\nUseful tasks (move point to the link and press RET):\n")
+	    (insert "\nUseful tasks:\n")
 	    (insert-button "Visit New File"
 			   'action (lambda (button) (call-interactively 'find-file))
 			   'follow-link t)
-	    (insert "		Specify a new file's name, to edit the file\n")
+	    (insert "\t\t\t")
 	    (insert-button "Open Home Directory"
 			   'action (lambda (button) (dired "~"))
 			   'follow-link t)
-	    (insert "	Open your home directory, to operate on its files\n")
+	    (insert "\n")
+	    (insert-button "Customize Startup"
+			   'action (lambda (button) (customize-group 'initialization))
+			   'follow-link t)
+	    (insert "\t\t")
 	    (insert-button "Open *scratch* buffer"
 			   'action (lambda (button) (switch-to-buffer
 						     (get-buffer-create "*scratch*")))
 			   'follow-link t)
-	    (insert "	Open buffer for notes you don't want to save\n")
+	    (insert "\n")
-	    (insert-button "Customize Startup"
-			   'action (lambda (button) (customize-group 'initialization))
-			   'follow-link t)
-	    (insert "	Change initialization settings including this screen\n")
 (insert "\n" (emacs-version)
 "\n" emacs-copyright)
 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
 t)
 (insert "\n\nIf an Emacs session crashed recently, "
 "type Meta-x recover-session RET\nto recover"
 " the files you were editing.\n"))
-	  (use-local-map button-buffer-map)
+	  (use-local-map splash-screen-keymap)
 ;; Display the input that we set up in the buffer.
 (set-buffer-modified-p nil)
 	  (setq buffer-read-only t)
 	  (if (and view-read-only (not view-mode))
 (switch-to-buffer (current-buffer))
 ;; In case the window is dedicated or something.
 (error (pop-to-buffer (current-buffer))))))
 ;; Unwind ... ensure splash buffer is killed
 (if (not static)
-	  (kill-buffer " About GNU Emacs")
+	  (kill-buffer "*About GNU Emacs*")
-	(switch-to-buffer " About GNU Emacs")
+	(switch-to-buffer "*About GNU Emacs*")
-	(rename-buffer " GNU Emacs" t)))))
+	(rename-buffer "*GNU Emacs*" t)))))
 (defun startup-echo-area-message ()
 (if (eq (key-binding "\C-h\C-p") 'describe-project)
 "For information about the GNU system and GNU/Linux, type C-h C-p."

Mercurial > emacs

comparison lisp/startup.el @ 82468:4f98fbdaf9ce