;;; startup.el --- process Emacs shell arguments
-;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; --iconic This option is passed on to term/x-win.el
;; -------------------------
;; Various X options for colors/fonts/geometry/title etc.
-;; These options are passed on to term/x-win.el which see. Certain
-;; of these are also found in term/pc-win.el
+;; These options are passed on to term/x-win.el which see.
;; -------------------------
;; FILE Visit FILE.
;; -visit FILE
(setq normal-top-level-add-subdirs-inode-list
(cons attrs normal-top-level-add-subdirs-inode-list))
(while contents
- (unless (member (car contents) '("." ".." "RCS" "CVS"))
+ ;; The lower-case variants of RCS and CVS are for DOS/Windows.
+ (unless (member (car contents) '("." ".." "RCS" "CVS" "rcs" "cvs"))
(when (and (string-match "\\`[[:alnum:]]" (car contents))
;; Avoid doing a `stat' when it isn't necessary
;; because that can cause trouble when an NFS server
("--foreground-color" . "-fg")
("--background-color" . "-bg")))
+(defconst tool-bar-images-pixel-height 24
+ "Height in pixels of images in the tool bar.")
+
+(defvar tool-bar-originally-present nil
+ "Non-nil if tool-bars are present before user and site init files are read.")
+
;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
(defun tty-handle-args (args)
(let ((rest nil))
(string= vc "simple"))
(setq version-control 'never))))
- (set-locale-environment nil)
-
;;! This has been commented out; I currently find the behavior when
;;! split-window-keep-point is nil disturbing, but if I can get used
;;! to it, then it would be better to eliminate the option.
(mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr error) ", "))))
'external-debugging-output)
+ (terpri 'external-debugging-output)
(setq window-system nil)
(kill-emacs)))
(not noninteractive))
(setq command-line-args (tty-handle-args command-line-args)))
+ (set-locale-environment nil)
+
(let ((done nil)
(args (cdr command-line-args)))
(and command-line-args (setcdr command-line-args args)))
;; Under X Windows, this creates the X frame and deletes the terminal frame.
- (if (fboundp 'frame-initialize)
- (frame-initialize))
+ (when (fboundp 'frame-initialize)
+ (frame-initialize))
+
;; If frame was created with a menu bar, set menu-bar-mode on.
(if (and (not noninteractive)
(or (not (memq window-system '(x w32)))
(when (and (not noninteractive)
(display-graphic-p)
(> (frame-parameter nil 'tool-bar-lines) 0))
- (tool-bar-mode t))
+ (tool-bar-mode 1))
;; Can't do this init in defcustom because window-system isn't set.
(when (and (not noninteractive)
(setq-default blink-cursor t)
(blink-cursor-mode 1))
+ (unless noninteractive
+ ;; DOS/Windows systems have a PC-type keyboard which has both
+ ;; <delete> and <backspace> keys.
+ (when (or (memq system-type '(ms-dos windows-nt))
+ (and (memq window-system '(x))
+ (fboundp 'x-backspace-delete-keys-p)
+ (x-backspace-delete-keys-p)))
+ (setq-default normal-erase-is-backspace t)
+ (normal-erase-is-backspace-mode 1)))
+
+ (when (and (not noninteractive)
+ (display-graphic-p)
+ (fboundp 'x-show-tip))
+ (setq-default tooltip-mode t)
+ (tooltip-mode 1))
+
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file.
(or (memq window-system '(x w32))
;; use the right colors, so clear them.
(clear-face-cache)))
- (run-hooks 'before-init-hook)
-
- ;; Run the site-start library if it exists. The point of this file is
- ;; that it is run before .emacs. There is no point in doing this after
- ;; .emacs; that is useless.
- (if site-run-file
- (load site-run-file t t))
-
- ;; Sites should not disable this. Only individuals should disable
- ;; the startup message.
- (setq inhibit-startup-message nil)
-
- ;; Load that user's init file, or the default one, or none.
- (let (debug-on-error-from-init-file
- debug-on-error-should-be-set
- (debug-on-error-initial
- (if (eq init-file-debug t) 'startup init-file-debug))
- (orig-enable-multibyte default-enable-multibyte-characters))
- (let ((debug-on-error debug-on-error-initial)
- ;; This function actually reads the init files.
- (inner
- (function
- (lambda ()
- (if init-file-user
- (let ((user-init-file-1
- (cond
- ((eq system-type 'ms-dos)
- (concat "~" init-file-user "/_emacs"))
- ((eq system-type 'windows-nt)
- (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
- "~/.emacs"
- "~/_emacs"))
- ((eq system-type 'vax-vms)
- "sys$login:.emacs")
- (t
- (concat "~" init-file-user "/.emacs")))))
- ;; This tells `load' to store the file name found
- ;; into user-init-file.
- (setq user-init-file t)
- (load user-init-file-1 t t)
- ;; If we did not find the user's init file,
- ;; set user-init-file conclusively to nil;
- ;; don't let it be set from default.el.
- (if (eq user-init-file t)
- (setq user-init-file nil))
- ;; If we loaded a compiled file, set
- ;; `user-init-file' to the source version if that
- ;; exists.
- (when (and user-init-file
- (equal (file-name-extension user-init-file)
- "elc")
- (file-exists-p user-init-file-1))
- (when (file-newer-than-file-p
- user-init-file-1 user-init-file)
- (message "Warning: %s is newer than %s"
- user-init-file-1 user-init-file)
- (sit-for 1))
- (setq user-init-file user-init-file-1))
- (or inhibit-default-init
- (let ((inhibit-startup-message nil))
- ;; Users are supposed to be told their rights.
- ;; (Plus how to get help and how to undo.)
- ;; Don't you dare turn this off for anyone
- ;; except yourself.
- (load "default" t t)))))))))
- (if init-file-debug
- ;; Do this without a condition-case if the user wants to debug.
- (funcall inner)
- (condition-case error
- (progn
- (funcall inner)
- (setq init-file-had-error nil))
- (error
- (let ((message-log-max nil))
- (save-excursion
- (set-buffer (get-buffer-create "*Messages*"))
- (insert "\n\n"
- (format "An error has occurred while loading `%s':\n\n"
- user-init-file)
- (format "%s%s%s"
- (get (car error) 'error-message)
- (if (cdr error) ": " "")
- (mapconcat 'prin1-to-string (cdr error) ", "))
- "\n\n"
- "To ensure normal operation, you should investigate the cause\n"
- "of the error in your initialization file and remove it. Start\n"
- "Emacs with the `--debug-init' option to view a complete error\n"
- "backtrace\n"))
- (message "Error in init file: %s%s%s"
- (get (car error) 'error-message)
- (if (cdr error) ": " "")
- (mapconcat 'prin1-to-string (cdr error) ", "))
- (pop-to-buffer "*Messages*")
- (setq init-file-had-error t)))))
- ;; If we can tell that the init file altered debug-on-error,
- ;; arrange to preserve the value that it set up.
- (or (eq debug-on-error debug-on-error-initial)
- (setq debug-on-error-should-be-set t
- debug-on-error-from-init-file debug-on-error)))
- (if debug-on-error-should-be-set
- (setq debug-on-error debug-on-error-from-init-file))
- (unless (or default-enable-multibyte-characters
- (eq orig-enable-multibyte default-enable-multibyte-characters))
- ;; Init file changed to unibyte. Reset existing multibyte
- ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
- ;; Arguably this should only be done if they're free of
- ;; multibyte characters.
- (mapcar (lambda (buffer)
- (with-current-buffer buffer
- (if enable-multibyte-characters
- (set-buffer-multibyte nil))))
- (buffer-list))
- ;; Also re-set the language environment in case it was
- ;; originally done before unibyte was set and is sensitive to
- ;; unibyte (display table, terminal coding system &c).
- (set-language-environment current-language-environment)))
-
- ;; Do this here in case the init file sets mail-host-address.
- (or user-mail-address
- (setq user-mail-address (concat (user-login-name) "@"
- (or mail-host-address
- (system-name)))))
-
+ ;; Record whether the tool-bar is present before the user and site
+ ;; init files are processed. frame-notice-user-settings uses this
+ ;; to determine if the tool-bar has been disabled by the init files,
+ ;; and the frame needs to be resized.
+ (when (fboundp 'frame-notice-user-settings)
+ (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
+ (assq 'tool-bar-lines default-frame-alist))))
+ (setq tool-bar-originally-present
+ (not (or (null tool-bar-lines)
+ (null (cdr tool-bar-lines))
+ (eq 0 (cdr tool-bar-lines)))))))
+
+ (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
+ (old-font-list-limit font-list-limit)
+ (old-face-ignored-fonts face-ignored-fonts))
+
+ (run-hooks 'before-init-hook)
+
+ ;; Run the site-start library if it exists. The point of this file is
+ ;; that it is run before .emacs. There is no point in doing this after
+ ;; .emacs; that is useless.
+ (if site-run-file
+ (load site-run-file t t))
+
+ ;; Sites should not disable this. Only individuals should disable
+ ;; the startup message.
+ (setq inhibit-startup-message nil)
+
+ ;; Load that user's init file, or the default one, or none.
+ (let (debug-on-error-from-init-file
+ debug-on-error-should-be-set
+ (debug-on-error-initial
+ (if (eq init-file-debug t) 'startup init-file-debug))
+ (orig-enable-multibyte default-enable-multibyte-characters))
+ (let ((debug-on-error debug-on-error-initial)
+ ;; This function actually reads the init files.
+ (inner
+ (function
+ (lambda ()
+ (if init-file-user
+ (let ((user-init-file-1
+ (cond
+ ((eq system-type 'ms-dos)
+ (concat "~" init-file-user "/_emacs"))
+ ((eq system-type 'windows-nt)
+ (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
+ "~/.emacs"
+ "~/_emacs"))
+ ((eq system-type 'vax-vms)
+ "sys$login:.emacs")
+ (t
+ (concat "~" init-file-user "/.emacs")))))
+ ;; This tells `load' to store the file name found
+ ;; into user-init-file.
+ (setq user-init-file t)
+ (load user-init-file-1 t t)
+
+ ;; If we did not find the user's init file,
+ ;; set user-init-file conclusively to nil;
+ ;; don't let it be set from default.el.
+ (if (eq user-init-file t)
+ (setq user-init-file nil))
+
+ ;; If we loaded a compiled file, set
+ ;; `user-init-file' to the source version if that
+ ;; exists.
+ (when (and user-init-file
+ (equal (file-name-extension user-init-file)
+ "elc"))
+ (let* ((source (file-name-sans-extension user-init-file))
+ (alt (concat source ".el")))
+ (setq source (cond ((file-exists-p alt) alt)
+ ((file-exists-p source) source)
+ (t nil)))
+ (when source
+ (when (file-newer-than-file-p source user-init-file)
+ (message "Warning: %s is newer than %s"
+ source user-init-file)
+ (sit-for 1))
+ (setq user-init-file source))))
+
+ (or inhibit-default-init
+ (let ((inhibit-startup-message nil))
+ ;; Users are supposed to be told their rights.
+ ;; (Plus how to get help and how to undo.)
+ ;; Don't you dare turn this off for anyone
+ ;; except yourself.
+ (load "default" t t)))))))))
+ (if init-file-debug
+ ;; Do this without a condition-case if the user wants to debug.
+ (funcall inner)
+ (condition-case error
+ (progn
+ (funcall inner)
+ (setq init-file-had-error nil))
+ (error
+ (let ((message-log-max nil))
+ (save-excursion
+ (set-buffer (get-buffer-create "*Messages*"))
+ (insert "\n\n"
+ (format "An error has occurred while loading `%s':\n\n"
+ user-init-file)
+ (format "%s%s%s"
+ (get (car error) 'error-message)
+ (if (cdr error) ": " "")
+ (mapconcat 'prin1-to-string (cdr error) ", "))
+ "\n\n"
+ "To ensure normal operation, you should investigate the cause\n"
+ "of the error in your initialization file and remove it. Start\n"
+ "Emacs with the `--debug-init' option to view a complete error\n"
+ "backtrace\n"))
+ (message "Error in init file: %s%s%s"
+ (get (car error) 'error-message)
+ (if (cdr error) ": " "")
+ (mapconcat 'prin1-to-string (cdr error) ", "))
+ (pop-to-buffer "*Messages*")
+ (setq init-file-had-error t)))))
+ ;; If we can tell that the init file altered debug-on-error,
+ ;; arrange to preserve the value that it set up.
+ (or (eq debug-on-error debug-on-error-initial)
+ (setq debug-on-error-should-be-set t
+ debug-on-error-from-init-file debug-on-error)))
+ (if debug-on-error-should-be-set
+ (setq debug-on-error debug-on-error-from-init-file))
+ (unless (or default-enable-multibyte-characters
+ (eq orig-enable-multibyte default-enable-multibyte-characters))
+ ;; Init file changed to unibyte. Reset existing multibyte
+ ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
+ ;; Arguably this should only be done if they're free of
+ ;; multibyte characters.
+ (mapcar (lambda (buffer)
+ (with-current-buffer buffer
+ (if enable-multibyte-characters
+ (set-buffer-multibyte nil))))
+ (buffer-list))
+ ;; Also re-set the language environment in case it was
+ ;; originally done before unibyte was set and is sensitive to
+ ;; unibyte (display table, terminal coding system &c).
+ (set-language-environment current-language-environment)))
+
+ ;; Do this here in case the init file sets mail-host-address.
+ (or user-mail-address
+ (setq user-mail-address (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name)))))
+
+ ;; If parameter have been changed in the init file which influence
+ ;; face realization, clear the face cache so that new faces will
+ ;; be realized.
+ (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
+ (eq font-list-limit old-font-list-limit)
+ (eq face-ignored-fonts old-face-ignored-fonts))
+ (clear-face-cache)))
+
(run-hooks 'after-init-hook)
;; If *scratch* exists and init file didn't change its mode, initialize it.
(defvar fancy-splash-text
'((:face variable-pitch
"You can do basic editing with the menu bar and scroll bar \
-using the mouse.\n\n"
- :face (variable-pitch :weight bold)
- "Useful Files menu items:\n"
- :face variable-pitch "\
-Exit Emacs\t(or type Control-x followed by Control-c)
-Recover Session\trecover files you were editing before a crash
-
-
-"
- )
- (:face variable-pitch
- "You can do basic editing with the menu bar and scroll bar \
using the mouse.\n\n"
:face (variable-pitch :weight bold)
"Important Help menu items:\n"
:face variable-pitch "\
-Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently.
+Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently
Emacs FAQ\tFrequently asked questions and answers
\(Non)Warranty\tGNU Emacs comes with "
:face (variable-pitch :slant oblique)
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
"\
-Copying Conditions\tConditions for redistributing and changing Emacs\n"))
+Copying Conditions\tConditions for redistributing and changing Emacs
+Ordering Manuals\tHow to order Emacs manuals from the Free Software Foundation\n")
+ (:face variable-pitch
+ "You can do basic editing with the menu bar and scroll bar \
+using the mouse.\n\n"
+ :face (variable-pitch :weight bold)
+ "Useful File menu items:\n"
+ :face variable-pitch "\
+Exit Emacs\t(Or type Control-x followed by Control-c)
+Recover Session\tRecover files you were editing before a crash
+
+
+
+"
+ ))
"A list of texts to show in the middle part of splash screens.
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")
(defun fancy-splash-head ()
"Insert the head part of the splash screen into the current buffer."
- (let* ((img (create-image (or fancy-splash-image
- (if (and (display-color-p)
- (image-type-available-p 'xpm))
- "splash.xpm" "splash.pbm"))))
+ (let* ((image-file (cond ((stringp fancy-splash-image)
+ fancy-splash-image)
+ ((and (display-color-p)
+ (image-type-available-p 'xpm))
+ (if (and (fboundp 'x-display-planes)
+ (= (funcall 'x-display-planes) 8))
+ "splash8.xpm"
+ "splash.xpm"))
+ (t "splash.pbm")))
+ (img (create-image image-file))
(image-width (and img (car (image-size img))))
(window-width (window-width (selected-window))))
(when img
(let ((pos (/ (- window-width image-width) 2)))
(insert (propertize " " 'display `(space :align-to ,pos))))
- ;; Change the color of the XPM version of the splash image
- ;; 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" . "gray"))))))
-
;; Insert the image with a help-echo and a keymap.
(let ((map (make-sparse-keymap))
(help-echo "mouse-2: browse http://www.gnu.org/"))
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
- "Copyright (C) 2000 Free Software Foundation, Inc.")))
+ "Copyright (C) 2001 Free Software Foundation, Inc.")))
(defun fancy-splash-screens-1 (buffer)
(setq fancy-splash-help-echo (startup-echo-area-message))
(switch-to-buffer "GNU Emacs")
(setq tab-width 20)
- (let ((old-busy-cursor display-busy-cursor)
+ (let ((old-hourglass display-hourglass)
(splash-buffer (current-buffer))
timer)
(catch 'stop-splashing
(unwind-protect
- (let ((map (make-sparse-keymap))
- (show-help-function nil))
+ (let ((map (make-sparse-keymap)))
(use-local-map map)
(define-key map [t] 'fancy-splash-default-action)
(define-key map [mouse-movement] 'ignore)
(setq cursor-type nil
- display-busy-cursor nil
+ display-hourglass nil
buffer-undo-list t
mode-line-format
(propertize "---- %b %-" 'face '(:weight bold))
splash-buffer))
(recursive-edit))
(cancel-timer timer)
- (setq display-busy-cursor old-busy-cursor)
+ (setq display-hourglass old-hourglass)
(kill-buffer splash-buffer)))))
+(defun use-fancy-splash-screens-p ()
+ "Return t if fancy splash screens should be used."
+ (when (or (and (display-color-p)
+ (image-type-available-p 'xpm))
+ (image-type-available-p 'pbm))
+ (let* ((img (create-image (or fancy-splash-image
+ (if (and (display-color-p)
+ (image-type-available-p 'xpm))
+ "splash.xpm" "splash.pbm"))))
+ (image-height (and img (cdr (image-size img))))
+ (window-height (1- (window-height (selected-window)))))
+ (> window-height (+ image-height 15)))))
+
+
(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."
(defun display-startup-echo-area-message ()
- (message (startup-echo-area-message)))
+ (let ((resize-mini-windows t))
+ (message (startup-echo-area-message))))
(defun command-line-1 (command-line-args-left)
(if (assq 'display (frame-parameters))
- (if (or (and (display-color-p)
- (image-type-available-p 'xpm))
- (image-type-available-p 'pbm))
+ (if (use-fancy-splash-screens-p)
(progn
(setq wait-for-input nil)
(fancy-splash-screens))
(insert "\
You can do basic editing with the menu bar and scroll bar using the mouse.
-Useful Files menu items:
+Useful File menu items:
Exit Emacs (or type Control-x followed by Control-c)
Recover Session recover files you were editing before a crash
\(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.
+Ordering Manuals How to order manuals from the FSF.
")
(insert "\n\n" (emacs-version)
"
-Copyright (C) 2000 Free Software Foundation, Inc.")))
+Copyright (C) 2001 Free Software Foundation, Inc.")))
;; If keys have their default meanings,
;; use precomputed string to save lots of time.
(insert "
Get help C-h (Hold down CTRL and press h)
Undo changes C-x u Exit Emacs C-x C-c
-Get a tutorial C-h t Use Info to read docs C-h i")
+Get a tutorial C-h t Use Info to read docs C-h i
+Ordering manuals C-h RET")
(insert (substitute-command-keys
(format "\n
Get help %s
Undo changes \\[advertised-undo]
Exit Emacs \\[save-buffers-kill-emacs]
Get a tutorial \\[help-with-tutorial]
-Use Info to read docs \\[info]"
+Use Info to read docs \\[info]
+Ordering manuals \\[view-order-manuals]"
(let ((where (where-is-internal
'help-command nil t)))
(if where
(insert "\n\n" (emacs-version)
"
-Copyright (C) 2000 Free Software Foundation, Inc.")
+Copyright (C) 2001 Free Software Foundation, Inc.")
(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))
HCoop / bpt / emacs.git / blobdiff