;;; startup.el --- process Emacs shell arguments
-;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; --terminal FILE Using this implies "-nw" also.
;; This option is handled by emacs.c
;; -------------------------
-;; -d DISPNAME Use DISPNAME as the name of the X-windows
+;; -d DISPNAME Use DISPNAME as the name of the X
;; -display DISPNAME display for the initial frame.
;; --display DISPNAME This option is handled by emacs.c
;; -------------------------
;; --debug-init debugger run.
;; -------------------------
;; -i ICONTYPE Set type of icon using when Emacs is
-;; -itype ICONTYPE iconified under X-windows.
+;; -itype ICONTYPE iconified under X.
;; --icon-type ICONTYPE This option is passed on to term/x-win.el
;;
-;; -iconic Start Emacs iconified under X-windows.
+;; -iconic Start Emacs iconified.
;; --iconic This option is passed on to term/x-win.el
;; -------------------------
-;; Various X-windows options for colors/fonts/geometry/title etc.
+;; 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
;; -------------------------
;; FILE Visit FILE.
+;; -visit FILE
+;; --visit FILE
+;; -file FILE
+;; --file FILE
;;
;; -L DIRNAME Add DIRNAME to load-path
;; -directory DIRNAME
;;
;; -eval FORM Execute Emacs lisp form FORM.
;; --eval FORM
+;; -execute EXPR
+;; --execute EXPR
;;
;; -insert FILE Insert the contents of FILE into buffer.
;; --insert FILE
;;; This is here, rather than in x-win.el, so that we can ignore these
;;; options when we are not using X.
-(defvar command-line-x-option-alist
+(defconst command-line-x-option-alist
'(("-bw" 1 x-handle-numeric-switch border-width)
("-d" 1 x-handle-display)
("-display" 1 x-handle-display)
("-font" 1 x-handle-switch font)
("-ib" 1 x-handle-numeric-switch internal-border-width)
("-g" 1 x-handle-geometry)
+ ("-lsp" 1 x-handle-numeric-switch line-spacing)
("-geometry" 1 x-handle-geometry)
("-fg" 1 x-handle-switch foreground-color)
("-foreground" 1 x-handle-switch foreground-color)
("--xrm" 1 x-handle-xrm-switch)
("--cursor-color" 1 x-handle-switch cursor-color)
("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
+ ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
("--border-color" 1 x-handle-switch border-width))
"Alist of X Windows options.
Each element has the form
:type '(choice (const :tag "none" nil) string)
:group 'initialization)
-(defconst iso-8859-n-locale-regexp "8859[-_]?\\([1-49]\\)"
- "Regexp that specifies when to enable an ISO 8859-N character set.
-We do that if this regexp matches the locale name
-specified by the LC_ALL, LC_CTYPE and LANG environment variables.
-The paren group in the regexp should match the specific character
-set number, N.")
-
(defcustom mail-host-address nil
"*Name of this machine, for purposes of naming users."
:type '(choice (const nil) string)
:group 'mail)
(defcustom auto-save-list-file-prefix
- (if (eq system-type 'ms-dos)
- "~/_s" ; MS-DOS cannot have initial dot, and allows only 8.3 names
- "~/.saves-")
+ (cond ((eq system-type 'ms-dos)
+ ;; MS-DOS cannot have initial dot, and allows only 8.3 names
+ "~/_emacs.d/auto-save.list/_s")
+ (t
+ "~/.emacs.d/auto-save-list/.saves-"))
"Prefix for generating `auto-save-list-file-name'.
This is used after reading your `.emacs' file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,
if you have not already set `auto-save-list-file-name' yourself.
+Directories in the prefix will be created if necessary.
Set this to nil if you want to prevent `auto-save-list-file-name'
from being initialized."
:type '(choice (const :tag "Don't record a session's auto save list" nil)
string)
:group 'auto-save)
-(defvar locale-translation-file-name
- (let ((files '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
- "/usr/X11R6/lib/X11/locale/locale.alias" ; e.g. RedHat 4.2
- "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
- ;;
- ;; The following name appears after the X-related names above,
- ;; since the X-related names are what X actually uses.
- "/usr/share/locale/locale.alias" ; GNU/Linux sans X
- )))
- (while (and files (not (file-exists-p (car files))))
- (setq files (cdr files)))
- (car files))
- "*File name for the system's file of locale-name aliases, or nil if none.")
-
(defvar init-file-debug nil)
(defvar init-file-had-error nil)
(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"))
- (when (and (string-match "\\`[a-zA-Z0-9]" (car contents))
+ ;; 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
+ ;; is down.
+ (not (string-match "\\.elc?\\'" (car contents)))
(file-directory-p (car contents)))
(let ((expanded (expand-file-name (car contents))))
(unless (file-exists-p (expand-file-name ".nosearch"
(let ((tail load-path)
(thisdir (directory-file-name default-directory)))
(while (and tail
+ ;;Don't go all the way to the nil terminator.
+ (cdr tail)
(not (equal thisdir (car tail)))
(not (and (memq system-type '(ms-dos windows-nt))
(equal (downcase thisdir) (downcase (car tail))))))
(setq tail (cdr tail)))
- (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))
+ ;;Splice the new section in.
+ (when tail
+ (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
(defun normal-top-level ()
(if command-line-processed
;; Look in each dir in load-path for a subdirs.el file.
;; If we find one, load it, which will add the appropriate subdirs
;; of that dir into load-path,
+ ;; Look for a leim-list.el file too. Loading it will register
+ ;; available input methods.
(let ((tail load-path)
new)
(while tail
(setq new (cons (car tail) new))
- (let ((default-directory (car tail)))
- (load (expand-file-name "subdirs.el" (car tail)) t t t))
+ (condition-case nil
+ (let ((default-directory (car tail)))
+ (load (expand-file-name "subdirs.el" (car tail)) t t t)))
+ (condition-case nil
+ (let ((default-directory (car tail)))
+ (load (expand-file-name "leim-list.el" (car tail)) t t t)))
(setq tail (cdr tail))))
(if (not (eq system-type 'vax-vms))
(progn
(setq auto-save-list-file-name
;; Under MS-DOS our PID is almost always reused between
;; Emacs invocations. We need something more unique.
- (if (eq system-type 'ms-dos)
- (concat
- (make-temp-name
- (expand-file-name auto-save-list-file-prefix))
- "~")
-
- (expand-file-name (format "%s%d-%s~"
- auto-save-list-file-prefix
- (emacs-pid)
- (system-name)))))))
+ (cond ((eq system-type 'ms-dos)
+ ;; We are going to access the auto-save
+ ;; directory, so make sure it exists.
+ (make-directory
+ (file-name-directory auto-save-list-file-prefix)
+ t)
+ (concat
+ (make-temp-name
+ (expand-file-name
+ auto-save-list-file-prefix))
+ "~"))
+ (t
+ (expand-file-name
+ (format "%s%d-%s~"
+ auto-save-list-file-prefix
+ (emacs-pid)
+ (system-name))))))))
(run-hooks 'emacs-startup-hook)
(and term-setup-hook
(run-hooks 'term-setup-hook))
;; ...-frame-alist.
(if (fboundp 'frame-notice-user-settings)
(frame-notice-user-settings))
+ (if (fboundp 'frame-set-background-mode)
+ ;; Set the faces for the initial background mode even if
+ ;; frame-notice-user-settings didn't (such as on a tty).
+ ;; frame-set-background-mode is idempotent, so it won't
+ ;; cause any harm if it's already been done.
+ (let ((frame-background-mode frame-background-mode)
+ (frame (selected-frame))
+ term)
+ (when (and (null window-system)
+ ;; Don't override a possibly customized value.
+ (null frame-background-mode)
+ ;; Don't override user specifications.
+ (null (frame-parameter frame 'reverse))
+ (let ((bg (frame-parameter frame 'background-color)))
+ (or (null bg)
+ (member bg '(unspecified "unspecified-bg")))))
+ (setq term (getenv "TERM"))
+ (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+ term)
+ (setq frame-background-mode 'light)))
+ (frame-set-background-mode (selected-frame))))
+
;; Now we know the user's default font, so add it to the menu.
(if (fboundp 'font-menu-add-default)
(font-menu-add-default))
(and window-setup-hook
(run-hooks 'window-setup-hook))
(or menubar-bindings-done
- (if (memq window-system '(x w32))
+ (if (display-popup-menus-p)
(precompute-menubar-bindings)))))))
;; Precompute the keyboard equivalents in the menu bar items.
(if purify-flag
(garbage-collect))))
(setq submap (cdr submap))))
- (setq define-key-rebound-commands t))
+ (setq define-key-rebound-commands t))
+
+;; Command-line options supported by tty's:
+(defconst tty-long-option-alist
+ '(("--name" . "-name")
+ ("--title" . "-T")
+ ("--reverse-video" . "-reverse")
+ ("--foreground-color" . "-fg")
+ ("--background-color" . "-bg")))
+
+;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
+(defun tty-handle-args (args)
+ (let ((rest nil))
+ (message "%s" args)
+ (while (and args
+ (not (equal (car args) "--")))
+ (let* ((this (car args))
+ (orig-this this)
+ completion argval)
+ (setq args (cdr args))
+ ;; Check for long options with attached arguments
+ ;; and separate out the attached option argument into argval.
+ (if (string-match "^--[^=]*=" this)
+ (setq argval (substring this (match-end 0))
+ this (substring this 0 (1- (match-end 0)))))
+ (when (string-match "^--" this)
+ (setq completion (try-completion this tty-long-option-alist))
+ (if (eq completion t)
+ ;; Exact match for long option.
+ (setq this (cdr (assoc this tty-long-option-alist)))
+ (if (stringp completion)
+ (let ((elt (assoc completion tty-long-option-alist)))
+ ;; Check for abbreviated long option.
+ (or elt
+ (error "Option `%s' is ambiguous" this))
+ (setq this (cdr elt)))
+ ;; Check for a short option.
+ (setq argval nil this orig-this))))
+ (cond ((or (string= this "-fg") (string= this "-foreground"))
+ (or argval (setq argval (car args) args (cdr args)))
+ (setq default-frame-alist
+ (cons (cons 'foreground-color argval)
+ default-frame-alist)))
+ ((or (string= this "-bg") (string= this "-background"))
+ (or argval (setq argval (car args) args (cdr args)))
+ (setq default-frame-alist
+ (cons (cons 'background-color argval)
+ default-frame-alist)))
+ ((or (string= this "-T") (string= this "-name"))
+ (or argval (setq argval (car args) args (cdr args)))
+ (setq default-frame-alist
+ (cons
+ (cons 'title
+ (if (stringp argval)
+ argval
+ (let ((case-fold-search t)
+ i)
+ (setq argval (invocation-name))
+
+ ;; Change any . or * characters in name to
+ ;; hyphens, so as to emulate behavior on X.
+ (while
+ (setq i (string-match "[.*]" argval))
+ (aset argval i ?-))
+ argval)))
+ default-frame-alist)))
+ ((or (string= this "-r")
+ (string= this "-rv")
+ (string= this "-reverse"))
+ (setq default-frame-alist
+ (cons '(reverse . t)
+ default-frame-alist)))
+ (t (setq rest (cons this rest))))))
+ (nreverse rest)))
(defun command-line ()
(setq command-line-default-directory default-directory)
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
(t
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))))
+ (setq small-temporary-file-directory
+ (if (eq system-type 'ms-dos)
+ (getenv "TMPDIR")))
;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL")))
(string= vc "simple"))
(setq version-control 'never))))
- (let ((ctype
- ;; Use the first of these three envvars that has a nonempty value.
- (or (let ((string (getenv "LC_ALL")))
- (and (not (equal string "")) string))
- (let ((string (getenv "LC_CTYPE")))
- (and (not (equal string "")) string))
- (let ((string (getenv "LANG")))
- (and (not (equal string "")) string)))))
- ;; Translate "swedish" into "sv_SE.ISO-8859-1", and so on,
- ;; using the translation file that GNU/Linux systems have.
- (and ctype
- locale-translation-file-name
- (not (string-match iso-8859-n-locale-regexp ctype))
- (with-temp-buffer
- (insert-file-contents locale-translation-file-name)
- (if (re-search-forward
- (concat "^" (regexp-quote ctype) ":?[ \t]+") nil t)
- (setq ctype (buffer-substring (point)
- (progn (end-of-line) (point)))))))
- ;; Now see if the locale specifies an ISO 8859 character set.
- (when (and ctype
- (string-match iso-8859-n-locale-regexp ctype))
- (let (charset (which (match-string 1 ctype)))
- (if (equal "9" which)
- (setq which "5"))
- (setq charset (concat "latin-" which))
- (when (string-match "latin-[12345]" charset)
- ;; Set up for this character set.
- ;; This is now the right way to do it
- ;; for both unibyte and multibyte modes.
- (set-language-environment charset)
- (unless (or noninteractive (eq window-system 'x))
- ;; Send those codes literally to a non-X terminal.
- (when default-enable-multibyte-characters
- ;; If this is nil, we are using single-byte characters,
- ;; so the terminal coding system is irrelevant.
- (set-terminal-coding-system
- (intern (downcase charset)))))
- (standard-display-european-internal)))))
-
;;! 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.
;;! ;; Choose a good default value for split-window-keep-point.
;;! (setq split-window-keep-point (> baud-rate 2400))
+ ;; Set the default strings to display in mode line for
+ ;; end-of-line formats that aren't native to this platform.
+ (cond
+ ((memq system-type '(ms-dos windows-nt emx))
+ (setq eol-mnemonic-unix "(Unix)")
+ (setq eol-mnemonic-mac "(Mac)"))
+ ;; Mac-specific settings should come here, once there's a
+ ;; system-type symbol specific to MacOS.
+ (t ; this is for Unix/GNU/Linux systems
+ (setq eol-mnemonic-dos "(DOS)")
+ (setq eol-mnemonic-mac "(Mac)")))
+
;; Read window system's init file if using a window system.
(condition-case error
(if (and window-system (not noninteractive))
(if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s"
(nth 1 error)
- (mapconcat '(lambda (obj) (prin1-to-string obj t))
+ (mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr (cdr error)) ", "))
(format "%s: %s"
(get (car error) 'error-message)
- (mapconcat '(lambda (obj) (prin1-to-string obj t))
+ (mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr error) ", "))))
'external-debugging-output)
(setq window-system nil)
(kill-emacs)))
+ ;; Windowed displays do this inside their *-win.el.
+ (when (and (not (display-graphic-p))
+ (not noninteractive))
+ (setq command-line-args (tty-handle-args command-line-args)))
+
+ (set-locale-environment nil)
+
(let ((done nil)
(args (cdr command-line-args)))
(if (fboundp 'frame-initialize)
(frame-initialize))
;; If frame was created with a menu bar, set menu-bar-mode on.
- (if (or (not (memq window-system '(x w32)))
- (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0))
+ (if (and (not noninteractive)
+ (or (not (memq window-system '(x w32)))
+ (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)))
(menu-bar-mode t))
+ ;; If frame was created with a tool bar, switch tool-bar-mode on.
+ (when (and (not noninteractive)
+ (display-graphic-p)
+ (> (frame-parameter nil 'tool-bar-lines) 0))
+ (tool-bar-mode t))
+
+ ;; Can't do this init in defcustom because window-system isn't set.
+ (when (and (not noninteractive)
+ (not (eq system-type 'ms-dos))
+ (memq window-system '(x w32)))
+ (setq-default blink-cursor t)
+ (blink-cursor-mode 1))
+
+ (when (and (not noninteractive)
+ ;; DOS/Windows systems have a PC-type keyboard which has both
+ ;; <delete> and <backspace> keys.
+ (or (memq system-type '(ms-dos windows-nt))
+ (memq window-system '(x))))
+ (setq-default delete-key-deletes-forward
+ (or (not (fboundp 'x-backspace-delete-keys-p))
+ (x-backspace-delete-keys-p)))
+ (delete-key-deletes-forward-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))
+ (not (tty-display-color-p))
+ (let* ((colors (cond ((eq window-system 'pc)
+ msdos-color-values)
+ ((eq system-type 'windows-nt)
+ w32-tty-standard-colors)
+ (t tty-standard-colors)))
+ (color (car colors)))
+ (while colors
+ (tty-color-define (car color) (cadr color) (cddr color))
+ (setq colors (cdr colors) color (car colors)))
+ ;; Modifying color mappings means realized faces don't
+ ;; 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
(if site-run-file
(load site-run-file t t))
- ;; Register available input methods by loading LEIM list file.
- (load "leim-list.el" 'noerror 'nomessage 'nosuffix)
-
;; Sites should not disable this. Only individuals should disable
;; the startup message.
(setq inhibit-startup-message nil)
(function
(lambda ()
(if init-file-user
- (progn
- (setq user-init-file
+ (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?\\)?$")
+ (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
"~/.emacs"
"~/_emacs"))
((eq system-type 'vax-vms)
"sys$login:.emacs")
(t
- (concat "~" init-file-user "/.emacs"))))
- (load user-init-file t 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.
(progn
(funcall inner)
(setq init-file-had-error nil))
- (error (message "Error in init file: %s%s%s"
- (get (car error) 'error-message)
- (if (cdr error) ": " "")
- (mapconcat 'prin1-to-string (cdr error) ", "))
- (setq init-file-had-error t))))
+ (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)
(set-buffer "*scratch*")
(if (eq major-mode 'fundamental-mode)
(funcall initial-major-mode))))
+
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
(and term-file-prefix (not noninteractive) (not window-system)
;; If -batch, terminate after processing the command options.
(if noninteractive (kill-emacs t)))
-(defcustom initial-scratch-message "\
-This buffer is for notes you don't want to save, and for Lisp evaluation.
-If you want to create a file, visit that file with C-x C-f,
-then enter the text in that file's own buffer.
+(defcustom initial-scratch-message (purecopy "\
+;; This buffer is for notes you don't want to save, and for Lisp evaluation.
+;; If you want to create a file, visit that file with C-x C-f,
+;; then enter the text in that file's own buffer.
-"
+")
"Initial message displayed in *scratch* buffer at startup.
If this is nil, no message will be displayed."
:type 'string)
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fancy splash screen
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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 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
+
+
+"
+ )
+ (: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 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"))
+ "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.")
+
+
+(defgroup fancy-splash-screen ()
+ "Fancy splash screen when Emacs starts."
+ :version "21.1"
+ :group 'initialization)
+
+
+(defcustom fancy-splash-delay 10
+ "*Delay in seconds between splash screens."
+ :group 'fancy-splash-screen
+ :type 'integer)
+
+
+(defcustom fancy-splash-max-time 60
+ "*Show splash screens for at most this number of seconds.
+Values less than 60 seconds are ignored."
+ :group 'fancy-splash-screen
+ :type 'integer)
+
+
+(defcustom fancy-splash-image nil
+ "*The image to show in the splash screens, or nil for defaults."
+ :group 'fancy-splash-screen
+ :type '(choice (const :tag "Default" nil)
+ (file :tag "File")))
+
+
+;; These are temporary storage areas for the splash screen display.
+
+(defvar fancy-current-text nil)
+(defvar fancy-splash-help-echo nil)
+(defvar fancy-splash-stop-time nil)
+
+
+(defun fancy-splash-insert (&rest args)
+ "Insert text into the current buffer, with faces.
+Arguments from ARGS should be either strings or pairs `:face FACE',
+where FACE is a valid face specification, as it can be used with
+`put-text-properties'."
+ (let ((current-face nil))
+ (while args
+ (if (eq (car args) :face)
+ (setq args (cdr args) current-face (car args))
+ (insert (propertize (car args)
+ 'face current-face
+ 'help-echo fancy-splash-help-echo)))
+ (setq args (cdr args)))))
+
+
+(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"))))
+ (image-width (and img (car (image-size img))))
+ (window-width (window-width (selected-window))))
+ (when img
+ (when (> window-width image-width)
+ ;; Center the image in the window.
+ (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/"))
+ (define-key map [mouse-2]
+ (lambda ()
+ (interactive)
+ (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 "xxx" 'help-echo help-echo
+ 'keymap map)))
+ (insert "\n"))))
+ (if (eq system-type 'gnu/linux)
+ (fancy-splash-insert
+ :face '(variable-pitch :foreground "red")
+ "GNU Emacs is one component of a Linux-based GNU system.")
+ (fancy-splash-insert
+ :face '(variable-pitch :foreground "red")
+ "GNU Emacs is one component of the GNU operating system."))
+ (insert "\n"))
+
+
+(defun fancy-splash-tail ()
+ "Insert the tail part of the splash screen into the current buffer."
+ (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
+ "cyan" "darkblue")))
+ (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
+ "\nThis is "
+ (emacs-version)
+ "\n"
+ :face '(variable-pitch :height 0.5)
+ "Copyright (C) 2000 Free Software Foundation, Inc.")))
+
+
+(defun fancy-splash-screens-1 (buffer)
+ "Timer function displaying a splash screen."
+ (when (> (float-time) fancy-splash-stop-time)
+ (throw 'stop-splashing nil))
+ (unless fancy-current-text
+ (setq fancy-current-text fancy-splash-text))
+ (let ((text (car fancy-current-text)))
+ (set-buffer buffer)
+ (erase-buffer)
+ (fancy-splash-head)
+ (apply #'fancy-splash-insert text)
+ (fancy-splash-tail)
+ (unless (current-message)
+ (message fancy-splash-help-echo))
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (force-mode-line-update)
+ (setq fancy-current-text (cdr fancy-current-text))))
+
+
+(defun fancy-splash-default-action ()
+ "Default action for events in the splash screen buffer."
+ (interactive)
+ (push last-command-event unread-command-events)
+ (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")
+ (setq tab-width 20)
+ (let ((old-busy-cursor display-busy-cursor)
+ (splash-buffer (current-buffer))
+ timer)
+ (catch 'stop-splashing
+ (unwind-protect
+ (let ((map (make-sparse-keymap))
+ (show-help-function nil))
+ (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
+ buffer-undo-list t
+ mode-line-format
+ (propertize "---- %b %-" 'face '(:weight bold))
+ fancy-splash-stop-time (+ (float-time)
+ (max 60 fancy-splash-max-time))
+ timer (run-with-timer 0 fancy-splash-delay
+ #'fancy-splash-screens-1
+ splash-buffer))
+ (recursive-edit))
+ (cancel-timer timer)
+ (setq display-busy-cursor old-busy-cursor)
+ (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 14)))))
+
+
+(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."
+ (substitute-command-keys
+ "For information about the GNU Project and its goals, type \
+\\[describe-project].")))
+
+
+(defun display-startup-echo-area-message ()
+ (message (startup-echo-area-message)))
+
+
(defun command-line-1 (command-line-args-left)
(or noninteractive (input-pending-p) init-file-had-error
- (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 (string= 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 (string= init-file-user "")
- (user-login-name)
- init-file-user)))
- "[ \t\n]*)")
- nil t))
- (error nil))
- (kill-buffer buffer)))))
- (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."
- (substitute-command-keys
- "For information about the GNU Project and its goals, type \\[describe-project]."))))
+ (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 (string= 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 (string= init-file-user "")
+ (user-login-name)
+ init-file-user)))
+ "[ \t\n]*)")
+ nil t))
+ (error nil))
+ (kill-buffer buffer)))))
+ (display-startup-echo-area-message))
(if (null command-line-args-left)
(cond ((and (not inhibit-startup-message) (not noninteractive)
;; Don't clobber a non-scratch buffer if init file
;; 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 (display-popup-menus-p)
+ (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.
- (if (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))
(if (eq system-type 'gnu/linux)
(insert ", one component of a Linux-based GNU system."))
(insert "\n")
+
(if (assq 'display (frame-parameters))
- (progn
- (insert "\
-The menu bar and scroll bar are sufficient for basic editing with the mouse.
-
-Useful Files menu items:
+
+ (if (use-fancy-splash-screens-p)
+ (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 File menu items:
Exit Emacs (or type Control-x followed by Control-c)
Recover Session recover files you were editing before a crash
Important Help menu items:
Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
+Emacs FAQ Frequently asked questions and answers
\(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.
")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 1999 Free Software Foundation, Inc."))
+ (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)
(insert (substitute-command-keys "
Activate menubar \\[tmm-menubar]")))
- ;; Windows and MSDOS (currently) do not count as
- ;; window systems, but do have mouse support.
- (if window-system
+ (if (display-mouse-p)
(insert "
Mode-specific menu C-mouse-3 (third button, with CTRL)"))
;; Many users seem to have problems with these.
\(`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.)")
(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
(insert "\n\n" (emacs-version)
"
-Copyright (C) 1999 Free Software Foundation, Inc.")
+Copyright (C) 2000 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))
(insert
"\n
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
-You may give out copies of Emacs; type C-h C-c to see the conditions.
+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.
-You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
+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."))))
(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))
+ (when 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
(file-count 0)
first-file-buffer
tem
- just-files ;; t if this follows the magic -- option.
+ just-files;; t if this follows the magic -- option.
;; This includes our standard options' long versions
;; and long versions of what's on command-switch-alist.
(longopts
(append '(("--funcall") ("--load") ("--insert") ("--kill")
- ("--directory") ("--eval") ("--find-file") ("--visit"))
- (mapcar '(lambda (elt)
- (list (concat "-" (car elt))))
+ ("--directory") ("--eval") ("--execute")
+ ("--find-file") ("--visit") ("--file"))
+ (mapcar (lambda (elt)
+ (list (concat "-" (car elt))))
command-switch-alist)))
(line 0))
(cons argval command-line-args-left)))
(funcall (cdr tem) argi))
(funcall (cdr tem) argi)))
- ((or (string-equal argi "-f") ;what the manual claims
+
+ ((or (string-equal argi "-f") ;what the manual claims
(string-equal argi "-funcall")
(string-equal argi "-e")) ; what the source used to say
(if argval
(if (arrayp (symbol-function tem))
(command-execute tem)
(funcall tem)))
- ((string-equal argi "-eval")
+
+ ((or (string-equal argi "-eval")
+ (string-equal argi "-execute"))
(if argval
(setq tem argval)
(setq tem (car command-line-args-left))
(setq command-line-args-left (cdr command-line-args-left)))
(eval (read tem)))
;; Set the default directory as specified in -L.
+
((or (string-equal argi "-L")
(string-equal argi "-directory"))
(if argval
(cons (expand-file-name tem) extra-load-path))
(setq load-path (append (nreverse extra-load-path)
initial-load-path)))
+
((or (string-equal argi "-l")
(string-equal argi "-load"))
(if argval
(if (file-exists-p (expand-file-name file))
(setq file (expand-file-name file)))
(load file nil t)))
+
((string-equal argi "-insert")
(if argval
(setq tem argval)
(or (stringp tem)
(error "File name omitted from `-insert' option"))
(insert-file-contents (command-line-normalize-file-name tem)))
+
((string-equal argi "-kill")
(kill-emacs t))
+
((string-match "^\\+[0-9]+\\'" argi)
(setq line (string-to-int argi)))
+
((setq tem (assoc argi command-line-x-option-alist))
;; Ignore X-windows options and their args if not using X.
(setq command-line-args-left
(nthcdr (nth 1 tem) command-line-args-left)))
+
((or (string-equal argi "-find-file")
+ (string-equal argi "-file")
(string-equal argi "-visit"))
;; An explicit option to specify visiting a file.
+ (if argval
+ (setq tem argval)
+ (setq tem (car command-line-args-left)
+ command-line-args-left (cdr command-line-args-left)))
+ (unless (stringp tem)
+ (error "File name omitted from `%s' option" argi))
(setq file-count (1+ file-count))
- (let ((file
- (expand-file-name
- (command-line-normalize-file-name orig-argi)
- dir)))
+ (let ((file (expand-file-name
+ (command-line-normalize-file-name tem) dir)))
(if (= file-count 1)
(setq first-file-buffer (find-file file))
(find-file-other-window file)))
(or (zerop line)
(goto-line line))
(setq line 0))
+
((equal argi "--")
(setq just-files t))
(t
(progn (other-window 1)
(buffer-menu)))))))
+
(defun command-line-normalize-file-name (file)
"Collapse multiple slashes to one, to handle non-Emacs file names."
(save-match-data
HCoop / bpt / emacs.git / blobdiff