From: Miles Bader Date: Tue, 21 Aug 2007 04:55:30 +0000 (+0000) Subject: Merge from emacs--devo--0 X-Git-Tag: emacs-pretest-23.0.90~11236^2~57 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1fb072d1dff954c21d4805196df62c8eeead301c;p=emacs.git Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 852-856) - Update from CVS - Merge from emacs--rel--22 * emacs--rel--22 (patch 93-96) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 245) - Update from CVS Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-32 --- 1fb072d1dff954c21d4805196df62c8eeead301c diff --cc lisp/startup.el index 453567556f5,53f120b0159..b5a5a225739 --- a/lisp/startup.el +++ b/lisp/startup.el @@@ -36,16 -36,22 +36,29 @@@ (defvar command-line-processed nil "Non-nil once command line has been processed.") +(defvar window-system initial-window-system + "Name of window system the selected frame is displaying through. +The value is a symbol--for instance, `x' for X windows. +The value is nil if the selected frame is on a text-only-terminal.") + +(make-variable-frame-local 'window-system) + (defgroup initialization nil "Emacs start-up procedure." - :group 'internal) + :group 'environment) + + (defcustom initial-buffer-choice nil + "Buffer to show after starting Emacs. + If the value is nil and `inhibit-splash-screen' is nil, show the + startup screen. If the value is string, visit the specified file or + directory using `find-file'. If t, open the `*scratch*' buffer." + :type '(choice + (const :tag "Splash screen" nil) + (directory :tag "Directory" :value "~/") + (file :tag "File" :value "~/file.txt") + (const :tag "Lisp scratch buffer" t)) + :version "23.1" + :group 'initialization) (defcustom inhibit-splash-screen nil "Non-nil inhibits the startup screen. @@@ -1344,36 -1386,16 +1370,37 @@@ Warning Warning!!! Pure space overflo (force-mode-line-update) (setq fancy-current-text (cdr fancy-current-text)))) -(defun exit-splash-screen () - "Stop displaying the splash screen buffer." +(defun fancy-splash-default-action () + "Stop displaying the splash screen buffer. +This is an internal function used to turn off the splash screen after +the user caused an input event by hitting a key or clicking with the +mouse." (interactive) - (if fancy-splash-outer-buffer - (throw 'exit nil) + (if (and (memq 'down (event-modifiers last-command-event)) + (eq (posn-window (event-start last-command-event)) + (selected-window))) + ;; This is a mouse-down event in the splash screen window. + ;; Ignore it and consume the corresponding mouse-up event. + (read-event) + (push last-command-event unread-command-events)) + (throw 'exit nil)) + - (defun fancy-splash-exit () ++(defun exit-splash-screen () + "Exit the splash screen." - (if (get-buffer "GNU Emacs") - (throw 'stop-splashing nil))) ++ (if (get-buffer "*About GNU Emacs*") ++ (throw 'stop-splashing nil) + (quit-window t))) +(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))) ++ (run-at-time 0 nil 'exit-splash-screen))) + - (defun fancy-splash-screens (&optional hide-on-input) + (defun fancy-splash-screens (&optional static) "Display fancy splash screens when Emacs starts." - (if hide-on-input + (if (not static) (let ((old-hourglass display-hourglass) (fancy-splash-outer-buffer (current-buffer)) splash-buffer @@@ -1389,35 -1408,8 +1413,33 @@@ (setq splash-buffer (current-buffer)) (catch 'stop-splashing (unwind-protect - (let ((cursor-type nil)) + (let* ((map (make-sparse-keymap)) + (cursor-type nil) + (overriding-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) + ;; Temporarily bind special events to + ;; fancy-splash-special-event-action so as to stop + ;; displaying splash screens with such events. + ;; Otherwise, drag-n-drop into splash screens may + ;; leave us in recursive editing with invisible + ;; cursors for a while. + (setq special-event-map (make-sparse-keymap)) + (map-keymap + (lambda (key def) + (define-key special-event-map (vector key) + (if (eq def 'ignore) + 'ignore + 'fancy-splash-special-event-action))) + old-special-event-map) (setq display-hourglass nil - minor-mode-map-alist nil - emulation-mode-map-alists nil buffer-undo-list t mode-line-format (propertize "---- %b %-" 'face 'mode-line-buffer-id) @@@ -1426,24 -1418,15 +1448,27 @@@ timer (run-with-timer 0 fancy-splash-delay #'fancy-splash-screens-1 splash-buffer)) + (use-local-map splash-screen-keymap) + (setq tab-width 22) (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. + (setq display-hourglass old-hourglass + minor-mode-map-alist old-minor-mode-map-alist + emulation-mode-map-alists old-emulation-mode-map-alists + special-event-map old-special-event-map) + (kill-buffer splash-buffer) + (when (frame-live-p frame) + (select-frame frame) + (switch-to-buffer fancy-splash-outer-buffer)) + (when fancy-splash-last-input-event + (setq last-input-event fancy-splash-last-input-event + fancy-splash-last-input-event nil) + (command-execute (lookup-key special-event-map + (vector last-input-event)) + nil (vector last-input-event) t)))))) + ;; If hide-on-input is nil, don't hide the buffer on input. (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) (pop-to-buffer (current-buffer)) @@@ -1550,107 -1523,226 +1574,227 @@@ Warning Warning!!! Pure space overflo (progn (insert "\ You can do basic editing with the menu bar and scroll bar using the mouse. - To quit a partially entered command, type Control-g. - - Useful File menu items: - Exit Emacs (or type Control-x followed by Control-c) - Recover Crashed Session Recover files you were editing before a crash - - Important Help menu items: - Emacs Tutorial Learn how to use Emacs efficiently - Emacs FAQ Frequently asked questions and answers - Read the Emacs Manual View the Emacs manual using Info - \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY - Copying Conditions Conditions for redistributing and changing Emacs - Getting New Versions How to obtain the latest version of Emacs - More Manuals / Ordering Manuals How to order printed manuals from the FSF - ") - (insert "\n\n" (emacs-version) + To quit a partially entered command, type Control-g.\n") + + (insert "\nImportant Help menu items:\n") + (insert-button "Emacs Tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert "\t\tLearn how to use Emacs efficiently\n") + (insert-button "Emacs FAQ" + 'action (lambda (button) (view-emacs-FAQ)) + 'follow-link t) + (insert "\t\tFrequently asked questions and answers\n") + (insert-button "Read the Emacs Manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert "\tView the Emacs manual using Info\n") + (insert-button "\(Non)Warranty" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") + (insert-button "Copying Conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert "\tConditions for redistributing and changing Emacs\n") + (insert-button "Getting New Versions" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert "\tHow to obtain the latest version of Emacs\n") + (insert-button "More Manuals / Ordering Manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert " How to order printed manuals from the FSF\n") + + (insert "\nUseful tasks:\n") + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert "\t\tSpecify a new file's name, to edit the file\n") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (insert "\tOpen your home directory, to operate on its files\n") + (insert-button "Open *scratch* buffer" + 'action (lambda (button) (switch-to-buffer + (get-buffer-create "*scratch*"))) + 'follow-link t) + (insert "\tOpen buffer for notes you don't want to save\n") + (insert-button "Customize Startup" + 'action (lambda (button) (customize-group 'initialization)) + 'follow-link t) + (insert "\tChange initialization settings including this screen\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright)) - ;; No mouse menus, so give help using kbd commands. - - ;; 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) - (eq (key-binding "\C-ht") 'help-with-tutorial) - (eq (key-binding "\C-hi") 'info) - (eq (key-binding "\C-hr") 'info-emacs-manual) - (eq (key-binding "\C-h\C-n") 'view-emacs-news)) + ;; No mouse menus, so give help using kbd commands. + + ;; 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-terminal) + (eq (key-binding "\C-ht") 'help-with-tutorial) + (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 " + (progn + (insert " Get help C-h (Hold down CTRL and press h) - Emacs manual C-h r - Emacs tutorial C-h t Undo changes C-x u - Buy manuals C-h C-m Exit Emacs C-x C-c - Browse manuals C-h i") + ") + (insert-button "Emacs manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert " C-h r\t") + (insert-button "Browse manuals" + 'action (lambda (button) (Info-directory)) + 'follow-link t) + (insert "\t C-h i + ") + (insert-button "Emacs tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert " C-h t\tUndo changes\t C-x u + ") + (insert-button "Buy manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert "\t C-h C-m\tExit Emacs\t C-x C-c")) - (insert (format " + (insert (substitute-command-keys + (format "\n Get help %s - Emacs manual \\[info-emacs-manual] - Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] - Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal] - Browse manuals \\[info]" - (let ((where (where-is-internal - 'help-command nil t))) - (if where - (key-description where) - "M-x help")))))) - - ;; Say how to use the menu bar with the keyboard. - (if (and (eq (key-binding "\M-`") 'tmm-menubar) - (eq (key-binding [f10]) 'tmm-menubar)) - (insert " - Activate menubar F10 or ESC ` or M-`") - (insert (substitute-command-keys " - Activate menubar \\[tmm-menubar]"))) + " + (let ((where (where-is-internal + 'help-command nil t))) + (if where + (key-description where) + "M-x help")))) + (insert-button "Emacs manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert (substitute-command-keys" \\[info-emacs-manual]\t")) + (insert-button "Browse manuals" + 'action (lambda (button) (Info-directory)) + 'follow-link t) + (insert (substitute-command-keys "\t \\[info] + ")) + (insert-button "Emacs tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert (substitute-command-keys + " \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo] + ")) + (insert-button "Buy manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert (substitute-command-keys + "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]"))) + + ;; Say how to use the menu bar with the keyboard. + (insert "\n") + (insert-button "Activate menubar" + 'action (lambda (button) (tmm-menubar)) + 'follow-link t) + (if (and (eq (key-binding "\M-`") 'tmm-menubar) + (eq (key-binding [f10]) 'tmm-menubar)) + (insert " F10 or ESC ` or M-`") + (insert (substitute-command-keys " \\[tmm-menubar]"))) - ;; Many users seem to have problems with these. - (insert " + ;; Many users seem to have problems with these. + (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 "\n\n" (emacs-version) + ;; Insert links to useful tasks + (insert "\nUseful tasks:\n") + + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert "\t\t\t") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (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 "\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright) - (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) - (eq (key-binding "\C-h\C-d") 'describe-distribution) - (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) + (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) + (eq (key-binding "\C-h\C-d") 'describe-distribution) + (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) - (insert - "\n - GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. + (progn + (insert + "\n + GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") + (insert-button "full details" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies - of Emacs and modify it; type C-h C-c to see the conditions. - Type C-h C-d for information on getting the latest version.") - (insert (substitute-command-keys - "\n - GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. + of Emacs and modify it; type C-h C-c to see ") + (insert-button "the conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert ". + Type C-h C-d for information on ") + (insert-button "getting the latest version" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert ".")) + (insert (substitute-command-keys + "\n + GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) + (insert-button "full details" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies - of Emacs and modify it; type \\[describe-copying] to see the conditions. - Type \\[describe-distribution] for information on getting the latest version.")))) + of Emacs and modify it; type \\[describe-copying] to see ")) + (insert-button "the conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert (substitute-command-keys". + Type \\[describe-distribution] for information on ")) + (insert-button "getting the latest version" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert "."))) - ;; The rest of the startup screen is the same on all - ;; kinds of terminals. - - ;; Give information on recovering, if there was a crash. - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (insert "\n\nIf an Emacs session crashed recently, " - "type Meta-x recover-session RET\nto recover" + ;; The rest of the startup screen is the same on all + ;; kinds of terminals. + + ;; Give information on recovering, if there was a crash. + (and auto-save-list-file-prefix + ;; Don't signal an error if the + ;; directory for auto-save-list files + ;; does not yet exist. + (file-directory-p (file-name-directory + auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))) + t) + (insert "\n\nIf an Emacs session crashed recently, " + "type Meta-x recover-session RET\nto recover" - " the files you were editing.")) + " the files you were editing.\n")) + + (use-local-map splash-screen-keymap) ;; Display the input that we set up in the buffer. (set-buffer-modified-p nil) @@@ -1658,23 -1750,25 +1802,23 @@@ (if (and view-read-only (not view-mode)) (view-mode-enter nil 'kill-buffer)) (goto-char (point-min)) - (if (not static) - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - ;; If static is nil, creating a new frame will - ;; generate enough events that the subsequent `sit-for' - ;; will immediately return anyway. - nil ;; (pop-to-buffer (current-buffer)) + (if hide-on-input + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + ;; If hide-on-input is nil, creating a new frame will + ;; generate enough events that the subsequent `sit-for' + ;; will immediately return anyway. + nil ;; (pop-to-buffer (current-buffer)) (save-window-excursion - (switch-to-buffer (current-buffer)) - (sit-for 120))) - (condition-case nil - (switch-to-buffer (current-buffer)) - ;; In case the window is dedicated or something. - (error (pop-to-buffer (current-buffer)))))) + (switch-to-buffer (current-buffer)) + (sit-for 120)) + (condition-case nil + (switch-to-buffer (current-buffer)))))) ;; Unwind ... ensure splash buffer is killed - (if hide-on-input - (kill-buffer "GNU Emacs") - (switch-to-buffer "GNU Emacs") - (rename-buffer "*About GNU Emacs*" t))))) + (if (not static) + (kill-buffer "*About GNU Emacs*") + (switch-to-buffer "*About GNU Emacs*") + (rename-buffer "*GNU Emacs*" t))))) (defun startup-echo-area-message () @@@ -1687,61 -1781,61 +1831,61 @@@ (defun display-startup-echo-area-message () (let ((resize-mini-windows t)) - (message "%s" (startup-echo-area-message)))) + (or noninteractive ;(input-pending-p) init-file-had-error + ;; t if the init file says to inhibit the echo area startup message. + (and inhibit-startup-echo-area-message + user-init-file + (or (and (get 'inhibit-startup-echo-area-message 'saved-value) + (equal inhibit-startup-echo-area-message + (if (equal init-file-user "") + (user-login-name) + init-file-user))) + ;; Wasn't set with custom; see if .emacs has a setq. + (let ((buffer (get-buffer-create " *temp*"))) + (prog1 + (condition-case nil + (save-excursion + (set-buffer buffer) + (insert-file-contents user-init-file) + (re-search-forward + (concat + "([ \t\n]*setq[ \t\n]+" + "inhibit-startup-echo-area-message[ \t\n]+" + (regexp-quote + (prin1-to-string + (if (equal init-file-user "") + (user-login-name) + init-file-user))) + "[ \t\n]*)") + nil t)) + (error nil)) + (kill-buffer buffer))))) + ;; display-splash-screen at the end of command-line-1 calls + ;; use-fancy-splash-screens-p. This can cause image.el to be + ;; loaded, putting "Loading image... done" in the echo area. + ;; This hides startup-echo-area-message. So + ;; use-fancy-splash-screens-p is called here simply to get the + ;; loading of image.el (if needed) out of the way before + ;; display-startup-echo-area-message runs. + (progn + (use-fancy-splash-screens-p) + (message "%s" (startup-echo-area-message)))))) - (defun display-splash-screen (&optional hide-on-input) + (defun display-splash-screen (&optional static) "Display splash screen according to display. Fancy splash screens are used on graphic displays, normal otherwise. With a prefix argument, any user input hides the splash screen." (interactive "P") - (if (use-fancy-splash-screens-p) - (fancy-splash-screens static) - (normal-splash-screen static))) - -(defalias 'about-emacs 'display-splash-screen) + ;; Prevent recursive calls from server-process-filter. - (if (not (get-buffer "GNU Emacs")) ++ (if (not (get-buffer "*About GNU Emacs*")) + (if (use-fancy-splash-screens-p) + (fancy-splash-screens hide-on-input) + (normal-splash-screen hide-on-input)))) (defun command-line-1 (command-line-args-left) - (or noninteractive (input-pending-p) init-file-had-error - ;; t if the init file says to inhibit the echo area startup message. - (and inhibit-startup-echo-area-message - user-init-file - (or (and (get 'inhibit-startup-echo-area-message 'saved-value) - (equal inhibit-startup-echo-area-message - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - ;; Wasn't set with custom; see if .emacs has a setq. - (let ((buffer (get-buffer-create " *temp*"))) - (prog1 - (condition-case nil - (save-excursion - (set-buffer buffer) - (insert-file-contents user-init-file) - (re-search-forward - (concat - "([ \t\n]*setq[ \t\n]+" - "inhibit-startup-echo-area-message[ \t\n]+" - (regexp-quote - (prin1-to-string - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - "[ \t\n]*)") - nil t)) - (error nil)) - (kill-buffer buffer))))) - ;; display-splash-screen at the end of command-line-1 calls - ;; use-fancy-splash-screens-p. This can cause image.el to be - ;; loaded, putting "Loading image... done" in the echo area. - ;; This hides startup-echo-area-message. So - ;; use-fancy-splash-screens-p is called here simply to get the - ;; loading of image.el (if needed) out of the way before - ;; display-startup-echo-area-message runs. - (progn - (use-fancy-splash-screens-p) - (display-startup-echo-area-message))) + (display-startup-echo-area-message) ;; Delay 2 seconds after an init file error message ;; was displayed, so user can read it. diff --cc src/term.c index 5d8e0f2a61f,63455f525da..c906e1eb15a --- a/src/term.c +++ b/src/term.c @@@ -1970,11 -2251,9 +1980,8 @@@ static char *default_set_background /* Save or restore the default color-related capabilities of this terminal. */ static void -tty_default_color_capabilities (save) - int save; +tty_default_color_capabilities (struct tty_display_info *tty, int save) { - static char - *default_orig_pair, *default_set_foreground, *default_set_background; - static int default_max_colors, default_max_pairs, default_no_color_video; if (save) {